From cbb553627ee866738d4531cf826bd4d87530d5c1 Mon Sep 17 00:00:00 2001 From: Weslley S Pereira Date: Mon, 27 Nov 2023 10:29:11 -0700 Subject: [PATCH 001/206] Enables Fortran before including CheckFortranFunctionExists in CMakeLists.txt --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index f1f47ae24f..5c3818db5d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -223,6 +223,7 @@ option(USE_OPTIMIZED_BLAS "Whether or not to use an optimized BLAS library inste # Check the usage of the user provided BLAS libraries if(BLAS_LIBRARIES) + enable_language(Fortran) include(CheckFortranFunctionExists) set(CMAKE_REQUIRED_LIBRARIES ${BLAS_LIBRARIES}) CHECK_FORTRAN_FUNCTION_EXISTS("dgemm" BLAS_FOUND) From 10432bb5e87a3990f23ff3a3611b014a4b7c49d7 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 12:52:15 +0000 Subject: [PATCH 002/206] Fixed `HAS_ATTRIBUTE_WEAK_SUPPORT` flag for CBLAS objects --- CBLAS/src/CMakeLists.txt | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 787638a2c4..3724852007 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -119,6 +119,9 @@ list(REMOVE_DUPLICATES SOURCES) add_library(${CBLASLIB}_obj OBJECT ${SOURCES}) set_target_properties(${CBLASLIB}_obj PROPERTIES POSITION_INDEPENDENT_CODE ON) +if(HAS_ATTRIBUTE_WEAK_SUPPORT) + target_compile_definitions(${CBLASLIB}_obj PRIVATE HAS_ATTRIBUTE_WEAK_SUPPORT) +endif() if(BUILD_INDEX64_EXT_API) # 64bit Integer Interface @@ -143,6 +146,9 @@ if(BUILD_INDEX64_EXT_API) LINKER_LANGUAGE C) target_compile_options(${CBLASLIB}_64_cobj PRIVATE -DWeirdNEC -DCBLAS_API64) target_compile_options(${CBLASLIB}_64_fobj PRIVATE ${FOPT_ILP64}) + if(HAS_ATTRIBUTE_WEAK_SUPPORT) + target_compile_definitions(${CBLASLIB}_64_cobj PRIVATE HAS_ATTRIBUTE_WEAK_SUPPORT) + endif() #Add suffix to all Fortran functions via macros foreach(F IN LISTS SOURCES_64_F) set(COPT_64_F) @@ -169,11 +175,8 @@ set_target_properties( SOVERSION ${LAPACK_MAJOR_VERSION} POSITION_INDEPENDENT_CODE ON ) -if(HAS_ATTRIBUTE_WEAK_SUPPORT) - target_compile_definitions(${CBLASLIB} PRIVATE HAS_ATTRIBUTE_WEAK_SUPPORT) -endif() + target_include_directories(${CBLASLIB} PUBLIC - $ $ ) target_link_libraries(${CBLASLIB} PUBLIC ${BLAS_LIBRARIES}) From 26db2da3eb84856d997e05caf9904a6b56eac1e8 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 14:30:30 +0000 Subject: [PATCH 003/206] Fixed Fortran compiler flags check for nagfor compiler and usage in CBLAS target --- CBLAS/CMakeLists.txt | 4 ++++ CMAKE/CheckLAPACKCompilerFlags.cmake | 1 + 2 files changed, 5 insertions(+) diff --git a/CBLAS/CMakeLists.txt b/CBLAS/CMakeLists.txt index c276f7da3d..b01d795af9 100644 --- a/CBLAS/CMakeLists.txt +++ b/CBLAS/CMakeLists.txt @@ -14,6 +14,10 @@ if(CMAKE_Fortran_COMPILER) FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/cblas_mangling.h MACRO_NAMESPACE "F77_" SYMBOL_NAMESPACE "F77_") + + # Check for any necessary platform specific compiler flags + include(CheckLAPACKCompilerFlags) + CheckLAPACKCompilerFlags() endif() if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND) message(WARNING "Reverting to pre-defined include/cblas_mangling.h") diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index ecb5009ae5..653b817583 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -177,6 +177,7 @@ elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" ) endif() # Suppress compiler banner and summary + include(CheckFortranCompilerFlag) check_fortran_compiler_flag("-quiet" _quiet) if( _quiet AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]quiet") ) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -quiet") From 8c54a57d66e7fa8839eaabd81b0236203ead22e7 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 14:31:16 +0000 Subject: [PATCH 004/206] Replaced non-standard `IMAG` function with its standard counterpart `AIMAG. --- SRC/claqp2rk.f | 6 +++--- SRC/claqp3rk.f | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/SRC/claqp2rk.f b/SRC/claqp2rk.f index 6b1db085aa..0501c50bb4 100755 --- a/SRC/claqp2rk.f +++ b/SRC/claqp2rk.f @@ -378,7 +378,7 @@ SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, EXTERNAL CLARF, CLARFG, CSWAP * .. * .. Intrinsic Functions .. - INTRINSIC ABS, REAL, CONJG, IMAG, MAX, MIN, SQRT + INTRINSIC ABS, REAL, CONJG, AIMAG, MAX, MIN, SQRT * .. * .. External Functions .. LOGICAL SISNAN @@ -599,8 +599,8 @@ SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * IF( SISNAN( REAL( TAU(KK) ) ) ) THEN TAUNAN = REAL( TAU(KK) ) - ELSE IF( SISNAN( IMAG( TAU(KK) ) ) ) THEN - TAUNAN = IMAG( TAU(KK) ) + ELSE IF( SISNAN( AIMAG( TAU(KK) ) ) ) THEN + TAUNAN = AIMAG( TAU(KK) ) ELSE TAUNAN = ZERO END IF diff --git a/SRC/claqp3rk.f b/SRC/claqp3rk.f index 3703bcbd65..8fe5a220ff 100755 --- a/SRC/claqp3rk.f +++ b/SRC/claqp3rk.f @@ -431,7 +431,7 @@ SUBROUTINE CLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL, EXTERNAL CGEMM, CGEMV, CLARFG, CSWAP * .. * .. Intrinsic Functions .. - INTRINSIC ABS, REAL, CONJG, IMAG, MAX, MIN, SQRT + INTRINSIC ABS, REAL, CONJG, AIMAG, MAX, MIN, SQRT * .. * .. External Functions .. LOGICAL SISNAN @@ -739,8 +739,8 @@ SUBROUTINE CLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL, * IF( SISNAN( REAL( TAU(K) ) ) ) THEN TAUNAN = REAL( TAU(K) ) - ELSE IF( SISNAN( IMAG( TAU(K) ) ) ) THEN - TAUNAN = IMAG( TAU(K) ) + ELSE IF( SISNAN( AIMAG( TAU(K) ) ) ) THEN + TAUNAN = AIMAG( TAU(K) ) ELSE TAUNAN = ZERO END IF From c69a96ea9ee407b1d7284303e9ea89ba23f88424 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 14:33:00 +0000 Subject: [PATCH 005/206] Added missing comma in `FORMAT` expression --- TESTING/LIN/alahd.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TESTING/LIN/alahd.f b/TESTING/LIN/alahd.f index 8f966c5841..a566d52716 100755 --- a/TESTING/LIN/alahd.f +++ b/TESTING/LIN/alahd.f @@ -954,7 +954,7 @@ SUBROUTINE ALAHD( IOUNIT, PATH ) $ 4X, '10. Random, Last columns are zero starting from', $ ' MINMN/2+1, CNDNUM = 2', / $ 4X, '11. Random, Half MINMN columns in the middle are', - $ ' zero starting from MINMN/2-(MINMN/2)/2+1,' + $ ' zero starting from MINMN/2-(MINMN/2)/2+1', $ ' CNDNUM = 2', / $ 4X, '12. Random, Odd columns are ZERO, CNDNUM = 2', / $ 4X, '13. Random, Even columns are ZERO, CNDNUM = 2', / From 2a0aea9c4c87a5f186bcaf19dd72a2b9223050cd Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 14:34:19 +0000 Subject: [PATCH 006/206] Added missing comma in `FORMAT` expression --- TESTING/LIN/alahd.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TESTING/LIN/alahd.f b/TESTING/LIN/alahd.f index a566d52716..c0334b5de9 100755 --- a/TESTING/LIN/alahd.f +++ b/TESTING/LIN/alahd.f @@ -954,7 +954,7 @@ SUBROUTINE ALAHD( IOUNIT, PATH ) $ 4X, '10. Random, Last columns are zero starting from', $ ' MINMN/2+1, CNDNUM = 2', / $ 4X, '11. Random, Half MINMN columns in the middle are', - $ ' zero starting from MINMN/2-(MINMN/2)/2+1', + $ ' zero starting from MINMN/2-(MINMN/2)/2+1,', $ ' CNDNUM = 2', / $ 4X, '12. Random, Odd columns are ZERO, CNDNUM = 2', / $ 4X, '13. Random, Even columns are ZERO, CNDNUM = 2', / From 3d2b9cbdcdfdde9f42d5de5ffe72893cd10b7c3f Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Nov 2023 15:18:49 +0000 Subject: [PATCH 007/206] Fixed memory leak in testing framework (`?chkaa.F`) --- TESTING/LIN/cchkaa.F | 2 ++ TESTING/LIN/dchkaa.F | 2 ++ TESTING/LIN/schkaa.F | 2 ++ TESTING/LIN/zchkaa.F | 2 ++ 4 files changed, 8 insertions(+) diff --git a/TESTING/LIN/cchkaa.F b/TESTING/LIN/cchkaa.F index 474454a519..57d95c7419 100644 --- a/TESTING/LIN/cchkaa.F +++ b/TESTING/LIN/cchkaa.F @@ -1232,6 +1232,8 @@ PROGRAM CCHKAA * DEALLOCATE (A, STAT = AllocateStatus) DEALLOCATE (B, STAT = AllocateStatus) + DEALLOCATE (E, STAT = AllocateStatus) + DEALLOCATE (S, STAT = AllocateStatus) DEALLOCATE (WORK, STAT = AllocateStatus) DEALLOCATE (RWORK, STAT = AllocateStatus) * diff --git a/TESTING/LIN/dchkaa.F b/TESTING/LIN/dchkaa.F index 74077eb94e..6582cac135 100755 --- a/TESTING/LIN/dchkaa.F +++ b/TESTING/LIN/dchkaa.F @@ -1076,6 +1076,8 @@ PROGRAM DCHKAA * DEALLOCATE (A, STAT = AllocateStatus) DEALLOCATE (B, STAT = AllocateStatus) + DEALLOCATE (E, STAT = AllocateStatus) + DEALLOCATE (S, STAT = AllocateStatus) DEALLOCATE (WORK, STAT = AllocateStatus) DEALLOCATE (RWORK, STAT = AllocateStatus) * diff --git a/TESTING/LIN/schkaa.F b/TESTING/LIN/schkaa.F index 2b9f2ea452..036b13924f 100644 --- a/TESTING/LIN/schkaa.F +++ b/TESTING/LIN/schkaa.F @@ -1070,6 +1070,8 @@ PROGRAM SCHKAA * DEALLOCATE (A, STAT = AllocateStatus) DEALLOCATE (B, STAT = AllocateStatus) + DEALLOCATE (E, STAT = AllocateStatus) + DEALLOCATE (S, STAT = AllocateStatus) DEALLOCATE (WORK, STAT = AllocateStatus) DEALLOCATE (RWORK, STAT = AllocateStatus) * diff --git a/TESTING/LIN/zchkaa.F b/TESTING/LIN/zchkaa.F index 57d71833f9..f1020f2d87 100644 --- a/TESTING/LIN/zchkaa.F +++ b/TESTING/LIN/zchkaa.F @@ -1268,6 +1268,8 @@ PROGRAM ZCHKAA * DEALLOCATE (A, STAT = AllocateStatus) DEALLOCATE (B, STAT = AllocateStatus) + DEALLOCATE (E, STAT = AllocateStatus) + DEALLOCATE (S, STAT = AllocateStatus) DEALLOCATE (RWORK, STAT = AllocateStatus) DEALLOCATE (WORK, STAT = AllocateStatus) * From 5b0687f429cf420629c0eeafba6a74a2564d4131 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 1 Dec 2023 14:05:54 +0000 Subject: [PATCH 008/206] Fixed search phrase for determining the amount of successful tests --- lapack_testing.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack_testing.py b/lapack_testing.py index ae59926b88..96fbeb2a68 100755 --- a/lapack_testing.py +++ b/lapack_testing.py @@ -136,7 +136,7 @@ def run_summary_test( f, cmdline, short_summary): for line in pipe.readlines(): f.write(str(line)) words_in_line=line.split() - if (line.find("run")!=-1): + if (line.find("run)")!=-1): # print line whereisrun=words_in_line.index("run)") nb_test_run+=int(words_in_line[whereisrun-2]) From 6032a6bca0ff108f8b985018bf9ca08efb97f818 Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Tue, 21 Nov 2023 13:55:54 +0700 Subject: [PATCH 009/206] handle and document corner cases of lwork in lapack, double precision --- SRC/dgebrd.f | 24 ++++++++----- SRC/dgehrd.f | 12 +++++-- SRC/dgelq.f | 2 +- SRC/dgelqf.f | 18 ++++++---- SRC/dgelsd.f | 2 +- SRC/dgemlq.f | 24 ++++++++----- SRC/dgemqr.f | 24 ++++++++----- SRC/dgeqlf.f | 8 +++-- SRC/dgeqp3rk.f | 3 +- SRC/dgeqr.f | 2 +- SRC/dgeqrfp.f | 22 ++++++++---- SRC/dgerqf.f | 2 +- SRC/dgesvj.f | 18 +++++++--- SRC/dgetri.f | 3 +- SRC/dgetsls.f | 7 ++-- SRC/dgetsqrhrt.f | 13 ++++--- SRC/dgges.f | 4 +-- SRC/dgges3.f | 15 ++++++-- SRC/dggev3.f | 12 ++++--- SRC/dgghd3.f | 14 +++++--- SRC/dggqrf.f | 2 +- SRC/dggrqf.f | 2 +- SRC/dggsvd3.f | 2 +- SRC/dggsvp3.f | 2 +- SRC/dlamswlq.f | 60 +++++++++++++++++++------------- SRC/dlamtsqr.f | 62 ++++++++++++++++++++-------------- SRC/dlaswlq.f | 51 +++++++++++++++++----------- SRC/dlatrs3.f | 23 ++++++++++--- SRC/dlatsqr.f | 43 ++++++++++++++--------- SRC/dsyev_2stage.f | 2 +- SRC/dsyevd.f | 3 +- SRC/dsyevr_2stage.f | 16 ++++++--- SRC/dsyevx.f | 4 +-- SRC/dsysv_aa.f | 4 +-- SRC/dsysv_aa_2stage.f | 15 ++++---- SRC/dsysvx.f | 7 ++-- SRC/dsytrd.f | 2 +- SRC/dsytrd_2stage.f | 27 +++++++++------ SRC/dsytrd_sb2st.F | 29 ++++++++++------ SRC/dsytrd_sy2sb.f | 16 ++++++--- SRC/dsytrf.f | 2 +- SRC/dsytrf_aa.f | 2 +- SRC/dsytrf_aa_2stage.f | 18 +++++----- SRC/dsytrf_rk.f | 4 +-- SRC/dsytrf_rook.f | 2 +- SRC/dsytri2.f | 14 +++++--- SRC/dsytri_3.f | 19 +++++++---- SRC/dsytrs_aa.f | 25 ++++++++++---- TESTING/LIN/dchksy_aa_2stage.f | 5 ++- TESTING/LIN/ddrvsy_aa_2stage.f | 4 +-- 50 files changed, 443 insertions(+), 253 deletions(-) diff --git a/SRC/dgebrd.f b/SRC/dgebrd.f index f350e2191d..ac11d48a0b 100644 --- a/SRC/dgebrd.f +++ b/SRC/dgebrd.f @@ -122,7 +122,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,M,N). +*> The length of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise. *> For optimum performance LWORK >= (M+N)*NB, where NB *> is the optimal blocksize. *> @@ -223,8 +224,8 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX, WS + INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT, + $ MINMN, NB, NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL DGEBD2, DGEMM, DLABRD, XERBLA @@ -241,9 +242,17 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Test the input parameters * INFO = 0 - NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = ( M+N )*NB + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = MAX( M, N ) + NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) ) + LWKOPT = ( M+N )*NB + ENDIF WORK( 1 ) = DBLE( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -251,7 +260,7 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.LT.0 ) THEN @@ -263,7 +272,6 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * * Quick return if possible * - MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -282,7 +290,7 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Determine when to switch from blocked to unblocked code. * IF( NX.LT.MINMN ) THEN - WS = ( M+N )*NB + WS = LWKOPT IF( LWORK.LT.WS ) THEN * * Not enough work space for the optimal NB, consider using diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index 67825c93bd..2b1b88af10 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -89,7 +89,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -225,8 +225,13 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, -1 ) ) - LWKOPT = N*NB + TSIZE + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, + $ -1 ) ) + LWKOPT = N*NB + TSIZE + ENDIF WORK( 1 ) = LWKOPT END IF * @@ -344,6 +349,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * Use unblocked code to reduce the rest of the matrix * CALL DGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) +* WORK( 1 ) = LWKOPT * RETURN diff --git a/SRC/dgelq.f b/SRC/dgelq.f index 3dd72d8bc6..255e8732f2 100644 --- a/SRC/dgelq.f +++ b/SRC/dgelq.f @@ -98,7 +98,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 331d7a42e0..f0eb00a55d 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -93,7 +93,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,M). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise. *> For optimum performance LWORK >= M*NB, where NB is the *> optimal blocksize. *> @@ -174,9 +175,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Test the input arguments * INFO = 0 + K = MIN( M, N ) NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - LWKOPT = M*NB - WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -184,19 +184,25 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGELQF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = M*NB + END IF + WORK( 1 ) = LWKOPT RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/dgelsd.f b/SRC/dgelsd.f index 036cf379c8..7dc564f481 100644 --- a/SRC/dgelsd.f +++ b/SRC/dgelsd.f @@ -276,7 +276,7 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ LOG( TWO ) ) + 1, 0 ) * IF( INFO.EQ.0 ) THEN - MAXWRK = 0 + MAXWRK = 1 LIWORK = 3*MINMN*NLVL + 11*MINMN MM = M IF( M.GE.N .AND. M.GE.MNTHR ) THEN diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f index 841f7612ce..757683f467 100644 --- a/SRC/dgemlq.f +++ b/SRC/dgemlq.f @@ -111,13 +111,14 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -188,7 +189,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -204,7 +205,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) @@ -219,6 +220,13 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = M * MB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN @@ -247,12 +255,12 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LW + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN @@ -264,7 +272,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -277,7 +285,7 @@ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ MB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = LW + WORK( 1 ) = LWMIN * RETURN * diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f index 236cbae129..6088154837 100644 --- a/SRC/dgemqr.f +++ b/SRC/dgemqr.f @@ -111,13 +111,14 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -189,7 +190,7 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -205,7 +206,7 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) @@ -220,6 +221,13 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = MB * NB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN @@ -248,12 +256,12 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LW + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN @@ -265,7 +273,7 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -278,7 +286,7 @@ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ NB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = LW + WORK( 1 ) = LWMIN * RETURN * diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index b97eaab51a..a72d9dc766 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -88,7 +88,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is the *> optimal blocksize. *> @@ -188,8 +189,9 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) END IF WORK( 1 ) = LWKOPT * - IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF END IF * diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f index 117a68287f..ee9bc7f39a 100755 --- a/SRC/dgeqp3rk.f +++ b/SRC/dgeqp3rk.f @@ -427,7 +427,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*. LWORK >= (3*N + NRHS - 1) +*> LWORK >= 1, if MIN(M,N) = 0, +*> LWORK >= (3*N + NRHS - 1), otherwise. *> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )), *> where NB is the optimal block size for DGEQP3RK returned *> by ILAENV. Minimal block size MINNB=2. diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f index c7d1af0f0a..0ded941327 100644 --- a/SRC/dgeqr.f +++ b/SRC/dgeqr.f @@ -99,7 +99,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f index dd7c7b5f8b..aa757e96cf 100644 --- a/SRC/dgeqrfp.f +++ b/SRC/dgeqrfp.f @@ -97,7 +97,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -162,8 +163,8 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, - $ NBMIN, NX + INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT, + $ NB, NBMIN, NX * .. * .. External Subroutines .. EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA @@ -181,8 +182,16 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB + K = MIN( M, N ) + IF( K.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = N + LWKOPT = N*NB + END IF WORK( 1 ) = LWKOPT +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -190,7 +199,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF IF( INFO.NE.0 ) THEN @@ -202,7 +211,6 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -210,7 +218,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * NBMIN = 2 NX = 0 - IWS = N + IWS = LWKMIN IF( NB.GT.1 .AND. NB.LT.K ) THEN * * Determine when to cross over from blocked to unblocked code. diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 6a4ae33c23..435239cc79 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -189,7 +189,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) END IF WORK( 1 ) = LWKOPT * - IF ( .NOT.LQUERY ) THEN + IF( .NOT.LQUERY ) THEN IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) $ INFO = -7 END IF diff --git a/SRC/dgesvj.f b/SRC/dgesvj.f index 91b21b3896..8400a5c340 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -208,7 +208,7 @@ *> *> \param[in,out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> On entry : *> If JOBU = 'C' : *> WORK(1) = CTOL, where CTOL defines the threshold for convergence. @@ -239,7 +239,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> length of WORK, WORK >= MAX(6,M+N) +*> The length of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, LWORK >= MAX(6,M+N), otherwise. *> \endverbatim *> *> \param[out] INFO @@ -365,7 +366,7 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, - $ SWBAND + $ SWBAND, MINMN, LWMIN LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK, $ RSVEC, UCTOL, UPPER * .. @@ -407,6 +408,13 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, APPLV = LSAME( JOBV, 'A' ) UPPER = LSAME( JOBA, 'U' ) LOWER = LSAME( JOBA, 'L' ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 6, M+N ) + END IF * IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 @@ -427,7 +435,7 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN + ELSE IF( LWORK.LT.LWMIN ) THEN INFO = -13 ELSE INFO = 0 @@ -441,7 +449,7 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * * #:) Quick return for void matrix * - IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN + IF( MINMN.EQ.0 ) RETURN * * Set numerical parameters * The stopping criterion for Jacobi rotations is diff --git a/SRC/dgetri.f b/SRC/dgetri.f index a41531556b..7b5a3a1b6c 100644 --- a/SRC/dgetri.f +++ b/SRC/dgetri.f @@ -151,8 +151,9 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT +* LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index 8d027f2c7d..73b505ff7e 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -127,7 +127,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1, the routine calculates optimal size of WORK for the *> optimal performance and returns this value in WORK(1). @@ -226,7 +226,10 @@ SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * * Determine the optimum and minimum LWORK * - IF( M.GE.N ) THEN + IF( MIN( M, N, NRHS ).EQ.0 ) THEN + WSIZEM = 1 + WSIZEO = 1 + ELSE IF( M.GE.N ) THEN CALL DGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) TSZO = INT( TQ( 1 ) ) LWO = INT( WORKQ( 1 ) ) diff --git a/SRC/dgetsqrhrt.f b/SRC/dgetsqrhrt.f index 394fd0024f..d294cacbd8 100644 --- a/SRC/dgetsqrhrt.f +++ b/SRC/dgetsqrhrt.f @@ -130,14 +130,16 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. -*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), +*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NB1LOCAL = MIN(NB1,N). *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LW1 = NB1LOCAL * N, -*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), +*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ). +*> *> 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 @@ -212,7 +214,7 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * Test the input arguments * INFO = 0 - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. M.LT.N ) THEN @@ -263,8 +265,9 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) * LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) + LWORKOPT = MAX( 1, LWORKOPT ) * - IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN INFO = -11 END IF * @@ -346,4 +349,4 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * * End of DGETSQRHRT * - END \ No newline at end of file + END diff --git a/SRC/dgges.f b/SRC/dgges.f index 7282c80d6a..b9ffc79827 100644 --- a/SRC/dgges.f +++ b/SRC/dgges.f @@ -234,8 +234,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> If N = 0, LWORK >= 1, else LWORK >= 8*N+16. -*> For good performance , LWORK must generally be larger. +*> If N = 0, LWORK >= 1, else LWORK >= MAX(8*N,6*N+16). +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/dgges3.f b/SRC/dgges3.f index 7306a4a3c7..c89d50866d 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -234,6 +234,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK >= 6*N+16. +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -309,7 +311,8 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, $ LQUERY, LST2SL, WANTST INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, - $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT + $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT, + $ LWKMIN DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, $ PVSR, SAFMAX, SAFMIN, SMLNUM * .. @@ -361,6 +364,12 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + IF( N.EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 6*N+16 + END IF +* IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -377,7 +386,7 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -15 ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN INFO = -17 - ELSE IF( LWORK.LT.6*N+16 .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -19 END IF * @@ -385,7 +394,7 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( INFO.EQ.0 ) THEN CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 6*N+16, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT( WORK ( 1 ) ) ) CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) diff --git a/SRC/dggev3.f b/SRC/dggev3.f index 19b0237f99..4c3f35c5a8 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -188,7 +188,9 @@ *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER +*> LWORK is INTEGER. +*> The dimension of the array WORK. LWORK >= MAX(1,8*N). +*> For good performance, LWORK should generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -248,7 +250,8 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY CHARACTER CHTEMP INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, - $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT + $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT, + $ LWKMIN DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, $ SMLNUM, TEMP * .. @@ -298,6 +301,7 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 8*N ) IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -312,7 +316,7 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, INFO = -12 ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN INFO = -14 - ELSE IF( LWORK.LT.MAX( 1, 8*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -16 END IF * @@ -320,7 +324,7 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * IF( INFO.EQ.0 ) THEN CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX(1, 8*N, 3*N+INT( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, -1, $ IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f index 7ac514fa6c..f3bdf75ae8 100644 --- a/SRC/dgghd3.f +++ b/SRC/dgghd3.f @@ -179,14 +179,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> -*> \param[in] LWORK +*> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= 1. +*> The length of the array WORK. LWORK >= 1. *> For optimum performance LWORK >= 6*N*NB, where NB is the *> optimal blocksize. *> @@ -275,7 +275,12 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * INFO = 0 NB = ILAENV( 1, 'DGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = MAX( 6*N*NB, 1 ) + NH = IHI - ILO + 1 + IF( NH.LE.1 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = 6*N*NB + END IF WORK( 1 ) = DBLE( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) @@ -325,7 +330,6 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = ONE RETURN diff --git a/SRC/dggqrf.f b/SRC/dggqrf.f index f2ecea9e29..4f5f79f38e 100644 --- a/SRC/dggqrf.f +++ b/SRC/dggqrf.f @@ -250,7 +250,7 @@ SUBROUTINE DGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'DGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'DORMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN diff --git a/SRC/dggrqf.f b/SRC/dggrqf.f index 16db9fe3ec..3b1024c1cd 100644 --- a/SRC/dggrqf.f +++ b/SRC/dggrqf.f @@ -249,7 +249,7 @@ SUBROUTINE DGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'DGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'DORMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN diff --git a/SRC/dggsvd3.f b/SRC/dggsvd3.f index 7efc4d3fde..ee4d11e86f 100644 --- a/SRC/dggsvd3.f +++ b/SRC/dggsvd3.f @@ -278,7 +278,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/dggsvp3.f b/SRC/dggsvp3.f index cd0f15502f..485d95b369 100644 --- a/SRC/dggsvp3.f +++ b/SRC/dggsvp3.f @@ -227,7 +227,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f index 67664a85ae..07ef1bd57d 100644 --- a/SRC/dlamswlq.f +++ b/SRC/dlamswlq.f @@ -127,17 +127,20 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> If SIDE = 'L', LWORK >= max(1,NB) * MB; -*> if SIDE = 'R', LWORK >= max(1,M) * MB. +*> +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,NB*MB). +*> If SIDE = 'R', LWORK >= max(1,M*MB). *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -193,27 +196,27 @@ *> * ===================================================================== SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, CTR, LW + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, CTR, LW, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -225,52 +228,60 @@ SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * MB ELSE LW = M * MB END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * INFO = 0 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 - ELSE IF( K.LT.MB .OR. MB.LT.1) THEN + ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN INFO = -6 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, MB) ) THEN + ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN + END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DLAMSWLQ', -INFO ) - WORK(1) = LW RETURN - ELSE IF (LQUERY) THEN - WORK(1) = LW + ELSE IF( LQUERY ) THEN RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -404,7 +415,8 @@ SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = LWMIN +* RETURN * * End of DLAMSWLQ diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f index 9570ec6421..337b2c4a46 100644 --- a/SRC/dlamtsqr.f +++ b/SRC/dlamtsqr.f @@ -128,16 +128,18 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) -*> +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. *> -*> If SIDE = 'L', LWORK >= max(1,N)*NB; -*> if SIDE = 'R', LWORK >= max(1,MB)*NB. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,N*NB). +*> If SIDE = 'R', LWORK >= max(1,MB*NB). *> 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 @@ -195,27 +197,27 @@ *> * ===================================================================== SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + DOUBLE PRECISION A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -227,12 +229,13 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + INFO = 0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * NB Q = M ELSE @@ -240,11 +243,17 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, Q = N END IF * - INFO = 0 + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -255,30 +264,30 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -7 ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, NB) ) THEN + ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * * Determine the block size if it is tall skinny or short and wide * - IF( INFO.EQ.0) THEN - WORK(1) = LW + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'DLAMTSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -286,7 +295,7 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -412,7 +421,8 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = LWMIN +* RETURN * * End of DLAMTSQR diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index 8955b76d30..8575d5a440 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -99,19 +99,22 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) -*> +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= MB*M. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise. +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -163,31 +166,33 @@ *> * ===================================================================== SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, - $ INFO) + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT + INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, *) + DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. EXTERNAL SUBROUTINES .. EXTERNAL DGELQT, DTPLQT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -198,12 +203,19 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = M*MB + END IF * IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 - ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN + ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN INFO = -3 ELSE IF( NB.LT.0 ) THEN INFO = -4 @@ -211,24 +223,24 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 - ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = MB*M + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'DLASWLQ', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The LQ Decomposition @@ -264,7 +276,8 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ WORK, INFO ) END IF * - WORK( 1 ) = M * MB + WORK( 1 ) = LWMIN +* RETURN * * End of DLASWLQ diff --git a/SRC/dlatrs3.f b/SRC/dlatrs3.f index c66c399c9f..d9fe465697 100644 --- a/SRC/dlatrs3.f +++ b/SRC/dlatrs3.f @@ -151,13 +151,16 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK). +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal size of *> WORK. *> \endverbatim *> *> \param[in] LWORK *> LWORK is INTEGER +*> The dimension of the array WORK. +*> +*> If MIN(N,NRHS) = 0, LWORK >= 1, else *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> @@ -253,7 +256,7 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J, $ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2, - $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS + $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS, LWMIN DOUBLE PRECISION ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, $ SCAMIN, SMLNUM, TMAX * .. @@ -292,15 +295,24 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * row. WORK( I+KK*LDS ) is the scale factor of the vector * segment associated with the I-th block row and the KK-th vector * in the block column. +* LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) ) LDS = NBA +* * The second part stores upper bounds of the triangular A. There are * a total of NBA x NBA blocks, of which only the upper triangular * part or the lower triangular part is referenced. The upper bound of * the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ). +* LANRM = NBA * NBA AWRK = LSCALE - WORK( 1 ) = LSCALE + LANRM +* + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = LSCALE + LANRM + END IF + WORK( 1 ) = LWMIN * * Test the input parameters * @@ -322,7 +334,7 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, INFO = -8 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -10 - ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN + ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN INFO = -14 END IF IF( INFO.NE.0 ) THEN @@ -649,6 +661,9 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, END IF END DO END DO +* + WORK( 1 ) = LWMIN +* RETURN * * End of DLATRS3 diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f index c306fecc66..c73c086446 100644 --- a/SRC/dlatsqr.f +++ b/SRC/dlatsqr.f @@ -101,15 +101,18 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= NB*N. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, LWORK >= NB*N, otherwise. +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -165,25 +168,25 @@ *> * ===================================================================== SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, - $ LWORK, INFO) + $ LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK + INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), WORK( * ), T(LDT, *) + DOUBLE PRECISION A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME @@ -200,6 +203,13 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = N*NB + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -207,28 +217,29 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -2 ELSE IF( MB.LT.1 ) THEN INFO = -3 - ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN + ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -6 ELSE IF( LDT.LT.NB ) THEN INFO = -8 - ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = NB*N +* + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DLATSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN + IF( MINMN.EQ.0 ) THEN RETURN END IF * @@ -265,7 +276,7 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ WORK, INFO ) END IF * - WORK( 1 ) = N*NB + WORK( 1 ) = LWMIN RETURN * * End of DLATSQR diff --git a/SRC/dsyev_2stage.f b/SRC/dsyev_2stage.f index fc080456a9..286366bfec 100644 --- a/SRC/dsyev_2stage.f +++ b/SRC/dsyev_2stage.f @@ -97,7 +97,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension LWORK +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> diff --git a/SRC/dsyevd.f b/SRC/dsyevd.f index 8785baee11..adcfcb3731 100644 --- a/SRC/dsyevd.f +++ b/SRC/dsyevd.f @@ -96,8 +96,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, -*> dimension (LWORK) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 643c4d48ca..9a9486d5f8 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -278,6 +278,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N <= 1, LWORK must be at least 1. *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, 26*N, dimension) where *> dimension = max(stage1,stage2) + (KD+1)*N + 5*N @@ -306,7 +307,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the IWORK array, @@ -444,8 +446,14 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) - LIWMIN = MAX( 1, 10*N ) +* + IF( N.LE.1 ) THEN + LWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN @@ -504,7 +512,7 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 7 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = A( 1, 1 ) diff --git a/SRC/dsyevx.f b/SRC/dsyevx.f index e90a82bc3a..fd6a78e320 100644 --- a/SRC/dsyevx.f +++ b/SRC/dsyevx.f @@ -338,14 +338,14 @@ SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, IF( INFO.EQ.0 ) THEN IF( N.LE.1 ) THEN LWKMIN = 1 - WORK( 1 ) = LWKMIN + LWKOPT = 1 ELSE LWKMIN = 8*N NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( LWKMIN, ( NB + 3 )*N ) - WORK( 1 ) = LWKOPT END IF + WORK( 1 ) = LWKOPT * IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) $ INFO = -17 diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f index 7959012b71..581b6277e5 100644 --- a/SRC/dsysv_aa.f +++ b/SRC/dsysv_aa.f @@ -206,7 +206,7 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * @@ -216,7 +216,7 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) LWKOPT_SYTRS = INT( WORK(1) ) - LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS ) + LWKOPT = MAX( 1, LWKOPT_SYTRF, LWKOPT_SYTRS ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/dsysv_aa_2stage.f b/SRC/dsysv_aa_2stage.f index b91c0995e4..43c931281e 100644 --- a/SRC/dsysv_aa_2stage.f +++ b/SRC/dsysv_aa_2stage.f @@ -101,14 +101,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is DOUBLE PRECISION array, dimension (LTB) +*> TB is DOUBLE PRECISION array, dimension (MAX(1,LTB)) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -148,14 +148,15 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION workspace of size LWORK +*> WORK is DOUBLE PRECISION workspace of size (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -234,11 +235,11 @@ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 - ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * diff --git a/SRC/dsysvx.f b/SRC/dsysvx.f index 77a2c678d0..b2b8210ca4 100644 --- a/SRC/dsysvx.f +++ b/SRC/dsysvx.f @@ -305,7 +305,7 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * .. * .. Local Scalars .. LOGICAL LQUERY, NOFACT - INTEGER LWKOPT, NB + INTEGER LWKMIN, LWKOPT, NB DOUBLE PRECISION ANORM * .. * .. External Functions .. @@ -327,6 +327,7 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = 0 NOFACT = LSAME( FACT, 'N' ) LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 3*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) @@ -344,12 +345,12 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = -11 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, 3*N ) + LWKOPT = LWKMIN IF( NOFACT ) THEN NB = ILAENV( 1, 'DSYTRF', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( LWKOPT, N*NB ) diff --git a/SRC/dsytrd.f b/SRC/dsytrd.f index 386f1deed8..58d4b633b8 100644 --- a/SRC/dsytrd.f +++ b/SRC/dsytrd.f @@ -247,7 +247,7 @@ SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * Determine the block size. * NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/dsytrd_2stage.f b/SRC/dsytrd_2stage.f index eef9f9c6b9..a88ac1c73f 100644 --- a/SRC/dsytrd_2stage.f +++ b/SRC/dsytrd_2stage.f @@ -123,7 +123,7 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is DOUBLE PRECISION array, dimension (LHOUS2) +*> HOUS2 is DOUBLE PRECISION array, dimension (MAX(1,LHOUS2)) *> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim @@ -132,6 +132,8 @@ *> \verbatim *> LHOUS2 is INTEGER *> The dimension of the array HOUS2. +*> LHOUS2 >= 1. +*> *> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns @@ -143,14 +145,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS2 = -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 @@ -265,10 +270,13 @@ SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 ) IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) -* WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, -* $ LHMIN, LWMIN + IF( N.EQ.0 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN INFO = -1 @@ -324,8 +332,7 @@ SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * * - HOUS2( 1 ) = LHMIN - WORK( 1 ) = LWMIN + WORK( 1 ) = LWMIN RETURN * * End of DSYTRD_2STAGE diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index 374fcd9ebf..675c6fc481 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -132,15 +132,17 @@ *> *> \param[out] HOUS *> \verbatim -*> HOUS is DOUBLE PRECISION array, dimension LHOUS, that -*> store the Householder representation. +*> HOUS is DOUBLE PRECISION array, dimension (MAX(1,LHOUS)) +*> Stores the Householder representation. *> \endverbatim *> *> \param[in] LHOUS *> \verbatim *> LHOUS is INTEGER -*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array HOUS. +*> If N = 0, LHOUS >= 1, else LHOUS = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS array, returns *> this value as the first entry of the HOUS array, and no error @@ -152,14 +154,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension LWORK. +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array WORK. +*> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -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 @@ -292,8 +297,13 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the block size, the workspace size and the hous size. * IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + IF( N.EQ.0 .OR. KD.LE.1 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN INFO = -1 @@ -543,7 +553,6 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 170 CONTINUE ENDIF * - HOUS( 1 ) = LHMIN WORK( 1 ) = LWMIN RETURN * diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index f2292678df..38acc71f1f 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -123,8 +123,8 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) -*> On exit, if INFO = 0, or if LWORK=-1, +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, or if LWORK = -1, *> WORK(1) returns the size of LWORK. *> \endverbatim *> @@ -132,7 +132,9 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK which should be calculated -*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) +*> by a workspace query. +*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY) +*> *> 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 @@ -293,8 +295,12 @@ SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', ' ', N, KD, -1, -1 ) - + IF( N.LE.KD+1 ) THEN + LWMIN = 1 + ELSE + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', ' ', N, KD, -1, -1 ) + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f index d639c336af..7a7d99b1b1 100644 --- a/SRC/dsytrf.f +++ b/SRC/dsytrf.f @@ -107,7 +107,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index ede6d938d8..52ad4f8845 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -190,7 +190,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = (NB+1)*N + LWKOPT = MAX( 1, (NB+1)*N ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/dsytrf_aa_2stage.f b/SRC/dsytrf_aa_2stage.f index 4a295456ad..6d9da268e9 100644 --- a/SRC/dsytrf_aa_2stage.f +++ b/SRC/dsytrf_aa_2stage.f @@ -87,14 +87,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is DOUBLE PRECISION array, dimension (LTB) +*> TB is DOUBLE PRECISION array, dimension (MAX(1,LTB)) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -121,14 +121,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION workspace of size LWORK +*> WORK is DOUBLE PRECISION workspace of size (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used +*> to select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -211,9 +211,9 @@ SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN + ELSE IF ( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN + ELSE IF ( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -227,10 +227,10 @@ SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'DSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = (3*NB+1)*N + TB( 1 ) = MAX( 1, (3*NB+1)*N ) END IF IF( WQUERY ) THEN - WORK( 1 ) = N*NB + WORK( 1 ) = MAX( 1, N*NB ) END IF END IF IF( TQUERY .OR. WQUERY ) THEN diff --git a/SRC/dsytrf_rk.f b/SRC/dsytrf_rk.f index 4a0c702717..0717eb0765 100644 --- a/SRC/dsytrf_rk.f +++ b/SRC/dsytrf_rk.f @@ -177,14 +177,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension ( MAX(1,LWORK) ). +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned *> by ILAENV. *> diff --git a/SRC/dsytrf_rook.f b/SRC/dsytrf_rook.f index 181e061910..3166634857 100644 --- a/SRC/dsytrf_rook.f +++ b/SRC/dsytrf_rook.f @@ -118,7 +118,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f index 61379ae17c..ebc65d87b1 100644 --- a/SRC/dsytri2.f +++ b/SRC/dsytri2.f @@ -88,14 +88,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> WORK is size >= (N+NB+1)*(NB+3) +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine *> calculates: *> - the optimal size of the WORK array, returns @@ -159,9 +159,13 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) +* * Get blocksize +* NBMAX = ILAENV( 1, 'DSYTRI2', UPLO, N, -1, -1, -1 ) - IF ( NBMAX .GE. N ) THEN + IF( N.EQ.0 ) THEN + MINSIZE = 1 + ELSE IF ( NBMAX.GE.N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -173,7 +177,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * @@ -184,7 +188,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) CALL XERBLA( 'DSYTRI2', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK(1)=MINSIZE + WORK( 1 ) = MINSIZE RETURN END IF IF( N.EQ.0 ) diff --git a/SRC/dsytri_3.f b/SRC/dsytri_3.f index 946cc2ffc6..50834c605e 100644 --- a/SRC/dsytri_3.f +++ b/SRC/dsytri_3.f @@ -119,16 +119,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (N+NB+1)*(NB+3). +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= (N+NB+1)*(NB+3). +*> The length of WORK. +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> -*> If LDWORK = -1, then a workspace query is assumed; +*> If LWORK = -1, then a workspace query is assumed; *> the routine only calculates the optimal size of the optimal *> size of the WORK array, returns this value as the first *> entry of the WORK array, and no error message related to @@ -208,8 +209,13 @@ SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * * Determine the block size * - NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) ) - LWKOPT = ( N+NB+1 ) * ( NB+3 ) + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MAX( 1, ILAENV( 1, 'DSYTRI_3', UPLO, N, -1, -1, -1 ) ) + LWKOPT = ( N+NB+1 ) * ( NB+3 ) + END IF + WORK( 1 ) = LWKOPT * IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 @@ -217,7 +223,7 @@ SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN INFO = -8 END IF * @@ -225,7 +231,6 @@ SUBROUTINE DSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, CALL XERBLA( 'DSYTRI_3', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK( 1 ) = LWKOPT RETURN END IF * diff --git a/SRC/dsytrs_aa.f b/SRC/dsytrs_aa.f index d3894cc110..f0016cb7f7 100644 --- a/SRC/dsytrs_aa.f +++ b/SRC/dsytrs_aa.f @@ -105,7 +105,13 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> The dimension of the array WORK. +*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the minimal 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 @@ -151,7 +157,7 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * .. * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER K, KP, LWKOPT + INTEGER K, KP, LWKMIN * .. * .. External Functions .. LOGICAL LSAME @@ -161,13 +167,19 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL DLACPY, DGTSV, DSWAP, DTRSM, XERBLA * .. * .. Intrinsic Functions .. - INTRINSIC MAX + INTRINSIC MIN, MAX * .. * .. Executable Statements .. * INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 3*N-2 + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -178,21 +190,20 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DSYTRS_AA', -INFO ) RETURN ELSE IF( LQUERY ) THEN - LWKOPT = (3*N-2) - WORK( 1 ) = LWKOPT + WORK( 1 ) = LWKMIN RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) + IF( MIN( N, NRHS ).EQ.0 ) $ RETURN * IF( UPPER ) THEN diff --git a/TESTING/LIN/dchksy_aa_2stage.f b/TESTING/LIN/dchksy_aa_2stage.f index bc4e77a5aa..1940351a40 100644 --- a/TESTING/LIN/dchksy_aa_2stage.f +++ b/TESTING/LIN/dchksy_aa_2stage.f @@ -421,9 +421,9 @@ SUBROUTINE DCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, * block factorization, LWORK is the length of AINV. * SRNAMT = 'DSYTRF_AA_2STAGE' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) CALL DSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ WORK, LWORK, $ INFO ) @@ -503,7 +503,6 @@ SUBROUTINE DCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) * SRNAMT = 'DSYTRS_AA_2STAGE' - LWORK = MAX( 1, 3*N-2 ) CALL DSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ), $ X, LDA, INFO ) diff --git a/TESTING/LIN/ddrvsy_aa_2stage.f b/TESTING/LIN/ddrvsy_aa_2stage.f index 91c9e8e9af..d04106ae30 100644 --- a/TESTING/LIN/ddrvsy_aa_2stage.f +++ b/TESTING/LIN/ddrvsy_aa_2stage.f @@ -400,9 +400,9 @@ SUBROUTINE DDRVSY_AA_2STAGE( * Factor the matrix and solve the system using DSYSV_AA. * SRNAMT = 'DSYSV_AA_2STAGE ' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) CALL DSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ X, LDA, WORK, LWORK, INFO ) * From 0c1e0c3e758702ee94dee5d27ec704d464389822 Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Fri, 24 Nov 2023 18:57:14 +0700 Subject: [PATCH 010/206] handle and document corner cases of lwork in lapack, single precision --- SRC/sgebrd.f | 26 ++++++++----- SRC/sgehrd.f | 22 +++++++---- SRC/sgelq.f | 8 ++-- SRC/sgelqf.f | 20 ++++++---- SRC/sgemlq.f | 24 ++++++++---- SRC/sgemqr.f | 22 +++++++---- SRC/sgeqlf.f | 8 ++-- SRC/sgeqr.f | 20 ++++++---- SRC/sgeqrfp.f | 28 +++++++++----- SRC/sgesvj.f | 18 ++++++--- SRC/sgetri.f | 10 +++-- SRC/sgetsls.f | 7 +++- SRC/sgetsqrhrt.f | 13 ++++--- SRC/sgges3.f | 24 +++++++++--- SRC/sggev3.f | 17 ++++++--- SRC/sgghd3.f | 13 +++++-- SRC/sggqrf.f | 9 +++-- SRC/sggrqf.f | 2 +- SRC/sggsvd3.f | 2 +- SRC/sggsvp3.f | 5 ++- SRC/slamswlq.f | 60 ++++++++++++++++++------------ SRC/slamtsqr.f | 68 ++++++++++++++++++++-------------- SRC/slaswlq.f | 54 ++++++++++++++++----------- SRC/slatrs3.f | 28 ++++++++++---- SRC/slatsqr.f | 45 ++++++++++++++-------- SRC/ssyevd.f | 7 ++-- SRC/ssyevr.f | 4 +- SRC/ssyevr_2stage.f | 20 +++++++--- SRC/ssyevx.f | 6 +-- SRC/ssysv_aa.f | 11 +++--- SRC/ssysv_aa_2stage.f | 23 +++++++----- SRC/ssytrf_aa_2stage.f | 18 ++++----- SRC/ssytrf_rk.f | 8 ++-- SRC/ssytrf_rook.f | 7 ++-- SRC/ssytri2.f | 29 +++++++++------ SRC/ssytri_3.f | 21 +++++++---- SRC/ssytrs_aa.f | 30 ++++++++++----- TESTING/LIN/schksy_aa_2stage.f | 5 +-- TESTING/LIN/sdrvsy_aa_2stage.f | 4 +- 39 files changed, 471 insertions(+), 275 deletions(-) diff --git a/SRC/sgebrd.f b/SRC/sgebrd.f index 2d0c6d6511..3add5afe84 100644 --- a/SRC/sgebrd.f +++ b/SRC/sgebrd.f @@ -122,7 +122,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,M,N). +*> The length of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise. *> For optimum performance LWORK >= (M+N)*NB, where NB *> is the optimal blocksize. *> @@ -223,8 +224,8 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX, WS + INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT, + $ MINMN, NB, NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL SGEBD2, SGEMM, SLABRD, XERBLA @@ -242,9 +243,16 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Test the input parameters * INFO = 0 - NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = ( M+N )*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = MAX( M, N ) + NB = MAX( 1, ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) ) + LWKOPT = ( M+N )*NB + ENDIF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -252,7 +260,7 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.LT.0 ) THEN @@ -264,7 +272,6 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * * Quick return if possible * - MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -342,7 +349,8 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * CALL SGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ), $ TAUQ( I ), TAUP( I ), WORK, IINFO ) - WORK( 1 ) = SROUNDUP_LWORK(WS) +* + WORK( 1 ) = SROUNDUP_LWORK( WS ) RETURN * * End of SGEBRD diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index 47733d947e..70eb595504 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -89,7 +89,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (LWORK) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -173,7 +173,7 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDA, LWORK, N * .. * .. Array Arguments .. - REAL A( LDA, * ), TAU( * ), WORK( * ) + REAL A( LDA, * ), TAU( * ), WORK( * ) * .. * * ===================================================================== @@ -182,7 +182,7 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER NBMAX, LDT, TSIZE PARAMETER ( NBMAX = 64, LDT = NBMAX+1, $ TSIZE = LDT*NBMAX ) - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E+0, $ ONE = 1.0E+0 ) * .. @@ -190,7 +190,7 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) LOGICAL LQUERY INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB, $ NBMIN, NH, NX - REAL EI + REAL EI * .. * .. External Subroutines .. EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, STRMM, @@ -226,9 +226,14 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, -1 ) ) - LWKOPT = N*NB + TSIZE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, + $ -1 ) ) + LWKOPT = N*NB + TSIZE + ENDIF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -345,7 +350,8 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * Use unblocked code to reduce the rest of the matrix * CALL SGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/sgelq.f b/SRC/sgelq.f index 74c7cc267a..75f02675d8 100644 --- a/SRC/sgelq.f +++ b/SRC/sgelq.f @@ -98,7 +98,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error @@ -295,9 +295,9 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE - WORK( 1 ) = SROUNDUP_LWORK(LWREQ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) END IF END IF IF( INFO.NE.0 ) THEN @@ -322,7 +322,7 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWREQ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) RETURN * * End of SGELQ diff --git a/SRC/sgelqf.f b/SRC/sgelqf.f index 1ceec4742d..7ec1dee472 100644 --- a/SRC/sgelqf.f +++ b/SRC/sgelqf.f @@ -93,7 +93,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,M). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise. *> For optimum performance LWORK >= M*NB, where NB is the *> optimal blocksize. *> @@ -175,9 +176,8 @@ SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Test the input arguments * INFO = 0 + K = MIN( M, N ) NB = ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - LWKOPT = M*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -185,19 +185,25 @@ SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF( .NOT.LQUERY ) THEN + IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'SGELQF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = M*NB + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -267,7 +273,7 @@ SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ CALL SGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ IINFO ) * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of SGELQF diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index 83536825cc..7e4d9bf656 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -110,13 +110,14 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -187,7 +188,7 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -207,7 +208,7 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) @@ -222,6 +223,13 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = M * MB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN @@ -250,12 +258,12 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = SROUNDUP_LWORK( LW ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -267,7 +275,7 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -280,7 +288,7 @@ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ MB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = SROUNDUP_LWORK( LW ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * RETURN * diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f index 3207f8bfd0..19bf467b8b 100644 --- a/SRC/sgemqr.f +++ b/SRC/sgemqr.f @@ -189,12 +189,13 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEMQRT, SLAMTSQR, XERBLA @@ -206,7 +207,7 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) @@ -221,6 +222,13 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = MB * NB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN @@ -249,12 +257,12 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LW) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -266,7 +274,7 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -279,7 +287,7 @@ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ NB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = SROUNDUP_LWORK(LW) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * RETURN * diff --git a/SRC/sgeqlf.f b/SRC/sgeqlf.f index b1266c89eb..14942b7652 100644 --- a/SRC/sgeqlf.f +++ b/SRC/sgeqlf.f @@ -88,7 +88,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is the *> optimal blocksize. *> @@ -189,8 +190,9 @@ SUBROUTINE SGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) END IF WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) * - IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF END IF * diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f index 3bd77683d5..79a515e1c8 100644 --- a/SRC/sgeqr.f +++ b/SRC/sgeqr.f @@ -99,7 +99,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error @@ -190,11 +190,13 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SLATSQR, SGEQRT, XERBLA @@ -246,8 +248,10 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * * Determine if the workspace size satisfies minimal size * + LWMIN = MAX( 1, N ) + LWREQ = MAX( 1, N*NB ) LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N ) + IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.LWREQ ) $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN @@ -255,7 +259,7 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, NB = 1 MB = M END IF - IF( LWORK.LT.NB*N ) THEN + IF( LWORK.LT.LWREQ ) THEN LMINWS = .TRUE. NB = 1 END IF @@ -270,7 +274,7 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -284,9 +288,9 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) END IF END IF IF( INFO.NE.0 ) THEN @@ -311,7 +315,7 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) * RETURN * diff --git a/SRC/sgeqrfp.f b/SRC/sgeqrfp.f index d1ee2a8283..37747c5124 100644 --- a/SRC/sgeqrfp.f +++ b/SRC/sgeqrfp.f @@ -97,7 +97,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -162,8 +163,8 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, - $ NBMIN, NX + INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT, + $ NB, NBMIN, NX * .. * .. External Subroutines .. EXTERNAL SGEQR2P, SLARFB, SLARFT, XERBLA @@ -173,8 +174,9 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * .. * .. External Functions .. INTEGER ILAENV + EXTERNAL ILAENV REAL SROUNDUP_LWORK - EXTERNAL ILAENV, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. Executable Statements .. * @@ -182,8 +184,16 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + K = MIN( M, N ) + IF( K.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = N + LWKOPT = N*NB + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -191,7 +201,7 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF IF( INFO.NE.0 ) THEN @@ -211,7 +221,7 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * NBMIN = 2 NX = 0 - IWS = N + IWS = LWKMIN IF( NB.GT.1 .AND. NB.LT.K ) THEN * * Determine when to cross over from blocked to unblocked code. @@ -273,7 +283,7 @@ SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ CALL SGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ IINFO ) * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of SGEQRFP diff --git a/SRC/sgesvj.f b/SRC/sgesvj.f index 391cb0711d..15df1ccb63 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -208,7 +208,7 @@ *> *> \param[in,out] WORK *> \verbatim -*> WORK is REAL array, dimension (LWORK) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On entry, *> If JOBU = 'C' : *> WORK(1) = CTOL, where CTOL defines the threshold for convergence. @@ -239,7 +239,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> length of WORK, WORK >= MAX(6,M+N) +*> Length of WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(6,M+N), otherwise. *> \endverbatim *> *> \param[out] INFO @@ -351,7 +352,7 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, - $ SWBAND + $ SWBAND, MINMN, LWMIN LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK, $ RSVEC, UCTOL, UPPER * .. @@ -393,6 +394,13 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, APPLV = LSAME( JOBV, 'A' ) UPPER = LSAME( JOBA, 'U' ) LOWER = LSAME( JOBA, 'L' ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 6, M+N ) + END IF * IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 @@ -413,7 +421,7 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN + ELSE IF( LWORK.LT.LWMIN ) THEN INFO = -13 ELSE INFO = 0 @@ -427,7 +435,7 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * * #:) Quick return for void matrix * - IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN + IF( MINMN.EQ.0 ) RETURN * * Set numerical parameters * The stopping criterion for Jacobi rotations is diff --git a/SRC/sgetri.f b/SRC/sgetri.f index fe71bc4a52..7b06bb63db 100644 --- a/SRC/sgetri.f +++ b/SRC/sgetri.f @@ -137,8 +137,9 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * .. * .. External Functions .. INTEGER ILAENV + EXTERNAL ILAENV REAL SROUNDUP_LWORK - EXTERNAL ILAENV, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA @@ -152,8 +153,9 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'SGETRI', ' ', N, -1, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, N*NB ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 @@ -251,7 +253,7 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL SSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) 60 CONTINUE * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of SGETRI diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index d89c6a4e6d..08a427a8b3 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -127,7 +127,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1, the routine calculates optimal size of WORK for the *> optimal performance and returns this value in WORK(1). @@ -226,7 +226,10 @@ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * * Determine the optimum and minimum LWORK * - IF( M.GE.N ) THEN + IF( MIN( M, N, NRHS ).EQ.0 ) THEN + WSIZEO = 1 + WSIZEM = 1 + ELSE IF( M.GE.N ) THEN CALL SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) TSZO = INT( TQ( 1 ) ) LWO = INT( WORKQ( 1 ) ) diff --git a/SRC/sgetsqrhrt.f b/SRC/sgetsqrhrt.f index d80ff4da81..2303ee9af6 100644 --- a/SRC/sgetsqrhrt.f +++ b/SRC/sgetsqrhrt.f @@ -130,14 +130,16 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. -*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), +*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NB1LOCAL = MIN(NB1,N). *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LW1 = NB1LOCAL * N, -*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), +*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ). +*> *> 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 @@ -216,7 +218,7 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * Test the input arguments * INFO = 0 - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. M.LT.N ) THEN @@ -267,8 +269,9 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) * LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) + LWORKOPT = MAX( 1, LWORKOPT ) * - IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN INFO = -11 END IF * @@ -350,4 +353,4 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * * End of SGETSQRHRT * - END \ No newline at end of file + END diff --git a/SRC/sgges3.f b/SRC/sgges3.f index e35d4955a5..e90cd6947e 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -234,6 +234,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK >= 6*N+16. +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -309,7 +311,8 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, $ LQUERY, LST2SL, WANTST INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, - $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT + $ ILO, IP, IRIGHT, IROWS, ITAU, IWRK, LWKOPT, + $ LWKMIN REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, $ PVSR, SAFMAX, SAFMIN, SMLNUM * .. @@ -361,6 +364,12 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + IF( N.EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 6*N+16 + END IF +* IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -377,7 +386,7 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -15 ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN INFO = -17 - ELSE IF( LWORK.LT.6*N+16 .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -19 END IF * @@ -385,7 +394,7 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( INFO.EQ.0 ) THEN CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 6*N+16, 3*N+INT( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) @@ -407,7 +416,11 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, $ IERR ) LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) END IF - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) + END IF END IF * IF( INFO.NE.0 ) THEN @@ -421,6 +434,7 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( N.EQ.0 ) THEN SDIM = 0 + WORK( 1 ) = 1 RETURN END IF * @@ -657,7 +671,7 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * 40 CONTINUE * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/sggev3.f b/SRC/sggev3.f index c82d2187f5..dcd5ffb102 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -189,6 +189,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= MAX(1,8*N). +*> For good performance, LWORK should generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -248,7 +250,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL ILASCL, ILBSCL, ILV, ILVL, ILVR, LQUERY CHARACTER CHTEMP INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, - $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT + $ IN, IRIGHT, IROWS, ITAU, IWRK, JC, JR, LWKOPT, + $ LWKMIN REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, $ SMLNUM, TEMP * .. @@ -298,6 +301,7 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 8*N ) IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -312,7 +316,7 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, INFO = -12 ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN INFO = -14 - ELSE IF( LWORK.LT.MAX( 1, 8*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -16 END IF * @@ -320,7 +324,7 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * IF( INFO.EQ.0 ) THEN CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 1, 8*N, 3*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT ( WORK( 1 ) ) ) CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) ) @@ -340,8 +344,11 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, $ WORK, -1, 0, IERR ) LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) ) END IF - WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) -* + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) + END IF END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/sgghd3.f b/SRC/sgghd3.f index 9c5858b5a5..97f28095f8 100644 --- a/SRC/sgghd3.f +++ b/SRC/sgghd3.f @@ -179,14 +179,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (LWORK) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= 1. +*> The length of the array WORK. LWORK >= 1. *> For optimum performance LWORK >= 6*N*NB, where NB is the *> optimal blocksize. *> @@ -276,7 +276,12 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * INFO = 0 NB = ILAENV( 1, 'SGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = MAX( 6*N*NB, 1 ) + NH = IHI - ILO + 1 + IF( N.EQ.0 .OR. NH.LE.1 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = 6*N*NB + END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) @@ -326,7 +331,6 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = ONE RETURN @@ -886,6 +890,7 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, IF ( JCOL.LT.IHI ) $ CALL SGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, IERR ) +* WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN diff --git a/SRC/sggqrf.f b/SRC/sggqrf.f index ebb42a8998..da89807193 100644 --- a/SRC/sggqrf.f +++ b/SRC/sggqrf.f @@ -236,8 +236,9 @@ SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * .. * .. External Functions .. INTEGER ILAENV + EXTERNAL ILAENV REAL SROUNDUP_LWORK - EXTERNAL ILAENV, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN @@ -251,8 +252,9 @@ SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P )*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, N, M, P )*NB + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 @@ -289,6 +291,7 @@ SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * CALL SGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) LWKOPT = MAX( LOPT, INT( WORK( 1 ) ) ) +* WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN diff --git a/SRC/sggrqf.f b/SRC/sggrqf.f index 2163f1ef8e..8350c4b96c 100644 --- a/SRC/sggrqf.f +++ b/SRC/sggrqf.f @@ -250,7 +250,7 @@ SUBROUTINE SGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'SGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'SORMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P)*NB + LWKOPT = MAX( 1, N, M, P )*NB WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index 053fff5de1..cee630593e 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -278,7 +278,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/sggsvp3.f b/SRC/sggsvp3.f index a463b9064e..8e90d770cc 100644 --- a/SRC/sggsvp3.f +++ b/SRC/sggsvp3.f @@ -227,7 +227,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -300,8 +300,9 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * .. * .. External Functions .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEQP3, SGEQR2, SGERQ2, SLACPY, SLAPMT, diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index 88b2f4642c..bca33462b7 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -127,17 +127,20 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> If SIDE = 'L', LWORK >= max(1,NB) * MB; -*> if SIDE = 'R', LWORK >= max(1,M) * MB. +*> +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,NB*MB). +*> If SIDE = 'R', LWORK >= max(1,M*MB). *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -193,31 +196,34 @@ *> * ===================================================================== SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - REAL A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + REAL A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK +* .. * .. External Subroutines .. EXTERNAL STPMLQT, SGEMLQT, XERBLA * .. @@ -225,52 +231,58 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * MB ELSE LW = M * MB END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * INFO = 0 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 - ELSE IF( K.LT.MB .OR. MB.LT.1) THEN + ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN INFO = -6 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, MB) ) THEN + ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SLAMSWLQ', -INFO ) - WORK(1) = LW RETURN - ELSE IF (LQUERY) THEN - WORK(1) = LW + ELSE IF( LQUERY ) THEN RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -404,7 +416,7 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SLAMSWLQ diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f index 41684cfec2..8aedf3ecf9 100644 --- a/SRC/slamtsqr.f +++ b/SRC/slamtsqr.f @@ -128,22 +128,24 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> +*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. *> -*> If SIDE = 'L', LWORK >= max(1,N)*NB; -*> if SIDE = 'R', LWORK >= max(1,MB)*NB. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,N*NB). +*> If SIDE = 'R', LWORK >= max(1,MB*NB). *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -195,31 +197,34 @@ *> * ===================================================================== SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - REAL A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + REAL A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK +* .. * .. External Subroutines .. EXTERNAL SGEMQRT, STPMQRT, XERBLA * .. @@ -227,12 +232,13 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + INFO = 0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * NB Q = M ELSE @@ -240,11 +246,17 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, Q = N END IF * - INFO = 0 + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -255,30 +267,30 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -7 ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, NB) ) THEN + ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN. AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * * Determine the block size if it is tall skinny or short and wide * - IF( INFO.EQ.0) THEN - WORK(1) = LW + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SLAMTSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -286,7 +298,7 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -412,7 +424,7 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SLAMTSQR diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index 685f823a0e..a59ab9e754 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -96,22 +96,24 @@ *> The leading dimension of the array T. LDT >= MB. *> \endverbatim *> -*> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> +*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= MB * M. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise. +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -163,32 +165,35 @@ *> * ===================================================================== SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, - $ INFO) + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT + INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT * .. * .. Array Arguments .. - REAL A( LDA, * ), WORK( * ), T( LDT, *) + REAL A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK +* .. * .. EXTERNAL SUBROUTINES .. EXTERNAL SGELQT, SGEQRT, STPLQT, STPQRT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -199,12 +204,19 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = M*MB + END IF * IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 - ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN + ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN INFO = -3 ELSE IF( NB.LE.0 ) THEN INFO = -4 @@ -212,24 +224,24 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 - ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = MB*M + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SLASWLQ', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The LQ Decomposition @@ -265,7 +277,7 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ WORK, INFO ) END IF * - WORK( 1 ) = SROUNDUP_LWORK(M * MB) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SLASWLQ diff --git a/SRC/slatrs3.f b/SRC/slatrs3.f index 542d9d7b80..5eaaa3015b 100644 --- a/SRC/slatrs3.f +++ b/SRC/slatrs3.f @@ -151,13 +151,15 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (LWORK). -*> On exit, if INFO = 0, WORK(1) returns the optimal size of -*> WORK. +*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> LWORK is INTEGER +*> The dimension of the array WORK. +*> +*> If MIN(N,NRHS) = 0, LWORK >= 1, else *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> @@ -253,7 +255,7 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J, $ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2, - $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS + $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS, LWMIN REAL ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, $ SCAMIN, SMLNUM, TMAX * .. @@ -264,7 +266,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE, SLARMM * .. * .. External Subroutines .. - EXTERNAL SLATRS, SSCAL, XERBLA + REAL SROUNDUP_LWORK + EXTERNAL SLATRS, SSCAL, SROUNDUP_LWORK, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -292,15 +295,24 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * row. WORK( I + KK * LDS ) is the scale factor of the vector * segment associated with the I-th block row and the KK-th vector * in the block column. +* LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) ) LDS = NBA +* * The second part stores upper bounds of the triangular A. There are * a total of NBA x NBA blocks, of which only the upper triangular * part or the lower triangular part is referenced. The upper bound of * the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ). +* LANRM = NBA * NBA AWRK = LSCALE - WORK( 1 ) = LSCALE + LANRM +* + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = LSCALE + LANRM + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * * Test the input parameters. * @@ -322,7 +334,7 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, INFO = -8 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -10 - ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN + ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN INFO = -14 END IF IF( INFO.NE.0 ) THEN @@ -650,6 +662,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, END DO END DO RETURN +* + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * * End of SLATRS3 * diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f index 75e7e749b6..a3e699d205 100644 --- a/SRC/slatsqr.f +++ b/SRC/slatsqr.f @@ -101,13 +101,16 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= NB*N. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. +*> *> 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 @@ -172,24 +175,28 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK + INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. - REAL A( LDA, * ), WORK( * ), T(LDT, *) + REAL A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK +* .. * .. EXTERNAL SUBROUTINES .. EXTERNAL SGEQRT, STPQRT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -200,6 +207,13 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = N*NB + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -207,29 +221,30 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -2 ELSE IF( MB.LT.1 ) THEN INFO = -3 - ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN + ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -6 ELSE IF( LDT.LT.NB ) THEN INFO = -8 - ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = NB*N +* + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'SLATSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The QR Decomposition @@ -264,7 +279,7 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ WORK, INFO ) END IF * - work( 1 ) = N*NB + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SLATSQR diff --git a/SRC/ssyevd.f b/SRC/ssyevd.f index a5e4638d6f..2ae44fc813 100644 --- a/SRC/ssyevd.f +++ b/SRC/ssyevd.f @@ -96,8 +96,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, -*> dimension (LWORK) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -251,7 +250,7 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, $ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) ) LIOPT = LIWMIN END IF - WORK( 1 ) = SROUNDUP_LWORK(LOPT) + WORK( 1 ) = SROUNDUP_LWORK( LOPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -335,7 +334,7 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, IF( ISCALE.EQ.1 ) $ CALL SSCAL( N, ONE / SIGMA, W, 1 ) * - WORK( 1 ) = SROUNDUP_LWORK(LOPT) + WORK( 1 ) = SROUNDUP_LWORK( LOPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 47e4d7cbf3..6f5a604ec1 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -428,7 +428,7 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -677,7 +677,7 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index a2d6a62317..f32d886990 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -278,6 +278,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N <= 1, LWORK must be at least 1. *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, 26*N, dimension) where *> dimension = max(stage1,stage2) + (KD+1)*N + 5*N @@ -306,7 +307,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the IWORK array, @@ -445,8 +447,14 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) - LIWMIN = MAX( 1, 10*N ) +* + IF( N.LE.1 ) THEN + LWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = MAX( 26*N, 5*N + LHTRD + LWTRD ) + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN @@ -485,7 +493,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) * NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) ) * LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) IWORK( 1 ) = LIWMIN END IF * @@ -505,7 +513,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 26 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = A( 1, 1 ) @@ -733,7 +741,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index 2204aa39bc..aaed6dad57 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -338,14 +338,14 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, IF( INFO.EQ.0 ) THEN IF( N.LE.1 ) THEN LWKMIN = 1 - WORK( 1 ) = SROUNDUP_LWORK(LWKMIN) + LWKOPT = 1 ELSE LWKMIN = 8*N NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( LWKMIN, ( NB + 3 )*N ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) $ INFO = -17 @@ -542,7 +542,7 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f index e43d4de7f4..d8c98410b4 100644 --- a/SRC/ssysv_aa.f +++ b/SRC/ssysv_aa.f @@ -181,8 +181,9 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * .. * .. External Functions .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL XERBLA, SSYTRS_AA, SSYTRF_AA @@ -206,7 +207,7 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * @@ -216,8 +217,8 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) LWKOPT_SYTRS = INT( WORK(1) ) - LWKOPT = MAX( LWKOPT_SYTRF, LWKOPT_SYTRS ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, LWKOPT_SYTRF, LWKOPT_SYTRS ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -239,7 +240,7 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/ssysv_aa_2stage.f b/SRC/ssysv_aa_2stage.f index 3d88e068e6..b7904e8020 100644 --- a/SRC/ssysv_aa_2stage.f +++ b/SRC/ssysv_aa_2stage.f @@ -100,14 +100,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is REAL array, dimension (LTB) +*> TB is REAL array, dimension (MAX(1,LTB)) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -147,14 +147,15 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL workspace of size LWORK +*> WORK is REAL workspace of size (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -208,8 +209,9 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * .. * .. External Functions .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SSYTRF_AA_2STAGE, SSYTRS_AA_2STAGE, @@ -234,18 +236,19 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 - ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = INT( WORK(1) ) + LWKOPT = MAX( 1, INT( WORK( 1 ) ) ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -269,7 +272,7 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/ssytrf_aa_2stage.f b/SRC/ssytrf_aa_2stage.f index abe6564c5d..6b5cdee1bc 100644 --- a/SRC/ssytrf_aa_2stage.f +++ b/SRC/ssytrf_aa_2stage.f @@ -94,7 +94,7 @@ *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -121,14 +121,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL workspace of size LWORK +*> WORK is REAL workspace of size (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -212,9 +212,9 @@ SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -228,10 +228,10 @@ SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'SSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = (3*NB+1)*N + TB( 1 ) = SROUNDUP_LWORK( MAX( 1, (3*NB+1)*N ) ) END IF IF( WQUERY ) THEN - WORK( 1 ) = SROUNDUP_LWORK(N*NB) + WORK( 1 ) = SROUNDUP_LWORK( MAX( 1, N*NB ) ) END IF END IF IF( TQUERY .OR. WQUERY ) THEN @@ -240,7 +240,7 @@ SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF * diff --git a/SRC/ssytrf_rk.f b/SRC/ssytrf_rk.f index 72830543cf..89ecf38fde 100644 --- a/SRC/ssytrf_rk.f +++ b/SRC/ssytrf_rk.f @@ -177,14 +177,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL 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 *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned *> by ILAENV. *> @@ -312,7 +312,7 @@ SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * NB = ILAENV( 1, 'SSYTRF_RK', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( 1, N*NB ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -488,7 +488,7 @@ SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of SSYTRF_RK diff --git a/SRC/ssytrf_rook.f b/SRC/ssytrf_rook.f index 339a229e7c..7c2cbbc57e 100644 --- a/SRC/ssytrf_rook.f +++ b/SRC/ssytrf_rook.f @@ -118,7 +118,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -260,7 +260,7 @@ SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * NB = ILAENV( 1, 'SSYTRF_ROOK', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( 1, N*NB ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -383,7 +383,8 @@ SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of SSYTRF_ROOK diff --git a/SRC/ssytri2.f b/SRC/ssytri2.f index caa0abb15b..ba83605cc9 100644 --- a/SRC/ssytri2.f +++ b/SRC/ssytri2.f @@ -88,16 +88,16 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N+NB+1)*(NB+3) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> WORK is size >= (N+NB+1)*(NB+3) +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine -*> calculates: +*> 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. @@ -147,7 +147,8 @@ SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - EXTERNAL LSAME, ILAENV + REAL SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SSYTRI, SSYTRI2X, XERBLA @@ -159,9 +160,13 @@ SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) +* * Get blocksize +* NBMAX = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 ) - IF ( NBMAX .GE. N ) THEN + IF( N.EQ.0 ) THEN + MINSIZE = 1 + ELSE IF( NBMAX.GE.N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -173,24 +178,24 @@ SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF -* -* Quick return if possible -* * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SSYTRI2', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK(1)=MINSIZE + WORK( 1 ) = SROUNDUP_LWORK( MINSIZE ) RETURN END IF +* +* Quick return if possible +* IF( N.EQ.0 ) $ RETURN - - IF( NBMAX .GE. N ) THEN +* + IF( NBMAX.GE.N ) THEN CALL SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) ELSE CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) diff --git a/SRC/ssytri_3.f b/SRC/ssytri_3.f index bca01105d5..f0152a1499 100644 --- a/SRC/ssytri_3.f +++ b/SRC/ssytri_3.f @@ -119,16 +119,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N+NB+1)*(NB+3). +*> WORK is REAL array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= (N+NB+1)*(NB+3). +*> The length of WORK. +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> -*> If LDWORK = -1, then a workspace query is assumed; +*> If LWORK = -1, then a workspace query is assumed; *> the routine only calculates the optimal size of the optimal *> size of the WORK array, returns this value as the first *> entry of the WORK array, and no error message related to @@ -209,8 +210,13 @@ SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * * Determine the block size * - NB = MAX( 1, ILAENV( 1, 'SSYTRI_3', UPLO, N, -1, -1, -1 ) ) - LWKOPT = ( N+NB+1 ) * ( NB+3 ) + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MAX( 1, ILAENV( 1, 'SSYTRI_3', UPLO, N, -1, -1, -1 ) ) + LWKOPT = ( N+NB+1 ) * ( NB+3 ) + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 @@ -218,7 +224,7 @@ SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN INFO = -8 END IF * @@ -226,7 +232,6 @@ SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, CALL XERBLA( 'SSYTRI_3', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) RETURN END IF * @@ -237,7 +242,7 @@ SUBROUTINE SSYTRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * CALL SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/ssytrs_aa.f b/SRC/ssytrs_aa.f index 12fca0c716..265cf0c1dd 100644 --- a/SRC/ssytrs_aa.f +++ b/SRC/ssytrs_aa.f @@ -105,7 +105,13 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> The dimension of the array WORK. +*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the minimal 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 @@ -141,7 +147,7 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * .. * .. Array Arguments .. INTEGER IPIV( * ) - REAL A( LDA, * ), B( LDB, * ), WORK( * ) + REAL A( LDA, * ), B( LDB, * ), WORK( * ) * .. * * ===================================================================== @@ -151,24 +157,31 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * .. * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER K, KP, LWKOPT + INTEGER K, KP, LWKMIN * .. * .. External Functions .. LOGICAL LSAME + EXTERNAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME, SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGTSV, SSWAP, SLACPY, STRSM, XERBLA * .. * .. Intrinsic Functions .. - INTRINSIC MAX + INTRINSIC MIN, MAX * .. * .. Executable Statements .. * INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 3*N-2 + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -179,21 +192,20 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'SSYTRS_AA', -INFO ) RETURN ELSE IF( LQUERY ) THEN - LWKOPT = (3*N-2) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKMIN ) RETURN END IF * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) + IF( MIN( N, NRHS ).EQ.0 ) $ RETURN * IF( UPPER ) THEN diff --git a/TESTING/LIN/schksy_aa_2stage.f b/TESTING/LIN/schksy_aa_2stage.f index d3c27ae561..6490cd7c37 100644 --- a/TESTING/LIN/schksy_aa_2stage.f +++ b/TESTING/LIN/schksy_aa_2stage.f @@ -423,9 +423,9 @@ SUBROUTINE SCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, * block factorization, LWORK is the length of AINV. * SRNAMT = 'SSYTRF_AA_2STAGE' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) CALL SSYTRF_AA_2STAGE( UPLO, N, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ WORK, LWORK, $ INFO ) @@ -505,7 +505,6 @@ SUBROUTINE SCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) * SRNAMT = 'SSYTRS_AA_2STAGE' - LWORK = MAX( 1, 3*N-2 ) CALL SSYTRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ), $ X, LDA, INFO ) diff --git a/TESTING/LIN/sdrvsy_aa_2stage.f b/TESTING/LIN/sdrvsy_aa_2stage.f index aff32bce93..319b90805e 100644 --- a/TESTING/LIN/sdrvsy_aa_2stage.f +++ b/TESTING/LIN/sdrvsy_aa_2stage.f @@ -400,9 +400,9 @@ SUBROUTINE SDRVSY_AA_2STAGE( * Factor the matrix and solve the system using SSYSV_AA. * SRNAMT = 'SSYSV_AA_2STAGE ' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) CALL SSYSV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ X, LDA, WORK, LWORK, INFO ) * From e0d8afbed6b1058114ca13d9c7db6ad1741f6435 Mon Sep 17 00:00:00 2001 From: Elizaveta Tokmasheva Date: Mon, 27 Nov 2023 18:57:37 +0700 Subject: [PATCH 011/206] handle and document corner cases of lwork in lapack, single complex precision --- SRC/cgebrd.f | 28 ++++++++++------ SRC/cgehrd.f | 17 +++++++--- SRC/cgelq.f | 8 ++--- SRC/cgelqf.f | 20 +++++++---- SRC/cgemlq.f | 25 +++++++++----- SRC/cgemqr.f | 23 +++++++++---- SRC/cgeqlf.f | 12 ++++--- SRC/cgeqp3rk.f | 3 +- SRC/cgeqr.f | 19 ++++++----- SRC/cgeqrfp.f | 26 ++++++++++----- SRC/cgesvdx.f | 2 +- SRC/cgesvj.f | 43 +++++++++++++++--------- SRC/cgetri.f | 6 ++-- SRC/cgetsls.f | 7 ++-- SRC/cgetsqrhrt.f | 11 +++--- SRC/cgges3.f | 13 ++++++-- SRC/cggev3.f | 14 +++++--- SRC/cgghd3.f | 12 ++++--- SRC/cggqrf.f | 4 +-- SRC/cggrqf.f | 2 +- SRC/cggsvd3.f | 2 +- SRC/cggsvp3.f | 2 +- SRC/cheevr_2stage.f | 11 +++--- SRC/cheevx.f | 4 +-- SRC/chesv_aa.f | 8 ++--- SRC/chesv_aa_2stage.f | 17 +++++----- SRC/chesvx.f | 13 ++++---- SRC/chetrd_2stage.f | 30 +++++++++++------ SRC/chetrd_hb2st.F | 29 ++++++++++------ SRC/chetrd_he2hb.f | 18 ++++++---- SRC/chetrf.f | 6 ++-- SRC/chetrf_aa.f | 6 ++-- SRC/chetrf_aa_2stage.f | 24 +++++++------ SRC/chetrf_rk.f | 8 ++--- SRC/chetrf_rook.f | 6 ++-- SRC/chetri2.f | 15 +++++---- SRC/chetri_3.f | 21 +++++++----- SRC/chetrs_aa.f | 25 ++++++++++---- SRC/clamswlq.f | 34 ++++++++++++------- SRC/clamtsqr.f | 33 +++++++++++------- SRC/claswlq.f | 61 ++++++++++++++++++++-------------- SRC/clatrs3.f | 27 +++++++++++---- SRC/clatsqr.f | 59 +++++++++++++++++++------------- TESTING/LIN/cchkhe_aa_2stage.f | 7 ++-- TESTING/LIN/cdrvhe_aa_2stage.f | 4 +-- 45 files changed, 477 insertions(+), 288 deletions(-) diff --git a/SRC/cgebrd.f b/SRC/cgebrd.f index ed95bf35d1..cd03c86361 100644 --- a/SRC/cgebrd.f +++ b/SRC/cgebrd.f @@ -123,7 +123,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,M,N). +*> The length of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise. *> For optimum performance LWORK >= (M+N)*NB, where NB *> is the optimal blocksize. *> @@ -225,8 +226,8 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX, WS + INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT, + $ MINMN, NB, NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL CGEBD2, CGEMM, CLABRD, XERBLA @@ -236,16 +237,24 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * .. * .. External Functions .. INTEGER ILAENV - EXTERNAL ILAENV + REAL SROUNDUP_LWORK + EXTERNAL ILAENV, SROUNDUP_LWORK * .. * .. Executable Statements .. * * Test the input parameters * INFO = 0 - NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = ( M+N )*NB - WORK( 1 ) = REAL( LWKOPT ) + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = MAX( M, N ) + NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) ) + LWKOPT = MAX( 1, ( M+N )*NB ) + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -253,7 +262,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.LT.0 ) THEN @@ -265,7 +274,6 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * * Quick return if possible * - MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -343,7 +351,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * CALL CGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ), $ TAUQ( I ), TAUP( I ), WORK, IINFO ) - WORK( 1 ) = WS + WORK( 1 ) = SROUNDUP_LWORK( WS ) RETURN * * End of CGEBRD diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index f407f931a9..f50c5b43f1 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -89,7 +89,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (LWORK) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -226,9 +226,15 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'CGEHRD', ' ', N, ILO, IHI, -1 ) ) - LWKOPT = N*NB + TSIZE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, + $ -1 ) ) + LWKOPT = N*NB + TSIZE + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -345,7 +351,8 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * Use unblocked code to reduce the rest of the matrix * CALL CGEHD2( N, I, IHI, A, LDA, TAU, WORK, IINFO ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/cgelq.f b/SRC/cgelq.f index ff482bc42e..24aaa982e3 100644 --- a/SRC/cgelq.f +++ b/SRC/cgelq.f @@ -98,7 +98,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error @@ -295,9 +295,9 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE - WORK( 1 ) = SROUNDUP_LWORK(LWREQ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) END IF END IF IF( INFO.NE.0 ) THEN @@ -322,7 +322,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWREQ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) * RETURN * diff --git a/SRC/cgelqf.f b/SRC/cgelqf.f index 75f5bc9601..2d53ae89b3 100644 --- a/SRC/cgelqf.f +++ b/SRC/cgelqf.f @@ -93,7 +93,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,M). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise. *> For optimum performance LWORK >= M*NB, where NB is the *> optimal blocksize. *> @@ -175,9 +176,8 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Test the input arguments * INFO = 0 + K = MIN( M, N ) NB = ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - LWKOPT = M*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -185,19 +185,25 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF ( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CGELQF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = M*NB + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -267,7 +273,7 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ CALL CGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ IINFO ) * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of CGELQF diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f index 69c1b72353..c5560c314b 100644 --- a/SRC/cgemlq.f +++ b/SRC/cgemlq.f @@ -111,12 +111,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -187,11 +188,12 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME - EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLAMSWLQ, CGEMLQT, XERBLA @@ -203,7 +205,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) @@ -219,6 +221,13 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, MN = N END IF * + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF + IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN NBLCKS = ( MN - K ) / ( NB - K ) @@ -246,12 +255,12 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = REAL( LW ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -263,7 +272,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -276,7 +285,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ MB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = REAL( LW ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * RETURN * diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f index 94011d835a..c7d0827820 100644 --- a/SRC/cgemqr.f +++ b/SRC/cgemqr.f @@ -112,12 +112,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -189,11 +190,12 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME - EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CGEMQRT, CLAMTSQR, XERBLA @@ -205,7 +207,7 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) @@ -220,6 +222,13 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = MB * NB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN @@ -253,7 +262,7 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LW + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -265,7 +274,7 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -278,7 +287,7 @@ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ NB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = LW + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * RETURN * diff --git a/SRC/cgeqlf.f b/SRC/cgeqlf.f index 918bbddad5..bb7d22b674 100644 --- a/SRC/cgeqlf.f +++ b/SRC/cgeqlf.f @@ -88,7 +88,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -187,10 +188,11 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) NB = ILAENV( 1, 'CGEQLF', ' ', M, N, -1, -1 ) LWKOPT = N*NB END IF - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * - IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF END IF * @@ -277,7 +279,7 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) IF( MU.GT.0 .AND. NU.GT.0 ) $ CALL CGEQL2( MU, NU, A, LDA, TAU, WORK, IINFO ) * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of CGEQLF diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f index 5878606840..1e430b908b 100755 --- a/SRC/cgeqp3rk.f +++ b/SRC/cgeqp3rk.f @@ -428,7 +428,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*. LWORK >= N+NRHS-1 +*> LWORK >= 1, if MIN(M,N) = 0, +*> LWORK >= N+NRHS-1, otherwise. *> For optimal performance LWORK >= NB*( N+NRHS+1 ), *> where NB is the optimal block size for CGEQP3RK returned *> by ILAENV. Minimal block size MINNB=2. diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index 51a7389213..494ca5fe40 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -99,7 +99,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error @@ -190,11 +190,12 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ * .. * .. External Functions .. LOGICAL LSAME - EXTERNAL LSAME + REAL SROUNDUP_LWORK + EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLATSQR, CGEQRT, XERBLA @@ -246,8 +247,10 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * * Determine if the workspace size satisfies minimal size * + LWMIN = MAX( 1, N ) + LWREQ = MAX( 1, N*NB ) LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N ) + IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.LWREQ ) $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN @@ -255,7 +258,7 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, NB = 1 MB = M END IF - IF( LWORK.LT.NB*N ) THEN + IF( LWORK.LT.LWREQ ) THEN LMINWS = .TRUE. NB = 1 END IF @@ -284,9 +287,9 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) END IF END IF IF( INFO.NE.0 ) THEN @@ -311,7 +314,7 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = SROUNDUP_LWORK( LWREQ ) * RETURN * diff --git a/SRC/cgeqrfp.f b/SRC/cgeqrfp.f index eaf98ddf34..c504221c65 100644 --- a/SRC/cgeqrfp.f +++ b/SRC/cgeqrfp.f @@ -97,7 +97,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -162,8 +163,8 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, - $ NBMIN, NX + INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT, + $ NB, NBMIN, NX * .. * .. External Subroutines .. EXTERNAL CGEQR2P, CLARFB, CLARFT, XERBLA @@ -182,8 +183,16 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + K = MIN( M, N ) + IF ( K.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = N + LWKOPT = N*NB + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -191,7 +200,7 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF IF( INFO.NE.0 ) THEN @@ -203,7 +212,6 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -211,7 +219,7 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * NBMIN = 2 NX = 0 - IWS = N + IWS = LWKMIN IF( NB.GT.1 .AND. NB.LT.K ) THEN * * Determine when to cross over from blocked to unblocked code. @@ -273,7 +281,7 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ CALL CGEQR2P( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK, $ IINFO ) * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of CGEQRFP diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index 31e6fe64c4..51e69cbe0f 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -464,7 +464,7 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * * Quick return if possible * - IF( M.EQ.0 .OR. N.EQ.0 ) THEN + IF( MINMN.EQ.0 ) THEN RETURN END IF * diff --git a/SRC/cgesvj.f b/SRC/cgesvj.f index fdec6d39ed..125c34a565 100644 --- a/SRC/cgesvj.f +++ b/SRC/cgesvj.f @@ -216,7 +216,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER. -*> Length of CWORK, LWORK >= M+N. +*> Length of CWORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(1,M+N), otherwise. *> \endverbatim *> *> \param[in,out] RWORK @@ -374,16 +375,17 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, PARAMETER ( NSWEEP = 30 ) * .. * .. Local Scalars .. - COMPLEX AAPQ, OMPQ - REAL AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG, - $ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ, - $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL, - $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL - INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, - $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, - $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND - LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK, - $ RSVEC, UCTOL, UPPER + COMPLEX AAPQ, OMPQ + REAL AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG, + $ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ, + $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL, + $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL + INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, + $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, + $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND, + $ MINMN, LWMIN, LRWMIN + LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK, + $ RSVEC, UCTOL, UPPER * .. * .. * .. Intrinsic Functions .. @@ -421,6 +423,17 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, APPLV = LSAME( JOBV, 'A' ) UPPER = LSAME( JOBA, 'U' ) LOWER = LSAME( JOBA, 'L' ) + + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + LRWMIN = 6 + ELSE + LWMIN = M + N + LRWMIN = MAX( 6, N ) + END IF + CWORK(1) = LWMIN + RWORK(1) = LRWMIN * LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN @@ -442,9 +455,9 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.( M+N ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 - ELSE IF( LRWORK.LT.MAX( N, 6 ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LRWORK.LT.LRWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -15 ELSE INFO = 0 @@ -455,14 +468,12 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL XERBLA( 'CGESVJ', -INFO ) RETURN ELSE IF ( LQUERY ) THEN - CWORK(1) = M + N - RWORK(1) = MAX( N, 6 ) RETURN END IF * * #:) Quick return for void matrix * - IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN + IF( MINMN.EQ.0 ) RETURN * * Set numerical parameters * The stopping criterion for Jacobi rotations is diff --git a/SRC/cgetri.f b/SRC/cgetri.f index 2060d1444f..2eb3da7abe 100644 --- a/SRC/cgetri.f +++ b/SRC/cgetri.f @@ -153,8 +153,8 @@ SUBROUTINE CGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'CGETRI', ' ', N, -1, -1, -1 ) - LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, N*NB ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 @@ -252,7 +252,7 @@ SUBROUTINE CGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL CSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) 60 CONTINUE * - WORK( 1 ) = SROUNDUP_LWORK(IWS) + WORK( 1 ) = SROUNDUP_LWORK( IWS ) RETURN * * End of CGETRI diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index b4bb7562fc..3f43dc8de0 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -127,7 +127,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1, the routine calculates optimal size of WORK for the *> optimal performance and returns this value in WORK(1). @@ -229,7 +229,10 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * * Determine the optimum and minimum LWORK * - IF( M.GE.N ) THEN + IF( MIN( M, N, NRHS ).EQ.0 ) THEN + WSIZEO = 1 + WSIZEM = 1 + ELSE IF ( M.GE.N ) THEN CALL CGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) TSZO = INT( TQ( 1 ) ) LWO = INT( WORKQ( 1 ) ) diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 2600500e0c..477a833cae 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -131,13 +131,13 @@ *> \param[in] LWORK *> \verbatim *> The dimension of the array WORK. -*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), +*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NB1LOCAL = MIN(NB1,N). *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LW1 = NB1LOCAL * N, -*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), +*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ). *> 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 @@ -212,7 +212,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * Test the input arguments * INFO = 0 - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. M.LT.N ) THEN @@ -263,8 +263,9 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) * LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) + LWORKOPT = MAX( 1, LWORKOPT ) * - IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN INFO = -11 END IF * @@ -346,4 +347,4 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * * End of CGETSQRHRT * - END \ No newline at end of file + END diff --git a/SRC/cgges3.f b/SRC/cgges3.f index ea4cc5196c..362ada817e 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -216,6 +216,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK >= 2*N. +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -300,7 +302,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, $ LQUERY, WANTST INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, - $ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT + $ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT, + $ LWKMIN REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, $ PVSR, SMLNUM * .. @@ -352,6 +355,12 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + IF( N.EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 2*N + END IF +* IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -368,7 +377,7 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -14 ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN INFO = -16 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * diff --git a/SRC/cggev3.f b/SRC/cggev3.f index 350543c085..c5cd349613 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -174,7 +174,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= MAX(1,2*N). +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -243,7 +244,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHARACTER CHTEMP INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, $ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR, - $ LWKOPT + $ LWKOPT, LWKMIN REAL ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, $ SMLNUM, TEMP COMPLEX X @@ -300,6 +301,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N ) IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -314,7 +316,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, INFO = -11 ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -15 END IF * @@ -347,7 +349,11 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ RWORK, 0, IERR ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) END IF - WORK( 1 ) = CMPLX( LWKOPT ) + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = CMPLX( LWKOPT ) + END IF END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index 47e70e3a34..e105edf3e9 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -180,14 +180,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (LWORK) +*> WORK is COMPLEX array, dimension (MAX(1, LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= 1. +*> The length of the array WORK. LWORK >= 1. *> For optimum performance LWORK >= 6*N*NB, where NB is the *> optimal blocksize. *> @@ -280,7 +280,12 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * INFO = 0 NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = MAX( 6*N*NB, 1 ) + NH = IHI - ILO + 1 + IF( N.EQ.0 .OR. NH.LE.1 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = 6*N*NB + END IF WORK( 1 ) = CMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) @@ -330,7 +335,6 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = CONE RETURN diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f index 29b0bf4af3..0ab8c1dfc9 100644 --- a/SRC/cggqrf.f +++ b/SRC/cggqrf.f @@ -251,8 +251,8 @@ SUBROUTINE CGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'CGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'CUNMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P)*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, MAX( N, M, P)*NB ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 diff --git a/SRC/cggrqf.f b/SRC/cggrqf.f index 273ab3ef7b..0b301ce73e 100644 --- a/SRC/cggrqf.f +++ b/SRC/cggrqf.f @@ -250,7 +250,7 @@ SUBROUTINE CGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'CGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'CUNMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P)*NB + LWKOPT = MAX( 1, N, M, P)*NB WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN diff --git a/SRC/cggsvd3.f b/SRC/cggsvd3.f index 8297cdf629..4c4b85baee 100644 --- a/SRC/cggsvd3.f +++ b/SRC/cggsvd3.f @@ -278,7 +278,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/cggsvp3.f b/SRC/cggsvp3.f index 82a8222613..e19f7efd51 100644 --- a/SRC/cggsvp3.f +++ b/SRC/cggsvp3.f @@ -233,7 +233,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index f8b1ee1071..5ab6227bc3 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -443,8 +443,9 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV, ILAENV2STAGE - REAL SLAMCH, CLANSY - EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE + REAL SLAMCH, CLANSY, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, CLANSY, ILAENV, ILAENV2STAGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL, @@ -506,7 +507,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RWORK( 1 ) = LRWMIN IWORK( 1 ) = LIWMIN * @@ -666,7 +667,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) * - IF (ABSTOL .LE. TWO*N*EPS) THEN + IF ( ABSTOL .LE. TWO*N*EPS ) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. @@ -765,7 +766,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = LWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RWORK( 1 ) = LRWMIN IWORK( 1 ) = LIWMIN * diff --git a/SRC/cheevx.f b/SRC/cheevx.f index e91599a44e..99ab14025c 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -348,14 +348,14 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, IF( INFO.EQ.0 ) THEN IF( N.LE.1 ) THEN LWKMIN = 1 - WORK( 1 ) = LWKMIN + LWKOPT = 1 ELSE LWKMIN = 2*N NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( 1, ( NB + 1 )*N ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) $ INFO = -17 diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f index 53ecc0a165..bb3a5ea4f8 100644 --- a/SRC/chesv_aa.f +++ b/SRC/chesv_aa.f @@ -207,7 +207,7 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * @@ -217,8 +217,8 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) LWKOPT_HETRS = INT( WORK(1) ) - LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, LWKOPT_HETRF, LWKOPT_HETRS ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -240,7 +240,7 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/chesv_aa_2stage.f b/SRC/chesv_aa_2stage.f index 12950c4af8..e45a883aef 100644 --- a/SRC/chesv_aa_2stage.f +++ b/SRC/chesv_aa_2stage.f @@ -99,14 +99,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is COMPLEX array, dimension (LTB) +*> TB is COMPLEX array, dimension (MAX(1,LTB)). *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -146,14 +146,15 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX workspace of size LWORK +*> WORK is COMPLEX workspace of size (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -233,11 +234,11 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 - ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * @@ -268,7 +269,7 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/chesvx.f b/SRC/chesvx.f index c23a35ce72..d9e08f5cba 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -307,7 +307,7 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * .. * .. Local Scalars .. LOGICAL LQUERY, NOFACT - INTEGER LWKOPT, NB + INTEGER LWKMIN, LWKOPT, NB REAL ANORM * .. * .. External Functions .. @@ -329,6 +329,7 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = 0 NOFACT = LSAME( FACT, 'N' ) LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) @@ -346,17 +347,17 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = -11 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, 2*N ) + LWKOPT = LWKMIN IF( NOFACT ) THEN NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) - LWKOPT = MAX( LWKOPT, N*NB ) + LWKOPT = MAX( LWKMIN, N*NB ) END IF - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -405,7 +406,7 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) $ INFO = N + 1 * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f index 99ff034805..5733172d9f 100644 --- a/SRC/chetrd_2stage.f +++ b/SRC/chetrd_2stage.f @@ -123,7 +123,7 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is COMPLEX array, dimension (LHOUS2) +*> HOUS2 is COMPLEX array, dimension (MAX(1,LHOUS2)) *> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim @@ -132,6 +132,8 @@ *> \verbatim *> LHOUS2 is INTEGER *> The dimension of the array HOUS2. +*> LHOUS2 >= 1. +*> *> If LWORK = -1, or LHOUS2=-1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns @@ -143,13 +145,16 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (LWORK) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) +*> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension). +*> *> If LWORK = -1, or LHOUS2 = -1, *> then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -250,7 +255,8 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV2STAGE - EXTERNAL LSAME, ILAENV2STAGE + REAL SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV2STAGE, SROUNDUP_LWORK * .. * .. Executable Statements .. * @@ -265,10 +271,13 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 ) IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) -* WRITE(*,*),'CHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, -* $ LHMIN, LWMIN + IF( N.EQ.0 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN INFO = -1 @@ -286,7 +295,7 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * IF( INFO.EQ.0 ) THEN HOUS2( 1 ) = LHMIN - WORK( 1 ) = LWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -324,8 +333,7 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * * - HOUS2( 1 ) = LHMIN - WORK( 1 ) = LWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CHETRD_2STAGE diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index 3688e40a3d..17e7fcaf2d 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -132,15 +132,17 @@ *> *> \param[out] HOUS *> \verbatim -*> HOUS is COMPLEX array, dimension LHOUS, that -*> store the Householder representation. +*> HOUS is COMPLEX array, dimension (MAX(1,LHOUS)) +*> Stores the Householder representation. *> \endverbatim *> *> \param[in] LHOUS *> \verbatim *> LHOUS is INTEGER -*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array HOUS. +*> If N = 0, LHOUS >= 1, else LHOUS = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS array, returns *> this value as the first entry of the HOUS array, and no error @@ -152,14 +154,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension LWORK. +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)). +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array WORK. +*> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -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 @@ -296,8 +301,13 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the block size, the workspace size and the hous size. * IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + IF( N.EQ.0 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN INFO = -1 @@ -575,7 +585,6 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 170 CONTINUE ENDIF * - HOUS( 1 ) = LHMIN WORK( 1 ) = SROUNDUP_LWORK(LWMIN) RETURN * diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 090f021009..7de1dae694 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -123,8 +123,8 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (LWORK) -*> On exit, if INFO = 0, or if LWORK=-1, +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, or if LWORK = -1, *> WORK(1) returns the size of LWORK. *> \endverbatim *> @@ -132,7 +132,9 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK which should be calculated -*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) +*> by a workspace query. +*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY). +*> *> 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 @@ -294,7 +296,11 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 ) + IF(N.LE.KD+1) THEN + LWMIN = 1 + ELSE + LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 ) + END IF IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 @@ -314,7 +320,7 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, CALL XERBLA( 'CHETRD_HE2HB', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN END IF * @@ -507,7 +513,7 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CHETRD_HE2HB diff --git a/SRC/chetrf.f b/SRC/chetrf.f index 0c596ffe7c..2b44956283 100644 --- a/SRC/chetrf.f +++ b/SRC/chetrf.f @@ -107,7 +107,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> \endverbatim *> @@ -229,7 +229,7 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -347,7 +347,7 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of CHETRF diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index 0547a4eab3..62330cd71a 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -190,8 +190,8 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = (NB+1)*N - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, (NB+1)*N ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -460,7 +460,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) END IF * 20 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of CHETRF_AA diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index c41f65b263..723e0c2948 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -87,14 +87,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is COMPLEX array, dimension (LTB) +*> TB is COMPLEX array, dimension (MAX(1,LTB)) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -121,14 +121,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX workspace of size LWORK +*> WORK is COMPLEX workspace of size (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used +*> to select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -182,13 +182,14 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY INTEGER I, J, K, I1, I2, TD - INTEGER LDTB, NB, KB, JB, NT, IINFO + INTEGER LWKOPT, LDTB, NB, KB, JB, NT, IINFO COMPLEX PIV * .. * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - EXTERNAL LSAME, ILAENV + REAL SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. @@ -213,9 +214,9 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN + ELSE IF ( LTB .LT. MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN + ELSE IF ( LWORK .LT. MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -229,10 +230,11 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'CHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = (3*NB+1)*N + TB( 1 ) = MAX( 1, (3*NB+1)*N ) END IF IF( WQUERY ) THEN - WORK( 1 ) = N*NB + LWKOPT = MAX( 1, N*NB ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF END IF IF( TQUERY .OR. WQUERY ) THEN diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f index ef442c9378..bbf0578dfc 100644 --- a/SRC/chetrf_rk.f +++ b/SRC/chetrf_rk.f @@ -177,14 +177,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension ( MAX(1,LWORK) ). +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned *> by ILAENV. *> @@ -312,7 +312,7 @@ SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 ) LWKOPT = N*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -488,7 +488,7 @@ SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of CHETRF_RK diff --git a/SRC/chetrf_rook.f b/SRC/chetrf_rook.f index 1593c2edca..df0323520b 100644 --- a/SRC/chetrf_rook.f +++ b/SRC/chetrf_rook.f @@ -122,7 +122,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -264,7 +264,7 @@ SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( 1, N*NB ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -387,7 +387,7 @@ SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of CHETRF_ROOK diff --git a/SRC/chetri2.f b/SRC/chetri2.f index ca9191c7c2..11baacc8e1 100644 --- a/SRC/chetri2.f +++ b/SRC/chetri2.f @@ -88,14 +88,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (N+NB+1)*(NB+3) +*> WORK is COMPLEX array, dimension (MAX(1, LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> WORK is size >= (N+NB+1)*(NB+3) +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine *> calculates: *> - the optimal size of the WORK array, returns @@ -147,7 +147,8 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - EXTERNAL LSAME, ILAENV + REAL SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHETRI2X, CHETRI, XERBLA @@ -161,7 +162,9 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) LQUERY = ( LWORK.EQ.-1 ) * Get blocksize NBMAX = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) - IF ( NBMAX .GE. N ) THEN + IF( N.EQ.0 ) THEN + MINSIZE = 1 + ELSE IF ( NBMAX .GE. N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -173,7 +176,7 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * @@ -184,7 +187,7 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) CALL XERBLA( 'CHETRI2', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK(1)=MINSIZE + WORK( 1 ) = SROUNDUP_LWORK( MINSIZE ) RETURN END IF IF( N.EQ.0 ) diff --git a/SRC/chetri_3.f b/SRC/chetri_3.f index deda635983..bcc78cb95c 100644 --- a/SRC/chetri_3.f +++ b/SRC/chetri_3.f @@ -119,16 +119,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (N+NB+1)*(NB+3). +*> WORK is COMPLEX array, dimension (MAX(1, LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= (N+NB+1)*(NB+3). +*> The length of WORK. +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> -*> If LDWORK = -1, then a workspace query is assumed; +*> If LWORK = -1, then a workspace query is assumed; *> the routine only calculates the optimal size of the optimal *> size of the WORK array, returns this value as the first *> entry of the WORK array, and no error message related to @@ -209,8 +210,13 @@ SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * * Determine the block size * - NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) ) - LWKOPT = ( N+NB+1 ) * ( NB+3 ) + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) ) + LWKOPT = ( N+NB+1 ) * ( NB+3 ) + END IF + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 @@ -218,7 +224,7 @@ SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LWORK .LT. LWKOPT .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN INFO = -8 END IF * @@ -226,7 +232,6 @@ SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, CALL XERBLA( 'CHETRI_3', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) RETURN END IF * @@ -237,7 +242,7 @@ SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * CALL CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f index 8795491064..51a817dedc 100644 --- a/SRC/chetrs_aa.f +++ b/SRC/chetrs_aa.f @@ -105,7 +105,13 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> The dimension of the array WORK. +*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the minimal 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 @@ -151,24 +157,30 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * .. * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER K, KP, LWKOPT + INTEGER K, KP, LWKMIN * .. * .. External Functions .. LOGICAL LSAME REAL SROUNDUP_LWORK - EXTERNAL LSAME,SROUNDUP_LWORK + EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, XERBLA * .. * .. Intrinsic Functions .. - INTRINSIC MAX + INTRINSIC MIN, MAX * .. * .. Executable Statements .. * INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 3*N-2 + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -179,15 +191,14 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CHETRS_AA', -INFO ) RETURN ELSE IF( LQUERY ) THEN - LWKOPT = (3*N-2) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKMIN ) RETURN END IF * diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index 5daf60bf67..d96193d0c0 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -128,16 +128,18 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> If SIDE = 'L', LWORK >= max(1,NB) * MB; -*> if SIDE = 'R', LWORK >= max(1,M) * MB. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,NB*MB). +*> if SIDE = 'R', LWORK >= max(1,M*MB). *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -213,7 +215,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR + INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -226,17 +228,24 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF ( LEFT ) THEN LW = N * MB ELSE LW = M * MB END IF * + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF + INFO = 0 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN INFO = -1 @@ -248,7 +257,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 - ELSE IF( K.LT.MB .OR. MB.LT.1) THEN + ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN INFO = -6 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 @@ -256,22 +265,23 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * + IF ( INFO.EQ.0) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLAMSWLQ', -INFO ) - WORK(1) = SROUNDUP_LWORK(LW) RETURN ELSE IF (LQUERY) THEN - WORK(1) = SROUNDUP_LWORK(LW) RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -404,7 +414,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = SROUNDUP_LWORK(LW) + WORK(1) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CLAMSWLQ diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f index 05021e642b..c5d063904e 100644 --- a/SRC/clamtsqr.f +++ b/SRC/clamtsqr.f @@ -129,6 +129,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> *> \endverbatim *> \param[in] LWORK @@ -136,8 +137,9 @@ *> LWORK is INTEGER *> The dimension of the array WORK. *> -*> If SIDE = 'L', LWORK >= max(1,N)*NB; -*> if SIDE = 'R', LWORK >= max(1,MB)*NB. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,N*NB); +*> if SIDE = 'R', LWORK >= max(1,MB*NB). *> 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 @@ -215,7 +217,7 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + INTEGER I, II, KK, LW, CTR, Q, LWMIN, MINMNK * .. * .. External Functions .. LOGICAL LSAME @@ -228,12 +230,13 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * * Test the input arguments * - LQUERY = LWORK.LT.0 + INFO = 0 + LQUERY = ( LWORK.LT.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF ( LEFT ) THEN LW = N * NB Q = M ELSE @@ -241,7 +244,13 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, Q = N END IF * - INFO = 0 + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN @@ -260,26 +269,26 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + ELSE IF( LWORK.LT.MINMNK .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * * Determine the block size if it is tall skinny or short and wide * - IF( INFO.EQ.0) THEN - WORK(1) = SROUNDUP_LWORK(LW) + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLAMTSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN + ELSE IF ( LQUERY ) THEN RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * @@ -412,7 +421,7 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = SROUNDUP_LWORK(LW) + WORK( 1 ) = SROUNDUP_LWORK(LWMIN) RETURN * * End of CLAMTSQR diff --git a/SRC/claswlq.f b/SRC/claswlq.f index 12e8373df9..9c2209ba65 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -96,22 +96,26 @@ *> The leading dimension of the array T. LDT >= MB. *> \endverbatim *> -*> *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= MB*M. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise. +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -181,7 +185,7 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, II, KK, CTR + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME @@ -200,12 +204,19 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = M*MB + END IF * IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 - ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN + ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN INFO = -3 ELSE IF( NB.LE.0 ) THEN INFO = -4 @@ -213,60 +224,60 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 - ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( ( LWORK.LT.LWMIN ) .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = SROUNDUP_LWORK(MB*M) + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLASWLQ', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF ( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The LQ Decomposition * - IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN + IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN CALL CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF + END IF * - KK = MOD((N-M),(NB-M)) - II=N-KK+1 + KK = MOD((N-M),(NB-M)) + II = N-KK+1 * * Compute the LQ factorization of the first block A(1:M,1:NB) * - CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) - CTR = 1 + CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) + CTR = 1 * - DO I = NB+1, II-NB+M , (NB-M) + DO I = NB+1, II-NB+M , (NB-M) * * Compute the QR factorization of the current block A(1:M,I:I+NB-M) * - CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), + CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), $ LDA, T(1,CTR*M+1), $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CTR = CTR + 1 + END DO * * Compute the QR factorization of the last block A(1:M,II:N) * - IF (II.LE.N) THEN + IF ( II.LE.N ) THEN CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1,CTR*M+1), LDT, $ WORK, INFO ) - END IF + END IF * - WORK( 1 ) = SROUNDUP_LWORK(M * MB) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CLASWLQ diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index d97e416adb..35674be04d 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -152,13 +152,15 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (LWORK). +*> WORK is REAL array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal size of *> WORK. *> \endverbatim *> *> \param[in] LWORK *> LWORK is INTEGER +*> The dimension of the array WORK. +*> If MIN(N,NRHS) = 0, LWORK >= 1, else *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> @@ -257,15 +259,16 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J, $ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2, - $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS + $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS, LWMIN REAL ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, $ SCAMIN, SMLNUM, TMAX * .. * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - REAL SLAMCH, CLANGE, SLARMM - EXTERNAL ILAENV, LSAME, SLAMCH, CLANGE, SLARMM + REAL SLAMCH, CLANGE, SLARMM, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, CLANGE, SLARMM, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLATRS, CSSCAL, XERBLA @@ -296,15 +299,24 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * row. WORK( I + KK * LDS ) is the scale factor of the vector * segment associated with the I-th block row and the KK-th vector * in the block column. +* LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) ) LDS = NBA +* * The second part stores upper bounds of the triangular A. There are * a total of NBA x NBA blocks, of which only the upper triangular * part or the lower triangular part is referenced. The upper bound of * the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ). +* LANRM = NBA * NBA AWRK = LSCALE - WORK( 1 ) = LSCALE + LANRM +* + IF(MIN( N, NRHS ).EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = LSCALE + LANRM + END IF + WORK( 1 ) = SROUNDUP_LWORK ( LWMIN ) * * Test the input parameters. * @@ -326,7 +338,7 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, INFO = -8 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -10 - ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN + ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN INFO = -14 END IF IF( INFO.NE.0 ) THEN @@ -659,6 +671,9 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, END IF END DO END DO +* + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) +* RETURN * * End of CLATRS3 diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f index cd2cb4aa7f..35c199c217 100644 --- a/SRC/clatsqr.f +++ b/SRC/clatsqr.f @@ -102,12 +102,15 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= NB*N. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. +*> *> 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 @@ -183,7 +186,7 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, II, KK, CTR + INTEGER I, II, KK, CTR, LWMIN, MINMN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME @@ -201,6 +204,13 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = N*NB + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -214,58 +224,59 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -6 ELSE IF( LDT.LT.NB ) THEN INFO = -8 - ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF +* IF( INFO.EQ.0) THEN - WORK(1) = SROUNDUP_LWORK(NB*N) + WORK(1) = SROUNDUP_LWORK( LWMIN ) END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLATSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF ( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The QR Decomposition * - IF ((MB.LE.N).OR.(MB.GE.M)) THEN - CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) - RETURN - END IF - KK = MOD((M-N),(MB-N)) - II=M-KK+1 + IF ( (MB.LE.N) .OR. (MB.GE.M) ) THEN + CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) + RETURN + END IF + KK = MOD((M-N),(MB-N)) + II = M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * - CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) - CTR = 1 + CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) + CTR = 1 * - DO I = MB+1, II-MB+N , (MB-N) + DO I = MB+1, II-MB+N , (MB-N) * * Compute the QR factorization of the current block A(I:I+MB-N,1:N) * - CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, + CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, $ T(1,CTR * N + 1), $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CTR = CTR + 1 + END DO * * Compute the QR factorization of the last block A(II:M,1:N) * - IF (II.LE.M) THEN - CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, + IF (II.LE.M) THEN + CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1, CTR * N + 1), LDT, $ WORK, INFO ) - END IF + END IF * - WORK( 1 ) = SROUNDUP_LWORK(N*NB) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CLATSQR diff --git a/TESTING/LIN/cchkhe_aa_2stage.f b/TESTING/LIN/cchkhe_aa_2stage.f index 30a61261f5..8624587894 100644 --- a/TESTING/LIN/cchkhe_aa_2stage.f +++ b/TESTING/LIN/cchkhe_aa_2stage.f @@ -433,9 +433,9 @@ SUBROUTINE CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, * block factorization, LWORK is the length of AINV. * SRNAMT = 'CHETRF_AA_2STAGE' - LWORK = MIN(N*NB, 3*NMAX*NMAX) - CALL CHETRF_AA_2STAGE( UPLO, N, AFAC, LDA, - $ AINV, (3*NB+1)*N, + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX) + CALL CHETRF_AA_2STAGE( UPLO, N, AFAC, LDA, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ WORK, LWORK, $ INFO ) @@ -517,7 +517,6 @@ SUBROUTINE CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) * SRNAMT = 'CHETRS_AA_2STAGE' - LWORK = MAX( 1, 3*N-2 ) CALL CHETRS_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, $ AINV, (3*NB+1)*N, IWORK, IWORK( 1+N ), $ X, LDA, INFO ) diff --git a/TESTING/LIN/cdrvhe_aa_2stage.f b/TESTING/LIN/cdrvhe_aa_2stage.f index 51cef512d8..83e8a17b0f 100644 --- a/TESTING/LIN/cdrvhe_aa_2stage.f +++ b/TESTING/LIN/cdrvhe_aa_2stage.f @@ -400,9 +400,9 @@ SUBROUTINE CDRVHE_AA_2STAGE( * Factor the matrix and solve the system using CHESV_AA. * SRNAMT = 'CHESV_AA_2STAGE ' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX) CALL CHESV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ X, LDA, WORK, LWORK, INFO ) * From 7d15f830c25aba6225c80919013c89049a5ae96c Mon Sep 17 00:00:00 2001 From: Elizaveta Tokmasheva Date: Thu, 30 Nov 2023 17:59:08 +0700 Subject: [PATCH 012/206] handle and document corner cases of lwork in lapack, double complex precision --- SRC/zgebrd.f | 22 ++++++--- SRC/zgehrd.f | 11 +++-- SRC/zgelq.f | 2 +- SRC/zgelqf.f | 16 ++++--- SRC/zgemlq.f | 20 ++++++--- SRC/zgemqr.f | 20 ++++++--- SRC/zgeqlf.f | 8 ++-- SRC/zgeqp3rk.f | 3 +- SRC/zgeqr.f | 16 ++++--- SRC/zgeqrfp.f | 22 ++++++--- SRC/zgesvj.f | 81 ++++++++++++++++++++-------------- SRC/zgetri.f | 2 +- SRC/zgetsls.f | 7 ++- SRC/zgetsqrhrt.f | 13 +++--- SRC/zgges3.f | 25 +++++++---- SRC/zggev3.f | 16 ++++--- SRC/zgghd3.f | 12 +++-- SRC/zggqrf.f | 2 +- SRC/zggrqf.f | 2 +- SRC/zggsvd3.f | 2 +- SRC/zggsvp3.f | 2 +- SRC/zhesv_aa.f | 4 +- SRC/zhesv_aa_2stage.f | 23 +++++----- SRC/zhesvx.f | 11 ++--- SRC/zhetrf.f | 2 +- SRC/zhetrf_aa.f | 18 +++++--- SRC/zhetrf_aa_2stage.f | 26 +++++------ SRC/zhetrf_rk.f | 4 +- SRC/zhetrf_rook.f | 2 +- SRC/zhetri2.f | 20 +++++---- SRC/zhetrs_aa.f | 23 +++++++--- TESTING/LIN/zchkhe_aa_2stage.f | 6 +-- TESTING/LIN/zdrvhe_aa_2stage.f | 4 +- 33 files changed, 278 insertions(+), 169 deletions(-) diff --git a/SRC/zgebrd.f b/SRC/zgebrd.f index 089fc1095c..d85721b8ab 100644 --- a/SRC/zgebrd.f +++ b/SRC/zgebrd.f @@ -122,7 +122,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,M,N). +*> The length of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(M,N), otherwise. *> For optimum performance LWORK >= (M+N)*NB, where NB *> is the optimal blocksize. *> @@ -223,8 +224,8 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB, - $ NBMIN, NX, WS + INTEGER I, IINFO, J, LDWRKX, LDWRKY, LWKMIN, LWKOPT, + $ MINMN, NB, NBMIN, NX, WS * .. * .. External Subroutines .. EXTERNAL XERBLA, ZGEBD2, ZGEMM, ZLABRD @@ -241,9 +242,17 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Test the input parameters * INFO = 0 - NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = ( M+N )*NB + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = MAX( M, N ) + NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) ) + LWKOPT = MAX( 1, ( M+N )*NB ) + END IF WORK( 1 ) = DBLE( LWKOPT ) +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -251,7 +260,7 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.LT.0 ) THEN @@ -263,7 +272,6 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * * Quick return if possible * - MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 6ddb9551cb..05f385c976 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -89,7 +89,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (LWORK) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -225,8 +225,13 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, -1 ) ) - LWKOPT = N*NB + TSIZE + IF( N.EQ.0 ) THEN + LWKOPT = 1 + ELSE + NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, + $ -1 ) ) + LWKOPT = N*NB + TSIZE + END IF WORK( 1 ) = LWKOPT ENDIF * diff --git a/SRC/zgelq.f b/SRC/zgelq.f index 22ca6ca76a..86610e8019 100644 --- a/SRC/zgelq.f +++ b/SRC/zgelq.f @@ -98,7 +98,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error diff --git a/SRC/zgelqf.f b/SRC/zgelqf.f index 4d6e7d995b..3ca3b89088 100644 --- a/SRC/zgelqf.f +++ b/SRC/zgelqf.f @@ -93,6 +93,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise. *> The dimension of the array WORK. LWORK >= max(1,M). *> For optimum performance LWORK >= M*NB, where NB is the *> optimal blocksize. @@ -174,9 +175,8 @@ SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Test the input arguments * INFO = 0 + K = MIN( M, N ) NB = ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - LWKOPT = M*NB - WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -184,19 +184,25 @@ SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + ELSE IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGELQF', -INFO ) RETURN ELSE IF( LQUERY ) THEN + IF( K.EQ.0 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = M*NB + END IF + WORK( 1 ) = LWKOPT RETURN END IF * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f index 1c29aa886e..11489087a4 100644 --- a/SRC/zgemlq.f +++ b/SRC/zgemlq.f @@ -109,13 +109,14 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -186,7 +187,7 @@ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -202,7 +203,7 @@ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) @@ -217,6 +218,13 @@ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = M * MB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN @@ -245,7 +253,7 @@ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 END IF * @@ -262,7 +270,7 @@ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f index f299ece847..ca2742c759 100644 --- a/SRC/zgemqr.f +++ b/SRC/zgemqr.f @@ -111,13 +111,14 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1, then a workspace query is assumed. The routine *> only calculates the size of the WORK array, returns this *> value as WORK(1), and no error message related to WORK @@ -189,7 +190,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER MB, NB, LW, NBLCKS, MN + INTEGER MB, NB, LW, NBLCKS, MN, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME @@ -205,7 +206,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Test the input arguments * - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) @@ -220,6 +221,13 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, LW = MB * NB MN = N END IF +* + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF * IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, MB - K ).EQ.0 ) THEN @@ -248,7 +256,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -13 END IF * @@ -265,7 +273,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, * * Quick return if possible * - IF( MIN( M, N, K ).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * diff --git a/SRC/zgeqlf.f b/SRC/zgeqlf.f index 89c5b1b08c..a27612c640 100644 --- a/SRC/zgeqlf.f +++ b/SRC/zgeqlf.f @@ -88,7 +88,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -188,8 +189,9 @@ SUBROUTINE ZGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) END IF WORK( 1 ) = LWKOPT * - IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN - INFO = -7 + IF( .NOT.LQUERY ) THEN + IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) + $ INFO = -7 END IF END IF * diff --git a/SRC/zgeqp3rk.f b/SRC/zgeqp3rk.f index 247a3c3797..01dcce0ded 100755 --- a/SRC/zgeqp3rk.f +++ b/SRC/zgeqp3rk.f @@ -428,7 +428,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*. LWORK >= N+NRHS-1 +*> LWORK >= 1, if MIN(M,N) = 0, and +*> LWORK >= N+NRHS-1, otherwise. *> For optimal performance LWORK >= NB*( N+NRHS+1 ), *> where NB is the optimal block size for ZGEQP3RK returned *> by ILAENV. Minimal block size MINNB=2. diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f index 704bcbc6cd..7f37a4c7ff 100644 --- a/SRC/zgeqr.f +++ b/SRC/zgeqr.f @@ -99,7 +99,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. The routine *> only calculates the sizes of the T and WORK arrays, returns these *> values as the first entries of the T and WORK arrays, and no error @@ -190,7 +190,7 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -246,8 +246,10 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * * Determine if the workspace size satisfies minimal size * + LWMIN = MAX( 1, N ) + LWREQ = MAX( 1, N*NB ) LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N ) + IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.LWREQ ) $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN @@ -255,7 +257,7 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, NB = 1 MB = M END IF - IF( LWORK.LT.NB*N ) THEN + IF( LWORK.LT.LWREQ ) THEN LMINWS = .TRUE. NB = 1 END IF @@ -284,9 +286,9 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -311,7 +313,7 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = LWREQ * RETURN * diff --git a/SRC/zgeqrfp.f b/SRC/zgeqrfp.f index 6fe06d962d..3562de36ec 100644 --- a/SRC/zgeqrfp.f +++ b/SRC/zgeqrfp.f @@ -97,7 +97,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,N). +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= N, otherwise. *> For optimum performance LWORK >= N*NB, where NB is *> the optimal blocksize. *> @@ -162,8 +163,8 @@ SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * .. Local Scalars .. LOGICAL LQUERY - INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB, - $ NBMIN, NX + INTEGER I, IB, IINFO, IWS, K, LDWORK, LWKMIN, LWKOPT, + $ NB, NBMIN, NX * .. * .. External Subroutines .. EXTERNAL XERBLA, ZGEQR2P, ZLARFB, ZLARFT @@ -181,8 +182,16 @@ SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - LWKOPT = N*NB + K = MIN( M, N ) + IF( K.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = N + LWKOPT = N*NB + END IF WORK( 1 ) = LWKOPT +* LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -190,7 +199,7 @@ SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF IF( INFO.NE.0 ) THEN @@ -202,7 +211,6 @@ SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - K = MIN( M, N ) IF( K.EQ.0 ) THEN WORK( 1 ) = 1 RETURN @@ -210,7 +218,7 @@ SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * NBMIN = 2 NX = 0 - IWS = N + IWS = LWKMIN IF( NB.GT.1 .AND. NB.LT.K ) THEN * * Determine when to cross over from blocked to unblocked code. diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index ea0b162f95..82ee5e22d1 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -200,23 +200,25 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', then LDV >= max(1,N). -*> If JOBV = 'A', then LDV >= max(1,MV) . +*> If JOBV = 'V', then LDV >= MAX(1,N). +*> If JOBV = 'A', then LDV >= MAX(1,MV) . *> \endverbatim *> *> \param[in,out] CWORK *> \verbatim -*> CWORK is COMPLEX*16 array, dimension (max(1,LWORK)) +*> CWORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) *> Used as workspace. -*> If on entry LWORK = -1, then a workspace query is assumed and -*> no computation is done; CWORK(1) is set to the minial (and optimal) -*> length of CWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER. -*> Length of CWORK, LWORK >= M+N. +*> Length of CWORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(1,M+N), otherwise. +*> +*> If on entry LWORK = -1, then a workspace query is assumed and +*> no computation is done; CWORK(1) is set to the minial (and optimal) +*> length of CWORK. *> \endverbatim *> *> \param[in,out] RWORK @@ -247,15 +249,17 @@ *> RWORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. -*> If on entry LRWORK = -1, then a workspace query is assumed and -*> no computation is done; RWORK(1) is set to the minial (and optimal) -*> length of RWORK. *> \endverbatim *> *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> Length of RWORK, LRWORK >= MAX(6,N). +*> Length of RWORK. +*> LRWORK >= 1, if MIN(M,N) = 0, and LRWORK >= MAX(6,N), otherwise. +*> +*> If on entry LRWORK = -1, then a workspace query is assumed and +*> no computation is done; RWORK(1) is set to the minial (and optimal) +*> length of RWORK. *> \endverbatim *> *> \param[out] INFO @@ -367,23 +371,25 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * * .. Local Parameters .. DOUBLE PRECISION ZERO, HALF, ONE - PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) ) - INTEGER NSWEEP - PARAMETER ( NSWEEP = 30 ) + PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0) + COMPLEX*16 CZERO, CONE + PARAMETER ( CZERO = (0.0D0, 0.0D0), CONE = (1.0D0, 0.0D0) ) + INTEGER NSWEEP + PARAMETER ( NSWEEP = 30 ) * .. * .. Local Scalars .. - COMPLEX*16 AAPQ, OMPQ - DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG, - $ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ, - $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL, - $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, TOL - INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, - $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, - $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, SWBAND - LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK, - $ RSVEC, UCTOL, UPPER + COMPLEX*16 AAPQ, OMPQ + DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG, + $ BIGTHETA, CS, CTOL, EPSLN, MXAAPQ, + $ MXSINJ, ROOTBIG, ROOTEPS, ROOTSFMIN, ROOTTOL, + $ SKL, SFMIN, SMALL, SN, T, TEMP1, THETA, THSIGN, + $ TOL + INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1, + $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, + $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, + $ SWBAND, MINMN, LWMIN, LRWMIN + LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, + $ ROTOK, RSVEC, UCTOL, UPPER * .. * .. * .. Intrinsic Functions .. @@ -422,7 +428,18 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, UPPER = LSAME( JOBA, 'U' ) LOWER = LSAME( JOBA, 'L' ) * - LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + LRWMIN = 1 + ELSE + LWMIN = M+N + LRWMIN = MAX( 6, N ) + END IF + CWORK(1) = LWMIN + RWORK(1) = LRWMIN +* + LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN @@ -442,9 +459,9 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( ( LWORK.LT.( M+N ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 - ELSE IF( ( LRWORK.LT.MAX( N, 6 ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( ( LRWORK.LT.LRWMIN ) .AND. ( .NOT.LQUERY ) ) THEN INFO = -15 ELSE INFO = 0 @@ -454,15 +471,13 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGESVJ', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN - CWORK(1) = M + N - RWORK(1) = MAX( N, 6 ) + ELSE IF( LQUERY ) THEN RETURN END IF * * #:) Quick return for void matrix * - IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )RETURN + IF( MINMN.EQ.0 ) RETURN * * Set numerical parameters * The stopping criterion for Jacobi rotations is diff --git a/SRC/zgetri.f b/SRC/zgetri.f index 9aab294975..f3806a77c2 100644 --- a/SRC/zgetri.f +++ b/SRC/zgetri.f @@ -152,7 +152,7 @@ SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * INFO = 0 NB = ILAENV( 1, 'ZGETRI', ' ', N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index b9adbc8325..26311c611b 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -127,7 +127,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> If LWORK = -1 or -2, then a workspace query is assumed. *> If LWORK = -1, the routine calculates optimal size of WORK for the *> optimal performance and returns this value in WORK(1). @@ -229,7 +229,10 @@ SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * * Determine the optimum and minimum LWORK * - IF( M.GE.N ) THEN + IF( MIN( M, N, NRHS ).EQ.0 ) THEN + WSIZEO = 1 + WSIZEM = 1 + ELSE IF( M.GE.N ) THEN CALL ZGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 ) TSZO = INT( TQ( 1 ) ) LWO = INT( WORKQ( 1 ) ) diff --git a/SRC/zgetsqrhrt.f b/SRC/zgetsqrhrt.f index 807a96fbef..e7ce993aa3 100644 --- a/SRC/zgetsqrhrt.f +++ b/SRC/zgetsqrhrt.f @@ -131,13 +131,15 @@ *> \param[in] LWORK *> \verbatim *> The dimension of the array WORK. -*> LWORK >= MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), +*> If MIN(M,N) = 0, LWORK >= 1, else +*> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), *> NB1LOCAL = MIN(NB1,N). *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LW1 = NB1LOCAL * N, -*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ), +*> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ). +*> *> 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 @@ -212,7 +214,7 @@ SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * Test the input arguments * INFO = 0 - LQUERY = LWORK.EQ.-1 + LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. M.LT.N ) THEN @@ -225,7 +227,7 @@ SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, INFO = -5 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -7 - ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN + ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN INFO = -9 ELSE * @@ -263,8 +265,9 @@ SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ) * LWORKOPT = MAX( LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ) + LWORKOPT = MAX( 1, LWORKOPT ) * - IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + IF( LWORK.LT.LWORKOPT .AND. .NOT.LQUERY ) THEN INFO = -11 END IF * diff --git a/SRC/zgges3.f b/SRC/zgges3.f index c316c66945..daf407102c 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -215,7 +215,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= MAX(1,2*N) *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -300,7 +300,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL CURSL, ILASCL, ILBSCL, ILVSL, ILVSR, LASTSL, $ LQUERY, WANTST INTEGER I, ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, - $ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT + $ ILO, IRIGHT, IROWS, IRWRK, ITAU, IWRK, LWKOPT, + $ LWKMIN DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, PVSL, $ PVSR, SMLNUM * .. @@ -352,6 +353,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N ) +* IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -368,7 +371,7 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -14 ELSE IF( LDVSR.LT.1 .OR. ( ILVSR .AND. LDVSR.LT.N ) ) THEN INFO = -16 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * @@ -376,28 +379,32 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( INFO.EQ.0 ) THEN CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 1, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, N + INT( WORK( 1 ) ) ) CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) - LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) ) IF( ILVSL ) THEN CALL ZUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR ) LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) END IF CALL ZGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, $ LDVSL, VSR, LDVSR, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) ) CALL ZLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, $ RWORK, 0, IERR ) - LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) ) IF( WANTST ) THEN CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, $ PVSL, PVSR, DIF, WORK, -1, IDUM, 1, IERR ) - LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) ) + END IF + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = DCMPLX( LWKOPT ) END IF - WORK( 1 ) = DCMPLX( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/zggev3.f b/SRC/zggev3.f index f8729e91d2..0cc0734708 100644 --- a/SRC/zggev3.f +++ b/SRC/zggev3.f @@ -174,7 +174,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= MAX(1,2*N). +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -243,7 +244,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHARACTER CHTEMP INTEGER ICOLS, IERR, IHI, IJOBVL, IJOBVR, ILEFT, ILO, $ IN, IRIGHT, IROWS, IRWRK, ITAU, IWRK, JC, JR, - $ LWKOPT + $ LWKMIN, LWKOPT DOUBLE PRECISION ANRM, ANRMTO, BIGNUM, BNRM, BNRMTO, EPS, $ SMLNUM, TEMP COMPLEX*16 X @@ -300,6 +301,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N ) IF( IJOBVL.LE.0 ) THEN INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN @@ -314,7 +316,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, INFO = -11 ELSE IF( LDVR.LT.1 .OR. ( ILVR .AND. LDVR.LT.N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -15 END IF * @@ -322,7 +324,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * IF( INFO.EQ.0 ) THEN CALL ZGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 1, N+INT( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, N+INT( WORK( 1 ) ) ) CALL ZUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) @@ -347,7 +349,11 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ RWORK, 0, IERR ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) END IF - WORK( 1 ) = DCMPLX( LWKOPT ) + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = DCMPLX( LWKOPT ) + END IF END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index 0da8972966..159984e099 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -176,14 +176,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (LWORK) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= 1. +*> The length of the array WORK. LWORK >= 1. *> For optimum performance LWORK >= 6*N*NB, where NB is the *> optimal blocksize. *> @@ -275,7 +275,12 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * INFO = 0 NB = ILAENV( 1, 'ZGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = MAX( 6*N*NB, 1 ) + NH = IHI - ILO + 1 + IF( N.LE.1 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = 6*N*NB + END IF WORK( 1 ) = DCMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) @@ -325,7 +330,6 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = CONE RETURN diff --git a/SRC/zggqrf.f b/SRC/zggqrf.f index 79104606c0..d8636d6635 100644 --- a/SRC/zggqrf.f +++ b/SRC/zggqrf.f @@ -250,7 +250,7 @@ SUBROUTINE ZGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'ZGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'ZUNMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN diff --git a/SRC/zggrqf.f b/SRC/zggrqf.f index 8e4e45f003..69c14af245 100644 --- a/SRC/zggrqf.f +++ b/SRC/zggrqf.f @@ -249,7 +249,7 @@ SUBROUTINE ZGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'ZGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'ZUNMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN diff --git a/SRC/zggsvd3.f b/SRC/zggsvd3.f index d97265d44c..40624f5beb 100644 --- a/SRC/zggsvd3.f +++ b/SRC/zggsvd3.f @@ -277,7 +277,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/zggsvp3.f b/SRC/zggsvp3.f index c21a146fa8..7b465aaeea 100644 --- a/SRC/zggsvp3.f +++ b/SRC/zggsvp3.f @@ -233,7 +233,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. +*> The dimension of the array WORK. LWORK >= 1. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f index 30f9e41a31..4a16376bf7 100644 --- a/SRC/zhesv_aa.f +++ b/SRC/zhesv_aa.f @@ -206,7 +206,7 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX(2*N, 3*N-2) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * @@ -216,7 +216,7 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, CALL ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) LWKOPT_HETRS = INT( WORK(1) ) - LWKOPT = MAX( LWKOPT_HETRF, LWKOPT_HETRS ) + LWKOPT = MAX( 1, LWKOPT_HETRF, LWKOPT_HETRS ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/zhesv_aa_2stage.f b/SRC/zhesv_aa_2stage.f index b68d7a5f33..158791ccf2 100644 --- a/SRC/zhesv_aa_2stage.f +++ b/SRC/zhesv_aa_2stage.f @@ -100,14 +100,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is COMPLEX*16 array, dimension (LTB) +*> TB is COMPLEX*16 array, dimension (MAX(1,LTB)). *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -142,19 +142,20 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). +*> The leading dimension of the array B. LDB >= MAX(1,N). *> \endverbatim *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 workspace of size LWORK +*> WORK is COMPLEX*16 workspace of size MAX(1,LWORK). +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -208,7 +209,7 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY - INTEGER LWKOPT + INTEGER LWKOPT, LWKMIN * .. * .. External Functions .. LOGICAL LSAME @@ -229,6 +230,7 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, UPPER = LSAME( UPLO, 'U' ) WQUERY = ( LWORK.EQ.-1 ) TQUERY = ( LTB.EQ.-1 ) + LWKMIN = MAX( 1, N ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -237,18 +239,19 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 - ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = INT( WORK(1) ) + LWKOPT = MAX( LWKMIN, INT( WORK(1) ) ) + WORK( 1 ) = LWKOPT END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/zhesvx.f b/SRC/zhesvx.f index db9ca6d521..64aa166749 100644 --- a/SRC/zhesvx.f +++ b/SRC/zhesvx.f @@ -234,8 +234,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= max(1,2*N), and for best -*> performance, when FACT = 'N', LWORK >= max(1,2*N,N*NB), where +*> The length of WORK. LWORK >= MAX(1,2*N), and for best +*> performance, when FACT = 'N', LWORK >= MAX(1,2*N,N*NB), where *> NB is the optimal blocksize for ZHETRF. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -307,7 +307,7 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * .. * .. Local Scalars .. LOGICAL LQUERY, NOFACT - INTEGER LWKOPT, NB + INTEGER LWKOPT, LWKMIN, NB DOUBLE PRECISION ANORM * .. * .. External Functions .. @@ -329,6 +329,7 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = 0 NOFACT = LSAME( FACT, 'N' ) LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) @@ -346,12 +347,12 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = -11 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, 2*N ) + LWKOPT = LWKMIN IF( NOFACT ) THEN NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( LWKOPT, N*NB ) diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f index cb5429839a..a8df90ffe9 100644 --- a/SRC/zhetrf.f +++ b/SRC/zhetrf.f @@ -107,7 +107,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> \endverbatim *> diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index acca14627a..55217521e6 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -101,8 +101,10 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance -*> LWORK >= N*(1+NB), where NB is the optimal blocksize. +*> The length of WORK. +*> LWORK >= 1, if N >= 1, and LWORK >= 2*N, otherwise. +*> For optimum performance LWORK >= N*(1+NB), where NB is +*> the optimal blocksize, returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -128,7 +130,7 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) + SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -189,7 +191,11 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = (NB+1)*N + IF( N.LE.1 ) THEN + LWKOPT = 1 + ELSE + LWKOPT = (NB+1)*N + END IF WORK( 1 ) = LWKOPT END IF * @@ -202,11 +208,11 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF IPIV( 1 ) = 1 - IF ( N.EQ.1 ) THEN + IF( N.EQ.1 ) THEN A( 1, 1 ) = DBLE( A( 1, 1 ) ) RETURN END IF diff --git a/SRC/zhetrf_aa_2stage.f b/SRC/zhetrf_aa_2stage.f index 631f7deb6f..6d6676436e 100644 --- a/SRC/zhetrf_aa_2stage.f +++ b/SRC/zhetrf_aa_2stage.f @@ -87,14 +87,14 @@ *> *> \param[out] TB *> \verbatim -*> TB is COMPLEX*16 array, dimension (LTB) +*> TB is COMPLEX*16 array, dimension (MAX(1,LTB)) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> *> \param[in] LTB *> \verbatim *> LTB is INTEGER -*> The size of the array TB. LTB >= 4*N, internally +*> The size of the array TB. LTB >= MAX(1,4*N), internally *> used to select NB such that LTB >= (3*NB+1)*N. *> *> If LTB = -1, then a workspace query is assumed; the @@ -121,14 +121,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 workspace of size LWORK +*> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= N, internally used to select NB -*> such that LWORK >= N*NB. +*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the WORK array, @@ -182,7 +182,7 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY INTEGER I, J, K, I1, I2, TD - INTEGER LDTB, NB, KB, JB, NT, IINFO + INTEGER LWKOPT, LDTB, NB, KB, JB, NT, IINFO COMPLEX*16 PIV * .. * .. External Functions .. @@ -212,9 +212,9 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB .LT. 4*N .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK .LT. N .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT. MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -228,10 +228,10 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'ZHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = (3*NB+1)*N + TB( 1 ) = MAX( 1, (3*NB+1)*N ) END IF IF( WQUERY ) THEN - WORK( 1 ) = N*NB + WORK( 1 ) = MAX( 1, N*NB ) END IF END IF IF( TQUERY .OR. WQUERY ) THEN @@ -240,7 +240,7 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF * @@ -392,7 +392,7 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, CALL ZGETRF( N-(J+1)*NB, NB, $ WORK, N, $ IPIV( (J+1)*NB+1 ), IINFO ) -c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN +c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN c INFO = IINFO+(J+1)*NB c END IF * @@ -587,7 +587,7 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, CALL ZGETRF( N-(J+1)*NB, NB, $ A( (J+1)*NB+1, J*NB+1 ), LDA, $ IPIV( (J+1)*NB+1 ), IINFO ) -c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN +c IF( IINFO.NE.0 .AND. INFO.EQ.0 ) THEN c INFO = IINFO+(J+1)*NB c END IF * diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f index f0c3b68bb2..01b3e412dc 100644 --- a/SRC/zhetrf_rk.f +++ b/SRC/zhetrf_rk.f @@ -177,14 +177,14 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension ( MAX(1,LWORK) ). +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned *> by ILAENV. *> diff --git a/SRC/zhetrf_rook.f b/SRC/zhetrf_rook.f index 9cae55366c..a563490927 100644 --- a/SRC/zhetrf_rook.f +++ b/SRC/zhetrf_rook.f @@ -122,7 +122,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >=1. For best performance +*> The length of WORK. LWORK >= 1. For best performance *> LWORK >= N*NB, where NB is the block size returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f index 0748a6e989..3d4b896bc4 100644 --- a/SRC/zhetri2.f +++ b/SRC/zhetri2.f @@ -88,16 +88,16 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (N+NB+1)*(NB+3) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK). *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> WORK is size >= (N+NB+1)*(NB+3) +*> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine -*> calculates: +*> 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. @@ -161,7 +161,9 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) LQUERY = ( LWORK.EQ.-1 ) * Get blocksize NBMAX = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) - IF ( NBMAX .GE. N ) THEN + IF( N.EQ.0 ) THEN + MINSIZE = 1 + ELSE IF( NBMAX .GE. N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -173,20 +175,20 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF (LWORK .LT. MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF -* -* Quick return if possible -* * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZHETRI2', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK(1)=MINSIZE + WORK( 1 ) = MINSIZE RETURN END IF +* +* Quick return if possible +* IF( N.EQ.0 ) $ RETURN diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f index b203665d0c..a75fcd9cbb 100644 --- a/SRC/zhetrs_aa.f +++ b/SRC/zhetrs_aa.f @@ -106,7 +106,13 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> The dimension of the array WORK. +*> If MIN(N,NRHS) = 0, LWORK >= 1, else LWORK >= 3*N-2. +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates the minimal 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 @@ -152,7 +158,7 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * .. * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER K, KP, LWKOPT + INTEGER K, KP, LWKMIN * .. * .. External Functions .. LOGICAL LSAME @@ -162,13 +168,19 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, XERBLA * .. * .. Intrinsic Functions .. - INTRINSIC MAX + INTRINSIC MIN, MAX * .. * .. Executable Statements .. * INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWKMIN = 1 + ELSE + LWKMIN = 3*N-2 + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -179,15 +191,14 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZHETRS_AA', -INFO ) RETURN ELSE IF( LQUERY ) THEN - LWKOPT = (3*N-2) - WORK( 1 ) = LWKOPT + WORK( 1 ) = LWKMIN RETURN END IF * diff --git a/TESTING/LIN/zchkhe_aa_2stage.f b/TESTING/LIN/zchkhe_aa_2stage.f index 802bc9e7cc..51082f1d0b 100644 --- a/TESTING/LIN/zchkhe_aa_2stage.f +++ b/TESTING/LIN/zchkhe_aa_2stage.f @@ -431,9 +431,9 @@ SUBROUTINE ZCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, * block factorization, LWORK is the length of AINV. * SRNAMT = 'ZHETRF_AA_2STAGE' - LWORK = MIN(N*NB, 3*NMAX*NMAX) - CALL ZHETRF_AA_2STAGE( UPLO, N, AFAC, LDA, - $ AINV, (3*NB+1)*N, + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) + CALL ZHETRF_AA_2STAGE( UPLO, N, AFAC, LDA, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ WORK, LWORK, $ INFO ) diff --git a/TESTING/LIN/zdrvhe_aa_2stage.f b/TESTING/LIN/zdrvhe_aa_2stage.f index 9401867e0c..fcd7744912 100644 --- a/TESTING/LIN/zdrvhe_aa_2stage.f +++ b/TESTING/LIN/zdrvhe_aa_2stage.f @@ -400,9 +400,9 @@ SUBROUTINE ZDRVHE_AA_2STAGE( * Factor the matrix and solve the system using ZHESV_AA. * SRNAMT = 'ZHESV_AA_2STAGE ' - LWORK = MIN(N*NB, 3*NMAX*NMAX) + LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX ) CALL ZHESV_AA_2STAGE( UPLO, N, NRHS, AFAC, LDA, - $ AINV, (3*NB+1)*N, + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ X, LDA, WORK, LWORK, INFO ) * From 9dc24803a2c033ef4bf814a2a44b48a57ec3d82a Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Fri, 1 Dec 2023 14:20:05 +0700 Subject: [PATCH 013/206] handle and document corner cases of lwork in lapack, align all precisions --- SRC/cgebrd.f | 4 +- SRC/cgehrd.f | 5 +- SRC/cgelqf.f | 2 +- SRC/cgemlq.f | 6 +-- SRC/cgemqr.f | 4 +- SRC/cgeqlf.f | 2 +- SRC/cgeqp3rk.f | 23 +++++---- SRC/cgeqrfp.f | 10 ++-- SRC/cgesvj.f | 39 ++++++++------- SRC/cgetsqrhrt.f | 16 ++++-- SRC/cgges3.f | 33 ++++++------ SRC/cggev3.f | 10 ++-- SRC/cgghd3.f | 9 ++-- SRC/cggqrf.f | 4 +- SRC/cggrqf.f | 6 +-- SRC/cheevd.f | 3 +- SRC/cheevx.f | 2 +- SRC/chesv_aa.f | 11 ++-- SRC/chesv_aa_2stage.f | 11 ++-- SRC/chesvx.f | 2 +- SRC/chetrd_2stage.f | 2 +- SRC/chetrd_hb2st.F | 19 ++++--- SRC/chetrd_he2hb.f | 8 +-- SRC/chetrf_aa.f | 25 +++++++--- SRC/chetrf_aa_2stage.f | 13 +++-- SRC/chetri2.f | 14 +++--- SRC/chetri_3.f | 2 +- SRC/clamswlq.f | 50 ++++++++++--------- SRC/clamtsqr.f | 69 +++++++++++++------------- SRC/claswlq.f | 31 ++++++------ SRC/clatrs3.f | 7 ++- SRC/clatsqr.f | 44 ++++++++-------- SRC/dgehrd.f | 10 ++-- SRC/dgeqp3rk.f | 4 +- SRC/dgeqr.f | 16 +++--- SRC/dgesvj.f | 16 ++++-- SRC/dgetsqrhrt.f | 3 +- SRC/dgges3.f | 18 ++++--- SRC/dggev3.f | 17 ++++--- SRC/dggqrf.f | 1 + SRC/dlamtsqr.f | 12 ++--- SRC/dlaswlq.f | 41 +++++++-------- SRC/dlatrs3.f | 2 + SRC/dlatsqr.f | 49 +++++++++--------- SRC/dsyevr_2stage.f | 2 +- SRC/dsysv_aa.f | 11 ++-- SRC/dsysv_aa_2stage.f | 9 ++-- SRC/dsytrd_sb2st.F | 7 ++- SRC/dsytrf_aa.f | 25 +++++++--- SRC/dsytrf_aa_2stage.f | 6 +-- SRC/dsytri2.f | 8 +-- SRC/sgebrd.f | 2 +- SRC/sgehrd.f | 4 +- SRC/sgelqf.f | 2 +- SRC/sgeqp3rk.f | 22 ++++---- SRC/sgesvj.f | 18 +++++-- SRC/sgetsqrhrt.f | 3 +- SRC/sggev3.f | 12 ++--- SRC/sgghd3.f | 4 +- SRC/sggqrf.f | 2 +- SRC/sggrqf.f | 2 +- SRC/slamswlq.f | 4 +- SRC/slamtsqr.f | 10 ++-- SRC/slaswlq.f | 38 +++++++------- SRC/slatrs3.f | 2 + SRC/slatsqr.f | 48 +++++++++--------- SRC/ssyevr_2stage.f | 2 +- SRC/ssysv_aa.f | 11 ++-- SRC/ssysv_aa_2stage.f | 8 +-- SRC/ssysvx.f | 7 +-- SRC/ssytrd_2stage.f | 24 +++++---- SRC/ssytrd_sb2st.F | 40 +++++++++------ SRC/ssytrd_sy2sb.f | 18 ++++--- SRC/ssytrf_aa.f | 36 +++++++++----- SRC/zgebrd.f | 4 +- SRC/zgehrd.f | 10 ++-- SRC/zgelqf.f | 4 +- SRC/zgemqr.f | 4 +- SRC/zgesvj.f | 14 +++--- SRC/zgges3.f | 1 + SRC/zgghd3.f | 2 +- SRC/zheevd.f | 3 +- SRC/zhesv_aa.f | 13 ++--- SRC/zhesv_aa_2stage.f | 6 +-- SRC/zhetrd_2stage.f | 25 ++++++---- SRC/zhetrd_hb2st.F | 34 ++++++++----- SRC/zhetrd_he2hb.f | 16 ++++-- SRC/zhetrf_aa.f | 21 ++++---- SRC/zhetrf_aa_2stage.f | 2 +- SRC/zhetri2.f | 8 +-- SRC/zlamswlq.f | 66 ++++++++++++++---------- SRC/zlamtsqr.f | 74 +++++++++++++++------------ SRC/zlaswlq.f | 89 ++++++++++++++++++--------------- SRC/zlatrs3.f | 20 ++++++-- SRC/zlatsqr.f | 91 +++++++++++++++++++--------------- TESTING/LIN/cchkhe_aa_2stage.f | 2 +- 96 files changed, 883 insertions(+), 688 deletions(-) diff --git a/SRC/cgebrd.f b/SRC/cgebrd.f index cd03c86361..5920b1cf58 100644 --- a/SRC/cgebrd.f +++ b/SRC/cgebrd.f @@ -252,7 +252,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, ELSE LWKMIN = MAX( M, N ) NB = MAX( 1, ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = MAX( 1, ( M+N )*NB ) + LWKOPT = ( M+N )*NB END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) @@ -292,7 +292,7 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Determine when to switch from blocked to unblocked code. * IF( NX.LT.MINMN ) THEN - WS = ( M+N )*NB + WS = LWKOPT IF( LWORK.LT.WS ) THEN * * Not enough work space for the optimal NB, consider using diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index f50c5b43f1..7c62694f39 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -222,12 +222,12 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -8 END IF * + NH = IHI - ILO + 1 IF( INFO.EQ.0 ) THEN * * Compute the workspace requirements * - - IF( N.EQ.0 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, @@ -255,7 +255,6 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/cgelqf.f b/SRC/cgelqf.f index 2d53ae89b3..3847a958a7 100644 --- a/SRC/cgelqf.f +++ b/SRC/cgelqf.f @@ -185,7 +185,7 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF ( .NOT.LQUERY ) THEN + ELSE IF( .NOT.LQUERY ) THEN IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) $ INFO = -7 END IF diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f index c5560c314b..e5b02b6693 100644 --- a/SRC/cgemlq.f +++ b/SRC/cgemlq.f @@ -110,8 +110,8 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -227,7 +227,7 @@ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, ELSE LWMIN = MAX( 1, LW ) END IF - +* IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN NBLCKS = ( MN - K ) / ( NB - K ) diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f index c7d0827820..0b7dd9dd71 100644 --- a/SRC/cgemqr.f +++ b/SRC/cgemqr.f @@ -111,8 +111,8 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK diff --git a/SRC/cgeqlf.f b/SRC/cgeqlf.f index bb7d22b674..6c67344c5c 100644 --- a/SRC/cgeqlf.f +++ b/SRC/cgeqlf.f @@ -192,7 +192,7 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * IF( .NOT.LQUERY ) THEN IF( LWORK.LE.0 .OR. ( M.GT.0 .AND. LWORK.LT.MAX( 1, N ) ) ) - $ INFO = -7 + $ INFO = -7 END IF END IF * diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f index 1e430b908b..731c44edb4 100755 --- a/SRC/cgeqp3rk.f +++ b/SRC/cgeqp3rk.f @@ -428,7 +428,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> LWORK >= 1, if MIN(M,N) = 0, +*> LWORK >= 1, if MIN(M,N) = 0, and *> LWORK >= N+NRHS-1, otherwise. *> For optimal performance LWORK >= NB*( N+NRHS+1 ), *> where NB is the optimal block size for CGEQP3RK returned @@ -628,8 +628,9 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * .. External Functions .. LOGICAL SISNAN INTEGER ISAMAX, ILAENV - REAL SLAMCH, SCNRM2 - EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, SROUNDUP_LWORK + EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, MAX, MIN @@ -704,7 +705,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * LWKOPT = 2*N + NB*( N+NRHS+1 ) END IF - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN INFO = -15 @@ -727,7 +728,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, K = 0 MAXC2NRMK = ZERO RELMAXC2NRMK = ZERO - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -779,7 +780,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * * Array TAU is not set and contains undefined elements. * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -798,7 +799,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, TAU( J ) = CZERO END DO * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * END IF @@ -829,7 +830,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, DO J = 1, MINMN TAU( J ) = CZERO END DO - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -874,7 +875,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, TAU( J ) = CZERO END DO * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -992,7 +993,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * * Return from the routine. * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * @@ -1083,7 +1084,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * END IF * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/cgeqrfp.f b/SRC/cgeqrfp.f index c504221c65..5b6226c67b 100644 --- a/SRC/cgeqrfp.f +++ b/SRC/cgeqrfp.f @@ -184,12 +184,12 @@ SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = 0 NB = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) K = MIN( M, N ) - IF ( K.EQ.0 ) THEN - LWKMIN = 1 - LWKOPT = 1 + IF( K.EQ.0 ) THEN + LWKMIN = 1 + LWKOPT = 1 ELSE - LWKMIN = N - LWKOPT = N*NB + LWKMIN = N + LWKOPT = N*NB END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * diff --git a/SRC/cgesvj.f b/SRC/cgesvj.f index 125c34a565..b9c8f1709e 100644 --- a/SRC/cgesvj.f +++ b/SRC/cgesvj.f @@ -208,16 +208,17 @@ *> \verbatim *> CWORK is COMPLEX array, dimension (max(1,LWORK)) *> Used as workspace. -*> If on entry LWORK = -1, then a workspace query is assumed and -*> no computation is done; CWORK(1) is set to the minial (and optimal) -*> length of CWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER. *> Length of CWORK. -*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(1,M+N), otherwise. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M+N, otherwise. +*> +*> If on entry LWORK = -1, then a workspace query is assumed and +*> no computation is done; CWORK(1) is set to the minial (and optimal) +*> length of CWORK. *> \endverbatim *> *> \param[in,out] RWORK @@ -248,15 +249,17 @@ *> RWORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. -*> If on entry LRWORK = -1, then a workspace query is assumed and -*> no computation is done; RWORK(1) is set to the minial (and optimal) -*> length of RWORK. *> \endverbatim *> *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> Length of RWORK, LRWORK >= MAX(6,N). +*> Length of RWORK. +*> LRWORK >= 1, if MIN(M,N) = 0, and LRWORK >= MAX(6,N), otherwise +*> +*> If on entry LRWORK = -1, then a workspace query is assumed and +*> no computation is done; RWORK(1) is set to the minial (and optimal) +*> length of RWORK. *> \endverbatim *> *> \param[out] INFO @@ -400,8 +403,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INTEGER ISAMAX EXTERNAL ISAMAX * from LAPACK - REAL SLAMCH - EXTERNAL SLAMCH + REAL SLAMCH, SROUNDUP_LWORK + EXTERNAL SLAMCH, SROUNDUP_LWORK LOGICAL LSAME EXTERNAL LSAME * .. @@ -423,19 +426,17 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, APPLV = LSAME( JOBV, 'A' ) UPPER = LSAME( JOBA, 'U' ) LOWER = LSAME( JOBA, 'L' ) - +* MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN - LWMIN = 1 - LRWMIN = 6 + LWMIN = 1 + LRWMIN = 1 ELSE - LWMIN = M + N + LWMIN = M + N LRWMIN = MAX( 6, N ) END IF - CWORK(1) = LWMIN - RWORK(1) = LRWMIN * - LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) + LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN @@ -467,7 +468,9 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( INFO.NE.0 ) THEN CALL XERBLA( 'CGESVJ', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN + ELSE IF( LQUERY ) THEN + CWORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN ) RETURN END IF * diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 477a833cae..087e9bc7fa 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -131,6 +131,7 @@ *> \param[in] LWORK *> \verbatim *> The dimension of the array WORK. +*> If MIN(M,N) = 0, LWORK >= 1, else *> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), @@ -138,6 +139,7 @@ *> LWT = NUM_ALL_ROW_BLOCKS * N * NB1LOCAL, *> LW1 = NB1LOCAL * N, *> LW2 = NB1LOCAL * MAX( NB1LOCAL, ( N - NB1LOCAL ) ). +*> *> 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 @@ -200,6 +202,10 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, INTEGER I, IINFO, J, LW1, LW2, LWT, LDWT, LWORKOPT, $ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS * .. +* .. External Functions .. + REAL SROUNDUP_LWORK + EXTERNAL SROUNDUP_LWORK +* .. * .. External Subroutines .. EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL, $ XERBLA @@ -212,7 +218,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, * Test the input arguments * INFO = 0 - LQUERY = ( LWORK.EQ.-1 ) + LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. M.LT.N ) THEN @@ -225,7 +231,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, INFO = -5 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -7 - ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN + ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN INFO = -9 ELSE * @@ -278,14 +284,14 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, CALL XERBLA( 'CGETSQRHRT', -INFO ) RETURN ELSE IF ( LQUERY ) THEN - WORK( 1 ) = CMPLX( LWORKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT ) RETURN END IF * * Quick return if possible * IF( MIN( M, N ).EQ.0 ) THEN - WORK( 1 ) = CMPLX( LWORKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT ) RETURN END IF * @@ -342,7 +348,7 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, END IF END DO * - WORK( 1 ) = CMPLX( LWORKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWORKOPT ) RETURN * * End of CGETSQRHRT diff --git a/SRC/cgges3.f b/SRC/cgges3.f index 362ada817e..c1ca796887 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -215,8 +215,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. -*> If N = 0, LWORK >= 1, else LWORK >= 2*N. +*> The dimension of the array WORK. LWORK >= MAX(1,2*N). *> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -317,8 +316,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * .. * .. External Functions .. LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH + REAL CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT @@ -355,11 +354,7 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( N.EQ.0 ) THEN - LWKMIN = 1 - ELSE - LWKMIN = 2*N - END IF + LWKMIN = MAX( 1, 2*N ) * IF( IJOBVL.LE.0 ) THEN INFO = -1 @@ -385,29 +380,33 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( INFO.EQ.0 ) THEN CALL CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( 1, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, N + INT( WORK( 1 ) ) ) CALL CUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) - LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) ) IF( ILVSL ) THEN CALL CUNGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, $ IERR ) - LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) ) END IF CALL CGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, $ LDVSL, VSR, LDVSR, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, N + INT( WORK( 1 ) ) ) CALL CLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, $ RWORK, 0, IERR ) - LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) ) IF( WANTST ) THEN CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, $ PVSL, PVSR, DIF, WORK, -1, IDUM, 1, IERR ) - LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, INT( WORK( 1 ) ) ) + END IF + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF - WORK( 1 ) = CMPLX( LWKOPT ) END IF * @@ -592,7 +591,7 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * 30 CONTINUE * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/cggev3.f b/SRC/cggev3.f index c5cd349613..d2b75aebc7 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -258,8 +258,8 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * .. * .. External Functions .. LOGICAL LSAME - REAL CLANGE, SLAMCH - EXTERNAL LSAME, CLANGE, SLAMCH + REAL CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL, SQRT @@ -324,7 +324,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * IF( INFO.EQ.0 ) THEN CALL CGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( N, N+INT( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, N+INT( WORK( 1 ) ) ) CALL CUNMQR( 'L', 'C', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, N+INT( WORK( 1 ) ) ) @@ -352,7 +352,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, IF( N.EQ.0 ) THEN WORK( 1 ) = 1 ELSE - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF END IF * @@ -553,7 +553,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, IF( ILBSCL ) $ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) * - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of CGGEV3 diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index e105edf3e9..c4123e4c76 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -180,7 +180,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (MAX(1, LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -265,7 +265,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - EXTERNAL ILAENV, LSAME + REAL SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, CGEMM, @@ -281,12 +282,12 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, INFO = 0 NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 ) NH = IHI - ILO + 1 - IF( N.EQ.0 .OR. NH.LE.1 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE LWKOPT = 6*N*NB END IF - WORK( 1 ) = CMPLX( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) INITZ = LSAME( COMPZ, 'I' ) diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f index 0ab8c1dfc9..309f170e8f 100644 --- a/SRC/cggqrf.f +++ b/SRC/cggqrf.f @@ -251,7 +251,7 @@ SUBROUTINE CGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'CGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'CUNMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( 1, MAX( N, M, P)*NB ) + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN @@ -288,7 +288,7 @@ SUBROUTINE CGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * RQ factorization of N-by-P matrix B: B = T*Z. * CALL CGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) - WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) + WORK( 1 ) = SROUNDUP_LWORK( MAX( LOPT, INT( WORK( 1 ) ) ) ) * RETURN * diff --git a/SRC/cggrqf.f b/SRC/cggrqf.f index 0b301ce73e..8470a1ce22 100644 --- a/SRC/cggrqf.f +++ b/SRC/cggrqf.f @@ -250,8 +250,8 @@ SUBROUTINE CGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'CGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'CUNMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( 1, N, M, P)*NB - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN INFO = -1 @@ -288,7 +288,7 @@ SUBROUTINE CGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, * QR factorization of P-by-N matrix B: B = Z*T * CALL CGEQRF( P, N, B, LDB, TAUB, WORK, LWORK, INFO ) - WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) + WORK( 1 ) = SROUNDUP_LWORK( MAX( LOPT, INT( WORK( 1 ) ) ) ) * RETURN * diff --git a/SRC/cheevd.f b/SRC/cheevd.f index b5ca804ebe..e24850f5a7 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -116,8 +116,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is REAL array, -*> dimension (LRWORK) +*> RWORK is REAL array, dimension (MAX(1,LRWORK)) *> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. *> \endverbatim *> diff --git a/SRC/cheevx.f b/SRC/cheevx.f index 99ab14025c..a8a2bde630 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -353,7 +353,7 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, LWKMIN = 2*N NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) - LWKOPT = MAX( 1, ( NB + 1 )*N ) + LWKOPT = ( NB + 1 )*N END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f index bb3a5ea4f8..0f41c93321 100644 --- a/SRC/chesv_aa.f +++ b/SRC/chesv_aa.f @@ -177,7 +177,7 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS + INTEGER LWKMIN, LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS * .. * .. External Functions .. LOGICAL LSAME @@ -197,6 +197,7 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N, 3*N-2 ) IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -207,17 +208,17 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * IF( INFO.EQ.0 ) THEN CALL CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT_HETRF = INT( WORK(1) ) + LWKOPT_HETRF = INT( WORK( 1 ) ) CALL CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) - LWKOPT_HETRS = INT( WORK(1) ) - LWKOPT = MAX( 1, LWKOPT_HETRF, LWKOPT_HETRS ) + LWKOPT_HETRS = INT( WORK( 1 ) ) + LWKOPT = MAX( LWKMIN, LWKOPT_HETRF, LWKOPT_HETRS ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * diff --git a/SRC/chesv_aa_2stage.f b/SRC/chesv_aa_2stage.f index e45a883aef..05ebd9253a 100644 --- a/SRC/chesv_aa_2stage.f +++ b/SRC/chesv_aa_2stage.f @@ -153,7 +153,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The size of WORK. LWORK >= MAX(1,N), internally used to +*> The size of WORK. LWORK >= MAX(1,N), internally used to *> select NB such that LWORK >= N*NB. *> *> If LWORK = -1, then a workspace query is assumed; the @@ -204,7 +204,7 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY - INTEGER LWKOPT + INTEGER LWKMIN, LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -226,6 +226,7 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, UPPER = LSAME( UPLO, 'U' ) WQUERY = ( LWORK.EQ.-1 ) TQUERY = ( LTB.EQ.-1 ) + LWKMIN = MAX( 1, N ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -238,14 +239,15 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = INT( WORK(1) ) + LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -255,7 +257,6 @@ SUBROUTINE CHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, RETURN END IF * -* * Compute the factorization A = U**H*T*U or A = L*T*L**H. * CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, diff --git a/SRC/chesvx.f b/SRC/chesvx.f index d9e08f5cba..bdaad55ec1 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -355,7 +355,7 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LWKOPT = LWKMIN IF( NOFACT ) THEN NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) - LWKOPT = MAX( LWKMIN, N*NB ) + LWKOPT = MAX( LWKOPT, N*NB ) END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f index 5733172d9f..ec70757980 100644 --- a/SRC/chetrd_2stage.f +++ b/SRC/chetrd_2stage.f @@ -294,7 +294,7 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * IF( INFO.EQ.0 ) THEN - HOUS2( 1 ) = LHMIN + HOUS2( 1 ) = SROUNDUP_LWORK( LHMIN ) WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index 17e7fcaf2d..b0d3e45fbf 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -140,7 +140,7 @@ *> \verbatim *> LHOUS is INTEGER *> The dimension of the array HOUS. -*> If N = 0, LHOUS >= 1, else LHOUS = MAX(1, dimension). +*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension). *> *> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine @@ -267,7 +267,7 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, - $ NBTILES, TTYPE, TID, NTHREADS, DEBUG, + $ NBTILES, TTYPE, TID, NTHREADS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ SICEV, SIZETAU, LDV, LHMIN, LWMIN @@ -291,7 +291,6 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the minimal workspace size required. * Test the input parameters * - DEBUG = 0 INFO = 0 AFTERS1 = LSAME( STAGE1, 'Y' ) WANTQ = LSAME( VECT, 'V' ) @@ -300,13 +299,13 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 ) - IF( N.EQ.0 ) THEN + IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 ) + IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN @@ -328,8 +327,8 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, END IF * IF( INFO.EQ.0 ) THEN - HOUS( 1 ) = LHMIN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + HOUS( 1 ) = SROUNDUP_LWORK( LHMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -585,7 +584,7 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 170 CONTINUE ENDIF * - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CHETRD_HB2ST diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 7de1dae694..42e71e0b20 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -124,7 +124,7 @@ *> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, or if LWORK = -1, +*> On exit, if INFO = 0, or if LWORK = -1, *> WORK(1) returns the size of LWORK. *> \endverbatim *> @@ -296,12 +296,12 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) - IF(N.LE.KD+1) THEN + IF( N.LE.KD+1 ) THEN LWMIN = 1 ELSE - LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_HE2HB', '', N, KD, -1, -1 ) END IF - +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index 62330cd71a..51410a6ed7 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -101,8 +101,10 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= 2*N. For optimum performance -*> LWORK >= N*(1+NB), where NB is the optimal blocksize. +*> The length of WORK. +*> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise. +*> For optimum performance LWORK >= N*(1+NB), where NB is +*> the optimal blocksize, returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -128,7 +130,7 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) + SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -152,7 +154,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT + INTEGER J, LWKMIN, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX ALPHA * .. @@ -179,18 +181,25 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( N.LE.1 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = 2*N + LWKOPT = (NB+1)*N + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.( 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, (NB+1)*N ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * @@ -203,11 +212,11 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF IPIV( 1 ) = 1 - IF ( N.EQ.1 ) THEN + IF( N.EQ.1 ) THEN A( 1, 1 ) = REAL( A( 1, 1 ) ) RETURN END IF diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index 723e0c2948..a79343753b 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -182,7 +182,7 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY INTEGER I, J, K, I1, I2, TD - INTEGER LWKOPT, LDTB, NB, KB, JB, NT, IINFO + INTEGER LDTB, NB, KB, JB, NT, IINFO COMPLEX PIV * .. * .. External Functions .. @@ -214,9 +214,9 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB .LT. MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK .LT. MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -230,11 +230,10 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'CHETRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = MAX( 1, (3*NB+1)*N ) + TB( 1 ) = SROUNDUP_LWORK( MAX( 1, (3*NB+1)*N ) ) END IF IF( WQUERY ) THEN - LWKOPT = MAX( 1, N*NB ) - WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( MAX( 1, N*NB ) ) END IF END IF IF( TQUERY .OR. WQUERY ) THEN @@ -243,7 +242,7 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF * diff --git a/SRC/chetri2.f b/SRC/chetri2.f index 11baacc8e1..33e4dc5259 100644 --- a/SRC/chetri2.f +++ b/SRC/chetri2.f @@ -88,7 +88,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (MAX(1, LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK @@ -97,7 +97,7 @@ *> The dimension of the array WORK. *> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine -*> calculates: +*> 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. @@ -160,11 +160,13 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) +* * Get blocksize +* NBMAX = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) IF( N.EQ.0 ) THEN MINSIZE = 1 - ELSE IF ( NBMAX .GE. N ) THEN + ELSE IF( NBMAX.GE.N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -179,9 +181,6 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF -* -* Quick return if possible -* * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CHETRI2', -INFO ) @@ -190,6 +189,9 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) WORK( 1 ) = SROUNDUP_LWORK( MINSIZE ) RETURN END IF +* +* Quick return if possible +* IF( N.EQ.0 ) $ RETURN diff --git a/SRC/chetri_3.f b/SRC/chetri_3.f index bcc78cb95c..ccfce5070b 100644 --- a/SRC/chetri_3.f +++ b/SRC/chetri_3.f @@ -119,7 +119,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (MAX(1, LWORK)). +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index d96193d0c0..8f474a3abb 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -127,8 +127,8 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -137,7 +137,8 @@ *> The dimension of the array WORK. *> If MIN(M,N,K) = 0, LWORK >= 1. *> If SIDE = 'L', LWORK >= max(1,NB*MB). -*> if SIDE = 'R', LWORK >= max(1,M*MB). +*> If SIDE = 'R', LWORK >= max(1,M*MB). +*> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the minimal size of the WORK array, returns *> this value as the first entry of the WORK array, and no error @@ -195,45 +196,47 @@ *> * ===================================================================== SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - COMPLEX A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME REAL SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK +* .. * .. External Subroutines .. - EXTERNAL CTPMLQT, CGEMLQT, XERBLA + EXTERNAL CTPMLQT, CGEMLQT, XERBLA * .. * .. Executable Statements .. * * Test the input arguments * + INFO = 0 LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF ( LEFT ) THEN + IF( LEFT ) THEN LW = N * MB ELSE LW = M * MB @@ -241,16 +244,15 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * MINMNK = MIN( M, N, K ) IF( MINMNK.EQ.0 ) THEN - LWMIN = 1 + LWMIN = 1 ELSE - LWMIN = MAX( 1, LW ) + LWMIN = MAX( 1, LW ) END IF - - INFO = 0 +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( M.LT.K ) THEN @@ -261,21 +263,21 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -6 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, MB) ) THEN + ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 + INFO = -13 ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * - IF ( INFO.EQ.0) THEN + IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLAMSWLQ', -INFO ) RETURN - ELSE IF (LQUERY) THEN + ELSE IF( LQUERY ) THEN RETURN END IF * @@ -287,7 +289,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN END IF * @@ -414,7 +416,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = SROUNDUP_LWORK( LWMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CLAMSWLQ diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f index c5d063904e..13625087f0 100644 --- a/SRC/clamtsqr.f +++ b/SRC/clamtsqr.f @@ -128,24 +128,24 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. -*> +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> *> If MIN(M,N,K) = 0, LWORK >= 1. -*> If SIDE = 'L', LWORK >= max(1,N*NB); -*> if SIDE = 'R', LWORK >= max(1,MB*NB). +*> If SIDE = 'L', LWORK >= max(1,N*NB). +*> If SIDE = 'R', LWORK >= max(1,MB*NB). +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -197,46 +197,47 @@ *> * ===================================================================== SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - COMPLEX A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + COMPLEX A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q, LWMIN, MINMNK + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME REAL SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK +* .. * .. External Subroutines .. - EXTERNAL CGEMQRT, CTPMQRT, XERBLA + EXTERNAL CGEMQRT, CTPMQRT, XERBLA * .. * .. Executable Statements .. * * Test the input arguments * INFO = 0 - LQUERY = ( LWORK.LT.-1 ) + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF ( LEFT ) THEN + IF( LEFT ) THEN LW = N * NB Q = M ELSE @@ -246,15 +247,15 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * MINMNK = MIN( M, N, K ) IF( MINMNK.EQ.0 ) THEN - LWMIN = 1 + LWMIN = 1 ELSE - LWMIN = MAX( 1, LW ) + LWMIN = MAX( 1, LW ) END IF * IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -265,25 +266,23 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -7 ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, NB) ) THEN + ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF( LWORK.LT.MINMNK .AND. (.NOT.LQUERY) ) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * -* Determine the block size if it is tall skinny or short and wide -* - IF( INFO.EQ.0 ) THEN - WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLAMTSQR', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible @@ -291,12 +290,14 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, IF( MINMNK.EQ.0 ) THEN RETURN END IF +* +* Determine the block size if it is tall skinny or short and wide * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -421,7 +422,7 @@ SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of CLAMTSQR diff --git a/SRC/claswlq.f b/SRC/claswlq.f index 9c2209ba65..2044e055cc 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -98,9 +98,8 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. -*> +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -113,7 +112,6 @@ *> only calculates the minimal 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 @@ -167,33 +165,35 @@ *> * ===================================================================== SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, - $ INFO) + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT + INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT * .. * .. Array Arguments .. - COMPLEX A( LDA, * ), WORK( * ), T( LDT, *) + COMPLEX A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR, MINMN, LWMIN + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME INTEGER ILAENV REAL SROUNDUP_LWORK EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK +* .. * .. EXTERNAL SUBROUTINES .. EXTERNAL CGELQT, CTPLQT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -224,17 +224,18 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 - ELSE IF( ( LWORK.LT.LWMIN ) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0 ) THEN +* + IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLASWLQ', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN + ELSE IF( LQUERY ) THEN RETURN END IF * @@ -254,14 +255,14 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, KK = MOD((N-M),(NB-M)) II = N-KK+1 * -* Compute the LQ factorization of the first block A(1:M,1:NB) +* Compute the LQ factorization of the first block A(1:M,1:NB) * CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) CTR = 1 * DO I = NB+1, II-NB+M , (NB-M) * -* Compute the QR factorization of the current block A(1:M,I:I+NB-M) +* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), $ LDA, T(1,CTR*M+1), @@ -271,7 +272,7 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, * * Compute the QR factorization of the last block A(1:M,II:N) * - IF ( II.LE.N ) THEN + IF( II.LE.N ) THEN CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1,CTR*M+1), LDT, $ WORK, INFO ) diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index 35674be04d..354141a8b1 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -158,8 +158,10 @@ *> \endverbatim *> *> \param[in] LWORK +*> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> *> If MIN(N,NRHS) = 0, LWORK >= 1, else *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> NBA = (N + NB - 1)/NB and NB is the optimal block size. @@ -168,6 +170,7 @@ *> only calculates the optimal dimensions 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 @@ -311,12 +314,12 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LANRM = NBA * NBA AWRK = LSCALE * - IF(MIN( N, NRHS ).EQ.0 ) THEN + IF( MIN( N, NRHS ).EQ.0 ) THEN LWMIN = 1 ELSE LWMIN = LSCALE + LANRM END IF - WORK( 1 ) = SROUNDUP_LWORK ( LWMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * * Test the input parameters. * diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f index 35c199c217..67403693f8 100644 --- a/SRC/clatsqr.f +++ b/SRC/clatsqr.f @@ -101,8 +101,8 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -112,7 +112,7 @@ *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. *> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -168,32 +168,34 @@ *> * ===================================================================== SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, - $ LWORK, INFO) + $ LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK + INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. - COMPLEX A( LDA, * ), WORK( * ), T(LDT, *) + COMPLEX A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR, LWMIN, MINMN + LOGICAL LQUERY + INTEGER I, II, KK, CTR, LWMIN, MINMN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME REAL SROUNDUP_LWORK EXTERNAL LSAME, SROUNDUP_LWORK +* .. * .. EXTERNAL SUBROUTINES .. - EXTERNAL CGEQRT, CTPQRT, XERBLA + EXTERNAL CGEQRT, CTPQRT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -218,7 +220,7 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -2 ELSE IF( MB.LT.1 ) THEN INFO = -3 - ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN + ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -6 @@ -228,13 +230,13 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -10 END IF * - IF( INFO.EQ.0) THEN - WORK(1) = SROUNDUP_LWORK( LWMIN ) + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CLATSQR', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN + ELSE IF( LQUERY ) THEN RETURN END IF * @@ -247,33 +249,33 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * The QR Decomposition * IF ( (MB.LE.N) .OR. (MB.GE.M) ) THEN - CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) + CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) RETURN END IF KK = MOD((M-N),(MB-N)) II = M-KK+1 * -* Compute the QR factorization of the first block A(1:MB,1:N) +* Compute the QR factorization of the first block A(1:MB,1:N) * CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) CTR = 1 * - DO I = MB+1, II-MB+N , (MB-N) + DO I = MB+1, II-MB+N, (MB-N) * -* Compute the QR factorization of the current block A(I:I+MB-N,1:N) +* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, $ T(1,CTR * N + 1), - $ LDT, WORK, INFO ) + $ LDT, WORK, INFO ) CTR = CTR + 1 END DO * -* Compute the QR factorization of the last block A(II:M,1:N) +* Compute the QR factorization of the last block A(II:M,1:N) * - IF (II.LE.M) THEN + IF( II.LE.M ) THEN CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1, CTR * N + 1), LDT, - $ WORK, INFO ) + $ WORK, INFO ) END IF * WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index 2b1b88af10..90a8b69498 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -173,7 +173,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDA, LWORK, N * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) * .. * * ===================================================================== @@ -182,7 +182,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER NBMAX, LDT, TSIZE PARAMETER ( NBMAX = 64, LDT = NBMAX+1, $ TSIZE = LDT*NBMAX ) - DOUBLE PRECISION ZERO, ONE + DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, $ ONE = 1.0D+0 ) * .. @@ -190,7 +190,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) LOGICAL LQUERY INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB, $ NBMIN, NH, NX - DOUBLE PRECISION EI + DOUBLE PRECISION EI * .. * .. External Subroutines .. EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM, @@ -221,11 +221,12 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -8 END IF * + NH = IHI - ILO + 1 IF( INFO.EQ.0 ) THEN * * Compute the workspace requirements * - IF( N.EQ.0 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, @@ -253,7 +254,6 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f index ee9bc7f39a..b8e41b39cd 100755 --- a/SRC/dgeqp3rk.f +++ b/SRC/dgeqp3rk.f @@ -427,8 +427,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> LWORK >= 1, if MIN(M,N) = 0, -*> LWORK >= (3*N + NRHS - 1), otherwise. +*> LWORK >= 1, if MIN(M,N) = 0, and +*> LWORK >= (3*N+NRHS-1), otherwise. *> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )), *> where NB is the optimal block size for DGEQP3RK returned *> by ILAENV. Minimal block size MINNB=2. diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f index 0ded941327..6ed8f211f1 100644 --- a/SRC/dgeqr.f +++ b/SRC/dgeqr.f @@ -190,7 +190,7 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -246,8 +246,10 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * * Determine if the workspace size satisfies minimal size * + LWMIN = MAX( 1, N ) + LWREQ = MAX( 1, N*NB ) LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N ) + IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.LWREQ ) $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN @@ -255,7 +257,7 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, NB = 1 MB = M END IF - IF( LWORK.LT.NB*N ) THEN + IF( LWORK.LT.LWREQ ) THEN LMINWS = .TRUE. NB = 1 END IF @@ -270,7 +272,7 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -284,9 +286,9 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -311,7 +313,7 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, NB*N ) + WORK( 1 ) = LWREQ * RETURN * diff --git a/SRC/dgesvj.f b/SRC/dgesvj.f index 8400a5c340..198bfb0a50 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -240,7 +240,11 @@ *> \verbatim *> LWORK is INTEGER *> The length of the array WORK. -*> LWORK >= 1, if MIN(M,N) = 0, LWORK >= MAX(6,M+N), otherwise. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(6,M+N), otherwise. +*> +*> If on entry LWORK = -1, then a workspace query is assumed and +*> no computation is done; WORK(1) is set to the minial (and optimal) +*> length of WORK. *> \endverbatim *> *> \param[out] INFO @@ -367,8 +371,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, $ SWBAND, MINMN, LWMIN - LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK, - $ RSVEC, UCTOL, UPPER + LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, + $ ROTOK, RSVEC, UCTOL, UPPER * .. * .. Local Arrays .. DOUBLE PRECISION FASTR( 5 ) @@ -416,6 +420,7 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LWMIN = MAX( 6, M+N ) END IF * + LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN @@ -435,7 +440,7 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.LWMIN ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 ELSE INFO = 0 @@ -445,6 +450,9 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGESVJ', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + WORK( 1 ) = LWMIN + RETURN END IF * * #:) Quick return for void matrix diff --git a/SRC/dgetsqrhrt.f b/SRC/dgetsqrhrt.f index d294cacbd8..682c7c30fa 100644 --- a/SRC/dgetsqrhrt.f +++ b/SRC/dgetsqrhrt.f @@ -132,6 +132,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If MIN(M,N) = 0, LWORK >= 1, else *> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), @@ -227,7 +228,7 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, INFO = -5 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -7 - ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN + ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN INFO = -9 ELSE * diff --git a/SRC/dgges3.f b/SRC/dgges3.f index c89d50866d..2ef55951a3 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -394,29 +394,33 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( INFO.EQ.0 ) THEN CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( LWKMIN, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) IF( ILVSL ) THEN CALL DORGQR( N, N, N, VSL, LDVSL, WORK, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) END IF CALL DGGHD3( JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, VSL, $ LDVSL, VSR, LDVSR, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) CALL DLAQZ0( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, $ WORK, -1, 0, IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) IF( WANTST ) THEN CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, $ SDIM, PVSL, PVSR, DIF, WORK, -1, IDUM, 1, $ IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) + END IF + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = LWKOPT END IF - WORK( 1 ) = LWKOPT END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/dggev3.f b/SRC/dggev3.f index 4c3f35c5a8..b970c04c4e 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -327,10 +327,10 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, -1, $ IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) IF( ILVL ) THEN CALL DORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) END IF IF( ILV ) THEN CALL DGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, @@ -339,18 +339,21 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, CALL DLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ WORK, -1, 0, IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) ELSE CALL DGGHD3( 'N', 'N', N, 1, N, A, LDA, B, LDB, VL, LDVL, $ VR, LDVR, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) CALL DLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ WORK, -1, 0, IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT( WORK ( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) + END IF + IF( N.EQ.0 ) THEN + WORK( 1 ) = 1 + ELSE + WORK( 1 ) = LWKOPT END IF - - WORK( 1 ) = LWKOPT END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/dggqrf.f b/SRC/dggqrf.f index 4f5f79f38e..edac7f22f2 100644 --- a/SRC/dggqrf.f +++ b/SRC/dggqrf.f @@ -287,6 +287,7 @@ SUBROUTINE DGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * RQ factorization of N-by-P matrix B: B = T*Z. * CALL DGERQF( N, P, B, LDB, TAUB, WORK, LWORK, INFO ) +* WORK( 1 ) = MAX( LOPT, INT( WORK( 1 ) ) ) * RETURN diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f index 337b2c4a46..023db5ac9b 100644 --- a/SRC/dlamtsqr.f +++ b/SRC/dlamtsqr.f @@ -136,16 +136,16 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> *> If MIN(M,N,K) = 0, LWORK >= 1. *> If SIDE = 'L', LWORK >= max(1,N*NB). *> If SIDE = 'R', LWORK >= max(1,MB*NB). +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -271,8 +271,6 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF -* -* Determine the block size if it is tall skinny or short and wide * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN @@ -290,10 +288,12 @@ SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, IF( MINMNK.EQ.0 ) THEN RETURN END IF +* +* Determine the block size if it is tall skinny or short and wide * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN END IF * diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index 8575d5a440..636c12dc87 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -226,7 +226,8 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0 ) THEN +* + IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN END IF * @@ -245,36 +246,36 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, * * The LQ Decomposition * - IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN - CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) + IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN + CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) RETURN - END IF + END IF * - KK = MOD((N-M),(NB-M)) - II=N-KK+1 + KK = MOD((N-M),(NB-M)) + II = N-KK+1 * -* Compute the LQ factorization of the first block A(1:M,1:NB) +* Compute the LQ factorization of the first block A(1:M,1:NB) * - CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) - CTR = 1 + CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO ) + CTR = 1 * - DO I = NB+1, II-NB+M , (NB-M) + DO I = NB+1, II-NB+M, (NB-M) * -* Compute the QR factorization of the current block A(1:M,I:I+NB-M) +* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * - CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), - $ LDA, T(1, CTR * M + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), + $ LDA, T(1, CTR * M + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * * Compute the QR factorization of the last block A(1:M,II:N) * - IF (II.LE.N) THEN + IF( II.LE.N ) THEN CALL DTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), - $ LDA, T(1, CTR * M + 1), LDT, - $ WORK, INFO ) - END IF + $ LDA, T(1, CTR * M + 1), LDT, + $ WORK, INFO ) + END IF * WORK( 1 ) = LWMIN * diff --git a/SRC/dlatrs3.f b/SRC/dlatrs3.f index d9fe465697..d18675b2d0 100644 --- a/SRC/dlatrs3.f +++ b/SRC/dlatrs3.f @@ -157,6 +157,7 @@ *> \endverbatim *> *> \param[in] LWORK +*> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. *> @@ -168,6 +169,7 @@ *> only calculates the optimal dimensions 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 diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f index c73c086446..0000aab68c 100644 --- a/SRC/dlatsqr.f +++ b/SRC/dlatsqr.f @@ -109,7 +109,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> LWORK >= 1, if MIN(M,N) = 0, LWORK >= NB*N, otherwise. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the minimal size of the WORK array, returns @@ -230,6 +230,7 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN END IF +* IF( INFO.NE.0 ) THEN CALL XERBLA( 'DLATSQR', -INFO ) RETURN @@ -240,41 +241,41 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * Quick return if possible * IF( MINMN.EQ.0 ) THEN - RETURN + RETURN END IF * * The QR Decomposition * - IF ((MB.LE.N).OR.(MB.GE.M)) THEN - CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) - RETURN - END IF + IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN + CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) + RETURN + END IF * - KK = MOD((M-N),(MB-N)) - II=M-KK+1 + KK = MOD((M-N),(MB-N)) + II = M-KK+1 * -* Compute the QR factorization of the first block A(1:MB,1:N) +* Compute the QR factorization of the first block A(1:MB,1:N) * - CALL DGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) + CALL DGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) * - CTR = 1 - DO I = MB+1, II-MB+N , (MB-N) + CTR = 1 + DO I = MB+1, II-MB+N, (MB-N) * -* Compute the QR factorization of the current block A(I:I+MB-N,1:N) +* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * - CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, - $ T(1, CTR * N + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, + $ T(1, CTR * N + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * -* Compute the QR factorization of the last block A(II:M,1:N) +* Compute the QR factorization of the last block A(II:M,1:N) * - IF (II.LE.M) THEN - CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, - $ T(1, CTR * N + 1), LDT, - $ WORK, INFO ) - END IF + IF( II.LE.M ) THEN + CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, + $ T(1, CTR * N + 1), LDT, + $ WORK, INFO ) + END IF * WORK( 1 ) = LWMIN RETURN diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 9a9486d5f8..90109e08f6 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -301,7 +301,7 @@ *> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) -*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. *> \endverbatim *> *> \param[in] LIWORK diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f index 581b6277e5..0a96ecd7e5 100644 --- a/SRC/dsysv_aa.f +++ b/SRC/dsysv_aa.f @@ -177,7 +177,7 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS + INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS * .. * .. External Functions .. LOGICAL LSAME @@ -196,6 +196,7 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N, 3*N-2 ) IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -206,17 +207,17 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * IF( INFO.EQ.0 ) THEN CALL DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT_SYTRF = INT( WORK(1) ) + LWKOPT_SYTRF = INT( WORK( 1 ) ) CALL DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) - LWKOPT_SYTRS = INT( WORK(1) ) - LWKOPT = MAX( 1, LWKOPT_SYTRF, LWKOPT_SYTRS ) + LWKOPT_SYTRS = INT( WORK( 1 ) ) + LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/dsysv_aa_2stage.f b/SRC/dsysv_aa_2stage.f index 43c931281e..90dd0a38ae 100644 --- a/SRC/dsysv_aa_2stage.f +++ b/SRC/dsysv_aa_2stage.f @@ -206,7 +206,7 @@ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY - INTEGER LWKOPT + INTEGER LWKMIN, LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -227,6 +227,7 @@ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, UPPER = LSAME( UPLO, 'U' ) WQUERY = ( LWORK.EQ.-1 ) TQUERY = ( LTB.EQ.-1 ) + LWKMIN = MAX( 1, N ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -239,14 +240,15 @@ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = INT( WORK(1) ) + LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) ) + WORK( 1 ) = LWKOPT END IF * IF( INFO.NE.0 ) THEN @@ -256,7 +258,6 @@ SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, RETURN END IF * -* * Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index 675c6fc481..04d03d587a 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -140,7 +140,7 @@ *> \verbatim *> LHOUS is INTEGER *> The dimension of the array HOUS. -*> If N = 0, LHOUS >= 1, else LHOUS = MAX(1, dimension). +*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension). *> *> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine @@ -266,7 +266,7 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, - $ NBTILES, TTYPE, TID, NTHREADS, DEBUG, + $ NBTILES, TTYPE, TID, NTHREADS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ SIDEV, SIZETAU, LDV, LHMIN, LWMIN @@ -287,7 +287,6 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the minimal workspace size required. * Test the input parameters * - DEBUG = 0 INFO = 0 AFTERS1 = LSAME( STAGE1, 'Y' ) WANTQ = LSAME( VECT, 'V' ) @@ -296,7 +295,7 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 52ad4f8845..924d4c1650 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -101,8 +101,10 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance -*> LWORK >= N*(1+NB), where NB is the optimal blocksize. +*> The length of WORK. +*> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise. +*> For optimum performance LWORK >= N*(1+NB), where NB is +*> the optimal blocksize, returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -128,7 +130,7 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) + SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -152,7 +154,7 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT + INTEGER J, LWKMIN, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB DOUBLE PRECISION ALPHA * .. @@ -179,18 +181,25 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( N.LE.1 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = 2*N + LWKOPT = (NB+1)*N + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, (NB+1)*N ) WORK( 1 ) = LWKOPT END IF * @@ -203,11 +212,11 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF IPIV( 1 ) = 1 - IF ( N.EQ.1 ) THEN + IF( N.EQ.1 ) THEN RETURN END IF * diff --git a/SRC/dsytrf_aa_2stage.f b/SRC/dsytrf_aa_2stage.f index 6d9da268e9..fae95bab24 100644 --- a/SRC/dsytrf_aa_2stage.f +++ b/SRC/dsytrf_aa_2stage.f @@ -211,9 +211,9 @@ SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN + ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF ( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * @@ -239,7 +239,7 @@ SUBROUTINE DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF * diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f index ebc65d87b1..e7333f9fbf 100644 --- a/SRC/dsytri2.f +++ b/SRC/dsytri2.f @@ -97,7 +97,7 @@ *> The dimension of the array WORK. *> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3). *> If LWORK = -1, then a workspace query is assumed; the routine -*> calculates: +*> 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. @@ -180,9 +180,6 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF -* -* Quick return if possible -* * IF( INFO.NE.0 ) THEN CALL XERBLA( 'DSYTRI2', -INFO ) @@ -191,6 +188,9 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) WORK( 1 ) = MINSIZE RETURN END IF +* +* Quick return if possible +* IF( N.EQ.0 ) $ RETURN diff --git a/SRC/sgebrd.f b/SRC/sgebrd.f index 3add5afe84..b33ad0b1f7 100644 --- a/SRC/sgebrd.f +++ b/SRC/sgebrd.f @@ -290,7 +290,7 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Determine when to switch from blocked to unblocked code. * IF( NX.LT.MINMN ) THEN - WS = ( M+N )*NB + WS = LWKOPT IF( LWORK.LT.WS ) THEN * * Not enough work space for the optimal NB, consider using diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index 70eb595504..33f6c71718 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -222,11 +222,12 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -8 END IF * + NH = IHI - ILO + 1 IF( INFO.EQ.0 ) THEN * * Compute the workspace requirements * - IF( N.EQ.0 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE NB = MIN( NBMAX, ILAENV( 1, 'SGEHRD', ' ', N, ILO, IHI, @@ -254,7 +255,6 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/sgelqf.f b/SRC/sgelqf.f index 7ec1dee472..3b3913d843 100644 --- a/SRC/sgelqf.f +++ b/SRC/sgelqf.f @@ -186,7 +186,7 @@ SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 ELSE IF( .NOT.LQUERY ) THEN - IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) + IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) $ INFO = -7 END IF IF( INFO.NE.0 ) THEN diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f index bb5da72dc2..f852fb360b 100755 --- a/SRC/sgeqp3rk.f +++ b/SRC/sgeqp3rk.f @@ -427,7 +427,8 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*. LWORK >= (3*N + NRHS - 1) +*> LWORK >= 1, if MIN(M,N) = 0, and +*> LWORK >= (3*N+NRHS-1), otherwise. *> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )), *> where NB is the optimal block size for SGEQP3RK returned *> by ILAENV. Minimal block size MINNB=2. @@ -618,8 +619,9 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * .. External Functions .. LOGICAL SISNAN INTEGER ISAMAX, ILAENV - REAL SLAMCH, SNRM2 - EXTERNAL SISNAN, SLAMCH, SNRM2, ISAMAX, ILAENV + REAL SLAMCH, SNRM2, SROUNDUP_LWORK + EXTERNAL SISNAN, SLAMCH, SNRM2, ISAMAX, ILAENV, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC REAL, MAX, MIN @@ -696,7 +698,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * LWKOPT = 2*N + NB*( N+NRHS+1 ) END IF - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN INFO = -15 @@ -719,7 +721,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, K = 0 MAXC2NRMK = ZERO RELMAXC2NRMK = ZERO - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -772,7 +774,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * * Array TAU is not set and contains undefined elements. * - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -791,7 +793,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, TAU( J ) = ZERO END DO * - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * END IF @@ -867,7 +869,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, TAU( J ) = ZERO END DO * - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * @@ -985,7 +987,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * * Return from the routine. * - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * @@ -1072,7 +1074,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * END IF * - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/sgesvj.f b/SRC/sgesvj.f index 15df1ccb63..36aed2853c 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -241,6 +241,10 @@ *> LWORK is INTEGER *> Length of WORK. *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(6,M+N), otherwise. +*> +*> If on entry LWORK = -1, then a workspace query is assumed and +*> no computation is done; WORK(1) is set to the minial (and optimal) +*> length of WORK. *> \endverbatim *> *> \param[out] INFO @@ -353,8 +357,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ ISWROT, jbc, jgl, KBL, LKAHEAD, MVL, N2, N34, $ N4, NBL, NOTROT, p, PSKIPPED, q, ROWSKIP, $ SWBAND, MINMN, LWMIN - LOGICAL APPLV, GOSCALE, LOWER, LSVEC, NOSCALE, ROTOK, - $ RSVEC, UCTOL, UPPER + LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, + $ ROTOK, RSVEC, UCTOL, UPPER * .. * .. Local Arrays .. REAL FASTR( 5 ) @@ -370,8 +374,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INTEGER ISAMAX EXTERNAL ISAMAX * from LAPACK - REAL SLAMCH - EXTERNAL SLAMCH + REAL SLAMCH, SROUNDUP_LWORK + EXTERNAL SLAMCH, SROUNDUP_LWORK LOGICAL LSAME EXTERNAL LSAME * .. @@ -402,6 +406,7 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LWMIN = MAX( 6, M+N ) END IF * + LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN @@ -421,7 +426,7 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.LWMIN ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 ELSE INFO = 0 @@ -431,6 +436,9 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( INFO.NE.0 ) THEN CALL XERBLA( 'SGESVJ', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + RETURN END IF * * #:) Quick return for void matrix diff --git a/SRC/sgetsqrhrt.f b/SRC/sgetsqrhrt.f index 2303ee9af6..7ade8a66c1 100644 --- a/SRC/sgetsqrhrt.f +++ b/SRC/sgetsqrhrt.f @@ -132,6 +132,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If MIN(M,N) = 0, LWORK >= 1, else *> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), *> where *> NUM_ALL_ROW_BLOCKS = CEIL((M-N)/(MB1-N)), @@ -231,7 +232,7 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, INFO = -5 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -7 - ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN + ELSE IF( LDT.LT.MAX( 1, MIN( NB2, N ) ) ) THEN INFO = -9 ELSE * diff --git a/SRC/sggev3.f b/SRC/sggev3.f index dcd5ffb102..d788d11472 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -324,25 +324,25 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * IF( INFO.EQ.0 ) THEN CALL SGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) - LWKOPT = MAX( LWKMIN, 3*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL, $ VR, LDVR, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) IF( ILVL ) THEN CALL SORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR ) - LWKOPT = MAX( LWKOPT, 3*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) CALL SLAQZ0( 'S', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ WORK, -1, 0, IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) ELSE CALL SLAQZ0( 'E', JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, $ WORK, -1, 0, IERR ) - LWKOPT = MAX( LWKOPT, 2*N+INT ( WORK( 1 ) ) ) + LWKOPT = MAX( LWKOPT, 2*N+INT( WORK( 1 ) ) ) END IF IF( N.EQ.0 ) THEN WORK( 1 ) = 1 diff --git a/SRC/sgghd3.f b/SRC/sgghd3.f index 97f28095f8..01e57088ad 100644 --- a/SRC/sgghd3.f +++ b/SRC/sgghd3.f @@ -183,7 +183,7 @@ *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> -*> \param[in] LWORK +*> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The length of the array WORK. LWORK >= 1. @@ -277,7 +277,7 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, INFO = 0 NB = ILAENV( 1, 'SGGHD3', ' ', N, ILO, IHI, -1 ) NH = IHI - ILO + 1 - IF( N.EQ.0 .OR. NH.LE.1 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE LWKOPT = 6*N*NB diff --git a/SRC/sggqrf.f b/SRC/sggqrf.f index da89807193..d32b484100 100644 --- a/SRC/sggqrf.f +++ b/SRC/sggqrf.f @@ -252,7 +252,7 @@ SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'SGERQF', ' ', N, P, -1, -1 ) NB3 = ILAENV( 1, 'SORMQR', ' ', N, M, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( 1, N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * LQUERY = ( LWORK.EQ.-1 ) diff --git a/SRC/sggrqf.f b/SRC/sggrqf.f index 8350c4b96c..b3842ec2ab 100644 --- a/SRC/sggrqf.f +++ b/SRC/sggrqf.f @@ -250,7 +250,7 @@ SUBROUTINE SGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, NB2 = ILAENV( 1, 'SGEQRF', ' ', P, N, -1, -1 ) NB3 = ILAENV( 1, 'SORMRQ', ' ', M, N, P, -1 ) NB = MAX( NB1, NB2, NB3 ) - LWKOPT = MAX( 1, N, M, P )*NB + LWKOPT = MAX( 1, MAX( N, M, P )*NB ) WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) LQUERY = ( LWORK.EQ.-1 ) IF( M.LT.0 ) THEN diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index bca33462b7..432afadedf 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -248,7 +248,6 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, ELSE LWMIN = MAX( 1, LW ) END IF - WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) * INFO = 0 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN @@ -273,6 +272,9 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -15 END IF * + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'SLAMSWLQ', -INFO ) RETURN diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f index 8aedf3ecf9..f9b167aea3 100644 --- a/SRC/slamtsqr.f +++ b/SRC/slamtsqr.f @@ -136,10 +136,10 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> *> If MIN(M,N,K) = 0, LWORK >= 1. *> If SIDE = 'L', LWORK >= max(1,N*NB). *> If SIDE = 'R', LWORK >= max(1,MB*NB). +*> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the minimal size of the WORK array, returns *> this value as the first entry of the WORK array, and no error @@ -275,9 +275,7 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -15 END IF * -* Determine the block size if it is tall skinny or short and wide -* - IF( INFO.EQ.0 ) THEN + IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * @@ -293,10 +291,12 @@ SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, IF( MINMNK.EQ.0 ) THEN RETURN END IF +* +* Determine the block size if it is tall skinny or short and wide * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN END IF * diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index a59ab9e754..594c646db3 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -246,36 +246,36 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, * * The LQ Decomposition * - IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN - CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) + IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN + CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) RETURN - END IF + END IF * - KK = MOD((N-M),(NB-M)) - II=N-KK+1 + KK = MOD((N-M),(NB-M)) + II = N-KK+1 * -* Compute the LQ factorization of the first block A(1:M,1:NB) +* Compute the LQ factorization of the first block A(1:M,1:NB) * - CALL SGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) - CTR = 1 + CALL SGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO ) + CTR = 1 * - DO I = NB+1, II-NB+M , (NB-M) + DO I = NB+1, II-NB+M, (NB-M) * -* Compute the QR factorization of the current block A(1:M,I:I+NB-M) +* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * - CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), - $ LDA, T(1, CTR * M + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), + $ LDA, T(1, CTR * M + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * * Compute the QR factorization of the last block A(1:M,II:N) * - IF (II.LE.N) THEN + IF( II.LE.N ) THEN CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), - $ LDA, T(1, CTR * M + 1), LDT, - $ WORK, INFO ) - END IF + $ LDA, T(1, CTR * M + 1), LDT, + $ WORK, INFO ) + END IF * WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN diff --git a/SRC/slatrs3.f b/SRC/slatrs3.f index 5eaaa3015b..17052289ee 100644 --- a/SRC/slatrs3.f +++ b/SRC/slatrs3.f @@ -156,6 +156,7 @@ *> \endverbatim *> *> \param[in] LWORK +*> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. *> @@ -167,6 +168,7 @@ *> only calculates the optimal dimensions 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 diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f index a3e699d205..4730815b5f 100644 --- a/SRC/slatsqr.f +++ b/SRC/slatsqr.f @@ -112,7 +112,7 @@ *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. *> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -168,7 +168,7 @@ *> * ===================================================================== SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, - $ LWORK, INFO) + $ LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -249,35 +249,35 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * * The QR Decomposition * - IF ((MB.LE.N).OR.(MB.GE.M)) THEN - CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) - RETURN - END IF - KK = MOD((M-N),(MB-N)) - II=M-KK+1 + IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN + CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) + RETURN + END IF + KK = MOD((M-N),(MB-N)) + II = M-KK+1 * -* Compute the QR factorization of the first block A(1:MB,1:N) +* Compute the QR factorization of the first block A(1:MB,1:N) * - CALL SGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) + CALL SGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) * - CTR = 1 - DO I = MB+1, II-MB+N , (MB-N) + CTR = 1 + DO I = MB+1, II-MB+N, (MB-N) * -* Compute the QR factorization of the current block A(I:I+MB-N,1:N) +* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * - CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, - $ T(1, CTR * N + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, + $ T(1, CTR * N + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * -* Compute the QR factorization of the last block A(II:M,1:N) +* Compute the QR factorization of the last block A(II:M,1:N) * - IF (II.LE.M) THEN - CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, - $ T(1, CTR * N + 1), LDT, - $ WORK, INFO ) - END IF + IF( II.LE.M ) THEN + CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, + $ T(1, CTR * N + 1), LDT, + $ WORK, INFO ) + END IF * WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index f32d886990..24fd615ad8 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -301,7 +301,7 @@ *> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) -*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. *> \endverbatim *> *> \param[in] LIWORK diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f index d8c98410b4..711a275e13 100644 --- a/SRC/ssysv_aa.f +++ b/SRC/ssysv_aa.f @@ -177,7 +177,7 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS + INTEGER LWKMIN, LWKOPT, LWKOPT_SYTRF, LWKOPT_SYTRS * .. * .. External Functions .. LOGICAL LSAME @@ -197,6 +197,7 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N, 3*N-2 ) IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -207,17 +208,17 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * IF( INFO.EQ.0 ) THEN CALL SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT_SYTRF = INT( WORK(1) ) + LWKOPT_SYTRF = INT( WORK( 1 ) ) CALL SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) - LWKOPT_SYTRS = INT( WORK(1) ) - LWKOPT = MAX( 1, LWKOPT_SYTRF, LWKOPT_SYTRS ) + LWKOPT_SYTRS = INT( WORK( 1 ) ) + LWKOPT = MAX( LWKMIN, LWKOPT_SYTRF, LWKOPT_SYTRS ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * diff --git a/SRC/ssysv_aa_2stage.f b/SRC/ssysv_aa_2stage.f index b7904e8020..fb068b3bf7 100644 --- a/SRC/ssysv_aa_2stage.f +++ b/SRC/ssysv_aa_2stage.f @@ -205,7 +205,7 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * .. * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY - INTEGER LWKOPT + INTEGER LWKMIN, LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -228,6 +228,7 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, UPPER = LSAME( UPLO, 'U' ) WQUERY = ( LWORK.EQ.-1 ) TQUERY = ( LTB.EQ.-1 ) + LWKMIN = MAX( 1, N ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -240,14 +241,14 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -11 - ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.WQUERY ) THEN INFO = -13 END IF * IF( INFO.EQ.0 ) THEN CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = MAX( 1, INT( WORK( 1 ) ) ) + LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * @@ -258,7 +259,6 @@ SUBROUTINE SSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, RETURN END IF * -* * Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, diff --git a/SRC/ssysvx.f b/SRC/ssysvx.f index 0d72217eb3..06a6413f19 100644 --- a/SRC/ssysvx.f +++ b/SRC/ssysvx.f @@ -305,7 +305,7 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * .. * .. Local Scalars .. LOGICAL LQUERY, NOFACT - INTEGER LWKOPT, NB + INTEGER LWKMIN, LWKOPT, NB REAL ANORM * .. * .. External Functions .. @@ -327,6 +327,7 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = 0 NOFACT = LSAME( FACT, 'N' ) LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 3*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) @@ -344,12 +345,12 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, INFO = -11 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -13 - ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -18 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = MAX( 1, 3*N ) + LWKOPT = LWKMIN IF( NOFACT ) THEN NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( LWKOPT, N*NB ) diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f index b85c647ce0..5b401c3d04 100644 --- a/SRC/ssytrd_2stage.f +++ b/SRC/ssytrd_2stage.f @@ -123,7 +123,7 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is REAL array, dimension (LHOUS2) +*> HOUS2 is REAL array, dimension (MAX(1,LHOUS2)) *> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim @@ -132,6 +132,8 @@ *> \verbatim *> LHOUS2 is INTEGER *> The dimension of the array HOUS2. +*> LHOUS2 >= 1. +*> *> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns @@ -149,8 +151,10 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS2 = -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 @@ -265,10 +269,13 @@ SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 ) IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) -* WRITE(*,*),'SSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, -* $ LHMIN, LWMIN + IF( N.EQ.0 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN INFO = -1 @@ -324,8 +331,7 @@ SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * * - HOUS2( 1 ) = LHMIN - WORK( 1 ) = LWMIN + WORK( 1 ) = LWMIN RETURN * * End of SSYTRD_2STAGE diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index 32bae26dc0..111eaa93ec 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -132,15 +132,17 @@ *> *> \param[out] HOUS *> \verbatim -*> HOUS is REAL array, dimension LHOUS, that -*> store the Householder representation. +*> HOUS is REAL array, dimension (MAX(1,LHOUS)) +*> Stores the Householder representation. *> \endverbatim *> *> \param[in] LHOUS *> \verbatim *> LHOUS is INTEGER -*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array HOUS. +*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension) +*> +*> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS array, returns *> this value as the first entry of the HOUS array, and no error @@ -152,14 +154,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension LWORK. +*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array WORK. +*> IF N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension) +*> +*> If LWORK = -1, or LHOUS = -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 @@ -261,7 +266,7 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, - $ NBTILES, TTYPE, TID, NTHREADS, DEBUG, + $ NBTILES, TTYPE, TID, NTHREADS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ SISEV, SIZETAU, LDV, LHMIN, LWMIN @@ -283,7 +288,6 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the minimal workspace size required. * Test the input parameters * - DEBUG = 0 INFO = 0 AFTERS1 = LSAME( STAGE1, 'Y' ) WANTQ = LSAME( VECT, 'V' ) @@ -292,9 +296,14 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 ) + IF( N.EQ.0 .OR. KD.LE.1 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN INFO = -1 @@ -315,8 +324,8 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, END IF * IF( INFO.EQ.0 ) THEN - HOUS( 1 ) = LHMIN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + HOUS( 1 ) = SROUNDUP_LWORK( LHMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) END IF * IF( INFO.NE.0 ) THEN @@ -544,8 +553,7 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 170 CONTINUE ENDIF * - HOUS( 1 ) = LHMIN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SSYTRD_SB2ST diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index 4efc436302..3996e07bba 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -124,7 +124,7 @@ *> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (LWORK) -*> On exit, if INFO = 0, or if LWORK=-1, +*> On exit, if INFO = 0, or if LWORK = -1, *> WORK(1) returns the size of LWORK. *> \endverbatim *> @@ -132,7 +132,9 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK which should be calculated -*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) +*> by a workspace query. +*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY) +*> *> 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 @@ -294,8 +296,12 @@ SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) - LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SY2SB', '', N, KD, -1, -1 ) - + IF( N.LE.KD+1 ) THEN + LWMIN = 1 + ELSE + LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SY2SB', '', N, KD, -1, -1 ) + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -314,7 +320,7 @@ SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, CALL XERBLA( 'SSYTRD_SY2SB', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN END IF * @@ -507,7 +513,7 @@ SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, END IF * - WORK( 1 ) = SROUNDUP_LWORK(LWMIN) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) RETURN * * End of SSYTRD_SY2SB diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index d6408a9788..af32fb064a 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -101,8 +101,10 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= MAX(1,2*N). For optimum performance -*> LWORK >= N*(1+NB), where NB is the optimal blocksize. +*> The length of WORK. +*> LWORK >= 1, if N <= 1, and LWORK >= 2*N, otherwise. +*> For optimum performance LWORK >= N*(1+NB), where NB is +*> the optimal blocksize, returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -128,7 +130,7 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) + SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -142,19 +144,19 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * .. * .. Array Arguments .. INTEGER IPIV( * ) - REAL A( LDA, * ), WORK( * ) + REAL A( LDA, * ), WORK( * ) * .. * * ===================================================================== * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT + INTEGER J, LWKMIN, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB - REAL ALPHA + REAL ALPHA * .. * .. External Functions .. LOGICAL LSAME @@ -180,19 +182,26 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( N.LE.1 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = 2*N + LWKOPT = (NB+1)*N + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * IF( INFO.EQ.0 ) THEN - LWKOPT = (NB+1)*N - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -204,11 +213,11 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) * * Quick return * - IF ( N.EQ.0 ) THEN + IF( N.EQ.0 ) THEN RETURN ENDIF IPIV( 1 ) = 1 - IF ( N.EQ.1 ) THEN + IF( N.EQ.1 ) THEN RETURN END IF * @@ -458,7 +467,8 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) END IF * 20 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of SSYTRF_AA diff --git a/SRC/zgebrd.f b/SRC/zgebrd.f index d85721b8ab..c1a6169a77 100644 --- a/SRC/zgebrd.f +++ b/SRC/zgebrd.f @@ -249,7 +249,7 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, ELSE LWKMIN = MAX( M, N ) NB = MAX( 1, ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) ) - LWKOPT = MAX( 1, ( M+N )*NB ) + LWKOPT = ( M+N )*NB END IF WORK( 1 ) = DBLE( LWKOPT ) * @@ -290,7 +290,7 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * Determine when to switch from blocked to unblocked code. * IF( NX.LT.MINMN ) THEN - WS = ( M+N )*NB + WS = LWKOPT IF( LWORK.LT.WS ) THEN * * Not enough work space for the optimal NB, consider using diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 05f385c976..36b576cbc9 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -173,7 +173,7 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER IHI, ILO, INFO, LDA, LWORK, N * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * ) + COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * ) * .. * * ===================================================================== @@ -182,7 +182,7 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INTEGER NBMAX, LDT, TSIZE PARAMETER ( NBMAX = 64, LDT = NBMAX+1, $ TSIZE = LDT*NBMAX ) - COMPLEX*16 ZERO, ONE + COMPLEX*16 ZERO, ONE PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), $ ONE = ( 1.0D+0, 0.0D+0 ) ) * .. @@ -190,7 +190,7 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) LOGICAL LQUERY INTEGER I, IB, IINFO, IWT, J, LDWORK, LWKOPT, NB, $ NBMIN, NH, NX - COMPLEX*16 EI + COMPLEX*16 EI * .. * .. External Subroutines .. EXTERNAL ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM, @@ -221,11 +221,12 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -8 END IF * + NH = IHI - ILO + 1 IF( INFO.EQ.0 ) THEN * * Compute the workspace requirements * - IF( N.EQ.0 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE NB = MIN( NBMAX, ILAENV( 1, 'ZGEHRD', ' ', N, ILO, IHI, @@ -253,7 +254,6 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Quick return if possible * - NH = IHI - ILO + 1 IF( NH.LE.1 ) THEN WORK( 1 ) = 1 RETURN diff --git a/SRC/zgelqf.f b/SRC/zgelqf.f index 3ca3b89088..e988ea818a 100644 --- a/SRC/zgelqf.f +++ b/SRC/zgelqf.f @@ -93,8 +93,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER +*> The dimension of the array WORK. *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M, otherwise. -*> The dimension of the array WORK. LWORK >= max(1,M). *> For optimum performance LWORK >= M*NB, where NB is the *> optimal blocksize. *> @@ -186,7 +186,7 @@ SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) INFO = -4 ELSE IF( .NOT.LQUERY ) THEN IF( LWORK.LE.0 .OR. ( N.GT.0 .AND. LWORK.LT.MAX( 1, M ) ) ) - $ INFO = -7 + $ INFO = -7 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGELQF', -INFO ) diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f index ca2742c759..d14d74fe28 100644 --- a/SRC/zgemqr.f +++ b/SRC/zgemqr.f @@ -261,7 +261,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LW + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN @@ -286,7 +286,7 @@ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, $ NB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK( 1 ) = LW + WORK( 1 ) = LWMIN * RETURN * diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index 82ee5e22d1..2be45d826e 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -214,7 +214,7 @@ *> \verbatim *> LWORK is INTEGER. *> Length of CWORK. -*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MAX(1,M+N), otherwise. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= M+N, otherwise. *> *> If on entry LWORK = -1, then a workspace query is assumed and *> no computation is done; CWORK(1) is set to the minial (and optimal) @@ -430,14 +430,12 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * MINMN = MIN( M, N ) IF( MINMN.EQ.0 ) THEN - LWMIN = 1 + LWMIN = 1 LRWMIN = 1 ELSE - LWMIN = M+N + LWMIN = M+N LRWMIN = MAX( 6, N ) END IF - CWORK(1) = LWMIN - RWORK(1) = LRWMIN * LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN @@ -459,9 +457,9 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, INFO = -11 ELSE IF( UCTOL .AND. ( RWORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( ( LWORK.LT.LWMIN ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 - ELSE IF( ( LRWORK.LT.LRWMIN ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( LRWORK.LT.LRWMIN .AND. ( .NOT.LQUERY ) ) THEN INFO = -15 ELSE INFO = 0 @@ -472,6 +470,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL XERBLA( 'ZGESVJ', -INFO ) RETURN ELSE IF( LQUERY ) THEN + CWORK( 1 ) = LWMIN + RWORK( 1 ) = LRWMIN RETURN END IF * diff --git a/SRC/zgges3.f b/SRC/zgges3.f index daf407102c..8235c2543a 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -216,6 +216,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= MAX(1,2*N) +*> For good performance, LWORK must generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index 159984e099..f466d42886 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -276,7 +276,7 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, INFO = 0 NB = ILAENV( 1, 'ZGGHD3', ' ', N, ILO, IHI, -1 ) NH = IHI - ILO + 1 - IF( N.LE.1 ) THEN + IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE LWKOPT = 6*N*NB diff --git a/SRC/zheevd.f b/SRC/zheevd.f index 791988a892..8e86b9e88a 100644 --- a/SRC/zheevd.f +++ b/SRC/zheevd.f @@ -116,8 +116,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is DOUBLE PRECISION array, -*> dimension (LRWORK) +*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK)) *> On exit, if INFO = 0, RWORK(1) returns the optimal LRWORK. *> \endverbatim *> diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f index 4a16376bf7..b3d4b37256 100644 --- a/SRC/zhesv_aa.f +++ b/SRC/zhesv_aa.f @@ -128,7 +128,7 @@ *> LWORK is INTEGER *> The length of WORK. LWORK >= MAX(1,2*N,3*N-2), and for best *> performance LWORK >= max(1,N*NB), where NB is the optimal -*> blocksize for ZHETRF. +*> blocksize for ZHETRF_AA. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns @@ -177,7 +177,7 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS + INTEGER LWKMIN, LWKOPT, LWKOPT_HETRF, LWKOPT_HETRS * .. * .. External Functions .. LOGICAL LSAME @@ -196,6 +196,7 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) + LWKMIN = MAX( 1, 2*N, 3*N-2 ) IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN @@ -206,17 +207,17 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = -5 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -8 - ELSE IF( LWORK.LT.MAX( 1, 2*N, 3*N-2 ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -10 END IF * IF( INFO.EQ.0 ) THEN CALL ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT_HETRF = INT( WORK(1) ) + LWKOPT_HETRF = INT( WORK( 1 ) ) CALL ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, $ -1, INFO ) - LWKOPT_HETRS = INT( WORK(1) ) - LWKOPT = MAX( 1, LWKOPT_HETRF, LWKOPT_HETRS ) + LWKOPT_HETRS = INT( WORK( 1 ) ) + LWKOPT = MAX( LWKMIN, LWKOPT_HETRF, LWKOPT_HETRS ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/zhesv_aa_2stage.f b/SRC/zhesv_aa_2stage.f index 158791ccf2..c503b5554d 100644 --- a/SRC/zhesv_aa_2stage.f +++ b/SRC/zhesv_aa_2stage.f @@ -142,12 +142,12 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. LDB >= MAX(1,N). +*> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 workspace of size MAX(1,LWORK). +*> WORK is COMPLEX*16 workspace of size (MAX(1,LWORK)). *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -250,7 +250,7 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IF( INFO.EQ.0 ) THEN CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV, $ IPIV2, WORK, -1, INFO ) - LWKOPT = MAX( LWKMIN, INT( WORK(1) ) ) + LWKOPT = MAX( LWKMIN, INT( WORK( 1 ) ) ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/zhetrd_2stage.f b/SRC/zhetrd_2stage.f index 652d6725db..ab444894b9 100644 --- a/SRC/zhetrd_2stage.f +++ b/SRC/zhetrd_2stage.f @@ -123,7 +123,7 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is COMPLEX*16 array, dimension (LHOUS2) +*> HOUS2 is COMPLEX*16 array, dimension (MAX(1,LHOUS2)) *> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim @@ -132,6 +132,8 @@ *> \verbatim *> LHOUS2 is INTEGER *> The dimension of the array HOUS2. +*> LHOUS2 >= 1. +*> *> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns @@ -143,14 +145,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (LWORK) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array WORK. +*> If N = 0, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS2 = -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 @@ -265,10 +270,13 @@ SUBROUTINE ZHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 ) IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) -* WRITE(*,*),'ZHETRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO, -* $ LHMIN, LWMIN + IF( N.EQ.0 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN INFO = -1 @@ -324,7 +332,6 @@ SUBROUTINE ZHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * * - HOUS2( 1 ) = LHMIN WORK( 1 ) = LWMIN RETURN * diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 4f04d82c69..247497ab67 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -132,15 +132,17 @@ *> *> \param[out] HOUS *> \verbatim -*> HOUS is COMPLEX*16 array, dimension LHOUS, that -*> store the Householder representation. +*> HOUS is COMPLEX*16 array, dimension (MAX(1,LHOUS)) +*> Stores the Householder representation. *> \endverbatim *> *> \param[in] LHOUS *> \verbatim *> LHOUS is INTEGER -*> The dimension of the array HOUS. LHOUS = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array HOUS. +*> If N = 0 or KD <= 1, LHOUS >= 1, else LHOUS = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS array, returns *> this value as the first entry of the HOUS array, and no error @@ -152,14 +154,17 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension LWORK. +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)). +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS=-1, +*> The dimension of the array WORK. +*> If N = 0 or KD <= 1, LWORK >= 1, else LWORK = MAX(1, dimension). +*> +*> If LWORK = -1, or LHOUS = -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 @@ -262,7 +267,7 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, INTEGER I, M, K, IB, SWEEPID, MYID, SHIFT, STT, ST, $ ED, STIND, EDIND, BLKLASTIND, COLPT, THED, $ STEPERCOL, GRSIZ, THGRSIZ, THGRNB, THGRID, - $ NBTILES, TTYPE, TID, NTHREADS, DEBUG, + $ NBTILES, TTYPE, TID, NTHREADS, $ ABDPOS, ABOFDPOS, DPOS, OFDPOS, AWPOS, $ INDA, INDW, APOS, SIZEA, LDA, INDV, INDTAU, $ SIZEV, SIZETAU, LDV, LHMIN, LWMIN @@ -285,7 +290,6 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * Determine the minimal workspace size required. * Test the input parameters * - DEBUG = 0 INFO = 0 AFTERS1 = LSAME( STAGE1, 'Y' ) WANTQ = LSAME( VECT, 'V' ) @@ -294,9 +298,14 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 ) - LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 ) + IF( N.EQ.0 .OR. KD.LE.1 ) THEN + LHMIN = 1 + LWMIN = 1 + ELSE + LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) + END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN INFO = -1 @@ -575,7 +584,6 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, 170 CONTINUE ENDIF * - HOUS( 1 ) = LHMIN WORK( 1 ) = LWMIN RETURN * diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index e0a70cbb85..3e3bfa374c 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -123,8 +123,8 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (LWORK) -*> On exit, if INFO = 0, or if LWORK=-1, +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, or if LWORK = -1, *> WORK(1) returns the size of LWORK. *> \endverbatim *> @@ -132,7 +132,9 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK which should be calculated -*> by a workspace query. LWORK = MAX(1, LWORK_QUERY) +*> by a workspace query. +*> If N <= KD+1, LWORK >= 1, else LWORK = MAX(1, LWORK_QUERY). +*> *> 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 @@ -293,8 +295,12 @@ SUBROUTINE ZHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) - LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HE2HB', ' ', N, KD, -1, -1 ) - + IF( N.LE.KD+1 ) THEN + LWMIN = 1 + ELSE + LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HE2HB', '', N, KD, -1, -1 ) + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index 55217521e6..381c87d51c 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -101,9 +101,9 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. +*> The length of WORK. *> LWORK >= 1, if N >= 1, and LWORK >= 2*N, otherwise. -*> For optimum performance LWORK >= N*(1+NB), where NB is +*> For optimum performance LWORK >= N*(1+NB), where NB is *> the optimal blocksize, returned by ILAENV. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -154,7 +154,7 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * * .. Local Scalars .. LOGICAL LQUERY, UPPER - INTEGER J, LWKOPT + INTEGER J, LWKMIN, LWKOPT INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB COMPLEX*16 ALPHA * .. @@ -180,22 +180,25 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) + IF( N.LE.1 ) THEN + LWKMIN = 1 + LWKOPT = 1 + ELSE + LWKMIN = 2*N + LWKOPT = (NB+1)*N + END IF +* IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * IF( INFO.EQ.0 ) THEN - IF( N.LE.1 ) THEN - LWKOPT = 1 - ELSE - LWKOPT = (NB+1)*N - END IF WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/zhetrf_aa_2stage.f b/SRC/zhetrf_aa_2stage.f index 6d6676436e..bab13a99d8 100644 --- a/SRC/zhetrf_aa_2stage.f +++ b/SRC/zhetrf_aa_2stage.f @@ -214,7 +214,7 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, INFO = -4 ELSE IF( LTB.LT.MAX( 1, 4*N ) .AND. .NOT.TQUERY ) THEN INFO = -6 - ELSE IF( LWORK.LT. MAX( 1, N ) .AND. .NOT.WQUERY ) THEN + ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.WQUERY ) THEN INFO = -10 END IF * diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f index 3d4b896bc4..bfbb94827e 100644 --- a/SRC/zhetri2.f +++ b/SRC/zhetri2.f @@ -88,7 +88,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK). +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)). *> \endverbatim *> *> \param[in] LWORK @@ -159,11 +159,13 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = 0 UPPER = LSAME( UPLO, 'U' ) LQUERY = ( LWORK.EQ.-1 ) +* * Get blocksize +* NBMAX = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) IF( N.EQ.0 ) THEN MINSIZE = 1 - ELSE IF( NBMAX .GE. N ) THEN + ELSE IF( NBMAX.GE.N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -192,7 +194,7 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( N.EQ.0 ) $ RETURN - IF( NBMAX .GE. N ) THEN + IF( NBMAX.GE.N ) THEN CALL ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) ELSE CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f index cf478d6713..59a0a55581 100644 --- a/SRC/zlamswlq.f +++ b/SRC/zlamswlq.f @@ -127,17 +127,20 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> If SIDE = 'L', LWORK >= max(1,NB) * MB; -*> if SIDE = 'R', LWORK >= max(1,M) * MB. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,NB*MB). +*> If SIDE = 'R', LWORK >= max(1,M*MB). +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -193,90 +196,99 @@ *> * ===================================================================== SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + COMPLEX*16 A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. External Subroutines .. - EXTERNAL ZTPMLQT, ZGEMLQT, XERBLA + EXTERNAL ZTPMLQT, ZGEMLQT, XERBLA * .. * .. Executable Statements .. * * Test the input arguments * - LQUERY = LWORK.LT.0 + INFO = 0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * MB ELSE LW = M * MB END IF * - INFO = 0 + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 - ELSE IF( K.LT.MB .OR. MB.LT.1) THEN + ELSE IF( K.LT.MB .OR. MB.LT.1 ) THEN INFO = -6 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, MB) ) THEN + ELSE IF( LDT.LT.MAX( 1, MB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN + END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZLAMSWLQ', -INFO ) - WORK(1) = LW RETURN - ELSE IF (LQUERY) THEN - WORK(1) = LW + ELSE IF( LQUERY ) THEN RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN END IF * @@ -405,7 +417,7 @@ SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = LWMIN RETURN * * End of ZLAMSWLQ diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f index 1b6f75506d..03770c06e3 100644 --- a/SRC/zlamtsqr.f +++ b/SRC/zlamtsqr.f @@ -128,22 +128,24 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If MIN(M,N,K) = 0, LWORK >= 1. +*> If SIDE = 'L', LWORK >= max(1,N*NB). +*> If SIDE = 'R', LWORK >= max(1,MB*NB). *> -*> If SIDE = 'L', LWORK >= max(1,N)*NB; -*> if SIDE = 'R', LWORK >= max(1,MB)*NB. *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -195,44 +197,46 @@ *> * ===================================================================== SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, - $ LDT, C, LDC, WORK, LWORK, INFO ) + $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), WORK( * ), C(LDC, * ), - $ T( LDT, * ) + COMPLEX*16 A( LDA, * ), WORK( * ), C( LDC, * ), + $ T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER I, II, KK, LW, CTR, Q, MINMNK, LWMIN * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. External Subroutines .. - EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA + EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA * .. * .. Executable Statements .. * * Test the input arguments * - LQUERY = LWORK.LT.0 + INFO = 0 + LQUERY = ( LWORK.EQ.-1 ) NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) - IF (LEFT) THEN + IF( LEFT ) THEN LW = N * NB Q = M ELSE @@ -240,11 +244,17 @@ SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, Q = N END IF * - INFO = 0 + MINMNK = MIN( M, N, K ) + IF( MINMNK.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = MAX( 1, LW ) + END IF +* IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( M.LT.K ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -255,38 +265,38 @@ SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -7 ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN INFO = -9 - ELSE IF( LDT.LT.MAX( 1, NB) ) THEN + ELSE IF( LDT.LT.MAX( 1, NB ) ) THEN INFO = -11 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN - INFO = -13 - ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN + INFO = -13 + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -15 END IF * -* Determine the block size if it is tall skinny or short and wide -* - IF( INFO.EQ.0) THEN - WORK(1) = LW + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZLAMTSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N,K).EQ.0 ) THEN + IF( MINMNK.EQ.0 ) THEN RETURN END IF +* +* Determine the block size if it is tall skinny or short and wide * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + $ T, LDT, C, LDC, WORK, INFO ) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -412,7 +422,7 @@ SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * END IF * - WORK(1) = LW + WORK( 1 ) = LWMIN RETURN * * End of ZLAMTSQR diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f index 0c89eeb5f7..7352071320 100644 --- a/SRC/zlaswlq.f +++ b/SRC/zlaswlq.f @@ -96,22 +96,23 @@ *> The leading dimension of the array T. LDT >= MB. *> \endverbatim *> -*> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= MB*M. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= MB*M, otherwise. +*> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -163,31 +164,33 @@ *> * ===================================================================== SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, - $ INFO) + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT + INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, *) + COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, MINMN, LWMIN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. EXTERNAL SUBROUTINES .. EXTERNAL ZGELQT, ZTPLQT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -198,12 +201,19 @@ SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = M*MB + END IF * IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 - ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN + ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 ) ) THEN INFO = -3 ELSE IF( NB.LE.0 ) THEN INFO = -4 @@ -211,60 +221,61 @@ SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 - ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = MB*M +* + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZLASWLQ', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The LQ Decomposition * - IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN - CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) + IF( (M.GE.N) .OR. (NB.LE.M) .OR. (NB.GE.N) ) THEN + CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) RETURN - END IF + END IF * - KK = MOD((N-M),(NB-M)) - II=N-KK+1 + KK = MOD((N-M),(NB-M)) + II = N-KK+1 * -* Compute the LQ factorization of the first block A(1:M,1:NB) +* Compute the LQ factorization of the first block A(1:M,1:NB) * - CALL ZGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO) - CTR = 1 + CALL ZGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO ) + CTR = 1 * - DO I = NB+1, II-NB+M , (NB-M) + DO I = NB+1, II-NB+M, (NB-M) * -* Compute the QR factorization of the current block A(1:M,I:I+NB-M) +* Compute the QR factorization of the current block A(1:M,I:I+NB-M) * - CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), - $ LDA, T(1, CTR * M + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), + $ LDA, T(1, CTR * M + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * * Compute the QR factorization of the last block A(1:M,II:N) * - IF (II.LE.N) THEN + IF( II.LE.N ) THEN CALL ZTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), - $ LDA, T(1, CTR * M + 1), LDT, - $ WORK, INFO ) - END IF + $ LDA, T(1, CTR * M + 1), LDT, + $ WORK, INFO ) + END IF * - WORK( 1 ) = M * MB + WORK( 1 ) = LWMIN RETURN * * End of ZLASWLQ diff --git a/SRC/zlatrs3.f b/SRC/zlatrs3.f index 38853af22c..27eac839bc 100644 --- a/SRC/zlatrs3.f +++ b/SRC/zlatrs3.f @@ -158,7 +158,11 @@ *> \endverbatim *> *> \param[in] LWORK +*> \verbatim *> LWORK is INTEGER +*> The dimension of the array WORK. +*> +*> If MIN(N,NRHS) = 0, LWORK >= 1, else *> LWORK >= MAX(1, 2*NBA * MAX(NBA, MIN(NRHS, 32)), where *> NBA = (N + NB - 1)/NB and NB is the optimal block size. *> @@ -166,6 +170,7 @@ *> only calculates the optimal dimensions 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 @@ -257,7 +262,7 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LQUERY, NOTRAN, NOUNIT, UPPER INTEGER AWRK, I, IFIRST, IINC, ILAST, II, I1, I2, J, $ JFIRST, JINC, JLAST, J1, J2, K, KK, K1, K2, - $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS + $ LANRM, LDS, LSCALE, NB, NBA, NBX, RHS, LWMIN DOUBLE PRECISION ANRM, BIGNUM, BNRM, RSCAL, SCAL, SCALOC, $ SCAMIN, SMLNUM, TMAX * .. @@ -296,15 +301,24 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * row. WORK( I + KK * LDS ) is the scale factor of the vector * segment associated with the I-th block row and the KK-th vector * in the block column. +* LSCALE = NBA * MAX( NBA, MIN( NRHS, NBRHS ) ) LDS = NBA +* * The second part stores upper bounds of the triangular A. There are * a total of NBA x NBA blocks, of which only the upper triangular * part or the lower triangular part is referenced. The upper bound of * the block A( I, J ) is stored as WORK( AWRK + I + J * NBA ). +* LANRM = NBA * NBA AWRK = LSCALE - WORK( 1 ) = LSCALE + LANRM +* + IF( MIN( N, NRHS ).EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = LSCALE + LANRM + END IF + WORK( 1 ) = LWMIN * * Test the input parameters. * @@ -326,7 +340,7 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, INFO = -8 ELSE IF( LDX.LT.MAX( 1, N ) ) THEN INFO = -10 - ELSE IF( .NOT.LQUERY .AND. LWORK.LT.WORK( 1 ) ) THEN + ELSE IF( .NOT.LQUERY .AND. LWORK.LT.LWMIN ) THEN INFO = -14 END IF IF( INFO.NE.0 ) THEN diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f index 4edcca1812..b2fe3aa111 100644 --- a/SRC/zlatsqr.f +++ b/SRC/zlatsqr.f @@ -101,13 +101,16 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the minimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= NB*N. +*> The dimension of the array WORK. +*> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. +*> *> 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 @@ -165,31 +168,33 @@ *> * ===================================================================== SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, - $ LWORK, INFO) + $ LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * * .. Scalar Arguments .. - INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK + INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), WORK( * ), T(LDT, *) + COMPLEX*16 A( LDA, * ), WORK( * ), T( LDT, * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LQUERY - INTEGER I, II, KK, CTR + LOGICAL LQUERY + INTEGER I, II, KK, CTR, LWMIN, MINMN * .. * .. EXTERNAL FUNCTIONS .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. EXTERNAL SUBROUTINES .. - EXTERNAL ZGEQRT, ZTPQRT, XERBLA + EXTERNAL ZGEQRT, ZTPQRT, XERBLA +* .. * .. INTRINSIC FUNCTIONS .. INTRINSIC MAX, MIN, MOD * .. @@ -200,6 +205,13 @@ SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = 0 * LQUERY = ( LWORK.EQ.-1 ) +* + MINMN = MIN( M, N ) + IF( MINMN.EQ.0 ) THEN + LWMIN = 1 + ELSE + LWMIN = N*NB + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -207,64 +219,65 @@ SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, INFO = -2 ELSE IF( MB.LT.1 ) THEN INFO = -3 - ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN + ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 ) ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -6 ELSE IF( LDT.LT.NB ) THEN INFO = -8 - ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN + ELSE IF( LWORK.LT.LWMIN .AND. (.NOT.LQUERY) ) THEN INFO = -10 END IF - IF( INFO.EQ.0) THEN - WORK(1) = NB*N +* + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LWMIN END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZLATSQR', -INFO ) RETURN - ELSE IF (LQUERY) THEN - RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF * * Quick return if possible * - IF( MIN(M,N).EQ.0 ) THEN - RETURN + IF( MINMN.EQ.0 ) THEN + RETURN END IF * * The QR Decomposition * - IF ((MB.LE.N).OR.(MB.GE.M)) THEN - CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) - RETURN - END IF - KK = MOD((M-N),(MB-N)) - II=M-KK+1 + IF( (MB.LE.N) .OR. (MB.GE.M) ) THEN + CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) + RETURN + END IF + KK = MOD((M-N),(MB-N)) + II=M-KK+1 * -* Compute the QR factorization of the first block A(1:MB,1:N) +* Compute the QR factorization of the first block A(1:MB,1:N) * - CALL ZGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) - CTR = 1 + CALL ZGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO ) + CTR = 1 * - DO I = MB+1, II-MB+N , (MB-N) + DO I = MB+1, II-MB+N, (MB-N) * -* Compute the QR factorization of the current block A(I:I+MB-N,1:N) +* Compute the QR factorization of the current block A(I:I+MB-N,1:N) * - CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, - $ T(1, CTR * N + 1), - $ LDT, WORK, INFO ) - CTR = CTR + 1 - END DO + CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, + $ T(1, CTR * N + 1), + $ LDT, WORK, INFO ) + CTR = CTR + 1 + END DO * -* Compute the QR factorization of the last block A(II:M,1:N) +* Compute the QR factorization of the last block A(II:M,1:N) * - IF (II.LE.M) THEN - CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, - $ T(1,CTR * N + 1), LDT, - $ WORK, INFO ) - END IF + IF( II.LE.M ) THEN + CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, + $ T(1,CTR * N + 1), LDT, + $ WORK, INFO ) + END IF * - work( 1 ) = N*NB + WORK( 1 ) = LWMIN RETURN * * End of ZLATSQR diff --git a/TESTING/LIN/cchkhe_aa_2stage.f b/TESTING/LIN/cchkhe_aa_2stage.f index 8624587894..d79978e557 100644 --- a/TESTING/LIN/cchkhe_aa_2stage.f +++ b/TESTING/LIN/cchkhe_aa_2stage.f @@ -435,7 +435,7 @@ SUBROUTINE CCHKHE_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, SRNAMT = 'CHETRF_AA_2STAGE' LWORK = MIN( MAX( 1, N*NB ), 3*NMAX*NMAX) CALL CHETRF_AA_2STAGE( UPLO, N, AFAC, LDA, - $ AINV, MAX( 1, (3*NB+1)*N ), + $ AINV, MAX( 1, (3*NB+1)*N ), $ IWORK, IWORK( 1+N ), $ WORK, LWORK, $ INFO ) From cd7523d5b2e06a62cfa084e35706e83a9d09cb8f Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Mon, 4 Dec 2023 14:45:31 +0700 Subject: [PATCH 014/206] handle corner case of lwork in evr/evr_2stage and fix output format in chkxer --- SRC/cheevr.f | 31 ++++++++++++++++++++----------- SRC/cheevr_2stage.f | 26 ++++++++++++++++++-------- SRC/dsyevr.f | 19 +++++++++++++------ SRC/dsyevr_2stage.f | 4 ++-- SRC/ssyevr.f | 15 +++++++++++---- SRC/ssyevr_2stage.f | 4 ++-- SRC/zheevr.f | 27 ++++++++++++++++++--------- SRC/zheevr_2stage.f | 22 ++++++++++++++++------ TESTING/EIG/cerrst.f | 12 ++++++------ TESTING/EIG/chkxer.f | 2 +- TESTING/EIG/derrst.f | 4 ++-- TESTING/EIG/serrst.f | 4 ++-- TESTING/EIG/zerrst.f | 12 ++++++------ 13 files changed, 117 insertions(+), 65 deletions(-) diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 05c5e66be2..ad5c8cd4aa 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -272,7 +272,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,2*N). +*> The length of the array WORK. +*> If N <= 1, LWORK >= 1, else LWORK >= 2*N. *> For optimal efficiency, LWORK >= (NB+1)*N, *> where NB is the max of the blocksize for CHETRD and for *> CUNMTR as returned by ILAENV. @@ -294,7 +295,8 @@ *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> The length of the array RWORK. LRWORK >= max(1,24*N). +*> The length of the array RWORK. +*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N. *> *> If LRWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -313,7 +315,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -417,9 +420,15 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. $ ( LIWORK.EQ.-1 ) ) * - LRWMIN = MAX( 1, 24*N ) - LIWMIN = MAX( 1, 10*N ) - LWMIN = MAX( 1, 2*N ) + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = 2*N + LRWMIN = 24*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN @@ -454,8 +463,8 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) - RWORK( 1 ) = LRWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) + RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -483,7 +492,7 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 2 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = REAL( A( 1, 1 ) ) @@ -710,8 +719,8 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) - RWORK( 1 ) = LRWMIN + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) + RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index 5ab6227bc3..e06925fcd0 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -280,6 +280,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N <= 1, LWORK must be at least 1. *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, 26*N, dimension) where *> dimension = max(stage1,stage2) + (KD+1)*N + N @@ -310,7 +311,8 @@ *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> The length of the array RWORK. LRWORK >= max(1,24*N). +*> The length of the array RWORK. +*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N. *> *> If LRWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -329,7 +331,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -473,9 +476,16 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWMIN = N + LHTRD + LWTRD - LRWMIN = MAX( 1, 24*N ) - LIWMIN = MAX( 1, 10*N ) +* + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = N + LHTRD + LWTRD + LRWMIN = 24*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN @@ -508,7 +518,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -536,7 +546,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 2 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = REAL( A( 1, 1 ) ) @@ -767,7 +777,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * Set WORK(1) to optimal workspace size. * WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = SROUNDUP_LWORK( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 77f29d768c..8647b0162c 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -271,7 +271,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,26*N). +*> The dimension of the array WORK. +*> If N <= 1, LWORK >= 1, else LWORK >= 26*N. *> For optimal efficiency, LWORK >= (NB+6)*N, *> where NB is the max of the blocksize for DSYTRD and DORMTR *> returned by ILAENV. @@ -285,13 +286,14 @@ *> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (MAX(1,LIWORK)) -*> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK. +*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK. *> \endverbatim *> *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal size of the IWORK array, @@ -390,8 +392,13 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) * - LWMIN = MAX( 1, 26*N ) - LIWMIN = MAX( 1, 10*N ) + IF( N.LE.1 ) THEN + LWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = 26*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN @@ -450,7 +457,7 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 7 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = A( 1, 1 ) diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 90109e08f6..63d5e31598 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -492,7 +492,7 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) * NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) ) * LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = LWMIN + WORK( 1 ) = LWMIN IWORK( 1 ) = LIWMIN END IF * @@ -735,7 +735,7 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = LWMIN + WORK( 1 ) = LWMIN IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 6f5a604ec1..870facd606 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -271,7 +271,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK >= max(1,26*N). +*> The dimension of the array WORK. +*> If N <= 1, LWORK >= 1, else LWORK >= 26*N. *> For optimal efficiency, LWORK >= (NB+6)*N, *> where NB is the max of the blocksize for SSYTRD and SORMTR *> returned by ILAENV. @@ -292,7 +293,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK and @@ -392,8 +394,13 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) * - LWMIN = MAX( 1, 26*N ) - LIWMIN = MAX( 1, 10*N ) + IF( N.LE.1 ) THEN + LWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = 26*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 24fd615ad8..471e259776 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -493,7 +493,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) * NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) ) * LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) IWORK( 1 ) = LIWMIN END IF * @@ -741,7 +741,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) + WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/zheevr.f b/SRC/zheevr.f index ad0d310d15..fe6e1a85f7 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -272,7 +272,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of the array WORK. LWORK >= max(1,2*N). +*> The length of the array WORK. +*> If N <= 1, LWORK >= 1, else LWORK >= 2*N. *> For optimal efficiency, LWORK >= (NB+1)*N, *> where NB is the max of the blocksize for ZHETRD and for *> ZUNMTR as returned by ILAENV. @@ -294,7 +295,8 @@ *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> The length of the array RWORK. LRWORK >= max(1,24*N). +*> The length of the array RWORK. +*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N. *> *> If LRWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -313,7 +315,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -417,9 +420,15 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. $ ( LIWORK.EQ.-1 ) ) * - LRWMIN = MAX( 1, 24*N ) - LIWMIN = MAX( 1, 10*N ) - LWMIN = MAX( 1, 2*N ) + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = 2*N + LRWMIN = 24*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN @@ -454,7 +463,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( ( NB+1 )*N, LWMIN ) - WORK( 1 ) = LWKOPT + WORK( 1 ) = LWKOPT RWORK( 1 ) = LRWMIN IWORK( 1 ) = LIWMIN * @@ -483,7 +492,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 2 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = DBLE( A( 1, 1 ) ) @@ -710,7 +719,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * * Set WORK(1) to optimal workspace size. * - WORK( 1 ) = LWKOPT + WORK( 1 ) = LWKOPT RWORK( 1 ) = LRWMIN IWORK( 1 ) = LIWMIN * diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index 23deaf5fd8..b1cc7175fa 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -280,6 +280,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. +*> If N <= 1, LWORK must be at least 1. *> If JOBZ = 'N' and N > 1, LWORK must be queried. *> LWORK = MAX(1, 26*N, dimension) where *> dimension = max(stage1,stage2) + (KD+1)*N + N @@ -310,7 +311,8 @@ *> \param[in] LRWORK *> \verbatim *> LRWORK is INTEGER -*> The length of the array RWORK. LRWORK >= max(1,24*N). +*> The length of the array RWORK. +*> If N <= 1, LRWORK >= 1, else LRWORK >= 24*N. *> *> If LRWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -329,7 +331,8 @@ *> \param[in] LIWORK *> \verbatim *> LIWORK is INTEGER -*> The dimension of the array IWORK. LIWORK >= max(1,10*N). +*> The dimension of the array IWORK. +*> If N <= 1, LIWORK >= 1, else LIWORK >= 10*N. *> *> If LIWORK = -1, then a workspace query is assumed; the *> routine only calculates the optimal sizes of the WORK, RWORK @@ -472,9 +475,16 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWMIN = N + LHTRD + LWTRD - LRWMIN = MAX( 1, 24*N ) - LIWMIN = MAX( 1, 10*N ) +* + IF( N.LE.1 ) THEN + LWMIN = 1 + LRWMIN = 1 + LIWMIN = 1 + ELSE + LWMIN = N + LHTRD + LWTRD + LRWMIN = 24*N + LIWMIN = 10*N + END IF * INFO = 0 IF( .NOT.( LSAME( JOBZ, 'N' ) ) ) THEN @@ -535,7 +545,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, END IF * IF( N.EQ.1 ) THEN - WORK( 1 ) = 2 + WORK( 1 ) = 1 IF( ALLEIG .OR. INDEIG ) THEN M = 1 W( 1 ) = DBLE( A( 1, 1 ) ) diff --git a/TESTING/EIG/cerrst.f b/TESTING/EIG/cerrst.f index 1748a2aad6..d23eb14eac 100644 --- a/TESTING/EIG/cerrst.f +++ b/TESTING/EIG/cerrst.f @@ -748,17 +748,17 @@ SUBROUTINE CERRST( PATH, NUNIT ) CALL CHKXER( 'CHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL CHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0E0, 0.0E0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ), + $ M, R, Z, 1, IW, Q, 0, RW, 24*N, IW( 2*N+1 ), $ 10*N, INFO ) CALL CHKXER( 'CHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0E0, 0.0E0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N-1, IW( 2*N-1 ), + $ M, R, Z, 1, IW, Q, 2*N, RW, 0, IW( 2*N-1 ), $ 10*N, INFO ) CALL CHKXER( 'CHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL CHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0E0, 0.0E0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW, 10*N-1, + $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW, 0, $ INFO ) CALL CHKXER( 'CHEEVR', INFOT, NOUT, LERR, OK ) NT = NT + 12 @@ -830,19 +830,19 @@ SUBROUTINE CERRST( PATH, NUNIT ) INFOT = 18 CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0, 0.0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ), + $ M, R, Z, 1, IW, Q, 0, RW, 24*N, IW( 2*N+1 ), $ 10*N, INFO ) CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0, 0.0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N-1, IW( 2*N-1 ), + $ M, R, Z, 1, IW, Q, 26*N, RW, 0, IW( 2*N-1 ), $ 10*N, INFO ) CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL CHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0, 0.0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 10*N-1, + $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 0, $ INFO ) CALL CHKXER( 'CHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) NT = NT + 13 diff --git a/TESTING/EIG/chkxer.f b/TESTING/EIG/chkxer.f index fd00bb65a7..70caf7e0a3 100644 --- a/TESTING/EIG/chkxer.f +++ b/TESTING/EIG/chkxer.f @@ -61,7 +61,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) RETURN * 9999 FORMAT( ' *** Illegal value of parameter number ', I2, - $ ' not detected by ', A6, ' ***' ) + $ ' not detected by ', A, ' ***' ) * * End of CHKXER * diff --git a/TESTING/EIG/derrst.f b/TESTING/EIG/derrst.f index 0595386448..7d111e2e0d 100644 --- a/TESTING/EIG/derrst.f +++ b/TESTING/EIG/derrst.f @@ -735,12 +735,12 @@ SUBROUTINE DERRST( PATH, NUNIT ) CALL CHKXER( 'DSYEVR', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL DSYEVR( 'V', 'I', 'U', 1, A, 1, 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 26*N-1, IW( 2*N+1 ), 10*N, + $ M, R, Z, 1, IW, Q, 0, IW( 2*N+1 ), 10*N, $ INFO ) CALL CHKXER( 'DSYEVR', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL DSYEVR( 'V', 'I', 'U', 1, A, 1, 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N-1, + $ M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 0, $ INFO ) CALL CHKXER( 'DSYEVR', INFOT, NOUT, LERR, OK ) NT = NT + 11 diff --git a/TESTING/EIG/serrst.f b/TESTING/EIG/serrst.f index b87fc42ef7..4083463829 100644 --- a/TESTING/EIG/serrst.f +++ b/TESTING/EIG/serrst.f @@ -733,12 +733,12 @@ SUBROUTINE SERRST( PATH, NUNIT ) CALL CHKXER( 'SSYEVR', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL SSYEVR( 'V', 'I', 'U', 1, A, 1, 0.0E0, 0.0E0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 26*N-1, IW( 2*N+1 ), 10*N, + $ M, R, Z, 1, IW, Q, 0, IW( 2*N+1 ), 10*N, $ INFO ) CALL CHKXER( 'SSYEVR', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL SSYEVR( 'V', 'I', 'U', 1, A, 1, 0.0E0, 0.0E0, 1, 1, 0.0, - $ M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 10*N-1, + $ M, R, Z, 1, IW, Q, 26*N, IW( 2*N+1 ), 0, $ INFO ) CALL CHKXER( 'SSYEVR', INFOT, NOUT, LERR, OK ) NT = NT + 11 diff --git a/TESTING/EIG/zerrst.f b/TESTING/EIG/zerrst.f index d7b41c0537..31881c4de1 100644 --- a/TESTING/EIG/zerrst.f +++ b/TESTING/EIG/zerrst.f @@ -748,17 +748,17 @@ SUBROUTINE ZERRST( PATH, NUNIT ) CALL CHKXER( 'ZHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL ZHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ), + $ M, R, Z, 1, IW, Q, 0, RW, 24*N, IW( 2*N+1 ), $ 10*N, INFO ) CALL CHKXER( 'ZHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N-1, IW( 2*N-1 ), + $ M, R, Z, 1, IW, Q, 2*N, RW, 0, IW( 2*N-1 ), $ 10*N, INFO ) CALL CHKXER( 'ZHEEVR', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL ZHEEVR( 'V', 'I', 'U', 1, A, 1, 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW, 10*N-1, + $ M, R, Z, 1, IW, Q, 2*N, RW, 24*N, IW, 0, $ INFO ) CALL CHKXER( 'ZHEEVR', INFOT, NOUT, LERR, OK ) NT = NT + 12 @@ -830,19 +830,19 @@ SUBROUTINE ZERRST( PATH, NUNIT ) INFOT = 18 CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 2*N-1, RW, 24*N, IW( 2*N+1 ), + $ M, R, Z, 1, IW, Q, 0, RW, 24*N, IW( 2*N+1 ), $ 10*N, INFO ) CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N-1, IW( 2*N-1 ), + $ M, R, Z, 1, IW, Q, 26*N, RW, 0, IW( 2*N-1 ), $ 10*N, INFO ) CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL ZHEEVR_2STAGE( 'N', 'I', 'U', 1, A, 1, $ 0.0D0, 0.0D0, 1, 1, 0.0D0, - $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 10*N-1, + $ M, R, Z, 1, IW, Q, 26*N, RW, 24*N, IW, 0, $ INFO ) CALL CHKXER( 'ZHEEVR_2STAGE', INFOT, NOUT, LERR, OK ) NT = NT + 13 From 280e16145dff7de25a2e64acb6e262252eb0525d Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Mon, 4 Dec 2023 16:33:50 +0700 Subject: [PATCH 015/206] add missed usage of sroundup_lwork in several functions --- SRC/cgehrd.f | 2 +- SRC/cgeqr.f | 2 +- SRC/cgesvdx.f | 10 +++++----- SRC/cgghd3.f | 3 ++- SRC/cheevd.f | 8 ++++---- SRC/chetrf.f | 2 +- SRC/chetrf_rk.f | 2 +- SRC/chetri2.f | 5 +++-- SRC/chetrs_aa.f | 2 +- SRC/dgehrd.f | 2 +- SRC/dgghd3.f | 1 + SRC/dsytrf.f | 1 + SRC/dsytri2.f | 7 ++++--- SRC/sgehrd.f | 2 +- SRC/sgeqp3rk.f | 2 +- SRC/ssytrf.f | 5 +++-- SRC/ssytri2.f | 1 + SRC/zgehrd.f | 2 +- SRC/zgeqr.f | 2 +- SRC/zgghd3.f | 1 + SRC/zhetrf.f | 3 ++- SRC/zhetrf_rk.f | 2 +- SRC/zhetri2.f | 1 + SRC/zhetrs_aa.f | 2 +- SRC/zlatsqr.f | 4 ++-- 25 files changed, 42 insertions(+), 32 deletions(-) diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index 7c62694f39..7ba87cc01b 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -274,7 +274,7 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Determine if workspace is large enough for blocked code * - IF( LWORK.LT.N*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN * * Not enough workspace to use optimal NB: determine the * minimum value of NB, and reduce NB or force use of diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index 494ca5fe40..3617594d02 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -273,7 +273,7 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index 51e69cbe0f..e1856a65fd 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -208,7 +208,7 @@ *> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (MAX(1,LWORK)) -*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK; +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -312,8 +312,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - REAL SLAMCH, CLANGE - EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE + REAL SLAMCH, CLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT @@ -448,7 +448,7 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, END IF END IF MAXWRK = MAX( MAXWRK, MINWRK ) - WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO ) + WORK( 1 ) = SROUNDUP_LWORK( MAXWRK ) * IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN INFO = -19 @@ -846,7 +846,7 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * * Return optimal workspace in WORK(1) * - WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO ) + WORK( 1 ) = SROUNDUP_LWORK( MAXWRK ) * RETURN * diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index c4123e4c76..f7175a72c7 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -893,7 +893,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, IF ( JCOL.LT.IHI ) $ CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, IERR ) - WORK( 1 ) = CMPLX( LWKOPT ) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) * RETURN * diff --git a/SRC/cheevd.f b/SRC/cheevd.f index e24850f5a7..9b62a2df60 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -281,8 +281,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LROPT = LRWMIN LIOPT = LIWMIN END IF - WORK( 1 ) = SROUNDUP_LWORK(LOPT) - RWORK( 1 ) = LROPT + WORK( 1 ) = SROUNDUP_LWORK( LOPT ) + RWORK( 1 ) = SROUNDUP_LWORK( LROPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -377,8 +377,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, CALL SSCAL( IMAX, ONE / SIGMA, W, 1 ) END IF * - WORK( 1 ) = SROUNDUP_LWORK(LOPT) - RWORK( 1 ) = LROPT + WORK( 1 ) = SROUNDUP_LWORK( LOPT ) + RWORK( 1 ) = SROUNDUP_LWORK( LROPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/SRC/chetrf.f b/SRC/chetrf.f index 2b44956283..2836e30bcc 100644 --- a/SRC/chetrf.f +++ b/SRC/chetrf.f @@ -228,7 +228,7 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Determine the block size * NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f index bbf0578dfc..a13c740e3c 100644 --- a/SRC/chetrf_rk.f +++ b/SRC/chetrf_rk.f @@ -311,7 +311,7 @@ SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Determine the block size * NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * diff --git a/SRC/chetri2.f b/SRC/chetri2.f index 33e4dc5259..f15065ae7d 100644 --- a/SRC/chetri2.f +++ b/SRC/chetri2.f @@ -178,7 +178,7 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * @@ -195,11 +195,12 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( N.EQ.0 ) $ RETURN - IF( NBMAX .GE. N ) THEN + IF( NBMAX.GE.N ) THEN CALL CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) ELSE CALL CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) END IF +* RETURN * * End of CHETRI2 diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f index 51a817dedc..07179ab923 100644 --- a/SRC/chetrs_aa.f +++ b/SRC/chetrs_aa.f @@ -204,7 +204,7 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) + IF( MIN( N, NRHS ).EQ.0 ) $ RETURN * IF( UPPER ) THEN diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index 90a8b69498..d95bbd1827 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -273,7 +273,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Determine if workspace is large enough for blocked code * - IF( LWORK.LT.N*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN * * Not enough workspace to use optimal NB: determine the * minimum value of NB, and reduce NB or force use of diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f index f3bdf75ae8..21a6685734 100644 --- a/SRC/dgghd3.f +++ b/SRC/dgghd3.f @@ -889,6 +889,7 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, IF ( JCOL.LT.IHI ) $ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, IERR ) +* WORK( 1 ) = DBLE( LWKOPT ) * RETURN diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f index 7a7d99b1b1..2a1a2d4dc4 100644 --- a/SRC/dsytrf.f +++ b/SRC/dsytrf.f @@ -352,6 +352,7 @@ SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE +* WORK( 1 ) = LWKOPT RETURN * diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f index e7333f9fbf..5960d39928 100644 --- a/SRC/dsytri2.f +++ b/SRC/dsytri2.f @@ -165,7 +165,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) NBMAX = ILAENV( 1, 'DSYTRI2', UPLO, N, -1, -1, -1 ) IF( N.EQ.0 ) THEN MINSIZE = 1 - ELSE IF ( NBMAX.GE.N ) THEN + ELSE IF( NBMAX.GE.N ) THEN MINSIZE = N ELSE MINSIZE = (N+NBMAX+1)*(NBMAX+3) @@ -177,7 +177,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) INFO = -2 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -4 - ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN + ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN INFO = -7 END IF * @@ -194,11 +194,12 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( N.EQ.0 ) $ RETURN - IF( NBMAX .GE. N ) THEN + IF( NBMAX.GE.N ) THEN CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) ELSE CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) END IF +* RETURN * * End of DSYTRI2 diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index 33f6c71718..cfa17e156f 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -274,7 +274,7 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Determine if workspace is large enough for blocked code * - IF( LWORK.LT.N*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN * * Not enough workspace to use optimal NB: determine the * minimum value of NB, and reduce NB or force use of diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f index f852fb360b..d3a335b88e 100755 --- a/SRC/sgeqp3rk.f +++ b/SRC/sgeqp3rk.f @@ -824,7 +824,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, DO J = 1, MINMN TAU( J ) = ZERO END DO - WORK( 1 ) = REAL( LWKOPT ) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN END IF * diff --git a/SRC/ssytrf.f b/SRC/ssytrf.f index a788fbcf07..55f3a4f0fe 100644 --- a/SRC/ssytrf.f +++ b/SRC/ssytrf.f @@ -234,7 +234,7 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 ) LWKOPT = MAX( 1, N*NB ) - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) END IF * IF( INFO.NE.0 ) THEN @@ -353,7 +353,8 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE - WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) +* + WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) RETURN * * End of SSYTRF diff --git a/SRC/ssytri2.f b/SRC/ssytri2.f index ba83605cc9..fd1c53473d 100644 --- a/SRC/ssytri2.f +++ b/SRC/ssytri2.f @@ -200,6 +200,7 @@ SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) ELSE CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) END IF +* RETURN * * End of SSYTRI2 diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 36b576cbc9..0f4424ded6 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -273,7 +273,7 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * Determine if workspace is large enough for blocked code * - IF( LWORK.LT.N*NB+TSIZE ) THEN + IF( LWORK.LT.LWKOPT ) THEN * * Not enough workspace to use optimal NB: determine the * minimum value of NB, and reduce NB or force use of diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f index 7f37a4c7ff..7df9c2403d 100644 --- a/SRC/zgeqr.f +++ b/SRC/zgeqr.f @@ -272,7 +272,7 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index f466d42886..08343688de 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -887,6 +887,7 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, IF ( JCOL.LT.IHI ) $ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, IERR ) +* WORK( 1 ) = DCMPLX( LWKOPT ) * RETURN diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f index a8df90ffe9..433887108b 100644 --- a/SRC/zhetrf.f +++ b/SRC/zhetrf.f @@ -227,7 +227,7 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Determine the block size * NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * @@ -346,6 +346,7 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) END IF * 40 CONTINUE +* WORK( 1 ) = LWKOPT RETURN * diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f index 01b3e412dc..7c505fa4de 100644 --- a/SRC/zhetrf_rk.f +++ b/SRC/zhetrf_rk.f @@ -310,7 +310,7 @@ SUBROUTINE ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Determine the block size * NB = ILAENV( 1, 'ZHETRF_RK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f index bfbb94827e..1d932b866c 100644 --- a/SRC/zhetri2.f +++ b/SRC/zhetri2.f @@ -199,6 +199,7 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) ELSE CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO ) END IF +* RETURN * * End of ZHETRI2 diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f index a75fcd9cbb..b7a1f7f07b 100644 --- a/SRC/zhetrs_aa.f +++ b/SRC/zhetrs_aa.f @@ -204,7 +204,7 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Quick return if possible * - IF( N.EQ.0 .OR. NRHS.EQ.0 ) + IF( MIN( N, NRHS ).EQ.0 ) $ RETURN * IF( UPPER ) THEN diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f index b2fe3aa111..24d00f28a8 100644 --- a/SRC/zlatsqr.f +++ b/SRC/zlatsqr.f @@ -112,7 +112,7 @@ *> LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise. *> *> If LWORK = -1, then a workspace query is assumed; the routine -*> only calculates the optimal size of the WORK array, returns +*> only calculates the minimal 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 @@ -252,7 +252,7 @@ SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, RETURN END IF KK = MOD((M-N),(MB-N)) - II=M-KK+1 + II = M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * From 101800018d82ee1ca6bed1e90915eea7ebb5dc8b Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Tue, 12 Dec 2023 12:42:50 +0700 Subject: [PATCH 016/206] add DMD tests into CMakeLists --- TESTING/CMakeLists.txt | 14 ++++++++++++-- TESTING/EIG/CMakeLists.txt | 13 +++++++++++++ 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/TESTING/CMakeLists.txt b/TESTING/CMakeLists.txt index 27940227cb..f9c2482fc8 100644 --- a/TESTING/CMakeLists.txt +++ b/TESTING/CMakeLists.txt @@ -53,9 +53,7 @@ add_lapack_test(stest.out stest.in xlintsts) # ======== SINGLE RFP LIN TESTS ======================== add_lapack_test(stest_rfp.out stest_rfp.in xlintstrfs) # -# # ======== SINGLE EIG TESTS =========================== -# add_lapack_test(snep.out nep.in xeigtsts) add_lapack_test(ssep.out sep.in xeigtsts) add_lapack_test(sse2.out se2.in xeigtsts) @@ -76,6 +74,9 @@ add_lapack_test(sgqr.out gqr.in xeigtsts) add_lapack_test(sgsv.out gsv.in xeigtsts) add_lapack_test(scsd.out csd.in xeigtsts) add_lapack_test(slse.out lse.in xeigtsts) +# +# ======== SINGLE DMD EIG TESTS =========================== +add_lapack_test(sdmd.out sdmd.in xdmdeigtsts) endif() if(BUILD_DOUBLE) @@ -107,6 +108,9 @@ add_lapack_test(dgqr.out gqr.in xeigtstd) add_lapack_test(dgsv.out gsv.in xeigtstd) add_lapack_test(dcsd.out csd.in xeigtstd) add_lapack_test(dlse.out lse.in xeigtstd) +# +# ======== DOUBLE DMD EIG TESTS =========================== +add_lapack_test(ddmd.out ddmd.in xdmdeigtstd) endif() if(BUILD_COMPLEX) @@ -136,6 +140,9 @@ add_lapack_test(cgqr.out gqr.in xeigtstc) add_lapack_test(cgsv.out gsv.in xeigtstc) add_lapack_test(ccsd.out csd.in xeigtstc) add_lapack_test(clse.out lse.in xeigtstc) +# +# ======== COMPLEX DMD EIG TESTS =========================== +add_lapack_test(cdmd.out cdmd.in xdmdeigtstc) endif() if(BUILD_COMPLEX16) @@ -167,6 +174,9 @@ add_lapack_test(zgqr.out gqr.in xeigtstz) add_lapack_test(zgsv.out gsv.in xeigtstz) add_lapack_test(zcsd.out csd.in xeigtstz) add_lapack_test(zlse.out lse.in xeigtstz) +# +# ======== COMPLEX16 DMD EIG TESTS =========================== +add_lapack_test(zdmd.out zdmd.in xdmdeigtstz) endif() diff --git a/TESTING/EIG/CMakeLists.txt b/TESTING/EIG/CMakeLists.txt index 3c8d9a8b28..d99762d434 100644 --- a/TESTING/EIG/CMakeLists.txt +++ b/TESTING/EIG/CMakeLists.txt @@ -42,6 +42,8 @@ set(SEIGTST schkee.F sort03.f ssbt21.f ssgt01.f sslect.f sspt21.f sstt21.f sstt22.f ssyl01.f ssyt21.f ssyt22.f) +set(SDMDEIGTST schkdmd.f90) + set(CEIGTST cchkee.F cbdt01.f cbdt02.f cbdt03.f cbdt05.f cchkbb.f cchkbd.f cchkbk.f cchkbl.f cchkec.f @@ -59,6 +61,8 @@ set(CEIGTST cchkee.F csgt01.f cslect.f csyl01.f cstt21.f cstt22.f cunt01.f cunt03.f) +set(CDMDEIGTST cchkdmd.f90) + set(DZIGTST dlafts.f dlahd2.f dlasum.f dlatb9.f dstech.f dstect.f dsvdch.f dsvdct.f dsxt1.f) @@ -79,6 +83,8 @@ set(DEIGTST dchkee.F dort03.f dsbt21.f dsgt01.f dslect.f dspt21.f dstt21.f dstt22.f dsyl01.f dsyt21.f dsyt22.f) +set(DDMDEIGTST dchkdmd.f90) + set(ZEIGTST zchkee.F zbdt01.f zbdt02.f zbdt03.f zbdt05.f zchkbb.f zchkbd.f zchkbk.f zchkbl.f zchkec.f @@ -96,6 +102,8 @@ set(ZEIGTST zchkee.F zsgt01.f zslect.f zsyl01.f zstt21.f zstt22.f zunt01.f zunt03.f) +set(ZDMDEIGTST zchkdmd.f90) + macro(add_eig_executable name) add_executable(${name} ${ARGN}) target_link_libraries(${name} ${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) @@ -103,16 +111,21 @@ endmacro() if(BUILD_SINGLE) add_eig_executable(xeigtsts ${SEIGTST} ${SCIGTST} ${AEIGTST}) +add_eig_executable(xdmdeigtsts ${SDMDEIGTST}) endif() if(BUILD_COMPLEX) add_eig_executable(xeigtstc ${CEIGTST} ${SCIGTST} ${AEIGTST}) +add_eig_executable(xdmdeigtstc ${CDMDEIGTST}) endif() + if(BUILD_DOUBLE) add_eig_executable(xeigtstd ${DEIGTST} ${DZIGTST} ${AEIGTST}) +add_eig_executable(xdmdeigtstd ${DDMDEIGTST}) endif() if(BUILD_COMPLEX16) add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST}) +add_eig_executable(xdmdeigtstz ${ZDMDEIGTST}) endif() From 47879152071b840ba5a94a84ec2d05f7bc76e3fe Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Tue, 12 Dec 2023 13:42:37 +0700 Subject: [PATCH 017/206] init variable SSUM before call of LASSQ in DMD --- SRC/cgedmd.f90 | 6 ++++-- SRC/dgedmd.f90 | 6 ++++-- SRC/sgedmd.f90 | 6 ++++-- SRC/zgedmd.f90 | 6 ++++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index f7d76428e9..1413130ec3 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -761,7 +761,8 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & K = 0 DO i = 1, N !WORK(i) = SCNRM2( M, X(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL CLASSQ( M, X(1,i), 1, SCALE, SSUM ) IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN K = 0 @@ -834,7 +835,8 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! carefully computed using CLASSQ. DO i = 1, N !RWORK(i) = SCNRM2( M, Y(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL CLASSQ( M, Y(1,i), 1, SCALE, SSUM ) IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN K = 0 diff --git a/SRC/dgedmd.f90 b/SRC/dgedmd.f90 index 3bb505cd92..15df48fe91 100644 --- a/SRC/dgedmd.f90 +++ b/SRC/dgedmd.f90 @@ -783,7 +783,8 @@ SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & K = 0 DO i = 1, N !WORK(i) = DNRM2( M, X(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL DLASSQ( M, X(1,i), 1, SCALE, SSUM ) IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN K = 0 @@ -856,7 +857,8 @@ SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! carefully computed using DLASSQ. DO i = 1, N !WORK(i) = DNRM2( M, Y(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL DLASSQ( M, Y(1,i), 1, SCALE, SSUM ) IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN K = 0 diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index d37a654f76..4860e88983 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -782,7 +782,8 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & K = 0 DO i = 1, N !WORK(i) = DNRM2( M, X(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL SLASSQ( M, X(1,i), 1, SCALE, SSUM ) IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN K = 0 @@ -855,7 +856,8 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! carefully computed using SLASSQ. DO i = 1, N !WORK(i) = DNRM2( M, Y(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL SLASSQ( M, Y(1,i), 1, SCALE, SSUM ) IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN K = 0 diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index c29151ef39..5045cb166c 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -758,7 +758,8 @@ SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & K = 0 DO i = 1, N !WORK(i) = DZNRM2( M, X(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL ZLASSQ( M, X(1,i), 1, SCALE, SSUM ) IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN K = 0 @@ -831,7 +832,8 @@ SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! carefully computed using ZLASSQ. DO i = 1, N !RWORK(i) = DZNRM2( M, Y(1,i), 1 ) - SCALE = ZERO + SSUM = ONE + SCALE = ZERO CALL ZLASSQ( M, Y(1,i), 1, SCALE, SSUM ) IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN K = 0 From 4a26507b5ff7526e4bcb8f5f3d9c2555e6091629 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 15 Dec 2023 17:36:33 +0000 Subject: [PATCH 018/206] Initialize test results to zero in LIN testing routines to preempt potential garbage data influencing the test evaluations. --- TESTING/LIN/cchkqp3rk.f | 3 +++ TESTING/LIN/dchkqp3rk.f | 3 +++ TESTING/LIN/schkqp3rk.f | 3 +++ TESTING/LIN/zchkqp3rk.f | 3 +++ 4 files changed, 12 insertions(+) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index 79d6add72e..c8dc612bb3 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -587,6 +587,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 434d2067e2..8f7c2f6b41 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -584,6 +584,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index 36cf9370ea..e0b286d9ae 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -583,6 +583,9 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index 302c7b1a87..d4a51624e6 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -587,6 +587,9 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be From f6355dc7697aeecb866d73ba91f1cf07e01af070 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 15 Dec 2023 17:54:40 +0000 Subject: [PATCH 019/206] Updated array index calculations in cchkqp3rk.f, dchkqp3rk.f, schkqp3rk.f, and zchkqp3rk.f to use the leading dimension (LDA) instead of the fixed size (M) --- TESTING/LIN/cchkqp3rk.f | 4 ++-- TESTING/LIN/dchkqp3rk.f | 4 ++-- TESTING/LIN/schkqp3rk.f | 4 ++-- TESTING/LIN/zchkqp3rk.f | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index c8dc612bb3..fbfd8291fb 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -720,8 +720,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 * - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 8f7c2f6b41..42ca0277fc 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -716,8 +716,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index e0b286d9ae..8ab7b847a1 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -715,8 +715,8 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index d4a51624e6..4afa20f19f 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -720,8 +720,8 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * DO J = 1, KFACT-1, 1 * - DTEMP = (( ABS( A( (J-1)*M+J ) ) - - $ ABS( A( (J)*M+J+1 ) ) ) / + DTEMP = (( ABS( A( (J-1)*LDA+J ) ) - + $ ABS( A( (J)*LDA+J+1 ) ) ) / $ ABS( A(1) ) ) * IF( DTEMP.LT.ZERO ) THEN From 4bd18e2663dcd40e981c7e5bb582ffc1f7e237ea Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Mon, 18 Dec 2023 17:17:07 +0000 Subject: [PATCH 020/206] Refactor test result initialization and reporting Consolidated the initialization of the RESULT array and the reporting of test outcomes for the xCHKQP3RK tests. The initialization of the RESULT array to zeros is now occurring immediately before the tests, ensuring a clean slate without scattering across different test phases. Reporting functionality has been centralized at the end of the 5 tests, eliminating redundant blocks and improving maintainability. --- TESTING/LIN/cchkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/dchkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/schkqp3rk.f | 90 ++++++++++++----------------------------- TESTING/LIN/zchkqp3rk.f | 90 ++++++++++++----------------------------- 4 files changed, 104 insertions(+), 256 deletions(-) diff --git a/TESTING/LIN/cchkqp3rk.f b/TESTING/LIN/cchkqp3rk.f index fbfd8291fb..b794d4664c 100644 --- a/TESTING/LIN/cchkqp3rk.f +++ b/TESTING/LIN/cchkqp3rk.f @@ -587,9 +587,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -611,6 +608,9 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL CLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOl = -1.0 @@ -655,16 +655,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, $ LWORK , RWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -678,7 +668,7 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = CQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -687,21 +677,8 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = CQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -730,20 +707,6 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -765,42 +728,41 @@ SUBROUTINE CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL CUNMQR( 'Left', 'Conjugate transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL CAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ CLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'CGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 42ca0277fc..1834e63282 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -584,9 +584,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -608,6 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + ! DO I = 1, NTESTS + ! RESULT( I ) = ZERO + ! END DO * ABSTOL = -1.0 RELTOL = -1.0 @@ -651,16 +651,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -674,7 +664,7 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = DQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -683,21 +673,8 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = DQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) -* -* Print information about the tests that did not pass -* the threshold. + $ LWORK ) * - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -726,20 +703,6 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -761,42 +724,41 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL DORMQR( 'Left', 'Transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL DAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ DLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not +* pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'DGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, + $ IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f index 8ab7b847a1..c5ce7ff609 100755 --- a/TESTING/LIN/schkqp3rk.f +++ b/TESTING/LIN/schkqp3rk.f @@ -583,9 +583,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -607,6 +604,9 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL SLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOL = -1.0 @@ -650,16 +650,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -673,7 +663,7 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = SQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -682,21 +672,8 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = SQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -725,20 +702,6 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -760,42 +723,41 @@ SUBROUTINE SCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL SORMQR( 'Left', 'Transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL SAXPY( M, -ONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ SLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ SLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( REAL( M )*SLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'SGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO diff --git a/TESTING/LIN/zchkqp3rk.f b/TESTING/LIN/zchkqp3rk.f index 4afa20f19f..5092058837 100644 --- a/TESTING/LIN/zchkqp3rk.f +++ b/TESTING/LIN/zchkqp3rk.f @@ -587,9 +587,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL XLAENV( 1, NB ) NX = NXVAL( INB ) CALL XLAENV( 3, NX ) - DO I = 1, NTESTS - RESULT( I ) = ZERO - END DO * * We do MIN(M,N)+1 because we need a test for KMAX > N, * when KMAX is larger than MIN(M,N), KMAX should be @@ -611,6 +608,9 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL ZLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOl = -1.0 @@ -655,16 +655,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, $ LWORK , RWORK ) * - DO T = 1, 1 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, NB, NX, - $ IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 1 @@ -678,7 +668,7 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A) * EPS ) * RESULT( 2 ) = ZQPT01( M, N, KFACT, COPYA, A, LDA, TAU, - $ IWORK( N+1 ), WORK, LWORK ) + $ IWORK( N+1 ), WORK, LWORK ) * * Compute test 3: * @@ -687,21 +677,8 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * 1-norm( Q**T * Q - I ) / ( M * EPS ) * RESULT( 3 ) = ZQRT11( M, KFACT, A, LDA, TAU, WORK, - $ LWORK ) + $ LWORK ) * -* Print information about the tests that did not pass -* the threshold. -* - DO T = 2, 3 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 2 * * Compute test 4: @@ -730,20 +707,6 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * END DO * -* Print information about the tests that did not -* pass the threshold. -* - DO T = 4, 4 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', - $ M, N, NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, - $ RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO NRUN = NRUN + 1 * * End test 4. @@ -765,42 +728,41 @@ SUBROUTINE ZCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, * LWORK_MQR = MAX(1, NRHS) CALL ZUNMQR( 'Left', 'Conjugate transpose', - $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, - $ WORK, LWORK_MQR, INFO ) + $ M, NRHS, KFACT, A, LDA, TAU, B, LDA, + $ WORK, LWORK_MQR, INFO ) * DO I = 1, NRHS * * Compare N+J-th column of A and J-column of B. * CALL ZAXPY( M, -CONE, A( ( N+I-1 )*LDA+1 ), 1, - $ B( ( I-1 )*LDA+1 ), 1 ) + $ B( ( I-1 )*LDA+1 ), 1 ) END DO * - RESULT( 5 ) = - $ ABS( - $ ZLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / - $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) - $ ) -* -* Print information about the tests that did not pass -* the threshold. -* - DO T = 5, 5 - IF( RESULT( T ).GE.THRESH ) THEN - IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) - $ CALL ALAHD( NOUT, PATH ) - WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, - $ NRHS, KMAX, ABSTOL, RELTOL, - $ NB, NX, IMAT, T, RESULT( T ) - NFAIL = NFAIL + 1 - END IF - END DO + RESULT( 5 ) = ABS( + $ ZLANGE( 'One-norm', M, NRHS, B, LDA, RDUMMY ) / + $ ( DBLE( M )*DLAMCH( 'Epsilon' ) ) ) +* NRUN = NRUN + 1 * * End compute test 5. * END IF * +* Print information about the tests that did not pass +* the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) 'ZGEQP3RK', M, N, + $ NRHS, KMAX, ABSTOL, RELTOL, + $ NB, NX, IMAT, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO +* * END DO KMAX = 1, MIN(M,N)+1 * END DO From d371e22ff044045a590cb37b49fe1529dedcc7eb Mon Sep 17 00:00:00 2001 From: Mo Zhou Date: Wed, 20 Dec 2023 21:28:36 -0500 Subject: [PATCH 021/206] Fix the wrong implementation of the new tests for xblat1.f. (Fixes: #963) Since this is a regression after upgrading from v3.11.0 to v3.12.0, we can narrow down the range of the bug into the newly added SB1NRM2 subroutine. According to the buildlog and the documentation in the code, the VALUES(9), calculated as SXVALS(XX,2) should be infty. But the current code is returning a zero (or randomly) initialized variable YY, which does not make sense. In fact, if you go back to the reference implementation, namely the supplementary material of this paper https://dl.acm.org/doi/abs/10.1145/3061665 You can find a similar implementation of the SXVALS function in the `la_xxvals.F90` file. This patch corrests the test following the reference code. --- BLAS/TESTING/cblat1.f | 8 ++++++-- BLAS/TESTING/dblat1.f | 8 ++++++-- BLAS/TESTING/sblat1.f | 8 ++++++-- BLAS/TESTING/zblat1.f | 8 ++++++-- 4 files changed, 24 insertions(+), 8 deletions(-) diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f index 83b02f0cac..82798fe0b6 100644 --- a/BLAS/TESTING/cblat1.f +++ b/BLAS/TESTING/cblat1.f @@ -994,13 +994,17 @@ REAL FUNCTION SXVALS(XX,K) * .. Scalar Arguments .. REAL XX INTEGER K +* .. Parameters .. + REAL ZERO + PARAMETER (ZERO=0.0E+0) * .. Local Scalars .. - REAL X, Y, YY, Z + REAL X, Y, Z * .. Intrinsic Functions .. INTRINSIC HUGE * .. Executable Statements .. + X = ZERO Y = HUGE(XX) - Z = YY + Z = Y*Y IF (K.EQ.1) THEN X = -Z ELSE IF (K.EQ.2) THEN diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f index 063ffac3d2..95da39d12e 100644 --- a/BLAS/TESTING/dblat1.f +++ b/BLAS/TESTING/dblat1.f @@ -1326,13 +1326,17 @@ DOUBLE PRECISION FUNCTION DXVALS(XX,K) * .. Scalar Arguments .. DOUBLE PRECISION XX INTEGER K +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) * .. Local Scalars .. - DOUBLE PRECISION X, Y, YY, Z + DOUBLE PRECISION X, Y, Z * .. Intrinsic Functions .. INTRINSIC HUGE * .. Executable Statements .. + X = ZERO Y = HUGE(XX) - Z = YY + Z = Y*Y IF (K.EQ.1) THEN X = -Z ELSE IF (K.EQ.2) THEN diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f index 4dc537e2f0..e68ee09c1a 100644 --- a/BLAS/TESTING/sblat1.f +++ b/BLAS/TESTING/sblat1.f @@ -1278,13 +1278,17 @@ REAL FUNCTION SXVALS(XX,K) * .. Scalar Arguments .. REAL XX INTEGER K +* .. Parameters .. + REAL ZERO + PARAMETER (ZERO=0.0E+0) * .. Local Scalars .. - REAL X, Y, YY, Z + REAL X, Y, Z * .. Intrinsic Functions .. INTRINSIC HUGE * .. Executable Statements .. + X = ZERO Y = HUGE(XX) - Z = YY + Z = Y*Y IF (K.EQ.1) THEN X = -Z ELSE IF (K.EQ.2) THEN diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f index ef6deff921..29daad5741 100644 --- a/BLAS/TESTING/zblat1.f +++ b/BLAS/TESTING/zblat1.f @@ -994,13 +994,17 @@ DOUBLE PRECISION FUNCTION DXVALS(XX,K) * .. Scalar Arguments .. DOUBLE PRECISION XX INTEGER K +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER (ZERO=0.0D+0) * .. Local Scalars .. - DOUBLE PRECISION X, Y, YY, Z + DOUBLE PRECISION X, Y, Z * .. Intrinsic Functions .. INTRINSIC HUGE * .. Executable Statements .. + X = ZERO Y = HUGE(XX) - Z = YY + Z = Y*Y IF (K.EQ.1) THEN X = -Z ELSE IF (K.EQ.2) THEN From 464f532552d59e119a7d1ec1c78e66b46c1875f0 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Sat, 6 Jan 2024 18:20:41 -0600 Subject: [PATCH 022/206] Remove executable permissions from source files --- SRC/cgeqp3rk.f | 0 SRC/claqp2rk.f | 0 SRC/claqp3rk.f | 0 SRC/dgeqp3rk.f | 0 SRC/dlaqp2rk.f | 0 SRC/dlaqp3rk.f | 0 SRC/sgeqp3rk.f | 0 SRC/slaqp2rk.f | 0 SRC/slaqp3rk.f | 0 SRC/zgeqp3rk.f | 0 SRC/zlaqp2rk.f | 0 SRC/zlaqp3rk.f | 0 TESTING/LIN/CMakeLists.txt | 0 TESTING/LIN/Makefile | 0 TESTING/LIN/alaerh.f | 0 TESTING/LIN/alahd.f | 0 TESTING/LIN/dchkaa.F | 0 TESTING/LIN/dchkqp3rk.f | 0 TESTING/LIN/dlatb4.f | 0 TESTING/LIN/dqpt01.f | 0 TESTING/LIN/dqrt11.f | 0 TESTING/LIN/dqrt12.f | 0 TESTING/LIN/schkqp3rk.f | 0 23 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 SRC/cgeqp3rk.f mode change 100755 => 100644 SRC/claqp2rk.f mode change 100755 => 100644 SRC/claqp3rk.f mode change 100755 => 100644 SRC/dgeqp3rk.f mode change 100755 => 100644 SRC/dlaqp2rk.f mode change 100755 => 100644 SRC/dlaqp3rk.f mode change 100755 => 100644 SRC/sgeqp3rk.f mode change 100755 => 100644 SRC/slaqp2rk.f mode change 100755 => 100644 SRC/slaqp3rk.f mode change 100755 => 100644 SRC/zgeqp3rk.f mode change 100755 => 100644 SRC/zlaqp2rk.f mode change 100755 => 100644 SRC/zlaqp3rk.f mode change 100755 => 100644 TESTING/LIN/CMakeLists.txt mode change 100755 => 100644 TESTING/LIN/Makefile mode change 100755 => 100644 TESTING/LIN/alaerh.f mode change 100755 => 100644 TESTING/LIN/alahd.f mode change 100755 => 100644 TESTING/LIN/dchkaa.F mode change 100755 => 100644 TESTING/LIN/dchkqp3rk.f mode change 100755 => 100644 TESTING/LIN/dlatb4.f mode change 100755 => 100644 TESTING/LIN/dqpt01.f mode change 100755 => 100644 TESTING/LIN/dqrt11.f mode change 100755 => 100644 TESTING/LIN/dqrt12.f mode change 100755 => 100644 TESTING/LIN/schkqp3rk.f diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/claqp2rk.f b/SRC/claqp2rk.f old mode 100755 new mode 100644 diff --git a/SRC/claqp3rk.f b/SRC/claqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/dlaqp2rk.f b/SRC/dlaqp2rk.f old mode 100755 new mode 100644 diff --git a/SRC/dlaqp3rk.f b/SRC/dlaqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/slaqp2rk.f b/SRC/slaqp2rk.f old mode 100755 new mode 100644 diff --git a/SRC/slaqp3rk.f b/SRC/slaqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/zgeqp3rk.f b/SRC/zgeqp3rk.f old mode 100755 new mode 100644 diff --git a/SRC/zlaqp2rk.f b/SRC/zlaqp2rk.f old mode 100755 new mode 100644 diff --git a/SRC/zlaqp3rk.f b/SRC/zlaqp3rk.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/CMakeLists.txt b/TESTING/LIN/CMakeLists.txt old mode 100755 new mode 100644 diff --git a/TESTING/LIN/Makefile b/TESTING/LIN/Makefile old mode 100755 new mode 100644 diff --git a/TESTING/LIN/alaerh.f b/TESTING/LIN/alaerh.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/alahd.f b/TESTING/LIN/alahd.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dchkaa.F b/TESTING/LIN/dchkaa.F old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dlatb4.f b/TESTING/LIN/dlatb4.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dqpt01.f b/TESTING/LIN/dqpt01.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dqrt11.f b/TESTING/LIN/dqrt11.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/dqrt12.f b/TESTING/LIN/dqrt12.f old mode 100755 new mode 100644 diff --git a/TESTING/LIN/schkqp3rk.f b/TESTING/LIN/schkqp3rk.f old mode 100755 new mode 100644 From ec2805b5e9568f7d9b318726f52878dec3d70991 Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Sat, 13 Jan 2024 17:07:13 +0100 Subject: [PATCH 023/206] CMake: restore compatibility with v3.10 and older The COMPILE_OPTIONS property exists only from CMake 3.11 onwards. fixes #975 --- BLAS/SRC/CMakeLists.txt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt index 9df128eb5a..ebf5fce26f 100644 --- a/BLAS/SRC/CMakeLists.txt +++ b/BLAS/SRC/CMakeLists.txt @@ -124,9 +124,9 @@ if(BUILD_INDEX64_EXT_API) #Add _64 suffix to all Fortran functions via macros foreach(F IN LISTS SOURCES_64_F) if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") - set(COPT_64_F -fpp) + set_source_files_properties(${F} PROPERTIES COMPILE_FLAGS "-fpp") else() - set(COPT_64_F -cpp) + set_source_files_properties(${F} PROPERTIES COMPILE_FLAGS "-cpp") endif() file(STRINGS ${F} ${F}.lst) list(FILTER ${F}.lst INCLUDE REGEX "subroutine|SUBROUTINE|external|EXTERNAL|function|FUNCTION") @@ -137,10 +137,10 @@ if(BUILD_INDEX64_EXT_API) string(REGEX REPLACE "^[a-zA-Z0-9_ *]*(subroutine|SUBROUTINE|external|EXTERNAL|function|FUNCTION)[ ]*[*]?" "" FUNC ${FUNC}) string(REGEX REPLACE "[(][a-zA-Z0-9_, )]*$" "" FUNC ${FUNC}) string(STRIP ${FUNC} FUNC) - list(APPEND COPT_64_F "-D${FUNC}=${FUNC}_64") + list(APPEND COPT_64_F "${FUNC}=${FUNC}_64") endforeach() list(REMOVE_DUPLICATES COPT_64_F) - set_source_files_properties(${F} PROPERTIES COMPILE_OPTIONS "${COPT_64_F}") + set_source_files_properties(${F} PROPERTIES COMPILE_DEFINITIONS "${COPT_64_F}") endforeach() endif() From f81db935cabe1a981b061fe15c7322486dcd55cd Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 15:54:41 -0600 Subject: [PATCH 024/206] Sort Doxygen lists for comparison purposes --- CMakeLists.txt | 2 +- DOCS/Doxyfile | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5c3818db5d..239d8ce2f4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -656,13 +656,13 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) html # Doxygen INPUT = - ${PROJECT_SOURCE_DIR}/README.md ${PROJECT_SOURCE_DIR}/BLAS ${PROJECT_SOURCE_DIR}/CBLAS ${PROJECT_SOURCE_DIR}/SRC ${PROJECT_SOURCE_DIR}/INSTALL ${PROJECT_SOURCE_DIR}/TESTING ${PROJECT_SOURCE_DIR}/DOCS/groups-usr.dox + ${PROJECT_SOURCE_DIR}/README.md COMMENT "Generating html LAPACK documentation (it will take some time... time to grab a coffee)" ) diff --git a/DOCS/Doxyfile b/DOCS/Doxyfile index 577675772c..40e47d7f85 100644 --- a/DOCS/Doxyfile +++ b/DOCS/Doxyfile @@ -885,9 +885,9 @@ INPUT_ENCODING = UTF-8 # *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f18, *.f, *.for, *.vhd, *.vhdl, # *.ucf, *.qsf and *.ice. -FILE_PATTERNS = *.c \ - *.f \ +FILE_PATTERNS = *.f \ *.f90 \ + *.c \ *.h # The RECURSIVE tag can be used to specify whether or not subdirectories should From 62c9cd885a15208939ff5e62016c8c21a6882226 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 15:55:41 -0600 Subject: [PATCH 025/206] Skip setting Doxygen options to default values QUIET defaults to NO, WARNINGS defaults to YES. --- CMakeLists.txt | 2 -- 1 file changed, 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 239d8ce2f4..6d1651af43 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -627,8 +627,6 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) set(DOXYGEN_GENERATE_TREEVIEW YES) set(DOXYGEN_DOT_IMAGE_FORMAT svg) set(DOXYGEN_INTERACTIVE_SVG YES) - set(DOXYGEN_QUIET NO) - set(DOXYGEN_WARNINGS YES) set(DOXYGEN_WARN_NO_PARAMDOC YES) set(DOXYGEN_WARN_LOGFILE doxygen_error) set(DOXYGEN_GENERATE_HTML NO) From bd6fece37bad29ecc9757ca8e63218328e01d202 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 16:21:49 -0600 Subject: [PATCH 026/206] Reset several Doxygen options to their default values The goal is to minimize the output of `doxygen -x DOCS/Doxyfile` so that it contains only the settings specified in CMakeLists.txt. In all cases, the changed values are intended to match what CMake is generating when using -DBUILD_HTML_DOCUMENTATION=ON, and ideally the changes should have no effect. Comments for ABBREVIATE_BRIEF and EXAMPLE_PATTERNS describe the default behavior when they are blank, but our blank values show up in the output of `doxygen -x DOCS/Doxyfile` indicating that blank is not the default value. Setting values to match the current default behavior should have no effect, unless Doxygen changes in the future. On the other hand, MATHJAX_RELPATH has changed and will change again in newer Doxygen versions. CMake automatically inserts its own set of EXCLUDE_PATTERNS that contains none of the patterns previously listed here. Neither the previous values nor the CMake-generated ones should have any effect due to our choice of INPUT and FILE_PATTERNS. MATHJAX_RELPATH, LATEX_CMD_NAME, RTF_HYPERLINKS, and MAN_LINKS all require some other option (USE_MATHJAX, GENERATE_LATEX, GENERATE_RTF, and GENERATE_MAN, respectively) to be set to YES to take effect, and all are set to NO, so these changes should have no effect. Note that the CMake-generated Doxyfile.man sets MAN_LINKS=YES in addition to GENERATE_MAN=YES. --- DOCS/Doxyfile | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/DOCS/Doxyfile b/DOCS/Doxyfile index 40e47d7f85..5cdf3208c4 100644 --- a/DOCS/Doxyfile +++ b/DOCS/Doxyfile @@ -126,7 +126,17 @@ REPEAT_BRIEF = YES # the entity):The $name class, The $name widget, The $name file, is, provides, # specifies, contains, represents, a, an and the. -ABBREVIATE_BRIEF = +ABBREVIATE_BRIEF = "The $name class" \ + "The $name widget" \ + "The $name file" \ + is \ + provides \ + specifies \ + contains \ + represents \ + a \ + an \ + the # If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then # doxygen will generate a detailed section even if there is only a brief @@ -927,11 +937,7 @@ EXCLUDE_SYMLINKS = NO # Note that the wildcards are matched against the file with absolute path, so to # exclude all test directories for example use the pattern */test/* -EXCLUDE_PATTERNS = *.py \ - *.txt \ - *.in \ - *.inc \ - Makefile +EXCLUDE_PATTERNS = # The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names # (namespaces, classes, functions, etc.) that should be excluded from the @@ -955,7 +961,7 @@ EXAMPLE_PATH = # *.h) to filter out the source-files in the directories. If left blank all # files are included. -EXAMPLE_PATTERNS = +EXAMPLE_PATTERNS = * # If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be # searched for input files to be used with the \include or \dontinclude commands @@ -1602,7 +1608,7 @@ MATHJAX_FORMAT = HTML-CSS # The default value is: https://cdn.jsdelivr.net/npm/mathjax@2. # This tag requires that the tag USE_MATHJAX is set to YES. -MATHJAX_RELPATH = http://www.mathjax.org/mathjax +MATHJAX_RELPATH = https://cdn.jsdelivr.net/npm/mathjax@2 # The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax # extension names that should be enabled during MathJax rendering. For example @@ -1735,7 +1741,7 @@ LATEX_OUTPUT = latex # the output language. # This tag requires that the tag GENERATE_LATEX is set to YES. -LATEX_CMD_NAME = latex +LATEX_CMD_NAME = # The MAKEINDEX_CMD_NAME tag can be used to specify the command name to generate # index for LaTeX. @@ -1938,7 +1944,7 @@ COMPACT_RTF = NO # The default value is: NO. # This tag requires that the tag GENERATE_RTF is set to YES. -RTF_HYPERLINKS = YES +RTF_HYPERLINKS = NO # Load stylesheet definitions from file. Syntax is similar to doxygen's # configuration file, i.e. a series of assignments. You only have to provide @@ -2009,7 +2015,7 @@ MAN_SUBDIR = # The default value is: NO. # This tag requires that the tag GENERATE_MAN is set to YES. -MAN_LINKS = YES +MAN_LINKS = NO #--------------------------------------------------------------------------- # Configuration options related to the XML output From cf9b217c50e342639463afc09c7eb23dd38fb8b4 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 21:55:08 -0600 Subject: [PATCH 027/206] Add options missing from the existing Doxyfile Both have been present in DOCS/Doxyfile since that file was added. --- CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6d1651af43..62ff0a7559 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -621,6 +621,7 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) set(DOXYGEN_SOURCE_BROWSER YES) set(DOXYGEN_CREATE_SUBDIRS YES) set(DOXYGEN_SEPARATE_MEMBER_PAGES YES) + set(DOXYGEN_TAB_SIZE 8) set(DOXYGEN_EXTRACT_ALL YES) set(DOXYGEN_FILE_PATTERNS *.f *.f90 *.c *.h ) set(DOXYGEN_RECURSIVE YES) @@ -646,6 +647,7 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) if (BUILD_HTML_DOCUMENTATION) set(DOXYGEN_GENERATE_HTML YES) set(DOXYGEN_HTML_OUTPUT explore-html) + set(DOXYGEN_HTML_TIMESTAMP YES) set(DOXYGEN_INLINE_SOURCES YES) set(DOXYGEN_CALL_GRAPH YES) set(DOXYGEN_CALLER_GRAPH YES) From 7952995ba08b96c339408bee5d3bbbcafce37a39 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 22:35:16 -0600 Subject: [PATCH 028/206] Adjust Doxygen source and output paths This removes another difference with DOCS/Doxyfile. From the CMake 3.9.6 documentation (earliest version describing doxygen_add_docs, I've updated cmake_minimum_required to match): "So that relative input paths work as expected, by default the working directory of the Doxygen command will be the current source directory (i.e. CMAKE_CURRENT_SOURCE_DIR)." Likewise for the output directory: "Set to CMAKE_CURRENT_BINARY_DIR by this module. Note that if the project provides its own value for this and it is a relative path, it will be converted to an absolute path relative to the current binary directory. This is necessary because doxygen will normally be run from a directory within the source tree so that relative source paths work as expected." --- CMakeLists.txt | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 62ff0a7559..02c1a2a4cc 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.6) +cmake_minimum_required(VERSION 3.9) project(LAPACK) @@ -615,8 +615,8 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) set(DOXYGEN_PROJECT_BRIEF "LAPACK: Linear Algebra PACKage") set(DOXYGEN_PROJECT_NUMBER ${LAPACK_VERSION}) - set(DOXYGEN_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/DOCS) - set(DOXYGEN_PROJECT_LOGO ${CMAKE_CURRENT_SOURCE_DIR}/DOCS/lapack.png) + set(DOXYGEN_OUTPUT_DIRECTORY DOCS) + set(DOXYGEN_PROJECT_LOGO DOCS/lapack.png) set(DOXYGEN_OPTIMIZE_FOR_FORTRAN YES) set(DOXYGEN_SOURCE_BROWSER YES) set(DOXYGEN_CREATE_SUBDIRS YES) @@ -656,13 +656,13 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) html # Doxygen INPUT = - ${PROJECT_SOURCE_DIR}/BLAS - ${PROJECT_SOURCE_DIR}/CBLAS - ${PROJECT_SOURCE_DIR}/SRC - ${PROJECT_SOURCE_DIR}/INSTALL - ${PROJECT_SOURCE_DIR}/TESTING - ${PROJECT_SOURCE_DIR}/DOCS/groups-usr.dox - ${PROJECT_SOURCE_DIR}/README.md + BLAS + CBLAS + SRC + INSTALL + TESTING + DOCS/groups-usr.dox + README.md COMMENT "Generating html LAPACK documentation (it will take some time... time to grab a coffee)" ) @@ -678,12 +678,12 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) man # Doxygen INPUT = - ${PROJECT_SOURCE_DIR}/BLAS - ${PROJECT_SOURCE_DIR}/CBLAS - ${PROJECT_SOURCE_DIR}/SRC - ${PROJECT_SOURCE_DIR}/INSTALL - ${PROJECT_SOURCE_DIR}/TESTING - ${PROJECT_SOURCE_DIR}/DOCS/groups-usr.dox + BLAS + CBLAS + SRC + INSTALL + TESTING + DOCS/groups-usr.dox COMMENT "Generating man LAPACK documentation" ) From 55d73a2ef29ac755c32c3cc16c2cc51564b6b0dc Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Mon, 15 Jan 2024 23:11:04 -0600 Subject: [PATCH 029/206] Prevent html options from being applied to manpage generation When both BUILD_HTML_DOCUMENTATION and BUILD_MAN_DOCUMENTATION are ON, DOXYGEN_GENERATE_HTML was set to YES (and some other HTML-only variables were set) whenever Doxyfile.man was generated, and therefore `make man` would also populate DOCS/explore-html, but with less detail due to the other differences between Doxyfile.man and Doxyfile.html. --- CMakeLists.txt | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 02c1a2a4cc..74384ec91d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -630,8 +630,6 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) set(DOXYGEN_INTERACTIVE_SVG YES) set(DOXYGEN_WARN_NO_PARAMDOC YES) set(DOXYGEN_WARN_LOGFILE doxygen_error) - set(DOXYGEN_GENERATE_HTML NO) - set(DOXYGEN_GENERATE_MAN NO) set(DOXYGEN_LAYOUT_FILE "DOCS/DoxygenLayout.xml") # Exclude functions that are duplicated, creating conflicts. @@ -646,12 +644,13 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) if (BUILD_HTML_DOCUMENTATION) set(DOXYGEN_GENERATE_HTML YES) - set(DOXYGEN_HTML_OUTPUT explore-html) - set(DOXYGEN_HTML_TIMESTAMP YES) + set(DOXYGEN_GENERATE_MAN NO) set(DOXYGEN_INLINE_SOURCES YES) set(DOXYGEN_CALL_GRAPH YES) set(DOXYGEN_CALLER_GRAPH YES) + set(DOXYGEN_HTML_OUTPUT explore-html) + set(DOXYGEN_HTML_TIMESTAMP YES) doxygen_add_docs( html @@ -666,14 +665,17 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) COMMENT "Generating html LAPACK documentation (it will take some time... time to grab a coffee)" ) + unset(DOXYGEN_HTML_OUTPUT) + unset(DOXYGEN_HTML_TIMESTAMP) endif() if (BUILD_MAN_DOCUMENTATION) + set(DOXYGEN_GENERATE_HTML NO) set(DOXYGEN_GENERATE_MAN YES) - set(DOXYGEN_MAN_LINKS YES) set(DOXYGEN_INLINE_SOURCES NO) set(DOXYGEN_CALL_GRAPH NO) set(DOXYGEN_CALLER_GRAPH NO) + set(DOXYGEN_MAN_LINKS YES) doxygen_add_docs( man @@ -687,6 +689,7 @@ if(BUILD_HTML_DOCUMENTATION OR BUILD_MAN_DOCUMENTATION) COMMENT "Generating man LAPACK documentation" ) + unset(DOXYGEN_MAN_LINKS) endif() endif() From 79a0785334ef3886b98d84bbc33b8289f74f5290 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Tue, 16 Jan 2024 21:46:01 -0600 Subject: [PATCH 030/206] Normalize line endings sed -i 's/\s\+$//' SRC/*dmd* TESTING/EIG/*dmd* Plus manually stripping empty lines at EOF. --- SRC/cgedmd.f90 | 2301 +++++++++++++++++++------------------ SRC/cgedmdq.f90 | 1705 ++++++++++++++------------- SRC/dgedmd.f90 | 2412 +++++++++++++++++++-------------------- SRC/dgedmdq.f90 | 1727 ++++++++++++++-------------- SRC/sgedmd.f90 | 2411 +++++++++++++++++++------------------- SRC/sgedmdq.f90 | 1725 ++++++++++++++-------------- SRC/zgedmd.f90 | 2295 +++++++++++++++++++------------------ SRC/zgedmdq.f90 | 1703 ++++++++++++++------------- TESTING/EIG/cchkdmd.f90 | 1442 +++++++++++------------ TESTING/EIG/dchkdmd.f90 | 1626 +++++++++++++------------- TESTING/EIG/schkdmd.f90 | 1584 ++++++++++++------------- TESTING/EIG/zchkdmd.f90 | 1490 ++++++++++++------------ 12 files changed, 11207 insertions(+), 11214 deletions(-) diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index 1413130ec3..87e92eeb4c 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -1,1151 +1,1150 @@ -!> \brief \b CGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & -! M, N, X, LDX, Y, LDY, NRNK, TOL, & -! K, EIGS, Z, LDZ, RES, B, LDB, & -! W, LDW, S, LDS, ZWORK, LZWORK, & -! RWORK, LRWORK, IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real32 -! -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & -! NRNK, LDZ, LDB, LDW, LDS, & -! LIWORK, LRWORK, LZWORK -! INTEGER, INTENT(OUT) :: K, INFO -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & -! W(LDW,*), S(LDS,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) -! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) -! REAL(KIND=WP), INTENT(OUT) :: RES(*) -! REAL(KIND=WP), INTENT(OUT) :: RWORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> CGEDMD computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, CGEDMD computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, CGEDMD returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!...................................................................... -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product X(:,1:K)*W, where X -!> contains a POD basis (leading left singular vectors -!> of the data matrix X) and W contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of K, X, W, Z. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will be -!> computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: CGESVD (the QR SVD algorithm) -!> 2 :: CGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: CGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: CGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M>= 0 -!> The state space dimension (the row dimension of X, Y). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshot pairs -!> (the number of columns of X and Y). -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (input/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, X contains the data snapshot matrix X. It is -!> assumed that the column norms of X are in the range of -!> the normalized floating point numbers. -!> < On exit, the leading K columns of X contain a POD basis, -!> i.e. the leading K left singular vectors of the input -!> data matrix X, U(:,1:K). All N columns of X contain all -!> left singular vectors of the input matrix X. -!> See the descriptions of K, Z and W. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= M -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (input/workspace/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, Y contains the data snapshot matrix Y -!> < On exit, -!> If JOBR == 'R', the leading K columns of Y contain -!> the residual vectors for the computed Ritz pairs. -!> See the description of RES. -!> If JOBR == 'N', Y contains the original input data, -!> scaled according to the value of JOBS. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= M -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the descriptions of TOL and K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the POD basis for the data snapshot -!> matrix X and the number of the computed Ritz pairs. -!> The value of K is determined according to the rule set -!> by the parameters NRNK and TOL. -!> See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] EIGS -!> \verbatim -!> EIGS (output) COMPLEX(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of EIGS contain -!> the computed eigenvalues (Ritz values). -!> See the descriptions of K, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) COMPLEX(KIND=WP) M-by-N array -!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) -!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. -!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as -!> the columns of X(:,1:K)*W(1:K,1:K), i.e. X(:,1:K)*W(:,i) -!> is an eigenvector corresponding to EIGS(i). The columns -!> of W(1:k,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. -!> See the descriptions of EIGS, X and W. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) N-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs, -!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. -!> See the description of EIGS and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) COMPLEX(KIND=WP) M-by-N array. -!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:M,1:K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> If JOBF =='N', then B is not referenced. -!> See the descriptions of X, W, K. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= M -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] W -!> \verbatim -!> W (workspace/output) COMPLEX(KIND=WP) N-by-N array -!> On exit, W(1:K,1:K) contains the K computed -!> eigenvectors of the matrix Rayleigh quotient. -!> The Ritz vectors (returned in Z) are the -!> product of X (containing a POD basis for the input -!> matrix X) and W. See the descriptions of K, S, X and Z. -!> W is also used as a workspace to temporarily store the -!> right singular vectors of X. -!> \endverbatim -!..... -!> \param[in] LDW -!> \verbatim -!> LDW (input) INTEGER, LDW >= N -!> The leading dimension of the array W. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (workspace/output) COMPLEX(KIND=WP) N-by-N array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by CGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] ZWORK -!> \verbatim -!> ZWORK (workspace/output) COMPLEX(KIND=WP) LZWORK-by-1 array -!> ZWORK is used as complex workspace in the complex SVD, as -!> specified by WHTSVD (1,2, 3 or 4) and for CGEEV for computing -!> the eigenvalues of a Rayleigh quotient. -!> If the call to CGEDMD is only workspace query, then -!> ZWORK(1) contains the minimal complex workspace length and -!> ZWORK(2) is the optimal complex workspace length. -!> Hence, the length of work is at least 2. -!> See the description of LZWORK. -!> \endverbatim -!..... -!> \param[in] LZWORK -!> \verbatim -!> LZWORK (input) INTEGER -!> The minimal length of the workspace vector ZWORK. -!> LZWORK is calculated as MAX(LZWORK_SVD, LZWORK_CGEEV), -!> where LZWORK_CGEEV = MAX( 1, 2*N ) and the minimal -!> LZWORK_SVD is calculated as follows -!> If WHTSVD == 1 :: CGESVD :: -!> LZWORK_SVD = MAX(1,2*MIN(M,N)+MAX(M,N)) -!> If WHTSVD == 2 :: CGESDD :: -!> LZWORK_SVD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) -!> If WHTSVD == 3 :: CGESVDQ :: -!> LZWORK_SVD = obtainable by a query -!> If WHTSVD == 4 :: CGEJSV :: -!> LZWORK_SVD = obtainable by a query -!> If on entry LZWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths and returns them in -!> LZWORK(1) and LZWORK(2), respectively. -!> \endverbatim -!..... -!> \param[out] RWORK -!> \verbatim -!> RWORK (workspace/output) REAL(KIND=WP) LRWORK-by-1 array -!> On exit, RWORK(1:N) contains the singular values of -!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). -!> If WHTSVD==4, then RWORK(N+1) and RWORK(N+2) contain -!> scaling factor RWORK(N+2)/RWORK(N+1) used to scale X -!> and Y to avoid overflow in the SVD of X. -!> This may be of interest if the scaling option is off -!> and as many as possible smallest eigenvalues are -!> desired to the highest feasible accuracy. -!> If the call to CGEDMD is only workspace query, then -!> RWORK(1) contains the minimal workspace length. -!> See the description of LRWORK. -!> \endverbatim -!..... -!> \param[in] LRWORK -!> \verbatim -!> LRWORK (input) INTEGER -!> The minimal length of the workspace vector RWORK. -!> LRWORK is calculated as follows: -!> LRWORK = MAX(1, N+LRWORK_SVD,N+LRWORK_CGEEV), where -!> LRWORK_CGEEV = MAX(1,2*N) and RWORK_SVD is the real workspace -!> for the SVD subroutine determined by the input parameter -!> WHTSVD. -!> If WHTSVD == 1 :: CGESVD :: -!> LRWORK_SVD = 5*MIN(M,N) -!> If WHTSVD == 2 :: CGESDD :: -!> LRWORK_SVD = MAX(5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), -!> 2*MAX(M,N)*MIN(M,N)+2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) -!> If WHTSVD == 3 :: CGESVDQ :: -!> LRWORK_SVD = obtainable by a query -!> If WHTSVD == 4 :: CGEJSV :: -!> LRWORK_SVD = obtainable by a query -!> If on entry LRWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> real workspace length and returns it in RWORK(1). -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for ZWORK, RWORK and -!> IWORK. See the descriptions of ZWORK, RWORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. - SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, EIGS, Z, LDZ, RES, B, LDB, & - W, LDW, S, LDS, ZWORK, LZWORK, & - RWORK, LRWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real32 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & - NRNK, LDZ, LDB, LDW, LDS, & - LIWORK, LRWORK, LZWORK - INTEGER, INTENT(OUT) :: K, INFO - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) - COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & - W(LDW,*), S(LDS,*) - COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) - COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) - REAL(KIND=WP), INTENT(OUT) :: RES(*) - REAL(KIND=WP), INTENT(OUT) :: RWORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP - COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) -! -! Local scalars -! ~~~~~~~~~~~~~ - REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & - SSUM, XSCL1, XSCL2 - INTEGER :: i, j, IMINWR, INFO1, INFO2, & - LWRKEV, LWRSDD, LWRSVD, LWRSVJ, & - LWRSVQ, MLWORK, MWRKEV, MWRSDD, & - MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & - OLWORK, MLRWRK - LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & - WNTEX, WNTREF, WNTRES, WNTVEC - CHARACTER :: JOBZL, T_OR_N - CHARACTER :: JSVOPT -! -! Local arrays -! ~~~~~~~~~~~~ - REAL(KIND=WP) :: RDUMMY(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - REAL(KIND=WP) CLANGE, SLAMCH, SCNRM2 - EXTERNAL CLANGE, SLAMCH, SCNRM2, ICAMAX - INTEGER ICAMAX - LOGICAL SISNAN, LSAME - EXTERNAL SISNAN, LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL CAXPY, CGEMM, CSSCAL - EXTERNAL CGEEV, CGEJSV, CGESDD, CGESVD, CGESVDQ, & - CLACPY, CLASCL, CLASSQ, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC FLOAT, INT, MAX, SQRT -!............................................................ -! -! Test the input arguments -! - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - INFO = 0 - LQUERY = ( ( LZWORK == -1 ) .OR. ( LIWORK == -1 ) & - .OR. ( LRWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & - .OR. LSAME(JOBZ,'F')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -4 - ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & - (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN - INFO = -5 - ELSE IF ( M < 0 ) THEN - INFO = -6 - ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN - INFO = -7 - ELSE IF ( LDX < M ) THEN - INFO = -9 - ELSE IF ( LDY < M ) THEN - INFO = -11 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -12 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -13 - ELSE IF ( LDZ < M ) THEN - INFO = -17 - ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN - INFO = -20 - ELSE IF ( LDW < N ) THEN - INFO = -22 - ELSE IF ( LDS < N ) THEN - INFO = -24 - END IF -! - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( N == 0 ) THEN - ! Quick return. All output except K is void. - ! INFO=1 signals the void input. - ! In case of a workspace query, the default - ! minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - RWORK(1) = 1 - ZWORK(1) = 2 - ZWORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - - IMINWR = 1 - MLRWRK = MAX(1,N) - MLWORK = 2 - OLWORK = 2 - SELECT CASE ( WHTSVD ) - CASE (1) - ! The following is specified as the minimal - ! length of WORK in the definition of CGESVD: - ! MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) - MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) - MLWORK = MAX(MLWORK,MWRSVD) - MLRWRK = MAX(MLRWRK,N + 5*MIN(M,N)) - IF ( LQUERY ) THEN - CALL CGESVD( 'O', 'S', M, N, X, LDX, RWORK, & - B, LDB, W, LDW, ZWORK, -1, RDUMMY, INFO1 ) - LWRSVD = INT( ZWORK(1) ) - OLWORK = MAX(OLWORK,LWRSVD) - END IF - CASE (2) - ! The following is specified as the minimal - ! length of WORK in the definition of CGESDD: - ! MWRSDD = 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). - ! RWORK length: 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N) - ! In LAPACK 3.10.1 RWORK is defined differently. - ! Below we take max over the two versions. - ! IMINWR = 8*MIN(M,N) - MWRSDD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) - MLWORK = MAX(MLWORK,MWRSDD) - IMINWR = 8*MIN(M,N) - MLRWRK = MAX( MLRWRK, N + & - MAX( 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), & - 5*MIN(M,N)*MIN(M,N)+5*MIN(M,N), & - 2*MAX(M,N)*MIN(M,N)+ & - 2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) - IF ( LQUERY ) THEN - CALL CGESDD( 'O', M, N, X, LDX, RWORK, B, & - LDB, W, LDW, ZWORK, -1, RDUMMY, IWORK, INFO1 ) - LWRSDD = MAX(MWRSDD,INT( ZWORK(1) )) - OLWORK = MAX(OLWORK,LWRSDD) - END IF - CASE (3) - CALL CGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, RWORK, Z, LDZ, W, LDW, NUMRNK, & - IWORK, -1, ZWORK, -1, RDUMMY, -1, INFO1 ) - IMINWR = IWORK(1) - MWRSVQ = INT(ZWORK(2)) - MLWORK = MAX(MLWORK,MWRSVQ) - MLRWRK = MAX(MLRWRK,N + INT(RDUMMY(1))) - IF ( LQUERY ) THEN - LWRSVQ = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,LWRSVQ) - END IF - CASE (4) - JSVOPT = 'J' - CALL CGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & - N, X, LDX, RWORK, Z, LDZ, W, LDW, & - ZWORK, -1, RDUMMY, -1, IWORK, INFO1 ) - IMINWR = IWORK(1) - MWRSVJ = INT(ZWORK(2)) - MLWORK = MAX(MLWORK,MWRSVJ) - MLRWRK = MAX(MLRWRK,N + MAX(7,INT(RDUMMY(1)))) - IF ( LQUERY ) THEN - LWRSVJ = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,LWRSVJ) - END IF - END SELECT - IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN - JOBZL = 'V' - ELSE - JOBZL = 'N' - END IF - ! Workspace calculation to the CGEEV call - MWRKEV = MAX( 1, 2*N ) - MLWORK = MAX(MLWORK,MWRKEV) - MLRWRK = MAX(MLRWRK,N+2*N) - IF ( LQUERY ) THEN - CALL CGEEV( 'N', JOBZL, N, S, LDS, EIGS, & - W, LDW, W, LDW, ZWORK, -1, RWORK, INFO1 ) ! LAPACK CALL - LWRKEV = INT(ZWORK(1)) - OLWORK = MAX( OLWORK, LWRKEV ) - OLWORK = MAX( 2, OLWORK ) - END IF -! - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -30 - IF ( LRWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -28 - IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -26 - - END IF -! - IF( INFO /= 0 ) THEN - CALL XERBLA( 'CGEDMD', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - RWORK(1) = MLRWRK - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK - RETURN - END IF -!............................................................ -! - OFL = SLAMCH('O')*SLAMCH('P') - SMALL = SLAMCH('S') - BADXY = .FALSE. -! -! <1> Optional scaling of the snapshots (columns of X, Y) -! ========================================================== - IF ( SCCOLX ) THEN - ! The columns of X will be normalized. - ! To prevent overflows, the column norms of X are - ! carefully computed using CLASSQ. - K = 0 - DO i = 1, N - !WORK(i) = SCNRM2( M, X(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL CLASSQ( M, X(1,i), 1, SCALE, SSUM ) - IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN - K = 0 - INFO = -8 - CALL XERBLA('CGEDMD',-INFO) - END IF - IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of X(:,i) overflows. First, X(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. -! Next, the norm of X(:,i) is stored without -! overflow as WORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of X(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL CLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, X(1,i), LDX, INFO2 ) - RWORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - RWORK(i) = SCALE * ROOTSC - CALL CLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & - X(1,i), LDX, INFO2 ) ! LAPACK CALL -! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC - END IF - ELSE - RWORK(i) = ZERO - K = K + 1 - END IF - END DO - IF ( K == N ) THEN - ! All columns of X are zero. Return error code -8. - ! (the 8th input variable had an illegal value) - K = 0 - INFO = -8 - CALL XERBLA('CGEDMD',-INFO) - RETURN - END IF - DO i = 1, N -! Now, apply the same scaling to the columns of Y. - IF ( RWORK(i) > ZERO ) THEN - CALL CSSCAL( M, ONE/RWORK(i), Y(1,i), 1 ) ! BLAS CALL -! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC - ELSE IF ( RWORK(i) < ZERO ) THEN - CALL CLASCL( 'G', 0, 0, -RWORK(i), & - ONE/FLOAT(M), M, 1, Y(1,i), LDY, INFO2 ) ! LAPACK CALL - ELSE IF ( ABS(Y(ICAMAX(M, Y(1,i),1),i )) & - /= ZERO ) THEN -! X(:,i) is zero vector. For consistency, -! Y(:,i) should also be zero. If Y(:,i) is not -! zero, then the data might be inconsistent or -! corrupted. If JOBS == 'C', Y(:,i) is set to -! zero and a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - IF ( LSAME(JOBS,'C')) & - CALL CSSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL - END IF - END DO - END IF - ! - IF ( SCCOLY ) THEN - ! The columns of Y will be normalized. - ! To prevent overflows, the column norms of Y are - ! carefully computed using CLASSQ. - DO i = 1, N - !RWORK(i) = SCNRM2( M, Y(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL CLASSQ( M, Y(1,i), 1, SCALE, SSUM ) - IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN - K = 0 - INFO = -10 - CALL XERBLA('CGEDMD',-INFO) - END IF - IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of Y(:,i) overflows. First, Y(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. -! Next, the norm of Y(:,i) is stored without -! overflow as RWORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of Y(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL CLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, Y(1,i), LDY, INFO2 ) - RWORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) - ELSE -! Y(:,i) will be scaled to unit 2-norm - RWORK(i) = SCALE * ROOTSC - CALL CLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & - Y(1,i), LDY, INFO2 ) ! LAPACK CALL -! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC - END IF - ELSE - RWORK(i) = ZERO - END IF - END DO - DO i = 1, N -! Now, apply the same scaling to the columns of X. - IF ( RWORK(i) > ZERO ) THEN - CALL CSSCAL( M, ONE/RWORK(i), X(1,i), 1 ) ! BLAS CALL -! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC - ELSE IF ( RWORK(i) < ZERO ) THEN - CALL CLASCL( 'G', 0, 0, -RWORK(i), & - ONE/FLOAT(M), M, 1, X(1,i), LDX, INFO2 ) ! LAPACK CALL - ELSE IF ( ABS(X(ICAMAX(M, X(1,i),1),i )) & - /= ZERO ) THEN -! Y(:,i) is zero vector. If X(:,i) is not -! zero, then a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - END IF - END DO - END IF -! -! <2> SVD of the data snapshot matrix X. -! ===================================== -! The left singular vectors are stored in the array X. -! The right singular vectors are in the array W. -! The array W will later on contain the eigenvectors -! of a Rayleigh quotient. - NUMRNK = N - SELECT CASE ( WHTSVD ) - CASE (1) - CALL CGESVD( 'O', 'S', M, N, X, LDX, RWORK, B, & - LDB, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL - T_OR_N = 'C' - CASE (2) - CALL CGESDD( 'O', M, N, X, LDX, RWORK, B, LDB, W, & - LDW, ZWORK, LZWORK, RWORK(N+1), IWORK, INFO1 ) ! LAPACK CALL - T_OR_N = 'C' - CASE (3) - CALL CGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, RWORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, LIWORK, ZWORK, & - LZWORK, RWORK(N+1), LRWORK-N, INFO1) ! LAPACK CALL - CALL CLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'C' - CASE (4) - CALL CGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & - N, X, LDX, RWORK, Z, LDZ, W, LDW, & - ZWORK, LZWORK, RWORK(N+1), LRWORK-N, IWORK, INFO1 ) ! LAPACK CALL - CALL CLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'N' - XSCL1 = RWORK(N+1) - XSCL2 = RWORK(N+2) - IF ( XSCL1 /= XSCL2 ) THEN - ! This is an exceptional situation. If the - ! data matrices are not scaled and the - ! largest singular value of X overflows. - ! In that case CGEJSV can return the SVD - ! in scaled form. The scaling factor can be used - ! to rescale the data (X and Y). - CALL CLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) - END IF - END SELECT -! - IF ( INFO1 > 0 ) THEN - ! The SVD selected subroutine did not converge. - ! Return with an error code. - INFO = 2 - RETURN - END IF -! - IF ( RWORK(1) == ZERO ) THEN - ! The largest computed singular value of (scaled) - ! X is zero. Return error code -8 - ! (the 8th input variable had an illegal value). - K = 0 - INFO = -8 - CALL XERBLA('CGEDMD',-INFO) - RETURN - END IF -! - !<3> Determine the numerical rank of the data - ! snapshots matrix X. This depends on the - ! parameters NRNK and TOL. - - SELECT CASE ( NRNK ) - CASE ( -1 ) - K = 1 - DO i = 2, NUMRNK - IF ( ( RWORK(i) <= RWORK(1)*TOL ) .OR. & - ( RWORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE ( -2 ) - K = 1 - DO i = 1, NUMRNK-1 - IF ( ( RWORK(i+1) <= RWORK(i)*TOL ) .OR. & - ( RWORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE DEFAULT - K = 1 - DO i = 2, NRNK - IF ( RWORK(i) <= SMALL ) EXIT - K = K + 1 - END DO - END SELECT - ! Now, U = X(1:M,1:K) is the SVD/POD basis for the - ! snapshot data in the input matrix X. - - !<4> Compute the Rayleigh quotient S = U^H * A * U. - ! Depending on the requested outputs, the computation - ! is organized to compute additional auxiliary - ! matrices (for the residuals and refinements). - ! - ! In all formulas below, we need V_k*Sigma_k^(-1) - ! where either V_k is in W(1:N,1:K), or V_k^H is in - ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). - IF ( LSAME(T_OR_N, 'N') ) THEN - DO i = 1, K - CALL CSSCAL( N, ONE/RWORK(i), W(1,i), 1 ) ! BLAS CALL - ! W(1:N,i) = (ONE/RWORK(i)) * W(1:N,i) ! INTRINSIC - END DO - ELSE - ! This non-unit stride access is due to the fact - ! that CGESVD, CGESVDQ and CGESDD return the - ! adjoint matrix of the right singular vectors. - !DO i = 1, K - ! CALL DSCAL( N, ONE/RWORK(i), W(i,1), LDW ) ! BLAS CALL - ! ! W(i,1:N) = (ONE/RWORK(i)) * W(i,1:N) ! INTRINSIC - !END DO - DO i = 1, K - RWORK(N+i) = ONE/RWORK(i) - END DO - DO j = 1, N - DO i = 1, K - W(i,j) = CMPLX(RWORK(N+i),ZERO,KIND=WP)*W(i,j) - END DO - END DO - END IF -! - IF ( WNTREF ) THEN - ! - ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) - ! for computing the refined Ritz vectors - ! (optionally, outside CGEDMD). - CALL CGEMM( 'N', T_OR_N, M, K, N, ZONE, Y, LDY, W, & - LDW, ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' - ! - ! At this point Z contains - ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and - ! this is needed for computing the residuals. - ! This matrix is returned in the array B and - ! it can be used to compute refined Ritz vectors. - CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL - ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC - - CALL CGEMM( 'C', 'N', K, K, M, ZONE, X, LDX, Z, & - LDZ, ZZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC - ! At this point S = U^H * A * U is the Rayleigh quotient. - ELSE - ! A * U(:,1:K) is not explicitly needed and the - ! computation is organized differently. The Rayleigh - ! quotient is computed more efficiently. - CALL CGEMM( 'C', 'N', K, N, M, ZONE, X, LDX, Y, LDY, & - ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC - ! - CALL CGEMM( 'N', T_OR_N, K, K, N, ZONE, Z, LDZ, W, & - LDW, ZZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' - ! At this point S = U^H * A * U is the Rayleigh quotient. - ! If the residuals are requested, save scaled V_k into Z. - ! Recall that V_k or V_k^H is stored in W. - IF ( WNTRES .OR. WNTEX ) THEN - IF ( LSAME(T_OR_N, 'N') ) THEN - CALL CLACPY( 'A', N, K, W, LDW, Z, LDZ ) - ELSE - CALL CLACPY( 'A', K, N, W, LDW, Z, LDZ ) - END IF - END IF - END IF -! - !<5> Compute the Ritz values and (if requested) the - ! right eigenvectors of the Rayleigh quotient. - ! - CALL CGEEV( 'N', JOBZL, K, S, LDS, EIGS, W, & - LDW, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL - ! - ! W(1:K,1:K) contains the eigenvectors of the Rayleigh - ! quotient. See the description of Z. - ! Also, see the description of CGEEV. - IF ( INFO1 > 0 ) THEN - ! CGEEV failed to compute the eigenvalues and - ! eigenvectors of the Rayleigh quotient. - INFO = 3 - RETURN - END IF -! - ! <6> Compute the eigenvectors (if requested) and, - ! the residuals (if requested). - ! - IF ( WNTVEC .OR. WNTEX ) THEN - IF ( WNTRES ) THEN - IF ( WNTREF ) THEN - ! Here, if the refinement is requested, we have - ! A*U(:,1:K) already computed and stored in Z. - ! For the residuals, need Y = A * U(:,1;K) * W. - CALL CGEMM( 'N', 'N', M, K, K, ZONE, Z, LDZ, W, & - LDW, ZZERO, Y, LDY ) ! BLAS CALL - ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC - ! This frees Z; Y contains A * U(:,1:K) * W. - ELSE - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) (or its adjoint) is stored in Z - CALL CGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & - W, LDW, ZZERO, S, LDS) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - LDS, ZZERO, Z, LDZ) - ! Save a copy of Z into Y and free Z for holding - ! the Ritz vectors. - CALL CLACPY( 'A', M, K, Z, LDZ, Y, LDY ) - IF ( WNTEX ) CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF - ELSE IF ( WNTEX ) THEN - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL CGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & - W, LDW, ZZERO, S, LDS) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - LDS, ZZERO, B, LDB) - ! The above call replaces the following two calls - ! that were used in the developing-testing phase. - ! CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - ! LDS, ZZERO, Z, LDZ) - ! Save a copy of Z into Y and free Z for holding - ! the Ritz vectors. - ! CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF -! - ! Compute the Ritz vectors - IF ( WNTVEC ) CALL CGEMM( 'N', 'N', M, K, K, ZONE, X, LDX, W, LDW, & - ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC -! - IF ( WNTRES ) THEN - DO i = 1, K - CALL CAXPY( M, -EIGS(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL - ! Y(1:M,i) = Y(1:M,i) - EIGS(i) * Z(1:M,i) ! INTRINSIC - RES(i) = SCNRM2( M, Y(1,i), 1) ! BLAS CALL - END DO - END IF - END IF -! - IF ( WHTSVD == 4 ) THEN - RWORK(N+1) = XSCL1 - RWORK(N+2) = XSCL2 - END IF -! -! Successful exit. - IF ( .NOT. BADXY ) THEN - INFO = 0 - ELSE - ! A warning on possible data inconsistency. - ! This should be a rare event. - INFO = 4 - END IF -!............................................................ - RETURN -! ...... - END SUBROUTINE CGEDMD - +!> \brief \b CGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & +! M, N, X, LDX, Y, LDY, NRNK, TOL, & +! K, EIGS, Z, LDZ, RES, B, LDB, & +! W, LDW, S, LDS, ZWORK, LZWORK, & +! RWORK, LRWORK, IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real32 +! +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & +! NRNK, LDZ, LDB, LDW, LDS, & +! LIWORK, LRWORK, LZWORK +! INTEGER, INTENT(OUT) :: K, INFO +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & +! W(LDW,*), S(LDS,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) +! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) +! REAL(KIND=WP), INTENT(OUT) :: RES(*) +! REAL(KIND=WP), INTENT(OUT) :: RWORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> CGEDMD computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, CGEDMD computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, CGEDMD returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!...................................................................... +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product X(:,1:K)*W, where X +!> contains a POD basis (leading left singular vectors +!> of the data matrix X) and W contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of K, X, W, Z. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will be +!> computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: CGESVD (the QR SVD algorithm) +!> 2 :: CGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: CGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: CGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M>= 0 +!> The state space dimension (the row dimension of X, Y). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshot pairs +!> (the number of columns of X and Y). +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (input/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, X contains the data snapshot matrix X. It is +!> assumed that the column norms of X are in the range of +!> the normalized floating point numbers. +!> < On exit, the leading K columns of X contain a POD basis, +!> i.e. the leading K left singular vectors of the input +!> data matrix X, U(:,1:K). All N columns of X contain all +!> left singular vectors of the input matrix X. +!> See the descriptions of K, Z and W. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= M +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (input/workspace/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, Y contains the data snapshot matrix Y +!> < On exit, +!> If JOBR == 'R', the leading K columns of Y contain +!> the residual vectors for the computed Ritz pairs. +!> See the description of RES. +!> If JOBR == 'N', Y contains the original input data, +!> scaled according to the value of JOBS. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= M +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the descriptions of TOL and K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the POD basis for the data snapshot +!> matrix X and the number of the computed Ritz pairs. +!> The value of K is determined according to the rule set +!> by the parameters NRNK and TOL. +!> See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] EIGS +!> \verbatim +!> EIGS (output) COMPLEX(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of EIGS contain +!> the computed eigenvalues (Ritz values). +!> See the descriptions of K, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) COMPLEX(KIND=WP) M-by-N array +!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) +!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. +!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as +!> the columns of X(:,1:K)*W(1:K,1:K), i.e. X(:,1:K)*W(:,i) +!> is an eigenvector corresponding to EIGS(i). The columns +!> of W(1:k,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. +!> See the descriptions of EIGS, X and W. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) N-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs, +!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. +!> See the description of EIGS and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) COMPLEX(KIND=WP) M-by-N array. +!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:M,1:K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> If JOBF =='N', then B is not referenced. +!> See the descriptions of X, W, K. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= M +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] W +!> \verbatim +!> W (workspace/output) COMPLEX(KIND=WP) N-by-N array +!> On exit, W(1:K,1:K) contains the K computed +!> eigenvectors of the matrix Rayleigh quotient. +!> The Ritz vectors (returned in Z) are the +!> product of X (containing a POD basis for the input +!> matrix X) and W. See the descriptions of K, S, X and Z. +!> W is also used as a workspace to temporarily store the +!> right singular vectors of X. +!> \endverbatim +!..... +!> \param[in] LDW +!> \verbatim +!> LDW (input) INTEGER, LDW >= N +!> The leading dimension of the array W. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (workspace/output) COMPLEX(KIND=WP) N-by-N array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by CGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] ZWORK +!> \verbatim +!> ZWORK (workspace/output) COMPLEX(KIND=WP) LZWORK-by-1 array +!> ZWORK is used as complex workspace in the complex SVD, as +!> specified by WHTSVD (1,2, 3 or 4) and for CGEEV for computing +!> the eigenvalues of a Rayleigh quotient. +!> If the call to CGEDMD is only workspace query, then +!> ZWORK(1) contains the minimal complex workspace length and +!> ZWORK(2) is the optimal complex workspace length. +!> Hence, the length of work is at least 2. +!> See the description of LZWORK. +!> \endverbatim +!..... +!> \param[in] LZWORK +!> \verbatim +!> LZWORK (input) INTEGER +!> The minimal length of the workspace vector ZWORK. +!> LZWORK is calculated as MAX(LZWORK_SVD, LZWORK_CGEEV), +!> where LZWORK_CGEEV = MAX( 1, 2*N ) and the minimal +!> LZWORK_SVD is calculated as follows +!> If WHTSVD == 1 :: CGESVD :: +!> LZWORK_SVD = MAX(1,2*MIN(M,N)+MAX(M,N)) +!> If WHTSVD == 2 :: CGESDD :: +!> LZWORK_SVD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) +!> If WHTSVD == 3 :: CGESVDQ :: +!> LZWORK_SVD = obtainable by a query +!> If WHTSVD == 4 :: CGEJSV :: +!> LZWORK_SVD = obtainable by a query +!> If on entry LZWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths and returns them in +!> LZWORK(1) and LZWORK(2), respectively. +!> \endverbatim +!..... +!> \param[out] RWORK +!> \verbatim +!> RWORK (workspace/output) REAL(KIND=WP) LRWORK-by-1 array +!> On exit, RWORK(1:N) contains the singular values of +!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). +!> If WHTSVD==4, then RWORK(N+1) and RWORK(N+2) contain +!> scaling factor RWORK(N+2)/RWORK(N+1) used to scale X +!> and Y to avoid overflow in the SVD of X. +!> This may be of interest if the scaling option is off +!> and as many as possible smallest eigenvalues are +!> desired to the highest feasible accuracy. +!> If the call to CGEDMD is only workspace query, then +!> RWORK(1) contains the minimal workspace length. +!> See the description of LRWORK. +!> \endverbatim +!..... +!> \param[in] LRWORK +!> \verbatim +!> LRWORK (input) INTEGER +!> The minimal length of the workspace vector RWORK. +!> LRWORK is calculated as follows: +!> LRWORK = MAX(1, N+LRWORK_SVD,N+LRWORK_CGEEV), where +!> LRWORK_CGEEV = MAX(1,2*N) and RWORK_SVD is the real workspace +!> for the SVD subroutine determined by the input parameter +!> WHTSVD. +!> If WHTSVD == 1 :: CGESVD :: +!> LRWORK_SVD = 5*MIN(M,N) +!> If WHTSVD == 2 :: CGESDD :: +!> LRWORK_SVD = MAX(5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), +!> 2*MAX(M,N)*MIN(M,N)+2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) +!> If WHTSVD == 3 :: CGESVDQ :: +!> LRWORK_SVD = obtainable by a query +!> If WHTSVD == 4 :: CGEJSV :: +!> LRWORK_SVD = obtainable by a query +!> If on entry LRWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> real workspace length and returns it in RWORK(1). +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for ZWORK, RWORK and +!> IWORK. See the descriptions of ZWORK, RWORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. + SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, EIGS, Z, LDZ, RES, B, LDB, & + W, LDW, S, LDS, ZWORK, LZWORK, & + RWORK, LRWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real32 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & + NRNK, LDZ, LDB, LDW, LDS, & + LIWORK, LRWORK, LZWORK + INTEGER, INTENT(OUT) :: K, INFO + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) + COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & + W(LDW,*), S(LDS,*) + COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) + COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) + REAL(KIND=WP), INTENT(OUT) :: RES(*) + REAL(KIND=WP), INTENT(OUT) :: RWORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP + COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) +! +! Local scalars +! ~~~~~~~~~~~~~ + REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & + SSUM, XSCL1, XSCL2 + INTEGER :: i, j, IMINWR, INFO1, INFO2, & + LWRKEV, LWRSDD, LWRSVD, LWRSVJ, & + LWRSVQ, MLWORK, MWRKEV, MWRSDD, & + MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & + OLWORK, MLRWRK + LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & + WNTEX, WNTREF, WNTRES, WNTVEC + CHARACTER :: JOBZL, T_OR_N + CHARACTER :: JSVOPT +! +! Local arrays +! ~~~~~~~~~~~~ + REAL(KIND=WP) :: RDUMMY(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + REAL(KIND=WP) CLANGE, SLAMCH, SCNRM2 + EXTERNAL CLANGE, SLAMCH, SCNRM2, ICAMAX + INTEGER ICAMAX + LOGICAL SISNAN, LSAME + EXTERNAL SISNAN, LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL CAXPY, CGEMM, CSSCAL + EXTERNAL CGEEV, CGEJSV, CGESDD, CGESVD, CGESVDQ, & + CLACPY, CLASCL, CLASSQ, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC FLOAT, INT, MAX, SQRT +!............................................................ +! +! Test the input arguments +! + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + INFO = 0 + LQUERY = ( ( LZWORK == -1 ) .OR. ( LIWORK == -1 ) & + .OR. ( LRWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & + .OR. LSAME(JOBZ,'F')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -4 + ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & + (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN + INFO = -5 + ELSE IF ( M < 0 ) THEN + INFO = -6 + ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN + INFO = -7 + ELSE IF ( LDX < M ) THEN + INFO = -9 + ELSE IF ( LDY < M ) THEN + INFO = -11 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -12 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -13 + ELSE IF ( LDZ < M ) THEN + INFO = -17 + ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN + INFO = -20 + ELSE IF ( LDW < N ) THEN + INFO = -22 + ELSE IF ( LDS < N ) THEN + INFO = -24 + END IF +! + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( N == 0 ) THEN + ! Quick return. All output except K is void. + ! INFO=1 signals the void input. + ! In case of a workspace query, the default + ! minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + RWORK(1) = 1 + ZWORK(1) = 2 + ZWORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + + IMINWR = 1 + MLRWRK = MAX(1,N) + MLWORK = 2 + OLWORK = 2 + SELECT CASE ( WHTSVD ) + CASE (1) + ! The following is specified as the minimal + ! length of WORK in the definition of CGESVD: + ! MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) + MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) + MLWORK = MAX(MLWORK,MWRSVD) + MLRWRK = MAX(MLRWRK,N + 5*MIN(M,N)) + IF ( LQUERY ) THEN + CALL CGESVD( 'O', 'S', M, N, X, LDX, RWORK, & + B, LDB, W, LDW, ZWORK, -1, RDUMMY, INFO1 ) + LWRSVD = INT( ZWORK(1) ) + OLWORK = MAX(OLWORK,LWRSVD) + END IF + CASE (2) + ! The following is specified as the minimal + ! length of WORK in the definition of CGESDD: + ! MWRSDD = 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). + ! RWORK length: 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N) + ! In LAPACK 3.10.1 RWORK is defined differently. + ! Below we take max over the two versions. + ! IMINWR = 8*MIN(M,N) + MWRSDD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) + MLWORK = MAX(MLWORK,MWRSDD) + IMINWR = 8*MIN(M,N) + MLRWRK = MAX( MLRWRK, N + & + MAX( 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), & + 5*MIN(M,N)*MIN(M,N)+5*MIN(M,N), & + 2*MAX(M,N)*MIN(M,N)+ & + 2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) + IF ( LQUERY ) THEN + CALL CGESDD( 'O', M, N, X, LDX, RWORK, B, & + LDB, W, LDW, ZWORK, -1, RDUMMY, IWORK, INFO1 ) + LWRSDD = MAX(MWRSDD,INT( ZWORK(1) )) + OLWORK = MAX(OLWORK,LWRSDD) + END IF + CASE (3) + CALL CGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, RWORK, Z, LDZ, W, LDW, NUMRNK, & + IWORK, -1, ZWORK, -1, RDUMMY, -1, INFO1 ) + IMINWR = IWORK(1) + MWRSVQ = INT(ZWORK(2)) + MLWORK = MAX(MLWORK,MWRSVQ) + MLRWRK = MAX(MLRWRK,N + INT(RDUMMY(1))) + IF ( LQUERY ) THEN + LWRSVQ = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,LWRSVQ) + END IF + CASE (4) + JSVOPT = 'J' + CALL CGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & + N, X, LDX, RWORK, Z, LDZ, W, LDW, & + ZWORK, -1, RDUMMY, -1, IWORK, INFO1 ) + IMINWR = IWORK(1) + MWRSVJ = INT(ZWORK(2)) + MLWORK = MAX(MLWORK,MWRSVJ) + MLRWRK = MAX(MLRWRK,N + MAX(7,INT(RDUMMY(1)))) + IF ( LQUERY ) THEN + LWRSVJ = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,LWRSVJ) + END IF + END SELECT + IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN + JOBZL = 'V' + ELSE + JOBZL = 'N' + END IF + ! Workspace calculation to the CGEEV call + MWRKEV = MAX( 1, 2*N ) + MLWORK = MAX(MLWORK,MWRKEV) + MLRWRK = MAX(MLRWRK,N+2*N) + IF ( LQUERY ) THEN + CALL CGEEV( 'N', JOBZL, N, S, LDS, EIGS, & + W, LDW, W, LDW, ZWORK, -1, RWORK, INFO1 ) ! LAPACK CALL + LWRKEV = INT(ZWORK(1)) + OLWORK = MAX( OLWORK, LWRKEV ) + OLWORK = MAX( 2, OLWORK ) + END IF +! + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -30 + IF ( LRWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -28 + IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -26 + + END IF +! + IF( INFO /= 0 ) THEN + CALL XERBLA( 'CGEDMD', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + RWORK(1) = MLRWRK + ZWORK(1) = MLWORK + ZWORK(2) = OLWORK + RETURN + END IF +!............................................................ +! + OFL = SLAMCH('O')*SLAMCH('P') + SMALL = SLAMCH('S') + BADXY = .FALSE. +! +! <1> Optional scaling of the snapshots (columns of X, Y) +! ========================================================== + IF ( SCCOLX ) THEN + ! The columns of X will be normalized. + ! To prevent overflows, the column norms of X are + ! carefully computed using CLASSQ. + K = 0 + DO i = 1, N + !WORK(i) = SCNRM2( M, X(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL CLASSQ( M, X(1,i), 1, SCALE, SSUM ) + IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN + K = 0 + INFO = -8 + CALL XERBLA('CGEDMD',-INFO) + END IF + IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of X(:,i) overflows. First, X(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. +! Next, the norm of X(:,i) is stored without +! overflow as WORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of X(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL CLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, X(1,i), LDX, INFO2 ) + RWORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + RWORK(i) = SCALE * ROOTSC + CALL CLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & + X(1,i), LDX, INFO2 ) ! LAPACK CALL +! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC + END IF + ELSE + RWORK(i) = ZERO + K = K + 1 + END IF + END DO + IF ( K == N ) THEN + ! All columns of X are zero. Return error code -8. + ! (the 8th input variable had an illegal value) + K = 0 + INFO = -8 + CALL XERBLA('CGEDMD',-INFO) + RETURN + END IF + DO i = 1, N +! Now, apply the same scaling to the columns of Y. + IF ( RWORK(i) > ZERO ) THEN + CALL CSSCAL( M, ONE/RWORK(i), Y(1,i), 1 ) ! BLAS CALL +! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC + ELSE IF ( RWORK(i) < ZERO ) THEN + CALL CLASCL( 'G', 0, 0, -RWORK(i), & + ONE/FLOAT(M), M, 1, Y(1,i), LDY, INFO2 ) ! LAPACK CALL + ELSE IF ( ABS(Y(ICAMAX(M, Y(1,i),1),i )) & + /= ZERO ) THEN +! X(:,i) is zero vector. For consistency, +! Y(:,i) should also be zero. If Y(:,i) is not +! zero, then the data might be inconsistent or +! corrupted. If JOBS == 'C', Y(:,i) is set to +! zero and a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + IF ( LSAME(JOBS,'C')) & + CALL CSSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL + END IF + END DO + END IF + ! + IF ( SCCOLY ) THEN + ! The columns of Y will be normalized. + ! To prevent overflows, the column norms of Y are + ! carefully computed using CLASSQ. + DO i = 1, N + !RWORK(i) = SCNRM2( M, Y(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL CLASSQ( M, Y(1,i), 1, SCALE, SSUM ) + IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN + K = 0 + INFO = -10 + CALL XERBLA('CGEDMD',-INFO) + END IF + IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of Y(:,i) overflows. First, Y(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. +! Next, the norm of Y(:,i) is stored without +! overflow as RWORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of Y(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL CLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, Y(1,i), LDY, INFO2 ) + RWORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) + ELSE +! Y(:,i) will be scaled to unit 2-norm + RWORK(i) = SCALE * ROOTSC + CALL CLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & + Y(1,i), LDY, INFO2 ) ! LAPACK CALL +! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC + END IF + ELSE + RWORK(i) = ZERO + END IF + END DO + DO i = 1, N +! Now, apply the same scaling to the columns of X. + IF ( RWORK(i) > ZERO ) THEN + CALL CSSCAL( M, ONE/RWORK(i), X(1,i), 1 ) ! BLAS CALL +! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC + ELSE IF ( RWORK(i) < ZERO ) THEN + CALL CLASCL( 'G', 0, 0, -RWORK(i), & + ONE/FLOAT(M), M, 1, X(1,i), LDX, INFO2 ) ! LAPACK CALL + ELSE IF ( ABS(X(ICAMAX(M, X(1,i),1),i )) & + /= ZERO ) THEN +! Y(:,i) is zero vector. If X(:,i) is not +! zero, then a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + END IF + END DO + END IF +! +! <2> SVD of the data snapshot matrix X. +! ===================================== +! The left singular vectors are stored in the array X. +! The right singular vectors are in the array W. +! The array W will later on contain the eigenvectors +! of a Rayleigh quotient. + NUMRNK = N + SELECT CASE ( WHTSVD ) + CASE (1) + CALL CGESVD( 'O', 'S', M, N, X, LDX, RWORK, B, & + LDB, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL + T_OR_N = 'C' + CASE (2) + CALL CGESDD( 'O', M, N, X, LDX, RWORK, B, LDB, W, & + LDW, ZWORK, LZWORK, RWORK(N+1), IWORK, INFO1 ) ! LAPACK CALL + T_OR_N = 'C' + CASE (3) + CALL CGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, RWORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, LIWORK, ZWORK, & + LZWORK, RWORK(N+1), LRWORK-N, INFO1) ! LAPACK CALL + CALL CLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'C' + CASE (4) + CALL CGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & + N, X, LDX, RWORK, Z, LDZ, W, LDW, & + ZWORK, LZWORK, RWORK(N+1), LRWORK-N, IWORK, INFO1 ) ! LAPACK CALL + CALL CLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'N' + XSCL1 = RWORK(N+1) + XSCL2 = RWORK(N+2) + IF ( XSCL1 /= XSCL2 ) THEN + ! This is an exceptional situation. If the + ! data matrices are not scaled and the + ! largest singular value of X overflows. + ! In that case CGEJSV can return the SVD + ! in scaled form. The scaling factor can be used + ! to rescale the data (X and Y). + CALL CLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) + END IF + END SELECT +! + IF ( INFO1 > 0 ) THEN + ! The SVD selected subroutine did not converge. + ! Return with an error code. + INFO = 2 + RETURN + END IF +! + IF ( RWORK(1) == ZERO ) THEN + ! The largest computed singular value of (scaled) + ! X is zero. Return error code -8 + ! (the 8th input variable had an illegal value). + K = 0 + INFO = -8 + CALL XERBLA('CGEDMD',-INFO) + RETURN + END IF +! + !<3> Determine the numerical rank of the data + ! snapshots matrix X. This depends on the + ! parameters NRNK and TOL. + + SELECT CASE ( NRNK ) + CASE ( -1 ) + K = 1 + DO i = 2, NUMRNK + IF ( ( RWORK(i) <= RWORK(1)*TOL ) .OR. & + ( RWORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE ( -2 ) + K = 1 + DO i = 1, NUMRNK-1 + IF ( ( RWORK(i+1) <= RWORK(i)*TOL ) .OR. & + ( RWORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE DEFAULT + K = 1 + DO i = 2, NRNK + IF ( RWORK(i) <= SMALL ) EXIT + K = K + 1 + END DO + END SELECT + ! Now, U = X(1:M,1:K) is the SVD/POD basis for the + ! snapshot data in the input matrix X. + + !<4> Compute the Rayleigh quotient S = U^H * A * U. + ! Depending on the requested outputs, the computation + ! is organized to compute additional auxiliary + ! matrices (for the residuals and refinements). + ! + ! In all formulas below, we need V_k*Sigma_k^(-1) + ! where either V_k is in W(1:N,1:K), or V_k^H is in + ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). + IF ( LSAME(T_OR_N, 'N') ) THEN + DO i = 1, K + CALL CSSCAL( N, ONE/RWORK(i), W(1,i), 1 ) ! BLAS CALL + ! W(1:N,i) = (ONE/RWORK(i)) * W(1:N,i) ! INTRINSIC + END DO + ELSE + ! This non-unit stride access is due to the fact + ! that CGESVD, CGESVDQ and CGESDD return the + ! adjoint matrix of the right singular vectors. + !DO i = 1, K + ! CALL DSCAL( N, ONE/RWORK(i), W(i,1), LDW ) ! BLAS CALL + ! ! W(i,1:N) = (ONE/RWORK(i)) * W(i,1:N) ! INTRINSIC + !END DO + DO i = 1, K + RWORK(N+i) = ONE/RWORK(i) + END DO + DO j = 1, N + DO i = 1, K + W(i,j) = CMPLX(RWORK(N+i),ZERO,KIND=WP)*W(i,j) + END DO + END DO + END IF +! + IF ( WNTREF ) THEN + ! + ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) + ! for computing the refined Ritz vectors + ! (optionally, outside CGEDMD). + CALL CGEMM( 'N', T_OR_N, M, K, N, ZONE, Y, LDY, W, & + LDW, ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' + ! + ! At this point Z contains + ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and + ! this is needed for computing the residuals. + ! This matrix is returned in the array B and + ! it can be used to compute refined Ritz vectors. + CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL + ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC + + CALL CGEMM( 'C', 'N', K, K, M, ZONE, X, LDX, Z, & + LDZ, ZZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC + ! At this point S = U^H * A * U is the Rayleigh quotient. + ELSE + ! A * U(:,1:K) is not explicitly needed and the + ! computation is organized differently. The Rayleigh + ! quotient is computed more efficiently. + CALL CGEMM( 'C', 'N', K, N, M, ZONE, X, LDX, Y, LDY, & + ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC + ! + CALL CGEMM( 'N', T_OR_N, K, K, N, ZONE, Z, LDZ, W, & + LDW, ZZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' + ! At this point S = U^H * A * U is the Rayleigh quotient. + ! If the residuals are requested, save scaled V_k into Z. + ! Recall that V_k or V_k^H is stored in W. + IF ( WNTRES .OR. WNTEX ) THEN + IF ( LSAME(T_OR_N, 'N') ) THEN + CALL CLACPY( 'A', N, K, W, LDW, Z, LDZ ) + ELSE + CALL CLACPY( 'A', K, N, W, LDW, Z, LDZ ) + END IF + END IF + END IF +! + !<5> Compute the Ritz values and (if requested) the + ! right eigenvectors of the Rayleigh quotient. + ! + CALL CGEEV( 'N', JOBZL, K, S, LDS, EIGS, W, & + LDW, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL + ! + ! W(1:K,1:K) contains the eigenvectors of the Rayleigh + ! quotient. See the description of Z. + ! Also, see the description of CGEEV. + IF ( INFO1 > 0 ) THEN + ! CGEEV failed to compute the eigenvalues and + ! eigenvectors of the Rayleigh quotient. + INFO = 3 + RETURN + END IF +! + ! <6> Compute the eigenvectors (if requested) and, + ! the residuals (if requested). + ! + IF ( WNTVEC .OR. WNTEX ) THEN + IF ( WNTRES ) THEN + IF ( WNTREF ) THEN + ! Here, if the refinement is requested, we have + ! A*U(:,1:K) already computed and stored in Z. + ! For the residuals, need Y = A * U(:,1;K) * W. + CALL CGEMM( 'N', 'N', M, K, K, ZONE, Z, LDZ, W, & + LDW, ZZERO, Y, LDY ) ! BLAS CALL + ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC + ! This frees Z; Y contains A * U(:,1:K) * W. + ELSE + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) (or its adjoint) is stored in Z + CALL CGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & + W, LDW, ZZERO, S, LDS) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + LDS, ZZERO, Z, LDZ) + ! Save a copy of Z into Y and free Z for holding + ! the Ritz vectors. + CALL CLACPY( 'A', M, K, Z, LDZ, Y, LDY ) + IF ( WNTEX ) CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF + ELSE IF ( WNTEX ) THEN + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL CGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & + W, LDW, ZZERO, S, LDS) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + LDS, ZZERO, B, LDB) + ! The above call replaces the following two calls + ! that were used in the developing-testing phase. + ! CALL CGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + ! LDS, ZZERO, Z, LDZ) + ! Save a copy of Z into Y and free Z for holding + ! the Ritz vectors. + ! CALL CLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF +! + ! Compute the Ritz vectors + IF ( WNTVEC ) CALL CGEMM( 'N', 'N', M, K, K, ZONE, X, LDX, W, LDW, & + ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC +! + IF ( WNTRES ) THEN + DO i = 1, K + CALL CAXPY( M, -EIGS(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL + ! Y(1:M,i) = Y(1:M,i) - EIGS(i) * Z(1:M,i) ! INTRINSIC + RES(i) = SCNRM2( M, Y(1,i), 1) ! BLAS CALL + END DO + END IF + END IF +! + IF ( WHTSVD == 4 ) THEN + RWORK(N+1) = XSCL1 + RWORK(N+2) = XSCL2 + END IF +! +! Successful exit. + IF ( .NOT. BADXY ) THEN + INFO = 0 + ELSE + ! A warning on possible data inconsistency. + ! This should be a rare event. + INFO = 4 + END IF +!............................................................ + RETURN +! ...... + END SUBROUTINE CGEDMD diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index 180563e513..b4eebee5dc 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -1,853 +1,852 @@ -!> \brief \b CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & -! WHTSVD, M, N, F, LDF, X, LDX, Y, & -! LDY, NRNK, TOL, K, EIGS, & -! Z, LDZ, RES, B, LDB, V, LDV, & -! S, LDS, ZWORK, LZWORK, WORK, LWORK, & -! IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real32 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & -! JOBT, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & -! LDY, NRNK, LDZ, LDB, LDV, & -! LDS, LZWORK, LWORK, LIWORK -! INTEGER, INTENT(OUT) :: INFO, K -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & -! Z(LDZ,*), B(LDB,*), & -! V(LDV,*), S(LDS,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) -! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) -! REAL(KIND=WP), INTENT(OUT) :: RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices, using a QR factorization -!> based compression of the data. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, CGEDMDQ computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, CGEDMDQ returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!...................................................................... -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. The data snapshots are the columns -!> of F. The leading N-1 columns of F are denoted X and the -!> trailing N-1 columns are denoted Y. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Z*V, where Z -!> is orthonormal and V contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of F, V, Z. -!> 'Q' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Q*Z, where Z -!> contains the eigenvectors of the compression of the -!> underlying discretised operator onto the span of -!> the data snapshots. See the descriptions of F, V, Z. -!> Q is from the inital QR facorization. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will -!> be computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBQ -!> \verbatim -!> JOBQ (input) CHARACTER*1 -!> Specifies whether to explicitly compute and return the -!> unitary matrix from the QR factorization. -!> 'Q' :: The matrix Q of the QR factorization of the data -!> snapshot matrix is computed and stored in the -!> array F. See the description of F. -!> 'N' :: The matrix Q is not explicitly computed. -!> \endverbatim -!..... -!> \param[in] JOBT -!> \verbatim -!> JOBT (input) CHARACTER*1 -!> Specifies whether to return the upper triangular factor -!> from the QR factorization. -!> 'R' :: The matrix R of the QR factorization of the data -!> snapshot matrix F is returned in the array Y. -!> See the description of Y and Further details. -!> 'N' :: The matrix R is not returned. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> To be useful on exit, this option needs JOBQ='Q'. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: CGESVD (the QR SVD algorithm) -!> 2 :: CGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: CGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: CGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M >= 0 -!> The state space dimension (the number of rows of F). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshots from a single trajectory, -!> taken at equidistant discrete times. This is the -!> number of columns of F. -!> \endverbatim -!..... -!> \param[in,out] F -!> \verbatim -!> F (input/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, -!> the columns of F are the sequence of data snapshots -!> from a single trajectory, taken at equidistant discrete -!> times. It is assumed that the column norms of F are -!> in the range of the normalized floating point numbers. -!> < On exit, -!> If JOBQ == 'Q', the array F contains the orthogonal -!> matrix/factor of the QR factorization of the initial -!> data snapshots matrix F. See the description of JOBQ. -!> If JOBQ == 'N', the entries in F strictly below the main -!> diagonal contain, column-wise, the information on the -!> Householder vectors, as returned by CGEQRF. The -!> remaining information to restore the orthogonal matrix -!> of the initial QR factorization is stored in ZWORK(1:MIN(M,N)). -!> See the description of ZWORK. -!> \endverbatim -!..... -!> \param[in] LDF -!> \verbatim -!> LDF (input) INTEGER, LDF >= M -!> The leading dimension of the array F. -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array -!> X is used as workspace to hold representations of the -!> leading N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, the leading K columns of X contain the leading -!> K left singular vectors of the above described content -!> of X. To lift them to the space of the left singular -!> vectors U(:,1:K) of the input data, pre-multiply with the -!> Q factor from the initial QR factorization. -!> See the descriptions of F, K, V and Z. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= N -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N) array -!> Y is used as workspace to hold representations of the -!> trailing N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, -!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper -!> triangular factor from the QR factorization of the data -!> snapshot matrix F. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= N -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N-1 :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the description of K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the SVD/POD basis for the leading N-1 -!> data snapshots (columns of F) and the number of the -!> computed Ritz pairs. The value of K is determined -!> according to the rule set by the parameters NRNK and -!> TOL. See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] EIGS -!> \verbatim -!> EIGS (output) COMPLEX(KIND=WP) (N-1)-by-1 array -!> The leading K (K<=N-1) entries of EIGS contain -!> the computed eigenvalues (Ritz values). -!> See the descriptions of K, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) COMPLEX(KIND=WP) M-by-(N-1) array -!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) -!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. -!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as -!> Z*V, where Z contains orthonormal matrix (the product of -!> Q from the initial QR factorization and the SVD/POD_basis -!> returned by CGEDMD in X) and the second factor (the -!> eigenvectors of the Rayleigh quotient) is in the array V, -!> as returned by CGEDMD. That is, X(:,1:K)*V(:,i) -!> is an eigenvector corresponding to EIGS(i). The columns -!> of V(1:K,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. -!> See the descriptions of EIGS, X and V. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) (N-1)-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs, -!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. -!> See the description of EIGS and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array. -!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:N,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> In both cases, the content of B can be lifted to the -!> original dimension of the input data by pre-multiplying -!> with the Q factor from the initial QR factorization. -!> Here A denotes a compression of the underlying operator. -!> See the descriptions of F and X. -!> If JOBF =='N', then B is not referenced. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= MIN(M,N) -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] V -!> \verbatim -!> V (workspace/output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array -!> On exit, V(1:K,1:K) V contains the K eigenvectors of -!> the Rayleigh quotient. The Ritz vectors -!> (returned in Z) are the product of Q from the initial QR -!> factorization (see the description of F) X (see the -!> description of X) and V. -!> \endverbatim -!..... -!> \param[in] LDV -!> \verbatim -!> LDV (input) INTEGER, LDV >= N-1 -!> The leading dimension of the array V. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by CGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N-1 -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] LZWORK -!> \verbatim -!> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array -!> On exit, -!> ZWORK(1:MIN(M,N)) contains the scalar factors of the -!> elementary reflectors as returned by CGEQRF of the -!> M-by-N input matrix F. -!> If the call to CGEDMDQ is only workspace query, then -!> ZWORK(1) contains the minimal complex workspace length and -!> ZWORK(2) is the optimal complex workspace length. -!> Hence, the length of work is at least 2. -!> See the description of LZWORK. -!> \endverbatim -!..... -!> \param[in] LZWORK -!> \verbatim -!> LZWORK (input) INTEGER -!> The minimal length of the workspace vector ZWORK. -!> LZWORK is calculated as follows: -!> Let MLWQR = N (minimal workspace for CGEQRF[M,N]) -!> MLWDMD = minimal workspace for CGEDMD (see the -!> description of LWORK in CGEDMD) -!> MLWMQR = N (minimal workspace for -!> ZUNMQR['L','N',M,N,N]) -!> MLWGQR = N (minimal workspace for ZUNGQR[M,N,N]) -!> MINMN = MIN(M,N) -!> Then -!> LZWORK = MAX(2, MIN(M,N)+MLWQR, MINMN+MLWDMD) -!> is further updated as follows: -!> if JOBZ == 'V' or JOBZ == 'F' THEN -!> LZWORK = MAX( LZWORK, MINMN+MLWMQR ) -!> if JOBQ == 'Q' THEN -!> LZWORK = MAX( ZLWORK, MINMN+MLWGQR) -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, -!> WORK(1:N-1) contains the singular values of -!> the input submatrix F(1:M,1:N-1). -!> If the call to CGEDMDQ is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. hence, the -!> length of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is the same as in CGEDMD, because in CGEDMDQ -!> only CGEDMD requires real workspace for snapshots -!> of dimensions MIN(M,N)-by-(N-1). -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> Let M1=MIN(M,N), N1=N-1. Then -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. -SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & - WHTSVD, M, N, F, LDF, X, LDX, Y, & - LDY, NRNK, TOL, K, EIGS, & - Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK, LZWORK, WORK, LWORK, & - IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real32 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & - JOBT, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & - LDY, NRNK, LDZ, LDB, LDV, & - LDS, LZWORK, LWORK, LIWORK - INTEGER, INTENT(OUT) :: INFO, K - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) - COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & - Z(LDZ,*), B(LDB,*), & - V(LDV,*), S(LDS,*) - COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) - COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) - REAL(KIND=WP), INTENT(OUT) :: RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) -! -! Local scalars -! ~~~~~~~~~~~~~ - INTEGER :: IMINWR, INFO1, MINMN, MLRWRK, & - MLWDMD, MLWGQR, MLWMQR, MLWORK, & - MLWQR, OLWDMD, OLWGQR, OLWMQR, & - OLWORK, OLWQR - LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & - WNTTRF, WNTRES, WNTVEC, WNTVCF, & - WNTVCQ, WNTREF, WNTEX - CHARACTER(LEN=1) :: JOBVL -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - LOGICAL LSAME - EXTERNAL LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL CGEDMD, CGEQRF, CLACPY, CLASET, CUNGQR, & - CUNMQR, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC MAX, MIN, INT -!.......................................................... -! -! Test the input arguments - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTVCF = LSAME(JOBZ,'F') - WNTVCQ = LSAME(JOBZ,'Q') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - WANTQ = LSAME(JOBQ,'Q') - WNTTRF = LSAME(JOBT,'R') - MINMN = MIN(M,N) - INFO = 0 - LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & - .OR. LSAME(JOBZ,'N')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN - INFO = -4 - ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN - INFO = -5 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -6 - ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & - (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN - INFO = -7 - ELSE IF ( M < 0 ) THEN - INFO = -8 - ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN - INFO = -9 - ELSE IF ( LDF < M ) THEN - INFO = -11 - ELSE IF ( LDX < MINMN ) THEN - INFO = -13 - ELSE IF ( LDY < MINMN ) THEN - INFO = -15 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -16 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -17 - ELSE IF ( LDZ < M ) THEN - INFO = -21 - ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN - INFO = -24 - ELSE IF ( LDV < N-1 ) THEN - INFO = -26 - ELSE IF ( LDS < N-1 ) THEN - INFO = -28 - END IF -! - IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN - JOBVL = 'V' - ELSE - JOBVL = 'N' - END IF - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN - ! All output except K is void. INFO=1 signals - ! the void input. In case of a workspace query, - ! the minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - - MLRWRK = 2 - MLWORK = 2 - OLWORK = 2 - IMINWR = 1 - MLWQR = MAX(1,N) ! Minimal workspace length for CGEQRF. - MLWORK = MAX(MLWORK,MINMN + MLWQR) - - IF ( LQUERY ) THEN - CALL CGEQRF( M, N, F, LDF, ZWORK, ZWORK, -1, & - INFO1 ) - OLWQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,MINMN + OLWQR) - END IF - CALL CGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - EIGS, Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK, LZWORK, WORK, -1, IWORK,& - LIWORK, INFO1 ) - MLWDMD = INT(ZWORK(1)) - MLWORK = MAX(MLWORK, MINMN + MLWDMD) - MLRWRK = MAX(MLRWRK, INT(WORK(1))) - IMINWR = MAX(IMINWR, IWORK(1)) - IF ( LQUERY ) THEN - OLWDMD = INT(ZWORK(2)) - OLWORK = MAX(OLWORK, MINMN+OLWDMD) - END IF - IF ( WNTVEC .OR. WNTVCF ) THEN - MLWMQR = MAX(1,N) - MLWORK = MAX(MLWORK, MINMN+MLWMQR) - IF ( LQUERY ) THEN - CALL CUNMQR( 'L','N', M, N, MINMN, F, LDF, & - ZWORK, Z, LDZ, ZWORK, -1, INFO1 ) - OLWMQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK, MINMN+OLWMQR) - END IF - END IF - IF ( WANTQ ) THEN - MLWGQR = MAX(1,N) - MLWORK = MAX(MLWORK, MINMN+MLWGQR) - IF ( LQUERY ) THEN - CALL CUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & - ZWORK, -1, INFO1 ) - OLWGQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK, MINMN+OLWGQR) - END IF - END IF - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -34 - IF ( LWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -32 - IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -30 - END IF - IF( INFO /= 0 ) THEN - CALL XERBLA( 'CGEDMDQ', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK - WORK(1) = MLRWRK - WORK(2) = MLRWRK - RETURN - END IF -!..... -! Initial QR factorization that is used to represent the -! snapshots as elements of lower dimensional subspace. -! For large scale computation with M >>N , at this place -! one can use an out of core QRF. -! - CALL CGEQRF( M, N, F, LDF, ZWORK, & - ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) -! -! Define X and Y as the snapshots representations in the -! orthogonal basis computed in the QR factorization. -! X corresponds to the leading N-1 and Y to the trailing -! N-1 snapshots. - CALL CLASET( 'L', MINMN, N-1, ZZERO, ZZERO, X, LDX ) - CALL CLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) - CALL CLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) - IF ( M >= 3 ) THEN - CALL CLASET( 'L', MINMN-2, N-2, ZZERO, ZZERO, & - Y(3,1), LDY ) - END IF -! -! Compute the DMD of the projected snapshot pairs (X,Y) - CALL CGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - EIGS, Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK(MINMN+1), LZWORK-MINMN, & - WORK, LWORK, IWORK, LIWORK, INFO1 ) - IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN - ! Return with error code. See CGEDMD for details. - INFO = INFO1 - RETURN - ELSE - INFO = INFO1 - END IF -! -! The Ritz vectors (Koopman modes) can be explicitly -! formed or returned in factored form. - IF ( WNTVEC ) THEN - ! Compute the eigenvectors explicitly. - IF ( M > MINMN ) CALL CLASET( 'A', M-MINMN, K, ZZERO, & - ZZERO, Z(MINMN+1,1), LDZ ) - CALL CUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & - LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - ELSE IF ( WNTVCF ) THEN - ! Return the Ritz vectors (eigenvectors) in factored - ! form Z*V, where Z contains orthonormal matrix (the - ! product of Q from the initial QR factorization and - ! the SVD/POD_basis returned by CGEDMD in X) and the - ! second factor (the eigenvectors of the Rayleigh - ! quotient) is in the array V, as returned by CGEDMD. - CALL CLACPY( 'A', N, K, X, LDX, Z, LDZ ) - IF ( M > N ) CALL CLASET( 'A', M-N, K, ZZERO, ZZERO, & - Z(N+1,1), LDZ ) - CALL CUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & - LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - END IF -! -! Some optional output variables: -! -! The upper triangular factor R in the initial QR -! factorization is optionally returned in the array Y. -! This is useful if this call to CGEDMDQ is to be - -! followed by a streaming DMD that is implemented in a -! QR compressed form. - IF ( WNTTRF ) THEN ! Return the upper triangular R in Y - CALL CLASET( 'A', MINMN, N, ZZERO, ZZERO, Y, LDY ) - CALL CLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) - END IF -! -! The orthonormal/unitary factor Q in the initial QR -! factorization is optionally returned in the array F. -! Same as with the triangular factor above, this is -! useful in a streaming DMD. - IF ( WANTQ ) THEN ! Q overwrites F - CALL CUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & - ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - END IF -! - RETURN -! - END SUBROUTINE CGEDMDQ - +!> \brief \b CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & +! WHTSVD, M, N, F, LDF, X, LDX, Y, & +! LDY, NRNK, TOL, K, EIGS, & +! Z, LDZ, RES, B, LDB, V, LDV, & +! S, LDS, ZWORK, LZWORK, WORK, LWORK, & +! IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real32 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & +! JOBT, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & +! LDY, NRNK, LDZ, LDB, LDV, & +! LDS, LZWORK, LWORK, LIWORK +! INTEGER, INTENT(OUT) :: INFO, K +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & +! Z(LDZ,*), B(LDB,*), & +! V(LDV,*), S(LDS,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) +! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) +! REAL(KIND=WP), INTENT(OUT) :: RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices, using a QR factorization +!> based compression of the data. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, CGEDMDQ computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, CGEDMDQ returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!...................................................................... +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. The data snapshots are the columns +!> of F. The leading N-1 columns of F are denoted X and the +!> trailing N-1 columns are denoted Y. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Z*V, where Z +!> is orthonormal and V contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of F, V, Z. +!> 'Q' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Q*Z, where Z +!> contains the eigenvectors of the compression of the +!> underlying discretised operator onto the span of +!> the data snapshots. See the descriptions of F, V, Z. +!> Q is from the inital QR facorization. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will +!> be computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBQ +!> \verbatim +!> JOBQ (input) CHARACTER*1 +!> Specifies whether to explicitly compute and return the +!> unitary matrix from the QR factorization. +!> 'Q' :: The matrix Q of the QR factorization of the data +!> snapshot matrix is computed and stored in the +!> array F. See the description of F. +!> 'N' :: The matrix Q is not explicitly computed. +!> \endverbatim +!..... +!> \param[in] JOBT +!> \verbatim +!> JOBT (input) CHARACTER*1 +!> Specifies whether to return the upper triangular factor +!> from the QR factorization. +!> 'R' :: The matrix R of the QR factorization of the data +!> snapshot matrix F is returned in the array Y. +!> See the description of Y and Further details. +!> 'N' :: The matrix R is not returned. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> To be useful on exit, this option needs JOBQ='Q'. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: CGESVD (the QR SVD algorithm) +!> 2 :: CGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: CGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: CGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M >= 0 +!> The state space dimension (the number of rows of F). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshots from a single trajectory, +!> taken at equidistant discrete times. This is the +!> number of columns of F. +!> \endverbatim +!..... +!> \param[in,out] F +!> \verbatim +!> F (input/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, +!> the columns of F are the sequence of data snapshots +!> from a single trajectory, taken at equidistant discrete +!> times. It is assumed that the column norms of F are +!> in the range of the normalized floating point numbers. +!> < On exit, +!> If JOBQ == 'Q', the array F contains the orthogonal +!> matrix/factor of the QR factorization of the initial +!> data snapshots matrix F. See the description of JOBQ. +!> If JOBQ == 'N', the entries in F strictly below the main +!> diagonal contain, column-wise, the information on the +!> Householder vectors, as returned by CGEQRF. The +!> remaining information to restore the orthogonal matrix +!> of the initial QR factorization is stored in ZWORK(1:MIN(M,N)). +!> See the description of ZWORK. +!> \endverbatim +!..... +!> \param[in] LDF +!> \verbatim +!> LDF (input) INTEGER, LDF >= M +!> The leading dimension of the array F. +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array +!> X is used as workspace to hold representations of the +!> leading N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, the leading K columns of X contain the leading +!> K left singular vectors of the above described content +!> of X. To lift them to the space of the left singular +!> vectors U(:,1:K) of the input data, pre-multiply with the +!> Q factor from the initial QR factorization. +!> See the descriptions of F, K, V and Z. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= N +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N) array +!> Y is used as workspace to hold representations of the +!> trailing N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, +!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper +!> triangular factor from the QR factorization of the data +!> snapshot matrix F. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= N +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N-1 :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the description of K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the SVD/POD basis for the leading N-1 +!> data snapshots (columns of F) and the number of the +!> computed Ritz pairs. The value of K is determined +!> according to the rule set by the parameters NRNK and +!> TOL. See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] EIGS +!> \verbatim +!> EIGS (output) COMPLEX(KIND=WP) (N-1)-by-1 array +!> The leading K (K<=N-1) entries of EIGS contain +!> the computed eigenvalues (Ritz values). +!> See the descriptions of K, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) COMPLEX(KIND=WP) M-by-(N-1) array +!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) +!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. +!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as +!> Z*V, where Z contains orthonormal matrix (the product of +!> Q from the initial QR factorization and the SVD/POD_basis +!> returned by CGEDMD in X) and the second factor (the +!> eigenvectors of the Rayleigh quotient) is in the array V, +!> as returned by CGEDMD. That is, X(:,1:K)*V(:,i) +!> is an eigenvector corresponding to EIGS(i). The columns +!> of V(1:K,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. +!> See the descriptions of EIGS, X and V. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) (N-1)-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs, +!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. +!> See the description of EIGS and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array. +!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:N,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> In both cases, the content of B can be lifted to the +!> original dimension of the input data by pre-multiplying +!> with the Q factor from the initial QR factorization. +!> Here A denotes a compression of the underlying operator. +!> See the descriptions of F and X. +!> If JOBF =='N', then B is not referenced. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= MIN(M,N) +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] V +!> \verbatim +!> V (workspace/output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array +!> On exit, V(1:K,1:K) V contains the K eigenvectors of +!> the Rayleigh quotient. The Ritz vectors +!> (returned in Z) are the product of Q from the initial QR +!> factorization (see the description of F) X (see the +!> description of X) and V. +!> \endverbatim +!..... +!> \param[in] LDV +!> \verbatim +!> LDV (input) INTEGER, LDV >= N-1 +!> The leading dimension of the array V. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by CGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N-1 +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] LZWORK +!> \verbatim +!> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array +!> On exit, +!> ZWORK(1:MIN(M,N)) contains the scalar factors of the +!> elementary reflectors as returned by CGEQRF of the +!> M-by-N input matrix F. +!> If the call to CGEDMDQ is only workspace query, then +!> ZWORK(1) contains the minimal complex workspace length and +!> ZWORK(2) is the optimal complex workspace length. +!> Hence, the length of work is at least 2. +!> See the description of LZWORK. +!> \endverbatim +!..... +!> \param[in] LZWORK +!> \verbatim +!> LZWORK (input) INTEGER +!> The minimal length of the workspace vector ZWORK. +!> LZWORK is calculated as follows: +!> Let MLWQR = N (minimal workspace for CGEQRF[M,N]) +!> MLWDMD = minimal workspace for CGEDMD (see the +!> description of LWORK in CGEDMD) +!> MLWMQR = N (minimal workspace for +!> ZUNMQR['L','N',M,N,N]) +!> MLWGQR = N (minimal workspace for ZUNGQR[M,N,N]) +!> MINMN = MIN(M,N) +!> Then +!> LZWORK = MAX(2, MIN(M,N)+MLWQR, MINMN+MLWDMD) +!> is further updated as follows: +!> if JOBZ == 'V' or JOBZ == 'F' THEN +!> LZWORK = MAX( LZWORK, MINMN+MLWMQR ) +!> if JOBQ == 'Q' THEN +!> LZWORK = MAX( ZLWORK, MINMN+MLWGQR) +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, +!> WORK(1:N-1) contains the singular values of +!> the input submatrix F(1:M,1:N-1). +!> If the call to CGEDMDQ is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. hence, the +!> length of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is the same as in CGEDMD, because in CGEDMDQ +!> only CGEDMD requires real workspace for snapshots +!> of dimensions MIN(M,N)-by-(N-1). +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> Let M1=MIN(M,N), N1=N-1. Then +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. +SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & + WHTSVD, M, N, F, LDF, X, LDX, Y, & + LDY, NRNK, TOL, K, EIGS, & + Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK, LZWORK, WORK, LWORK, & + IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real32 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & + JOBT, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & + LDY, NRNK, LDZ, LDB, LDV, & + LDS, LZWORK, LWORK, LIWORK + INTEGER, INTENT(OUT) :: INFO, K + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) + COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & + Z(LDZ,*), B(LDB,*), & + V(LDV,*), S(LDS,*) + COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) + COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) + REAL(KIND=WP), INTENT(OUT) :: RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) +! +! Local scalars +! ~~~~~~~~~~~~~ + INTEGER :: IMINWR, INFO1, MINMN, MLRWRK, & + MLWDMD, MLWGQR, MLWMQR, MLWORK, & + MLWQR, OLWDMD, OLWGQR, OLWMQR, & + OLWORK, OLWQR + LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & + WNTTRF, WNTRES, WNTVEC, WNTVCF, & + WNTVCQ, WNTREF, WNTEX + CHARACTER(LEN=1) :: JOBVL +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + LOGICAL LSAME + EXTERNAL LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL CGEDMD, CGEQRF, CLACPY, CLASET, CUNGQR, & + CUNMQR, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC MAX, MIN, INT +!.......................................................... +! +! Test the input arguments + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTVCF = LSAME(JOBZ,'F') + WNTVCQ = LSAME(JOBZ,'Q') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + WANTQ = LSAME(JOBQ,'Q') + WNTTRF = LSAME(JOBT,'R') + MINMN = MIN(M,N) + INFO = 0 + LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & + .OR. LSAME(JOBZ,'N')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN + INFO = -4 + ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN + INFO = -5 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -6 + ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & + (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN + INFO = -7 + ELSE IF ( M < 0 ) THEN + INFO = -8 + ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN + INFO = -9 + ELSE IF ( LDF < M ) THEN + INFO = -11 + ELSE IF ( LDX < MINMN ) THEN + INFO = -13 + ELSE IF ( LDY < MINMN ) THEN + INFO = -15 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -16 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -17 + ELSE IF ( LDZ < M ) THEN + INFO = -21 + ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN + INFO = -24 + ELSE IF ( LDV < N-1 ) THEN + INFO = -26 + ELSE IF ( LDS < N-1 ) THEN + INFO = -28 + END IF +! + IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN + JOBVL = 'V' + ELSE + JOBVL = 'N' + END IF + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN + ! All output except K is void. INFO=1 signals + ! the void input. In case of a workspace query, + ! the minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + + MLRWRK = 2 + MLWORK = 2 + OLWORK = 2 + IMINWR = 1 + MLWQR = MAX(1,N) ! Minimal workspace length for CGEQRF. + MLWORK = MAX(MLWORK,MINMN + MLWQR) + + IF ( LQUERY ) THEN + CALL CGEQRF( M, N, F, LDF, ZWORK, ZWORK, -1, & + INFO1 ) + OLWQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,MINMN + OLWQR) + END IF + CALL CGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + EIGS, Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK, LZWORK, WORK, -1, IWORK,& + LIWORK, INFO1 ) + MLWDMD = INT(ZWORK(1)) + MLWORK = MAX(MLWORK, MINMN + MLWDMD) + MLRWRK = MAX(MLRWRK, INT(WORK(1))) + IMINWR = MAX(IMINWR, IWORK(1)) + IF ( LQUERY ) THEN + OLWDMD = INT(ZWORK(2)) + OLWORK = MAX(OLWORK, MINMN+OLWDMD) + END IF + IF ( WNTVEC .OR. WNTVCF ) THEN + MLWMQR = MAX(1,N) + MLWORK = MAX(MLWORK, MINMN+MLWMQR) + IF ( LQUERY ) THEN + CALL CUNMQR( 'L','N', M, N, MINMN, F, LDF, & + ZWORK, Z, LDZ, ZWORK, -1, INFO1 ) + OLWMQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK, MINMN+OLWMQR) + END IF + END IF + IF ( WANTQ ) THEN + MLWGQR = MAX(1,N) + MLWORK = MAX(MLWORK, MINMN+MLWGQR) + IF ( LQUERY ) THEN + CALL CUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & + ZWORK, -1, INFO1 ) + OLWGQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK, MINMN+OLWGQR) + END IF + END IF + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -34 + IF ( LWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -32 + IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -30 + END IF + IF( INFO /= 0 ) THEN + CALL XERBLA( 'CGEDMDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + ZWORK(1) = MLWORK + ZWORK(2) = OLWORK + WORK(1) = MLRWRK + WORK(2) = MLRWRK + RETURN + END IF +!..... +! Initial QR factorization that is used to represent the +! snapshots as elements of lower dimensional subspace. +! For large scale computation with M >>N , at this place +! one can use an out of core QRF. +! + CALL CGEQRF( M, N, F, LDF, ZWORK, & + ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) +! +! Define X and Y as the snapshots representations in the +! orthogonal basis computed in the QR factorization. +! X corresponds to the leading N-1 and Y to the trailing +! N-1 snapshots. + CALL CLASET( 'L', MINMN, N-1, ZZERO, ZZERO, X, LDX ) + CALL CLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) + CALL CLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) + IF ( M >= 3 ) THEN + CALL CLASET( 'L', MINMN-2, N-2, ZZERO, ZZERO, & + Y(3,1), LDY ) + END IF +! +! Compute the DMD of the projected snapshot pairs (X,Y) + CALL CGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + EIGS, Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK(MINMN+1), LZWORK-MINMN, & + WORK, LWORK, IWORK, LIWORK, INFO1 ) + IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN + ! Return with error code. See CGEDMD for details. + INFO = INFO1 + RETURN + ELSE + INFO = INFO1 + END IF +! +! The Ritz vectors (Koopman modes) can be explicitly +! formed or returned in factored form. + IF ( WNTVEC ) THEN + ! Compute the eigenvectors explicitly. + IF ( M > MINMN ) CALL CLASET( 'A', M-MINMN, K, ZZERO, & + ZZERO, Z(MINMN+1,1), LDZ ) + CALL CUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & + LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + ELSE IF ( WNTVCF ) THEN + ! Return the Ritz vectors (eigenvectors) in factored + ! form Z*V, where Z contains orthonormal matrix (the + ! product of Q from the initial QR factorization and + ! the SVD/POD_basis returned by CGEDMD in X) and the + ! second factor (the eigenvectors of the Rayleigh + ! quotient) is in the array V, as returned by CGEDMD. + CALL CLACPY( 'A', N, K, X, LDX, Z, LDZ ) + IF ( M > N ) CALL CLASET( 'A', M-N, K, ZZERO, ZZERO, & + Z(N+1,1), LDZ ) + CALL CUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & + LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + END IF +! +! Some optional output variables: +! +! The upper triangular factor R in the initial QR +! factorization is optionally returned in the array Y. +! This is useful if this call to CGEDMDQ is to be + +! followed by a streaming DMD that is implemented in a +! QR compressed form. + IF ( WNTTRF ) THEN ! Return the upper triangular R in Y + CALL CLASET( 'A', MINMN, N, ZZERO, ZZERO, Y, LDY ) + CALL CLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) + END IF +! +! The orthonormal/unitary factor Q in the initial QR +! factorization is optionally returned in the array F. +! Same as with the triangular factor above, this is +! useful in a streaming DMD. + IF ( WANTQ ) THEN ! Q overwrites F + CALL CUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & + ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + END IF +! + RETURN +! + END SUBROUTINE CGEDMDQ diff --git a/SRC/dgedmd.f90 b/SRC/dgedmd.f90 index 15df48fe91..9c4afd182d 100644 --- a/SRC/dgedmd.f90 +++ b/SRC/dgedmd.f90 @@ -1,1206 +1,1206 @@ -!> \brief \b DGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & -! M, N, X, LDX, Y, LDY, NRNK, TOL, & -! K, REIG, IMEIG, Z, LDZ, RES, & -! B, LDB, W, LDW, S, LDS, & -! WORK, LWORK, IWORK, LIWORK, INFO ) -! -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real64 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & -! NRNK, LDZ, LDB, LDW, LDS, & -! LWORK, LIWORK -! INTEGER, INTENT(OUT) :: K, INFO -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) -! REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & -! W(LDW,*), S(LDS,*) -! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & -! RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> DGEDMD computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, DGEDMD computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, DGEDMD returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!...................................................................... -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) is CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product X(:,1:K)*W, where X -!> contains a POD basis (leading left singular vectors -!> of the data matrix X) and W contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of K, X, W, Z. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will be -!> computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: DGESVD (the QR SVD algorithm) -!> 2 :: DGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: DGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: DGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M>= 0 -!> The state space dimension (the row dimension of X, Y). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshot pairs -!> (the number of columns of X and Y). -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (input/output) REAL(KIND=WP) M-by-N array -!> > On entry, X contains the data snapshot matrix X. It is -!> assumed that the column norms of X are in the range of -!> the normalized floating point numbers. -!> < On exit, the leading K columns of X contain a POD basis, -!> i.e. the leading K left singular vectors of the input -!> data matrix X, U(:,1:K). All N columns of X contain all -!> left singular vectors of the input matrix X. -!> See the descriptions of K, Z and W. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= M -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (input/workspace/output) REAL(KIND=WP) M-by-N array -!> > On entry, Y contains the data snapshot matrix Y -!> < On exit, -!> If JOBR == 'R', the leading K columns of Y contain -!> the residual vectors for the computed Ritz pairs. -!> See the description of RES. -!> If JOBR == 'N', Y contains the original input data, -!> scaled according to the value of JOBS. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= M -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1). -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the descriptions of TOL and K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the POD basis for the data snapshot -!> matrix X and the number of the computed Ritz pairs. -!> The value of K is determined according to the rule set -!> by the parameters NRNK and TOL. -!> See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] REIG -!> \verbatim -!> REIG (output) REAL(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of REIG contain -!> the real parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> See the descriptions of K, IMEIG, and Z. -!> \endverbatim -!..... -!> \param[out] IMEIG -!> \verbatim -!> IMEIG (output) REAL(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of IMEIG contain -!> the imaginary parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> The eigenvalues are determined as follows: -!> If IMEIG(i) == 0, then the corresponding eigenvalue is -!> real, LAMBDA(i) = REIG(i). -!> If IMEIG(i)>0, then the corresponding complex -!> conjugate pair of eigenvalues reads -!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) -!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) -!> That is, complex conjugate pairs have consecutive -!> indices (i,i+1), with the positive imaginary part -!> listed first. -!> See the descriptions of K, REIG, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) REAL(KIND=WP) M-by-N array -!> If JOBZ =='V' then -!> Z contains real Ritz vectors as follows: -!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of -!> the i-th Ritz value; ||Z(:,i)||_2=1. -!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then -!> [Z(:,i) Z(:,i+1)] span an invariant subspace and -!> the Ritz values extracted from this subspace are -!> REIG(i) + sqrt(-1)*IMEIG(i) and -!> REIG(i) - sqrt(-1)*IMEIG(i). -!> The corresponding eigenvectors are -!> Z(:,i) + sqrt(-1)*Z(:,i+1) and -!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. -!> || Z(:,i:i+1)||_F = 1. -!> If JOBZ == 'F', then the above descriptions hold for -!> the columns of X(:,1:K)*W(1:K,1:K), where the columns -!> of W(1:k,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. The columns of W(1:K,1:K) -!> are similarly structured: If IMEIG(i) == 0 then -!> X(:,1:K)*W(:,i) is an eigenvector, and if IMEIG(i)>0 -!> then X(:,1:K)*W(:,i)+sqrt(-1)*X(:,1:K)*W(:,i+1) and -!> X(:,1:K)*W(:,i)-sqrt(-1)*X(:,1:K)*W(:,i+1) -!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). -!> See the descriptions of REIG, IMEIG, X and W. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) N-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs. -!> If LAMBDA(i) is real, then -!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. -!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair -!> then -!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F -!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] -!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. -!> It holds that -!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 -!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 -!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) -!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) -!> See the description of REIG, IMEIG and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) REAL(KIND=WP) M-by-N array. -!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:M,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> If JOBF =='N', then B is not referenced. -!> See the descriptions of X, W, K. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= M -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] W -!> \verbatim -!> W (workspace/output) REAL(KIND=WP) N-by-N array -!> On exit, W(1:K,1:K) contains the K computed -!> eigenvectors of the matrix Rayleigh quotient (real and -!> imaginary parts for each complex conjugate pair of the -!> eigenvalues). The Ritz vectors (returned in Z) are the -!> product of X (containing a POD basis for the input -!> matrix X) and W. See the descriptions of K, S, X and Z. -!> W is also used as a workspace to temporarily store the -!> right singular vectors of X. -!> \endverbatim -!..... -!> \param[in] LDW -!> \verbatim -!> LDW (input) INTEGER, LDW >= N -!> The leading dimension of the array W. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (workspace/output) REAL(KIND=WP) N-by-N array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by DGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, WORK(1:N) contains the singular values of -!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). -!> If WHTSVD==4, then WORK(N+1) and WORK(N+2) contain -!> scaling factor WORK(N+2)/WORK(N+1) used to scale X -!> and Y to avoid overflow in the SVD of X. -!> This may be of interest if the scaling option is off -!> and as many as possible smallest eigenvalues are -!> desired to the highest feasible accuracy. -!> If the call to DGEDMD is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. Hence, the -!> leng of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is calculated as follows: -!> If WHTSVD == 1 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)). -!> If JOBZ == 'N' then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)). -!> Here LWORK_SVD = MAX(1,3*N+M,5*N) is the minimal -!> workspace length of DGESVD. -!> If WHTSVD == 2 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)) -!> Here LWORK_SVD = MAX(M, 5*N*N+4*N)+3*N*N is the -!> minimal workspace length of DGESDD. -!> If WHTSVD == 3 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) -!> Here LWORK_SVD = N+M+MAX(3*N+1, -!> MAX(1,3*N+M,5*N),MAX(1,N)) -!> is the minimal workspace length of DGESVDQ. -!> If WHTSVD == 4 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) -!> Here LWORK_SVD = MAX(7,2*M+N,6*N+2*N*N) is the -!> minimal workspace length of DGEJSV. -!> The above expressions are not simplified in order to -!> make the usage of WORK more transparent, and for -!> easier checking. In any case, LWORK >= 2. -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. - SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, REIG, IMEIG, Z, LDZ, RES, & - B, LDB, W, LDW, S, LDS, & - WORK, LWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real64 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & - NRNK, LDZ, LDB, LDW, LDS, & - LWORK, LIWORK - INTEGER, INTENT(OUT) :: K, INFO - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) - REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & - W(LDW,*), S(LDS,*) - REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & - RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! -! Local scalars -! ~~~~~~~~~~~~~ - REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & - SSUM, XSCL1, XSCL2 - INTEGER :: i, j, IMINWR, INFO1, INFO2, & - LWRKEV, LWRSDD, LWRSVD, & - LWRSVQ, MLWORK, MWRKEV, MWRSDD, & - MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & - OLWORK - LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & - WNTEX, WNTREF, WNTRES, WNTVEC - CHARACTER :: JOBZL, T_OR_N - CHARACTER :: JSVOPT -! -! Local arrays -! ~~~~~~~~~~~~ - REAL(KIND=WP) :: AB(2,2), RDUMMY(2), RDUMMY2(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - REAL(KIND=WP) DLANGE, DLAMCH, DNRM2 - EXTERNAL DLANGE, DLAMCH, DNRM2, IDAMAX - INTEGER IDAMAX - LOGICAL DISNAN, LSAME - EXTERNAL DISNAN, LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL DAXPY, DGEMM, DSCAL - EXTERNAL DGEEV, DGEJSV, DGESDD, DGESVD, DGESVDQ, & - DLACPY, DLASCL, DLASSQ, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC DBLE, INT, MAX, SQRT -!............................................................ -! -! Test the input arguments -! - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - INFO = 0 - LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & - .OR. LSAME(JOBZ,'F')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -4 - ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & - (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN - INFO = -5 - ELSE IF ( M < 0 ) THEN - INFO = -6 - ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN - INFO = -7 - ELSE IF ( LDX < M ) THEN - INFO = -9 - ELSE IF ( LDY < M ) THEN - INFO = -11 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -12 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -13 - ELSE IF ( LDZ < M ) THEN - INFO = -18 - ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN - INFO = -21 - ELSE IF ( LDW < N ) THEN - INFO = -23 - ELSE IF ( LDS < N ) THEN - INFO = -25 - END IF -! - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( N == 0 ) THEN - ! Quick return. All output except K is void. - ! INFO=1 signals the void input. - ! In case of a workspace query, the default - ! minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - MLWORK = MAX(2,N) - OLWORK = MAX(2,N) - IMINWR = 1 - SELECT CASE ( WHTSVD ) - CASE (1) - ! The following is specified as the minimal - ! length of WORK in the definition of DGESVD: - ! MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - MLWORK = MAX(MLWORK,N + MWRSVD) - IF ( LQUERY ) THEN - CALL DGESVD( 'O', 'S', M, N, X, LDX, WORK, & - B, LDB, W, LDW, RDUMMY, -1, INFO1 ) - LWRSVD = MAX( MWRSVD, INT( RDUMMY(1) ) ) - OLWORK = MAX(OLWORK,N + LWRSVD) - END IF - CASE (2) - ! The following is specified as the minimal - ! length of WORK in the definition of DGESDD: - ! MWRSDD = 3*MIN(M,N)*MIN(M,N) + - ! MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) - ! IMINWR = 8*MIN(M,N) - MWRSDD = 3*MIN(M,N)*MIN(M,N) + & - MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) - MLWORK = MAX(MLWORK,N + MWRSDD) - IMINWR = 8*MIN(M,N) - IF ( LQUERY ) THEN - CALL DGESDD( 'O', M, N, X, LDX, WORK, B, & - LDB, W, LDW, RDUMMY, -1, IWORK, INFO1 ) - LWRSDD = MAX( MWRSDD, INT( RDUMMY(1) ) ) - OLWORK = MAX(OLWORK,N + LWRSDD) - END IF - CASE (3) - !LWQP3 = 3*N+1 - !LWORQ = MAX(N, 1) - !MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - !MWRSVQ = N + MAX( LWQP3, MWRSVD, LWORQ ) + MAX(M,2) - !MLWORK = N + MWRSVQ - !IMINWR = M+N-1 - CALL DGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, WORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, LIWORK, RDUMMY, & - -1, RDUMMY2, -1, INFO1 ) - IMINWR = IWORK(1) - MWRSVQ = INT(RDUMMY(2)) - MLWORK = MAX(MLWORK,N+MWRSVQ+INT(RDUMMY2(1))) - IF ( LQUERY ) THEN - LWRSVQ = MAX( MWRSVQ, INT(RDUMMY(1)) ) - OLWORK = MAX(OLWORK,N+LWRSVQ+INT(RDUMMY2(1))) - END IF - CASE (4) - JSVOPT = 'J' - !MWRSVJ = MAX( 7, 2*M+N, 6*N+2*N*N ) ! for JSVOPT='V' - MWRSVJ = MAX( 7, 2*M+N, 4*N+N*N, 2*N+N*N+6 ) - MLWORK = MAX(MLWORK,N+MWRSVJ) - IMINWR = MAX( 3, M+3*N ) - IF ( LQUERY ) THEN - OLWORK = MAX(OLWORK,N+MWRSVJ) - END IF - END SELECT - IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN - JOBZL = 'V' - ELSE - JOBZL = 'N' - END IF - ! Workspace calculation to the DGEEV call - IF ( LSAME(JOBZL,'V') ) THEN - MWRKEV = MAX( 1, 4*N ) - ELSE - MWRKEV = MAX( 1, 3*N ) - END IF - MLWORK = MAX(MLWORK,N+MWRKEV) - IF ( LQUERY ) THEN - CALL DGEEV( 'N', JOBZL, N, S, LDS, REIG, & - IMEIG, W, LDW, W, LDW, RDUMMY, -1, INFO1 ) - LWRKEV = MAX( MWRKEV, INT(RDUMMY(1)) ) - OLWORK = MAX( OLWORK, N+LWRKEV ) - END IF -! - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -29 - IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -27 - END IF -! - IF( INFO /= 0 ) THEN - CALL XERBLA( 'DGEDMD', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK - RETURN - END IF -!............................................................ -! - OFL = DLAMCH('O') - SMALL = DLAMCH('S') - BADXY = .FALSE. -! -! <1> Optional scaling of the snapshots (columns of X, Y) -! ========================================================== - IF ( SCCOLX ) THEN - ! The columns of X will be normalized. - ! To prevent overflows, the column norms of X are - ! carefully computed using DLASSQ. - K = 0 - DO i = 1, N - !WORK(i) = DNRM2( M, X(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL DLASSQ( M, X(1,i), 1, SCALE, SSUM ) - IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN - K = 0 - INFO = -8 - CALL XERBLA('DGEDMD',-INFO) - END IF - IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of X(:,i) overflows. First, X(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. -! Next, the norm of X(:,i) is stored without -! overflow as WORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of X(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL DLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, X(1,i), M, INFO2 ) - WORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - WORK(i) = SCALE * ROOTSC - CALL DLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & - X(1,i), M, INFO2 ) ! LAPACK CALL -! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC - END IF - ELSE - WORK(i) = ZERO - K = K + 1 - END IF - END DO - IF ( K == N ) THEN - ! All columns of X are zero. Return error code -8. - ! (the 8th input variable had an illegal value) - K = 0 - INFO = -8 - CALL XERBLA('DGEDMD',-INFO) - RETURN - END IF - DO i = 1, N -! Now, apply the same scaling to the columns of Y. - IF ( WORK(i) > ZERO ) THEN - CALL DSCAL( M, ONE/WORK(i), Y(1,i), 1 ) ! BLAS CALL -! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC - ELSE IF ( WORK(i) < ZERO ) THEN - CALL DLASCL( 'G', 0, 0, -WORK(i), & - ONE/DBLE(M), M, 1, Y(1,i), M, INFO2 ) ! LAPACK CALL - ELSE IF ( Y(IDAMAX(M, Y(1,i),1),i ) & - /= ZERO ) THEN -! X(:,i) is zero vector. For consistency, -! Y(:,i) should also be zero. If Y(:,i) is not -! zero, then the data might be inconsistent or -! corrupted. If JOBS == 'C', Y(:,i) is set to -! zero and a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - IF ( LSAME(JOBS,'C')) & - CALL DSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL - END IF - END DO - END IF - ! - IF ( SCCOLY ) THEN - ! The columns of Y will be normalized. - ! To prevent overflows, the column norms of Y are - ! carefully computed using DLASSQ. - DO i = 1, N - !WORK(i) = DNRM2( M, Y(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL DLASSQ( M, Y(1,i), 1, SCALE, SSUM ) - IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN - K = 0 - INFO = -10 - CALL XERBLA('DGEDMD',-INFO) - END IF - IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of Y(:,i) overflows. First, Y(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. -! Next, the norm of Y(:,i) is stored without -! overflow as WORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of Y(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL DLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, Y(1,i), M, INFO2 ) - WORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - WORK(i) = SCALE * ROOTSC - CALL DLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & - Y(1,i), M, INFO2 ) ! LAPACK CALL -! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC - END IF - ELSE - WORK(i) = ZERO - END IF - END DO - DO i = 1, N -! Now, apply the same scaling to the columns of X. - IF ( WORK(i) > ZERO ) THEN - CALL DSCAL( M, ONE/WORK(i), X(1,i), 1 ) ! BLAS CALL -! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC - ELSE IF ( WORK(i) < ZERO ) THEN - CALL DLASCL( 'G', 0, 0, -WORK(i), & - ONE/DBLE(M), M, 1, X(1,i), M, INFO2 ) ! LAPACK CALL - ELSE IF ( X(IDAMAX(M, X(1,i),1),i ) & - /= ZERO ) THEN -! Y(:,i) is zero vector. If X(:,i) is not -! zero, then a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - END IF - END DO - END IF -! -! <2> SVD of the data snapshot matrix X. -! ===================================== -! The left singular vectors are stored in the array X. -! The right singular vectors are in the array W. -! The array W will later on contain the eigenvectors -! of a Rayleigh quotient. - NUMRNK = N - SELECT CASE ( WHTSVD ) - CASE (1) - CALL DGESVD( 'O', 'S', M, N, X, LDX, WORK, B, & - LDB, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL - T_OR_N = 'T' - CASE (2) - CALL DGESDD( 'O', M, N, X, LDX, WORK, B, LDB, W, & - LDW, WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL - T_OR_N = 'T' - CASE (3) - CALL DGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, WORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, LIWORK, WORK(N+MAX(2,M)+1),& - LWORK-N-MAX(2,M), WORK(N+1), MAX(2,M), INFO1) ! LAPACK CALL - CALL DLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'T' - CASE (4) - CALL DGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & - N, X, LDX, WORK, Z, LDZ, W, LDW, & - WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL - CALL DLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'N' - XSCL1 = WORK(N+1) - XSCL2 = WORK(N+2) - IF ( XSCL1 /= XSCL2 ) THEN - ! This is an exceptional situation. If the - ! data matrices are not scaled and the - ! largest singular value of X overflows. - ! In that case DGEJSV can return the SVD - ! in scaled form. The scaling factor can be used - ! to rescale the data (X and Y). - CALL DLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) - END IF - END SELECT -! - IF ( INFO1 > 0 ) THEN - ! The SVD selected subroutine did not converge. - ! Return with an error code. - INFO = 2 - RETURN - END IF -! - IF ( WORK(1) == ZERO ) THEN - ! The largest computed singular value of (scaled) - ! X is zero. Return error code -8 - ! (the 8th input variable had an illegal value). - K = 0 - INFO = -8 - CALL XERBLA('DGEDMD',-INFO) - RETURN - END IF -! - !<3> Determine the numerical rank of the data - ! snapshots matrix X. This depends on the - ! parameters NRNK and TOL. - - SELECT CASE ( NRNK ) - CASE ( -1 ) - K = 1 - DO i = 2, NUMRNK - IF ( ( WORK(i) <= WORK(1)*TOL ) .OR. & - ( WORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE ( -2 ) - K = 1 - DO i = 1, NUMRNK-1 - IF ( ( WORK(i+1) <= WORK(i)*TOL ) .OR. & - ( WORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE DEFAULT - K = 1 - DO i = 2, NRNK - IF ( WORK(i) <= SMALL ) EXIT - K = K + 1 - END DO - END SELECT - ! Now, U = X(1:M,1:K) is the SVD/POD basis for the - ! snapshot data in the input matrix X. - - !<4> Compute the Rayleigh quotient S = U^T * A * U. - ! Depending on the requested outputs, the computation - ! is organized to compute additional auxiliary - ! matrices (for the residuals and refinements). - ! - ! In all formulas below, we need V_k*Sigma_k^(-1) - ! where either V_k is in W(1:N,1:K), or V_k^T is in - ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). - IF ( LSAME(T_OR_N, 'N') ) THEN - DO i = 1, K - CALL DSCAL( N, ONE/WORK(i), W(1,i), 1 ) ! BLAS CALL - ! W(1:N,i) = (ONE/WORK(i)) * W(1:N,i) ! INTRINSIC - END DO - ELSE - ! This non-unit stride access is due to the fact - ! that DGESVD, DGESVDQ and DGESDD return the - ! transposed matrix of the right singular vectors. - !DO i = 1, K - ! CALL DSCAL( N, ONE/WORK(i), W(i,1), LDW ) ! BLAS CALL - ! ! W(i,1:N) = (ONE/WORK(i)) * W(i,1:N) ! INTRINSIC - !END DO - DO i = 1, K - WORK(N+i) = ONE/WORK(i) - END DO - DO j = 1, N - DO i = 1, K - W(i,j) = (WORK(N+i))*W(i,j) - END DO - END DO - END IF -! - IF ( WNTREF ) THEN - ! - ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) - ! for computing the refined Ritz vectors - ! (optionally, outside DGEDMD). - CALL DGEMM( 'N', T_OR_N, M, K, N, ONE, Y, LDY, W, & - LDW, ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' - ! - ! At this point Z contains - ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and - ! this is needed for computing the residuals. - ! This matrix is returned in the array B and - ! it can be used to compute refined Ritz vectors. - CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL - ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC - - CALL DGEMM( 'T', 'N', K, K, M, ONE, X, LDX, Z, & - LDZ, ZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC - ! At this point S = U^T * A * U is the Rayleigh quotient. - ELSE - ! A * U(:,1:K) is not explicitly needed and the - ! computation is organized differently. The Rayleigh - ! quotient is computed more efficiently. - CALL DGEMM( 'T', 'N', K, N, M, ONE, X, LDX, Y, LDY, & - ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC - ! In the two DGEMM calls here, can use K for LDZ. - CALL DGEMM( 'N', T_OR_N, K, K, N, ONE, Z, LDZ, W, & - LDW, ZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' - ! At this point S = U^T * A * U is the Rayleigh quotient. - ! If the residuals are requested, save scaled V_k into Z. - ! Recall that V_k or V_k^T is stored in W. - IF ( WNTRES .OR. WNTEX ) THEN - IF ( LSAME(T_OR_N, 'N') ) THEN - CALL DLACPY( 'A', N, K, W, LDW, Z, LDZ ) - ELSE - CALL DLACPY( 'A', K, N, W, LDW, Z, LDZ ) - END IF - END IF - END IF -! - !<5> Compute the Ritz values and (if requested) the - ! right eigenvectors of the Rayleigh quotient. - ! - CALL DGEEV( 'N', JOBZL, K, S, LDS, REIG, IMEIG, W, & - LDW, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL - ! - ! W(1:K,1:K) contains the eigenvectors of the Rayleigh - ! quotient. Even in the case of complex spectrum, all - ! computation is done in real arithmetic. REIG and - ! IMEIG are the real and the imaginary parts of the - ! eigenvalues, so that the spectrum is given as - ! REIG(:) + sqrt(-1)*IMEIG(:). Complex conjugate pairs - ! are listed at consecutive positions. For such a - ! complex conjugate pair of the eigenvalues, the - ! corresponding eigenvectors are also a complex - ! conjugate pair with the real and imaginary parts - ! stored column-wise in W at the corresponding - ! consecutive column indices. See the description of Z. - ! Also, see the description of DGEEV. - IF ( INFO1 > 0 ) THEN - ! DGEEV failed to compute the eigenvalues and - ! eigenvectors of the Rayleigh quotient. - INFO = 3 - RETURN - END IF -! - ! <6> Compute the eigenvectors (if requested) and, - ! the residuals (if requested). - ! - IF ( WNTVEC .OR. WNTEX ) THEN - IF ( WNTRES ) THEN - IF ( WNTREF ) THEN - ! Here, if the refinement is requested, we have - ! A*U(:,1:K) already computed and stored in Z. - ! For the residuals, need Y = A * U(:,1;K) * W. - CALL DGEMM( 'N', 'N', M, K, K, ONE, Z, LDZ, W, & - LDW, ZERO, Y, LDY ) ! BLAS CALL - ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC - ! This frees Z; Y contains A * U(:,1:K) * W. - ELSE - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL DGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & - W, LDW, ZERO, S, LDS) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - LDS, ZERO, Z, LDZ) - ! Save a copy of Z into Y and free Z for holding - ! the Ritz vectors. - CALL DLACPY( 'A', M, K, Z, LDZ, Y, LDY ) - IF ( WNTEX ) CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF - ELSE IF ( WNTEX ) THEN - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL DGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & - W, LDW, ZERO, S, LDS ) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - LDS, ZERO, B, LDB ) - ! The above call replaces the following two calls - ! that were used in the developing-testing phase. - ! CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - ! LDS, ZERO, Z, LDZ) - ! Save a copy of Z into B and free Z for holding - ! the Ritz vectors. - ! CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF -! - ! Compute the real form of the Ritz vectors - IF ( WNTVEC ) CALL DGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & - ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC -! - IF ( WNTRES ) THEN - i = 1 - DO WHILE ( i <= K ) - IF ( IMEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL DAXPY( M, -REIG(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL - ! Y(1:M,i) = Y(1:M,i) - REIG(i) * Z(1:M,i) ! INTRINSIC - RES(i) = DNRM2( M, Y(1,i), 1) ! BLAS CALL - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IMEIG(i) - AB(1,2) = IMEIG(i) - AB(2,2) = REIG(i) - CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - LDZ, AB, 2, ONE, Y(1,i), LDY ) ! BLAS CALL - ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC - RES(i) = DLANGE( 'F', M, 2, Y(1,i), LDY, & - WORK(N+1) ) ! LAPACK CALL - RES(i+1) = RES(i) - i = i + 2 - END IF - END DO - END IF - END IF -! - IF ( WHTSVD == 4 ) THEN - WORK(N+1) = XSCL1 - WORK(N+2) = XSCL2 - END IF -! -! Successful exit. - IF ( .NOT. BADXY ) THEN - INFO = 0 - ELSE - ! A warning on possible data inconsistency. - ! This should be a rare event. - INFO = 4 - END IF -!............................................................ - RETURN -! ...... - END SUBROUTINE DGEDMD +!> \brief \b DGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & +! M, N, X, LDX, Y, LDY, NRNK, TOL, & +! K, REIG, IMEIG, Z, LDZ, RES, & +! B, LDB, W, LDW, S, LDS, & +! WORK, LWORK, IWORK, LIWORK, INFO ) +! +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real64 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & +! NRNK, LDZ, LDB, LDW, LDS, & +! LWORK, LIWORK +! INTEGER, INTENT(OUT) :: K, INFO +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) +! REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & +! W(LDW,*), S(LDS,*) +! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & +! RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> DGEDMD computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, DGEDMD computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, DGEDMD returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!...................................................................... +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) is CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product X(:,1:K)*W, where X +!> contains a POD basis (leading left singular vectors +!> of the data matrix X) and W contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of K, X, W, Z. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will be +!> computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: DGESVD (the QR SVD algorithm) +!> 2 :: DGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: DGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: DGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M>= 0 +!> The state space dimension (the row dimension of X, Y). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshot pairs +!> (the number of columns of X and Y). +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (input/output) REAL(KIND=WP) M-by-N array +!> > On entry, X contains the data snapshot matrix X. It is +!> assumed that the column norms of X are in the range of +!> the normalized floating point numbers. +!> < On exit, the leading K columns of X contain a POD basis, +!> i.e. the leading K left singular vectors of the input +!> data matrix X, U(:,1:K). All N columns of X contain all +!> left singular vectors of the input matrix X. +!> See the descriptions of K, Z and W. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= M +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (input/workspace/output) REAL(KIND=WP) M-by-N array +!> > On entry, Y contains the data snapshot matrix Y +!> < On exit, +!> If JOBR == 'R', the leading K columns of Y contain +!> the residual vectors for the computed Ritz pairs. +!> See the description of RES. +!> If JOBR == 'N', Y contains the original input data, +!> scaled according to the value of JOBS. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= M +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1). +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the descriptions of TOL and K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the POD basis for the data snapshot +!> matrix X and the number of the computed Ritz pairs. +!> The value of K is determined according to the rule set +!> by the parameters NRNK and TOL. +!> See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] REIG +!> \verbatim +!> REIG (output) REAL(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of REIG contain +!> the real parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> See the descriptions of K, IMEIG, and Z. +!> \endverbatim +!..... +!> \param[out] IMEIG +!> \verbatim +!> IMEIG (output) REAL(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of IMEIG contain +!> the imaginary parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> The eigenvalues are determined as follows: +!> If IMEIG(i) == 0, then the corresponding eigenvalue is +!> real, LAMBDA(i) = REIG(i). +!> If IMEIG(i)>0, then the corresponding complex +!> conjugate pair of eigenvalues reads +!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) +!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) +!> That is, complex conjugate pairs have consecutive +!> indices (i,i+1), with the positive imaginary part +!> listed first. +!> See the descriptions of K, REIG, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) REAL(KIND=WP) M-by-N array +!> If JOBZ =='V' then +!> Z contains real Ritz vectors as follows: +!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of +!> the i-th Ritz value; ||Z(:,i)||_2=1. +!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then +!> [Z(:,i) Z(:,i+1)] span an invariant subspace and +!> the Ritz values extracted from this subspace are +!> REIG(i) + sqrt(-1)*IMEIG(i) and +!> REIG(i) - sqrt(-1)*IMEIG(i). +!> The corresponding eigenvectors are +!> Z(:,i) + sqrt(-1)*Z(:,i+1) and +!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. +!> || Z(:,i:i+1)||_F = 1. +!> If JOBZ == 'F', then the above descriptions hold for +!> the columns of X(:,1:K)*W(1:K,1:K), where the columns +!> of W(1:k,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. The columns of W(1:K,1:K) +!> are similarly structured: If IMEIG(i) == 0 then +!> X(:,1:K)*W(:,i) is an eigenvector, and if IMEIG(i)>0 +!> then X(:,1:K)*W(:,i)+sqrt(-1)*X(:,1:K)*W(:,i+1) and +!> X(:,1:K)*W(:,i)-sqrt(-1)*X(:,1:K)*W(:,i+1) +!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). +!> See the descriptions of REIG, IMEIG, X and W. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) N-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs. +!> If LAMBDA(i) is real, then +!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. +!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair +!> then +!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F +!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] +!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. +!> It holds that +!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 +!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 +!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) +!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) +!> See the description of REIG, IMEIG and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) REAL(KIND=WP) M-by-N array. +!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:M,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> If JOBF =='N', then B is not referenced. +!> See the descriptions of X, W, K. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= M +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] W +!> \verbatim +!> W (workspace/output) REAL(KIND=WP) N-by-N array +!> On exit, W(1:K,1:K) contains the K computed +!> eigenvectors of the matrix Rayleigh quotient (real and +!> imaginary parts for each complex conjugate pair of the +!> eigenvalues). The Ritz vectors (returned in Z) are the +!> product of X (containing a POD basis for the input +!> matrix X) and W. See the descriptions of K, S, X and Z. +!> W is also used as a workspace to temporarily store the +!> right singular vectors of X. +!> \endverbatim +!..... +!> \param[in] LDW +!> \verbatim +!> LDW (input) INTEGER, LDW >= N +!> The leading dimension of the array W. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (workspace/output) REAL(KIND=WP) N-by-N array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by DGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, WORK(1:N) contains the singular values of +!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). +!> If WHTSVD==4, then WORK(N+1) and WORK(N+2) contain +!> scaling factor WORK(N+2)/WORK(N+1) used to scale X +!> and Y to avoid overflow in the SVD of X. +!> This may be of interest if the scaling option is off +!> and as many as possible smallest eigenvalues are +!> desired to the highest feasible accuracy. +!> If the call to DGEDMD is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. Hence, the +!> leng of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is calculated as follows: +!> If WHTSVD == 1 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)). +!> If JOBZ == 'N' then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)). +!> Here LWORK_SVD = MAX(1,3*N+M,5*N) is the minimal +!> workspace length of DGESVD. +!> If WHTSVD == 2 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)) +!> Here LWORK_SVD = MAX(M, 5*N*N+4*N)+3*N*N is the +!> minimal workspace length of DGESDD. +!> If WHTSVD == 3 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) +!> Here LWORK_SVD = N+M+MAX(3*N+1, +!> MAX(1,3*N+M,5*N),MAX(1,N)) +!> is the minimal workspace length of DGESVDQ. +!> If WHTSVD == 4 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) +!> Here LWORK_SVD = MAX(7,2*M+N,6*N+2*N*N) is the +!> minimal workspace length of DGEJSV. +!> The above expressions are not simplified in order to +!> make the usage of WORK more transparent, and for +!> easier checking. In any case, LWORK >= 2. +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. + SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, REIG, IMEIG, Z, LDZ, RES, & + B, LDB, W, LDW, S, LDS, & + WORK, LWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real64 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & + NRNK, LDZ, LDB, LDW, LDS, & + LWORK, LIWORK + INTEGER, INTENT(OUT) :: K, INFO + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) + REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & + W(LDW,*), S(LDS,*) + REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & + RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! +! Local scalars +! ~~~~~~~~~~~~~ + REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & + SSUM, XSCL1, XSCL2 + INTEGER :: i, j, IMINWR, INFO1, INFO2, & + LWRKEV, LWRSDD, LWRSVD, & + LWRSVQ, MLWORK, MWRKEV, MWRSDD, & + MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & + OLWORK + LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & + WNTEX, WNTREF, WNTRES, WNTVEC + CHARACTER :: JOBZL, T_OR_N + CHARACTER :: JSVOPT +! +! Local arrays +! ~~~~~~~~~~~~ + REAL(KIND=WP) :: AB(2,2), RDUMMY(2), RDUMMY2(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + REAL(KIND=WP) DLANGE, DLAMCH, DNRM2 + EXTERNAL DLANGE, DLAMCH, DNRM2, IDAMAX + INTEGER IDAMAX + LOGICAL DISNAN, LSAME + EXTERNAL DISNAN, LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL DAXPY, DGEMM, DSCAL + EXTERNAL DGEEV, DGEJSV, DGESDD, DGESVD, DGESVDQ, & + DLACPY, DLASCL, DLASSQ, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC DBLE, INT, MAX, SQRT +!............................................................ +! +! Test the input arguments +! + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + INFO = 0 + LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & + .OR. LSAME(JOBZ,'F')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -4 + ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & + (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN + INFO = -5 + ELSE IF ( M < 0 ) THEN + INFO = -6 + ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN + INFO = -7 + ELSE IF ( LDX < M ) THEN + INFO = -9 + ELSE IF ( LDY < M ) THEN + INFO = -11 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -12 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -13 + ELSE IF ( LDZ < M ) THEN + INFO = -18 + ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN + INFO = -21 + ELSE IF ( LDW < N ) THEN + INFO = -23 + ELSE IF ( LDS < N ) THEN + INFO = -25 + END IF +! + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( N == 0 ) THEN + ! Quick return. All output except K is void. + ! INFO=1 signals the void input. + ! In case of a workspace query, the default + ! minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + MLWORK = MAX(2,N) + OLWORK = MAX(2,N) + IMINWR = 1 + SELECT CASE ( WHTSVD ) + CASE (1) + ! The following is specified as the minimal + ! length of WORK in the definition of DGESVD: + ! MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + MLWORK = MAX(MLWORK,N + MWRSVD) + IF ( LQUERY ) THEN + CALL DGESVD( 'O', 'S', M, N, X, LDX, WORK, & + B, LDB, W, LDW, RDUMMY, -1, INFO1 ) + LWRSVD = MAX( MWRSVD, INT( RDUMMY(1) ) ) + OLWORK = MAX(OLWORK,N + LWRSVD) + END IF + CASE (2) + ! The following is specified as the minimal + ! length of WORK in the definition of DGESDD: + ! MWRSDD = 3*MIN(M,N)*MIN(M,N) + + ! MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) + ! IMINWR = 8*MIN(M,N) + MWRSDD = 3*MIN(M,N)*MIN(M,N) + & + MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) + MLWORK = MAX(MLWORK,N + MWRSDD) + IMINWR = 8*MIN(M,N) + IF ( LQUERY ) THEN + CALL DGESDD( 'O', M, N, X, LDX, WORK, B, & + LDB, W, LDW, RDUMMY, -1, IWORK, INFO1 ) + LWRSDD = MAX( MWRSDD, INT( RDUMMY(1) ) ) + OLWORK = MAX(OLWORK,N + LWRSDD) + END IF + CASE (3) + !LWQP3 = 3*N+1 + !LWORQ = MAX(N, 1) + !MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + !MWRSVQ = N + MAX( LWQP3, MWRSVD, LWORQ ) + MAX(M,2) + !MLWORK = N + MWRSVQ + !IMINWR = M+N-1 + CALL DGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, WORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, LIWORK, RDUMMY, & + -1, RDUMMY2, -1, INFO1 ) + IMINWR = IWORK(1) + MWRSVQ = INT(RDUMMY(2)) + MLWORK = MAX(MLWORK,N+MWRSVQ+INT(RDUMMY2(1))) + IF ( LQUERY ) THEN + LWRSVQ = MAX( MWRSVQ, INT(RDUMMY(1)) ) + OLWORK = MAX(OLWORK,N+LWRSVQ+INT(RDUMMY2(1))) + END IF + CASE (4) + JSVOPT = 'J' + !MWRSVJ = MAX( 7, 2*M+N, 6*N+2*N*N ) ! for JSVOPT='V' + MWRSVJ = MAX( 7, 2*M+N, 4*N+N*N, 2*N+N*N+6 ) + MLWORK = MAX(MLWORK,N+MWRSVJ) + IMINWR = MAX( 3, M+3*N ) + IF ( LQUERY ) THEN + OLWORK = MAX(OLWORK,N+MWRSVJ) + END IF + END SELECT + IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN + JOBZL = 'V' + ELSE + JOBZL = 'N' + END IF + ! Workspace calculation to the DGEEV call + IF ( LSAME(JOBZL,'V') ) THEN + MWRKEV = MAX( 1, 4*N ) + ELSE + MWRKEV = MAX( 1, 3*N ) + END IF + MLWORK = MAX(MLWORK,N+MWRKEV) + IF ( LQUERY ) THEN + CALL DGEEV( 'N', JOBZL, N, S, LDS, REIG, & + IMEIG, W, LDW, W, LDW, RDUMMY, -1, INFO1 ) + LWRKEV = MAX( MWRKEV, INT(RDUMMY(1)) ) + OLWORK = MAX( OLWORK, N+LWRKEV ) + END IF +! + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -29 + IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -27 + END IF +! + IF( INFO /= 0 ) THEN + CALL XERBLA( 'DGEDMD', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + WORK(1) = MLWORK + WORK(2) = OLWORK + RETURN + END IF +!............................................................ +! + OFL = DLAMCH('O') + SMALL = DLAMCH('S') + BADXY = .FALSE. +! +! <1> Optional scaling of the snapshots (columns of X, Y) +! ========================================================== + IF ( SCCOLX ) THEN + ! The columns of X will be normalized. + ! To prevent overflows, the column norms of X are + ! carefully computed using DLASSQ. + K = 0 + DO i = 1, N + !WORK(i) = DNRM2( M, X(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL DLASSQ( M, X(1,i), 1, SCALE, SSUM ) + IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN + K = 0 + INFO = -8 + CALL XERBLA('DGEDMD',-INFO) + END IF + IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of X(:,i) overflows. First, X(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. +! Next, the norm of X(:,i) is stored without +! overflow as WORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of X(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL DLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, X(1,i), M, INFO2 ) + WORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + WORK(i) = SCALE * ROOTSC + CALL DLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & + X(1,i), M, INFO2 ) ! LAPACK CALL +! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC + END IF + ELSE + WORK(i) = ZERO + K = K + 1 + END IF + END DO + IF ( K == N ) THEN + ! All columns of X are zero. Return error code -8. + ! (the 8th input variable had an illegal value) + K = 0 + INFO = -8 + CALL XERBLA('DGEDMD',-INFO) + RETURN + END IF + DO i = 1, N +! Now, apply the same scaling to the columns of Y. + IF ( WORK(i) > ZERO ) THEN + CALL DSCAL( M, ONE/WORK(i), Y(1,i), 1 ) ! BLAS CALL +! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC + ELSE IF ( WORK(i) < ZERO ) THEN + CALL DLASCL( 'G', 0, 0, -WORK(i), & + ONE/DBLE(M), M, 1, Y(1,i), M, INFO2 ) ! LAPACK CALL + ELSE IF ( Y(IDAMAX(M, Y(1,i),1),i ) & + /= ZERO ) THEN +! X(:,i) is zero vector. For consistency, +! Y(:,i) should also be zero. If Y(:,i) is not +! zero, then the data might be inconsistent or +! corrupted. If JOBS == 'C', Y(:,i) is set to +! zero and a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + IF ( LSAME(JOBS,'C')) & + CALL DSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL + END IF + END DO + END IF + ! + IF ( SCCOLY ) THEN + ! The columns of Y will be normalized. + ! To prevent overflows, the column norms of Y are + ! carefully computed using DLASSQ. + DO i = 1, N + !WORK(i) = DNRM2( M, Y(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL DLASSQ( M, Y(1,i), 1, SCALE, SSUM ) + IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN + K = 0 + INFO = -10 + CALL XERBLA('DGEDMD',-INFO) + END IF + IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of Y(:,i) overflows. First, Y(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. +! Next, the norm of Y(:,i) is stored without +! overflow as WORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of Y(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL DLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, Y(1,i), M, INFO2 ) + WORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + WORK(i) = SCALE * ROOTSC + CALL DLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & + Y(1,i), M, INFO2 ) ! LAPACK CALL +! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC + END IF + ELSE + WORK(i) = ZERO + END IF + END DO + DO i = 1, N +! Now, apply the same scaling to the columns of X. + IF ( WORK(i) > ZERO ) THEN + CALL DSCAL( M, ONE/WORK(i), X(1,i), 1 ) ! BLAS CALL +! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC + ELSE IF ( WORK(i) < ZERO ) THEN + CALL DLASCL( 'G', 0, 0, -WORK(i), & + ONE/DBLE(M), M, 1, X(1,i), M, INFO2 ) ! LAPACK CALL + ELSE IF ( X(IDAMAX(M, X(1,i),1),i ) & + /= ZERO ) THEN +! Y(:,i) is zero vector. If X(:,i) is not +! zero, then a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + END IF + END DO + END IF +! +! <2> SVD of the data snapshot matrix X. +! ===================================== +! The left singular vectors are stored in the array X. +! The right singular vectors are in the array W. +! The array W will later on contain the eigenvectors +! of a Rayleigh quotient. + NUMRNK = N + SELECT CASE ( WHTSVD ) + CASE (1) + CALL DGESVD( 'O', 'S', M, N, X, LDX, WORK, B, & + LDB, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL + T_OR_N = 'T' + CASE (2) + CALL DGESDD( 'O', M, N, X, LDX, WORK, B, LDB, W, & + LDW, WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL + T_OR_N = 'T' + CASE (3) + CALL DGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, WORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, LIWORK, WORK(N+MAX(2,M)+1),& + LWORK-N-MAX(2,M), WORK(N+1), MAX(2,M), INFO1) ! LAPACK CALL + CALL DLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'T' + CASE (4) + CALL DGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & + N, X, LDX, WORK, Z, LDZ, W, LDW, & + WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL + CALL DLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'N' + XSCL1 = WORK(N+1) + XSCL2 = WORK(N+2) + IF ( XSCL1 /= XSCL2 ) THEN + ! This is an exceptional situation. If the + ! data matrices are not scaled and the + ! largest singular value of X overflows. + ! In that case DGEJSV can return the SVD + ! in scaled form. The scaling factor can be used + ! to rescale the data (X and Y). + CALL DLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) + END IF + END SELECT +! + IF ( INFO1 > 0 ) THEN + ! The SVD selected subroutine did not converge. + ! Return with an error code. + INFO = 2 + RETURN + END IF +! + IF ( WORK(1) == ZERO ) THEN + ! The largest computed singular value of (scaled) + ! X is zero. Return error code -8 + ! (the 8th input variable had an illegal value). + K = 0 + INFO = -8 + CALL XERBLA('DGEDMD',-INFO) + RETURN + END IF +! + !<3> Determine the numerical rank of the data + ! snapshots matrix X. This depends on the + ! parameters NRNK and TOL. + + SELECT CASE ( NRNK ) + CASE ( -1 ) + K = 1 + DO i = 2, NUMRNK + IF ( ( WORK(i) <= WORK(1)*TOL ) .OR. & + ( WORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE ( -2 ) + K = 1 + DO i = 1, NUMRNK-1 + IF ( ( WORK(i+1) <= WORK(i)*TOL ) .OR. & + ( WORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE DEFAULT + K = 1 + DO i = 2, NRNK + IF ( WORK(i) <= SMALL ) EXIT + K = K + 1 + END DO + END SELECT + ! Now, U = X(1:M,1:K) is the SVD/POD basis for the + ! snapshot data in the input matrix X. + + !<4> Compute the Rayleigh quotient S = U^T * A * U. + ! Depending on the requested outputs, the computation + ! is organized to compute additional auxiliary + ! matrices (for the residuals and refinements). + ! + ! In all formulas below, we need V_k*Sigma_k^(-1) + ! where either V_k is in W(1:N,1:K), or V_k^T is in + ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). + IF ( LSAME(T_OR_N, 'N') ) THEN + DO i = 1, K + CALL DSCAL( N, ONE/WORK(i), W(1,i), 1 ) ! BLAS CALL + ! W(1:N,i) = (ONE/WORK(i)) * W(1:N,i) ! INTRINSIC + END DO + ELSE + ! This non-unit stride access is due to the fact + ! that DGESVD, DGESVDQ and DGESDD return the + ! transposed matrix of the right singular vectors. + !DO i = 1, K + ! CALL DSCAL( N, ONE/WORK(i), W(i,1), LDW ) ! BLAS CALL + ! ! W(i,1:N) = (ONE/WORK(i)) * W(i,1:N) ! INTRINSIC + !END DO + DO i = 1, K + WORK(N+i) = ONE/WORK(i) + END DO + DO j = 1, N + DO i = 1, K + W(i,j) = (WORK(N+i))*W(i,j) + END DO + END DO + END IF +! + IF ( WNTREF ) THEN + ! + ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) + ! for computing the refined Ritz vectors + ! (optionally, outside DGEDMD). + CALL DGEMM( 'N', T_OR_N, M, K, N, ONE, Y, LDY, W, & + LDW, ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' + ! + ! At this point Z contains + ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and + ! this is needed for computing the residuals. + ! This matrix is returned in the array B and + ! it can be used to compute refined Ritz vectors. + CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL + ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC + + CALL DGEMM( 'T', 'N', K, K, M, ONE, X, LDX, Z, & + LDZ, ZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC + ! At this point S = U^T * A * U is the Rayleigh quotient. + ELSE + ! A * U(:,1:K) is not explicitly needed and the + ! computation is organized differently. The Rayleigh + ! quotient is computed more efficiently. + CALL DGEMM( 'T', 'N', K, N, M, ONE, X, LDX, Y, LDY, & + ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC + ! In the two DGEMM calls here, can use K for LDZ. + CALL DGEMM( 'N', T_OR_N, K, K, N, ONE, Z, LDZ, W, & + LDW, ZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' + ! At this point S = U^T * A * U is the Rayleigh quotient. + ! If the residuals are requested, save scaled V_k into Z. + ! Recall that V_k or V_k^T is stored in W. + IF ( WNTRES .OR. WNTEX ) THEN + IF ( LSAME(T_OR_N, 'N') ) THEN + CALL DLACPY( 'A', N, K, W, LDW, Z, LDZ ) + ELSE + CALL DLACPY( 'A', K, N, W, LDW, Z, LDZ ) + END IF + END IF + END IF +! + !<5> Compute the Ritz values and (if requested) the + ! right eigenvectors of the Rayleigh quotient. + ! + CALL DGEEV( 'N', JOBZL, K, S, LDS, REIG, IMEIG, W, & + LDW, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL + ! + ! W(1:K,1:K) contains the eigenvectors of the Rayleigh + ! quotient. Even in the case of complex spectrum, all + ! computation is done in real arithmetic. REIG and + ! IMEIG are the real and the imaginary parts of the + ! eigenvalues, so that the spectrum is given as + ! REIG(:) + sqrt(-1)*IMEIG(:). Complex conjugate pairs + ! are listed at consecutive positions. For such a + ! complex conjugate pair of the eigenvalues, the + ! corresponding eigenvectors are also a complex + ! conjugate pair with the real and imaginary parts + ! stored column-wise in W at the corresponding + ! consecutive column indices. See the description of Z. + ! Also, see the description of DGEEV. + IF ( INFO1 > 0 ) THEN + ! DGEEV failed to compute the eigenvalues and + ! eigenvectors of the Rayleigh quotient. + INFO = 3 + RETURN + END IF +! + ! <6> Compute the eigenvectors (if requested) and, + ! the residuals (if requested). + ! + IF ( WNTVEC .OR. WNTEX ) THEN + IF ( WNTRES ) THEN + IF ( WNTREF ) THEN + ! Here, if the refinement is requested, we have + ! A*U(:,1:K) already computed and stored in Z. + ! For the residuals, need Y = A * U(:,1;K) * W. + CALL DGEMM( 'N', 'N', M, K, K, ONE, Z, LDZ, W, & + LDW, ZERO, Y, LDY ) ! BLAS CALL + ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC + ! This frees Z; Y contains A * U(:,1:K) * W. + ELSE + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL DGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & + W, LDW, ZERO, S, LDS) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + LDS, ZERO, Z, LDZ) + ! Save a copy of Z into Y and free Z for holding + ! the Ritz vectors. + CALL DLACPY( 'A', M, K, Z, LDZ, Y, LDY ) + IF ( WNTEX ) CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF + ELSE IF ( WNTEX ) THEN + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL DGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & + W, LDW, ZERO, S, LDS ) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + LDS, ZERO, B, LDB ) + ! The above call replaces the following two calls + ! that were used in the developing-testing phase. + ! CALL DGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + ! LDS, ZERO, Z, LDZ) + ! Save a copy of Z into B and free Z for holding + ! the Ritz vectors. + ! CALL DLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF +! + ! Compute the real form of the Ritz vectors + IF ( WNTVEC ) CALL DGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & + ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC +! + IF ( WNTRES ) THEN + i = 1 + DO WHILE ( i <= K ) + IF ( IMEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL DAXPY( M, -REIG(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL + ! Y(1:M,i) = Y(1:M,i) - REIG(i) * Z(1:M,i) ! INTRINSIC + RES(i) = DNRM2( M, Y(1,i), 1) ! BLAS CALL + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IMEIG(i) + AB(1,2) = IMEIG(i) + AB(2,2) = REIG(i) + CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + LDZ, AB, 2, ONE, Y(1,i), LDY ) ! BLAS CALL + ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC + RES(i) = DLANGE( 'F', M, 2, Y(1,i), LDY, & + WORK(N+1) ) ! LAPACK CALL + RES(i+1) = RES(i) + i = i + 2 + END IF + END DO + END IF + END IF +! + IF ( WHTSVD == 4 ) THEN + WORK(N+1) = XSCL1 + WORK(N+2) = XSCL2 + END IF +! +! Successful exit. + IF ( .NOT. BADXY ) THEN + INFO = 0 + ELSE + ! A warning on possible data inconsistency. + ! This should be a rare event. + INFO = 4 + END IF +!............................................................ + RETURN +! ...... + END SUBROUTINE DGEDMD diff --git a/SRC/dgedmdq.f90 b/SRC/dgedmdq.f90 index 2bf939f489..b1fb62b44a 100644 --- a/SRC/dgedmdq.f90 +++ b/SRC/dgedmdq.f90 @@ -1,864 +1,863 @@ -!> \brief \b DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE DGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & -! WHTSVD, M, N, F, LDF, X, LDX, Y, & -! LDY, NRNK, TOL, K, REIG, IMEIG, & -! Z, LDZ, RES, B, LDB, V, LDV, & -! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real64 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & -! JOBT, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & -! LDY, NRNK, LDZ, LDB, LDV, & -! LDS, LWORK, LIWORK -! INTEGER, INTENT(OUT) :: INFO, K -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) -! REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & -! Z(LDZ,*), B(LDB,*), & -! V(LDV,*), S(LDS,*) -! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & -! RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices, using a QR factorization -!> based compression of the data. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, DGEDMDQ computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, DGEDMDQ returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office. -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!...................................................................... -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. The data snapshots are the columns -!> of F. The leading N-1 columns of F are denoted X and the -!> trailing N-1 columns are denoted Y. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Z*V, where Z -!> is orthonormal and V contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of F, V, Z. -!> 'Q' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Q*Z, where Z -!> contains the eigenvectors of the compression of the -!> underlying discretized operator onto the span of -!> the data snapshots. See the descriptions of F, V, Z. -!> Q is from the initial QR factorization. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will -!> be computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBQ -!> \verbatim -!> JOBQ (input) CHARACTER*1 -!> Specifies whether to explicitly compute and return the -!> orthogonal matrix from the QR factorization. -!> 'Q' :: The matrix Q of the QR factorization of the data -!> snapshot matrix is computed and stored in the -!> array F. See the description of F. -!> 'N' :: The matrix Q is not explicitly computed. -!> \endverbatim -!..... -!> \param[in] JOBT -!> \verbatim -!> JOBT (input) CHARACTER*1 -!> Specifies whether to return the upper triangular factor -!> from the QR factorization. -!> 'R' :: The matrix R of the QR factorization of the data -!> snapshot matrix F is returned in the array Y. -!> See the description of Y and Further details. -!> 'N' :: The matrix R is not returned. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> To be useful on exit, this option needs JOBQ='Q'. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: DGESVD (the QR SVD algorithm) -!> 2 :: DGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: DGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: DGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M >= 0 -!> The state space dimension (the number of rows of F). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshots from a single trajectory, -!> taken at equidistant discrete times. This is the -!> number of columns of F. -!> \endverbatim -!..... -!> \param[in,out] F -!> \verbatim -!> F (input/output) REAL(KIND=WP) M-by-N array -!> > On entry, -!> the columns of F are the sequence of data snapshots -!> from a single trajectory, taken at equidistant discrete -!> times. It is assumed that the column norms of F are -!> in the range of the normalized floating point numbers. -!> < On exit, -!> If JOBQ == 'Q', the array F contains the orthogonal -!> matrix/factor of the QR factorization of the initial -!> data snapshots matrix F. See the description of JOBQ. -!> If JOBQ == 'N', the entries in F strictly below the main -!> diagonal contain, column-wise, the information on the -!> Householder vectors, as returned by DGEQRF. The -!> remaining information to restore the orthogonal matrix -!> of the initial QR factorization is stored in WORK(1:N). -!> See the description of WORK. -!> \endverbatim -!..... -!> \param[in] LDF -!> \verbatim -!> LDF (input) INTEGER, LDF >= M -!> The leading dimension of the array F. -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array -!> X is used as workspace to hold representations of the -!> leading N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, the leading K columns of X contain the leading -!> K left singular vectors of the above described content -!> of X. To lift them to the space of the left singular -!> vectors U(:,1:K)of the input data, pre-multiply with the -!> Q factor from the initial QR factorization. -!> See the descriptions of F, K, V and Z. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= N -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array -!> Y is used as workspace to hold representations of the -!> trailing N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, -!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper -!> triangular factor from the QR factorization of the data -!> snapshot matrix F. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= N -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N-1 :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the description of K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the SVD/POD basis for the leading N-1 -!> data snapshots (columns of F) and the number of the -!> computed Ritz pairs. The value of K is determined -!> according to the rule set by the parameters NRNK and -!> TOL. See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] REIG -!> \verbatim -!> REIG (output) REAL(KIND=WP) (N-1)-by-1 array -!> The leading K (K<=N) entries of REIG contain -!> the real parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> See the descriptions of K, IMEIG, Z. -!> \endverbatim -!..... -!> \param[out] IMEIG -!> \verbatim -!> IMEIG (output) REAL(KIND=WP) (N-1)-by-1 array -!> The leading K (K the imaginary parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> The eigenvalues are determined as follows: -!> If IMEIG(i) == 0, then the corresponding eigenvalue is -!> real, LAMBDA(i) = REIG(i). -!> If IMEIG(i)>0, then the corresponding complex -!> conjugate pair of eigenvalues reads -!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) -!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) -!> That is, complex conjugate pairs have consequtive -!> indices (i,i+1), with the positive imaginary part -!> listed first. -!> See the descriptions of K, REIG, Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) REAL(KIND=WP) M-by-(N-1) array -!> If JOBZ =='V' then -!> Z contains real Ritz vectors as follows: -!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of -!> the i-th Ritz value. -!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then -!> [Z(:,i) Z(:,i+1)] span an invariant subspace and -!> the Ritz values extracted from this subspace are -!> REIG(i) + sqrt(-1)*IMEIG(i) and -!> REIG(i) - sqrt(-1)*IMEIG(i). -!> The corresponding eigenvectors are -!> Z(:,i) + sqrt(-1)*Z(:,i+1) and -!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. -!> If JOBZ == 'F', then the above descriptions hold for -!> the columns of Z*V, where the columns of V are the -!> eigenvectors of the K-by-K Rayleigh quotient, and Z is -!> orthonormal. The columns of V are similarly structured: -!> If IMEIG(i) == 0 then Z*V(:,i) is an eigenvector, and if -!> IMEIG(i) > 0 then Z*V(:,i)+sqrt(-1)*Z*V(:,i+1) and -!> Z*V(:,i)-sqrt(-1)*Z*V(:,i+1) -!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). -!> See the descriptions of REIG, IMEIG, X and V. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) (N-1)-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs. -!> If LAMBDA(i) is real, then -!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. -!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair -!> then -!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F -!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] -!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. -!> It holds that -!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 -!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 -!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) -!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) -!> See the description of Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array. -!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:N,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> In both cases, the content of B can be lifted to the -!> original dimension of the input data by pre-multiplying -!> with the Q factor from the initial QR factorization. -!> Here A denotes a compression of the underlying operator. -!> See the descriptions of F and X. -!> If JOBF =='N', then B is not referenced. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= MIN(M,N) -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] V -!> \verbatim -!> V (workspace/output) REAL(KIND=WP) (N-1)-by-(N-1) array -!> On exit, V(1:K,1:K) contains the K eigenvectors of -!> the Rayleigh quotient. The eigenvectors of a complex -!> conjugate pair of eigenvalues are returned in real form -!> as explained in the description of Z. The Ritz vectors -!> (returned in Z) are the product of X and V; see -!> the descriptions of X and Z. -!> \endverbatim -!..... -!> \param[in] LDV -!> \verbatim -!> LDV (input) INTEGER, LDV >= N-1 -!> The leading dimension of the array V. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (output) REAL(KIND=WP) (N-1)-by-(N-1) array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by DGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N-1 -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, -!> WORK(1:MIN(M,N)) contains the scalar factors of the -!> elementary reflectors as returned by DGEQRF of the -!> M-by-N input matrix F. -!> WORK(MIN(M,N)+1:MIN(M,N)+N-1) contains the singular values of -!> the input submatrix F(1:M,1:N-1). -!> If the call to DGEDMDQ is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. Hence, the -!> length of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is calculated as follows: -!> Let MLWQR = N (minimal workspace for DGEQRF[M,N]) -!> MLWDMD = minimal workspace for DGEDMD (see the -!> description of LWORK in DGEDMD) for -!> snapshots of dimensions MIN(M,N)-by-(N-1) -!> MLWMQR = N (minimal workspace for -!> DORMQR['L','N',M,N,N]) -!> MLWGQR = N (minimal workspace for DORGQR[M,N,N]) -!> Then -!> LWORK = MAX(N+MLWQR, N+MLWDMD) -!> is updated as follows: -!> if JOBZ == 'V' or JOBZ == 'F' THEN -!> LWORK = MAX( LWORK, MIN(M,N)+N-1+MLWMQR ) -!> if JOBQ == 'Q' THEN -!> LWORK = MAX( LWORK, MIN(M,N)+N-1+MLWGQR) -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> Let M1=MIN(M,N), N1=N-1. Then -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. -SUBROUTINE DGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & - WHTSVD, M, N, F, LDF, X, LDX, Y, & - LDY, NRNK, TOL, K, REIG, IMEIG, & - Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real64 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & - JOBT, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & - LDY, NRNK, LDZ, LDB, LDV, & - LDS, LWORK, LIWORK - INTEGER, INTENT(OUT) :: INFO, K - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) - REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & - Z(LDZ,*), B(LDB,*), & - V(LDV,*), S(LDS,*) - REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & - RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! -! Local scalars -! ~~~~~~~~~~~~~ - INTEGER :: IMINWR, INFO1, MLWDMD, MLWGQR, & - MLWMQR, MLWORK, MLWQR, MINMN, & - OLWDMD, OLWGQR, OLWMQR, OLWORK, & - OLWQR - LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & - WNTTRF, WNTRES, WNTVEC, WNTVCF, & - WNTVCQ, WNTREF, WNTEX - CHARACTER(LEN=1) :: JOBVL -! -! Local array -! ~~~~~~~~~~~ - REAL(KIND=WP) :: RDUMMY(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - LOGICAL LSAME - EXTERNAL LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL DGEMM - EXTERNAL DGEDMD, DGEQRF, DLACPY, DLASET, DORGQR, & - DORMQR, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC MAX, MIN, INT - !.......................................................... - ! - ! Test the input arguments - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTVCF = LSAME(JOBZ,'F') - WNTVCQ = LSAME(JOBZ,'Q') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - WANTQ = LSAME(JOBQ,'Q') - WNTTRF = LSAME(JOBT,'R') - MINMN = MIN(M,N) - INFO = 0 - LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & - .OR. LSAME(JOBZ,'N')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN - INFO = -4 - ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN - INFO = -5 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -6 - ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & - (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN - INFO = -7 - ELSE IF ( M < 0 ) THEN - INFO = -8 - ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN - INFO = -9 - ELSE IF ( LDF < M ) THEN - INFO = -11 - ELSE IF ( LDX < MINMN ) THEN - INFO = -13 - ELSE IF ( LDY < MINMN ) THEN - INFO = -15 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -16 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -17 - ELSE IF ( LDZ < M ) THEN - INFO = -22 - ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN - INFO = -25 - ELSE IF ( LDV < N-1 ) THEN - INFO = -27 - ELSE IF ( LDS < N-1 ) THEN - INFO = -29 - END IF -! - IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN - JOBVL = 'V' - ELSE - JOBVL = 'N' - END IF - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN - ! All output except K is void. INFO=1 signals - ! the void input. In case of a workspace query, - ! the minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - MLWQR = MAX(1,N) ! Minimal workspace length for DGEQRF. - MLWORK = MINMN + MLWQR - IF ( LQUERY ) THEN - CALL DGEQRF( M, N, F, LDF, WORK, RDUMMY, -1, & - INFO1 ) - OLWQR = INT(RDUMMY(1)) - OLWORK = MIN(M,N) + OLWQR - END IF - CALL DGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - REIG, IMEIG, Z, LDZ, RES, B, LDB, & - V, LDV, S, LDS, WORK, -1, IWORK, & - LIWORK, INFO1 ) - MLWDMD = INT(WORK(1)) - MLWORK = MAX(MLWORK, MINMN + MLWDMD) - IMINWR = IWORK(1) - IF ( LQUERY ) THEN - OLWDMD = INT(WORK(2)) - OLWORK = MAX(OLWORK, MINMN+OLWDMD) - END IF - IF ( WNTVEC .OR. WNTVCF ) THEN - MLWMQR = MAX(1,N) - MLWORK = MAX(MLWORK,MINMN+N-1+MLWMQR) - IF ( LQUERY ) THEN - CALL DORMQR( 'L','N', M, N, MINMN, F, LDF, & - WORK, Z, LDZ, WORK, -1, INFO1 ) - OLWMQR = INT(WORK(1)) - OLWORK = MAX(OLWORK,MINMN+N-1+OLWMQR) - END IF - END IF - IF ( WANTQ ) THEN - MLWGQR = N - MLWORK = MAX(MLWORK,MINMN+N-1+MLWGQR) - IF ( LQUERY ) THEN - CALL DORGQR( M, MINMN, MINMN, F, LDF, WORK, & - WORK, -1, INFO1 ) - OLWGQR = INT(WORK(1)) - OLWORK = MAX(OLWORK,MINMN+N-1+OLWGQR) - END IF - END IF - IMINWR = MAX( 1, IMINWR ) - MLWORK = MAX( 2, MLWORK ) - IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -31 - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -33 - END IF - IF( INFO /= 0 ) THEN - CALL XERBLA( 'DGEDMDQ', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK - RETURN - END IF -!..... -! Initial QR factorization that is used to represent the -! snapshots as elements of lower dimensional subspace. -! For large scale computation with M >>N , at this place -! one can use an out of core QRF. -! - CALL DGEQRF( M, N, F, LDF, WORK, & - WORK(MINMN+1), LWORK-MINMN, INFO1 ) -! -! Define X and Y as the snapshots representations in the -! orthogonal basis computed in the QR factorization. -! X corresponds to the leading N-1 and Y to the trailing -! N-1 snapshots. - CALL DLASET( 'L', MINMN, N-1, ZERO, ZERO, X, LDX ) - CALL DLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) - CALL DLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) - IF ( M >= 3 ) THEN - CALL DLASET( 'L', MINMN-2, N-2, ZERO, ZERO, & - Y(3,1), LDY ) - END IF -! -! Compute the DMD of the projected snapshot pairs (X,Y) - CALL DGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - REIG, IMEIG, Z, LDZ, RES, B, LDB, V, & - LDV, S, LDS, WORK(MINMN+1), LWORK-MINMN, & - IWORK, LIWORK, INFO1 ) - IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN - ! Return with error code. See DGEDMD for details. - INFO = INFO1 - RETURN - ELSE - INFO = INFO1 - END IF -! -! The Ritz vectors (Koopman modes) can be explicitly -! formed or returned in factored form. - IF ( WNTVEC ) THEN - ! Compute the eigenvectors explicitly. - IF ( M > MINMN ) CALL DLASET( 'A', M-MINMN, K, ZERO, & - ZERO, Z(MINMN+1,1), LDZ ) - CALL DORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & - LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - ELSE IF ( WNTVCF ) THEN - ! Return the Ritz vectors (eigenvectors) in factored - ! form Z*V, where Z contains orthonormal matrix (the - ! product of Q from the initial QR factorization and - ! the SVD/POD_basis returned by DGEDMD in X) and the - ! second factor (the eigenvectors of the Rayleigh - ! quotient) is in the array V, as returned by DGEDMD. - CALL DLACPY( 'A', N, K, X, LDX, Z, LDZ ) - IF ( M > N ) CALL DLASET( 'A', M-N, K, ZERO, ZERO, & - Z(N+1,1), LDZ ) - CALL DORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & - LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - END IF -! -! Some optional output variables: -! -! The upper triangular factor R in the initial QR -! factorization is optionally returned in the array Y. -! This is useful if this call to DGEDMDQ is to be -! followed by a streaming DMD that is implemented in a -! QR compressed form. - IF ( WNTTRF ) THEN ! Return the upper triangular R in Y - CALL DLASET( 'A', MINMN, N, ZERO, ZERO, Y, LDY ) - CALL DLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) - END IF -! -! The orthonormal/orthogonal factor Q in the initial QR -! factorization is optionally returned in the array F. -! Same as with the triangular factor above, this is -! useful in a streaming DMD. - IF ( WANTQ ) THEN ! Q overwrites F - CALL DORGQR( M, MINMN, MINMN, F, LDF, WORK, & - WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - END IF -! - RETURN -! - END SUBROUTINE DGEDMDQ - +!> \brief \b DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE DGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & +! WHTSVD, M, N, F, LDF, X, LDX, Y, & +! LDY, NRNK, TOL, K, REIG, IMEIG, & +! Z, LDZ, RES, B, LDB, V, LDV, & +! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real64 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & +! JOBT, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & +! LDY, NRNK, LDZ, LDB, LDV, & +! LDS, LWORK, LIWORK +! INTEGER, INTENT(OUT) :: INFO, K +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) +! REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & +! Z(LDZ,*), B(LDB,*), & +! V(LDV,*), S(LDS,*) +! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & +! RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices, using a QR factorization +!> based compression of the data. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, DGEDMDQ computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, DGEDMDQ returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office. +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!...................................................................... +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. The data snapshots are the columns +!> of F. The leading N-1 columns of F are denoted X and the +!> trailing N-1 columns are denoted Y. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Z*V, where Z +!> is orthonormal and V contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of F, V, Z. +!> 'Q' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Q*Z, where Z +!> contains the eigenvectors of the compression of the +!> underlying discretized operator onto the span of +!> the data snapshots. See the descriptions of F, V, Z. +!> Q is from the initial QR factorization. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will +!> be computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBQ +!> \verbatim +!> JOBQ (input) CHARACTER*1 +!> Specifies whether to explicitly compute and return the +!> orthogonal matrix from the QR factorization. +!> 'Q' :: The matrix Q of the QR factorization of the data +!> snapshot matrix is computed and stored in the +!> array F. See the description of F. +!> 'N' :: The matrix Q is not explicitly computed. +!> \endverbatim +!..... +!> \param[in] JOBT +!> \verbatim +!> JOBT (input) CHARACTER*1 +!> Specifies whether to return the upper triangular factor +!> from the QR factorization. +!> 'R' :: The matrix R of the QR factorization of the data +!> snapshot matrix F is returned in the array Y. +!> See the description of Y and Further details. +!> 'N' :: The matrix R is not returned. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> To be useful on exit, this option needs JOBQ='Q'. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: DGESVD (the QR SVD algorithm) +!> 2 :: DGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: DGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: DGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M >= 0 +!> The state space dimension (the number of rows of F). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshots from a single trajectory, +!> taken at equidistant discrete times. This is the +!> number of columns of F. +!> \endverbatim +!..... +!> \param[in,out] F +!> \verbatim +!> F (input/output) REAL(KIND=WP) M-by-N array +!> > On entry, +!> the columns of F are the sequence of data snapshots +!> from a single trajectory, taken at equidistant discrete +!> times. It is assumed that the column norms of F are +!> in the range of the normalized floating point numbers. +!> < On exit, +!> If JOBQ == 'Q', the array F contains the orthogonal +!> matrix/factor of the QR factorization of the initial +!> data snapshots matrix F. See the description of JOBQ. +!> If JOBQ == 'N', the entries in F strictly below the main +!> diagonal contain, column-wise, the information on the +!> Householder vectors, as returned by DGEQRF. The +!> remaining information to restore the orthogonal matrix +!> of the initial QR factorization is stored in WORK(1:N). +!> See the description of WORK. +!> \endverbatim +!..... +!> \param[in] LDF +!> \verbatim +!> LDF (input) INTEGER, LDF >= M +!> The leading dimension of the array F. +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array +!> X is used as workspace to hold representations of the +!> leading N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, the leading K columns of X contain the leading +!> K left singular vectors of the above described content +!> of X. To lift them to the space of the left singular +!> vectors U(:,1:K)of the input data, pre-multiply with the +!> Q factor from the initial QR factorization. +!> See the descriptions of F, K, V and Z. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= N +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array +!> Y is used as workspace to hold representations of the +!> trailing N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, +!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper +!> triangular factor from the QR factorization of the data +!> snapshot matrix F. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= N +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N-1 :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the description of K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the SVD/POD basis for the leading N-1 +!> data snapshots (columns of F) and the number of the +!> computed Ritz pairs. The value of K is determined +!> according to the rule set by the parameters NRNK and +!> TOL. See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] REIG +!> \verbatim +!> REIG (output) REAL(KIND=WP) (N-1)-by-1 array +!> The leading K (K<=N) entries of REIG contain +!> the real parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> See the descriptions of K, IMEIG, Z. +!> \endverbatim +!..... +!> \param[out] IMEIG +!> \verbatim +!> IMEIG (output) REAL(KIND=WP) (N-1)-by-1 array +!> The leading K (K the imaginary parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> The eigenvalues are determined as follows: +!> If IMEIG(i) == 0, then the corresponding eigenvalue is +!> real, LAMBDA(i) = REIG(i). +!> If IMEIG(i)>0, then the corresponding complex +!> conjugate pair of eigenvalues reads +!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) +!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) +!> That is, complex conjugate pairs have consequtive +!> indices (i,i+1), with the positive imaginary part +!> listed first. +!> See the descriptions of K, REIG, Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) REAL(KIND=WP) M-by-(N-1) array +!> If JOBZ =='V' then +!> Z contains real Ritz vectors as follows: +!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of +!> the i-th Ritz value. +!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then +!> [Z(:,i) Z(:,i+1)] span an invariant subspace and +!> the Ritz values extracted from this subspace are +!> REIG(i) + sqrt(-1)*IMEIG(i) and +!> REIG(i) - sqrt(-1)*IMEIG(i). +!> The corresponding eigenvectors are +!> Z(:,i) + sqrt(-1)*Z(:,i+1) and +!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. +!> If JOBZ == 'F', then the above descriptions hold for +!> the columns of Z*V, where the columns of V are the +!> eigenvectors of the K-by-K Rayleigh quotient, and Z is +!> orthonormal. The columns of V are similarly structured: +!> If IMEIG(i) == 0 then Z*V(:,i) is an eigenvector, and if +!> IMEIG(i) > 0 then Z*V(:,i)+sqrt(-1)*Z*V(:,i+1) and +!> Z*V(:,i)-sqrt(-1)*Z*V(:,i+1) +!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). +!> See the descriptions of REIG, IMEIG, X and V. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) (N-1)-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs. +!> If LAMBDA(i) is real, then +!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. +!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair +!> then +!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F +!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] +!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. +!> It holds that +!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 +!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 +!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) +!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) +!> See the description of Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array. +!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:N,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> In both cases, the content of B can be lifted to the +!> original dimension of the input data by pre-multiplying +!> with the Q factor from the initial QR factorization. +!> Here A denotes a compression of the underlying operator. +!> See the descriptions of F and X. +!> If JOBF =='N', then B is not referenced. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= MIN(M,N) +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] V +!> \verbatim +!> V (workspace/output) REAL(KIND=WP) (N-1)-by-(N-1) array +!> On exit, V(1:K,1:K) contains the K eigenvectors of +!> the Rayleigh quotient. The eigenvectors of a complex +!> conjugate pair of eigenvalues are returned in real form +!> as explained in the description of Z. The Ritz vectors +!> (returned in Z) are the product of X and V; see +!> the descriptions of X and Z. +!> \endverbatim +!..... +!> \param[in] LDV +!> \verbatim +!> LDV (input) INTEGER, LDV >= N-1 +!> The leading dimension of the array V. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (output) REAL(KIND=WP) (N-1)-by-(N-1) array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by DGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N-1 +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, +!> WORK(1:MIN(M,N)) contains the scalar factors of the +!> elementary reflectors as returned by DGEQRF of the +!> M-by-N input matrix F. +!> WORK(MIN(M,N)+1:MIN(M,N)+N-1) contains the singular values of +!> the input submatrix F(1:M,1:N-1). +!> If the call to DGEDMDQ is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. Hence, the +!> length of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is calculated as follows: +!> Let MLWQR = N (minimal workspace for DGEQRF[M,N]) +!> MLWDMD = minimal workspace for DGEDMD (see the +!> description of LWORK in DGEDMD) for +!> snapshots of dimensions MIN(M,N)-by-(N-1) +!> MLWMQR = N (minimal workspace for +!> DORMQR['L','N',M,N,N]) +!> MLWGQR = N (minimal workspace for DORGQR[M,N,N]) +!> Then +!> LWORK = MAX(N+MLWQR, N+MLWDMD) +!> is updated as follows: +!> if JOBZ == 'V' or JOBZ == 'F' THEN +!> LWORK = MAX( LWORK, MIN(M,N)+N-1+MLWMQR ) +!> if JOBQ == 'Q' THEN +!> LWORK = MAX( LWORK, MIN(M,N)+N-1+MLWGQR) +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> Let M1=MIN(M,N), N1=N-1. Then +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. +SUBROUTINE DGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & + WHTSVD, M, N, F, LDF, X, LDX, Y, & + LDY, NRNK, TOL, K, REIG, IMEIG, & + Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real64 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & + JOBT, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & + LDY, NRNK, LDZ, LDB, LDV, & + LDS, LWORK, LIWORK + INTEGER, INTENT(OUT) :: INFO, K + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) + REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & + Z(LDZ,*), B(LDB,*), & + V(LDV,*), S(LDS,*) + REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & + RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! +! Local scalars +! ~~~~~~~~~~~~~ + INTEGER :: IMINWR, INFO1, MLWDMD, MLWGQR, & + MLWMQR, MLWORK, MLWQR, MINMN, & + OLWDMD, OLWGQR, OLWMQR, OLWORK, & + OLWQR + LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & + WNTTRF, WNTRES, WNTVEC, WNTVCF, & + WNTVCQ, WNTREF, WNTEX + CHARACTER(LEN=1) :: JOBVL +! +! Local array +! ~~~~~~~~~~~ + REAL(KIND=WP) :: RDUMMY(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + LOGICAL LSAME + EXTERNAL LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL DGEMM + EXTERNAL DGEDMD, DGEQRF, DLACPY, DLASET, DORGQR, & + DORMQR, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC MAX, MIN, INT + !.......................................................... + ! + ! Test the input arguments + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTVCF = LSAME(JOBZ,'F') + WNTVCQ = LSAME(JOBZ,'Q') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + WANTQ = LSAME(JOBQ,'Q') + WNTTRF = LSAME(JOBT,'R') + MINMN = MIN(M,N) + INFO = 0 + LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & + .OR. LSAME(JOBZ,'N')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN + INFO = -4 + ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN + INFO = -5 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -6 + ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & + (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN + INFO = -7 + ELSE IF ( M < 0 ) THEN + INFO = -8 + ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN + INFO = -9 + ELSE IF ( LDF < M ) THEN + INFO = -11 + ELSE IF ( LDX < MINMN ) THEN + INFO = -13 + ELSE IF ( LDY < MINMN ) THEN + INFO = -15 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -16 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -17 + ELSE IF ( LDZ < M ) THEN + INFO = -22 + ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN + INFO = -25 + ELSE IF ( LDV < N-1 ) THEN + INFO = -27 + ELSE IF ( LDS < N-1 ) THEN + INFO = -29 + END IF +! + IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN + JOBVL = 'V' + ELSE + JOBVL = 'N' + END IF + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN + ! All output except K is void. INFO=1 signals + ! the void input. In case of a workspace query, + ! the minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + MLWQR = MAX(1,N) ! Minimal workspace length for DGEQRF. + MLWORK = MINMN + MLWQR + IF ( LQUERY ) THEN + CALL DGEQRF( M, N, F, LDF, WORK, RDUMMY, -1, & + INFO1 ) + OLWQR = INT(RDUMMY(1)) + OLWORK = MIN(M,N) + OLWQR + END IF + CALL DGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + REIG, IMEIG, Z, LDZ, RES, B, LDB, & + V, LDV, S, LDS, WORK, -1, IWORK, & + LIWORK, INFO1 ) + MLWDMD = INT(WORK(1)) + MLWORK = MAX(MLWORK, MINMN + MLWDMD) + IMINWR = IWORK(1) + IF ( LQUERY ) THEN + OLWDMD = INT(WORK(2)) + OLWORK = MAX(OLWORK, MINMN+OLWDMD) + END IF + IF ( WNTVEC .OR. WNTVCF ) THEN + MLWMQR = MAX(1,N) + MLWORK = MAX(MLWORK,MINMN+N-1+MLWMQR) + IF ( LQUERY ) THEN + CALL DORMQR( 'L','N', M, N, MINMN, F, LDF, & + WORK, Z, LDZ, WORK, -1, INFO1 ) + OLWMQR = INT(WORK(1)) + OLWORK = MAX(OLWORK,MINMN+N-1+OLWMQR) + END IF + END IF + IF ( WANTQ ) THEN + MLWGQR = N + MLWORK = MAX(MLWORK,MINMN+N-1+MLWGQR) + IF ( LQUERY ) THEN + CALL DORGQR( M, MINMN, MINMN, F, LDF, WORK, & + WORK, -1, INFO1 ) + OLWGQR = INT(WORK(1)) + OLWORK = MAX(OLWORK,MINMN+N-1+OLWGQR) + END IF + END IF + IMINWR = MAX( 1, IMINWR ) + MLWORK = MAX( 2, MLWORK ) + IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -31 + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -33 + END IF + IF( INFO /= 0 ) THEN + CALL XERBLA( 'DGEDMDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + WORK(1) = MLWORK + WORK(2) = OLWORK + RETURN + END IF +!..... +! Initial QR factorization that is used to represent the +! snapshots as elements of lower dimensional subspace. +! For large scale computation with M >>N , at this place +! one can use an out of core QRF. +! + CALL DGEQRF( M, N, F, LDF, WORK, & + WORK(MINMN+1), LWORK-MINMN, INFO1 ) +! +! Define X and Y as the snapshots representations in the +! orthogonal basis computed in the QR factorization. +! X corresponds to the leading N-1 and Y to the trailing +! N-1 snapshots. + CALL DLASET( 'L', MINMN, N-1, ZERO, ZERO, X, LDX ) + CALL DLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) + CALL DLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) + IF ( M >= 3 ) THEN + CALL DLASET( 'L', MINMN-2, N-2, ZERO, ZERO, & + Y(3,1), LDY ) + END IF +! +! Compute the DMD of the projected snapshot pairs (X,Y) + CALL DGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + REIG, IMEIG, Z, LDZ, RES, B, LDB, V, & + LDV, S, LDS, WORK(MINMN+1), LWORK-MINMN, & + IWORK, LIWORK, INFO1 ) + IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN + ! Return with error code. See DGEDMD for details. + INFO = INFO1 + RETURN + ELSE + INFO = INFO1 + END IF +! +! The Ritz vectors (Koopman modes) can be explicitly +! formed or returned in factored form. + IF ( WNTVEC ) THEN + ! Compute the eigenvectors explicitly. + IF ( M > MINMN ) CALL DLASET( 'A', M-MINMN, K, ZERO, & + ZERO, Z(MINMN+1,1), LDZ ) + CALL DORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & + LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + ELSE IF ( WNTVCF ) THEN + ! Return the Ritz vectors (eigenvectors) in factored + ! form Z*V, where Z contains orthonormal matrix (the + ! product of Q from the initial QR factorization and + ! the SVD/POD_basis returned by DGEDMD in X) and the + ! second factor (the eigenvectors of the Rayleigh + ! quotient) is in the array V, as returned by DGEDMD. + CALL DLACPY( 'A', N, K, X, LDX, Z, LDZ ) + IF ( M > N ) CALL DLASET( 'A', M-N, K, ZERO, ZERO, & + Z(N+1,1), LDZ ) + CALL DORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & + LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + END IF +! +! Some optional output variables: +! +! The upper triangular factor R in the initial QR +! factorization is optionally returned in the array Y. +! This is useful if this call to DGEDMDQ is to be +! followed by a streaming DMD that is implemented in a +! QR compressed form. + IF ( WNTTRF ) THEN ! Return the upper triangular R in Y + CALL DLASET( 'A', MINMN, N, ZERO, ZERO, Y, LDY ) + CALL DLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) + END IF +! +! The orthonormal/orthogonal factor Q in the initial QR +! factorization is optionally returned in the array F. +! Same as with the triangular factor above, this is +! useful in a streaming DMD. + IF ( WANTQ ) THEN ! Q overwrites F + CALL DORGQR( M, MINMN, MINMN, F, LDF, WORK, & + WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + END IF +! + RETURN +! + END SUBROUTINE DGEDMDQ diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index 4860e88983..90d15c3360 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -1,1206 +1,1205 @@ -!> \brief \b SGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & -! M, N, X, LDX, Y, LDY, NRNK, TOL, & -! K, REIG, IMEIG, Z, LDZ, RES, & -! B, LDB, W, LDW, S, LDS, & -! WORK, LWORK, IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real32 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & -! NRNK, LDZ, LDB, LDW, LDS, & -! LWORK, LIWORK -! INTEGER, INTENT(OUT) :: K, INFO -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) -! REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & -! W(LDW,*), S(LDS,*) -! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & -! RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> SGEDMD computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, SGEDMD computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, SGEDMD returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Distribution Statement A: -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!============================================================ -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product X(:,1:K)*W, where X -!> contains a POD basis (leading left singular vectors -!> of the data matrix X) and W contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of K, X, W, Z. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will be -!> computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: SGESVD (the QR SVD algorithm) -!> 2 :: SGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: SGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: SGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M>= 0 -!> The state space dimension (the row dimension of X, Y). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshot pairs -!> (the number of columns of X and Y). -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (input/output) REAL(KIND=WP) M-by-N array -!> > On entry, X contains the data snapshot matrix X. It is -!> assumed that the column norms of X are in the range of -!> the normalized floating point numbers. -!> < On exit, the leading K columns of X contain a POD basis, -!> i.e. the leading K left singular vectors of the input -!> data matrix X, U(:,1:K). All N columns of X contain all -!> left singular vectors of the input matrix X. -!> See the descriptions of K, Z and W. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= M -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (input/workspace/output) REAL(KIND=WP) M-by-N array -!> > On entry, Y contains the data snapshot matrix Y -!> < On exit, -!> If JOBR == 'R', the leading K columns of Y contain -!> the residual vectors for the computed Ritz pairs. -!> See the description of RES. -!> If JOBR == 'N', Y contains the original input data, -!> scaled according to the value of JOBS. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= M -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the descriptions of TOL and K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the POD basis for the data snapshot -!> matrix X and the number of the computed Ritz pairs. -!> The value of K is determined according to the rule set -!> by the parameters NRNK and TOL. -!> See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] REIG -!> \verbatim -!> REIG (output) REAL(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of REIG contain -!> the real parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> See the descriptions of K, IMEIG, and Z. -!> \endverbatim -!..... -!> \param[out] IMEIG -!> \verbatim -!> IMEIG (output) REAL(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of IMEIG contain -!> the imaginary parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> The eigenvalues are determined as follows: -!> If IMEIG(i) == 0, then the corresponding eigenvalue is -!> real, LAMBDA(i) = REIG(i). -!> If IMEIG(i)>0, then the corresponding complex -!> conjugate pair of eigenvalues reads -!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) -!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) -!> That is, complex conjugate pairs have consecutive -!> indices (i,i+1), with the positive imaginary part -!> listed first. -!> See the descriptions of K, REIG, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) REAL(KIND=WP) M-by-N array -!> If JOBZ =='V' then -!> Z contains real Ritz vectors as follows: -!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of -!> the i-th Ritz value; ||Z(:,i)||_2=1. -!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then -!> [Z(:,i) Z(:,i+1)] span an invariant subspace and -!> the Ritz values extracted from this subspace are -!> REIG(i) + sqrt(-1)*IMEIG(i) and -!> REIG(i) - sqrt(-1)*IMEIG(i). -!> The corresponding eigenvectors are -!> Z(:,i) + sqrt(-1)*Z(:,i+1) and -!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. -!> || Z(:,i:i+1)||_F = 1. -!> If JOBZ == 'F', then the above descriptions hold for -!> the columns of X(:,1:K)*W(1:K,1:K), where the columns -!> of W(1:k,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. The columns of W(1:K,1:K) -!> are similarly structured: If IMEIG(i) == 0 then -!> X(:,1:K)*W(:,i) is an eigenvector, and if IMEIG(i)>0 -!> then X(:,1:K)*W(:,i)+sqrt(-1)*X(:,1:K)*W(:,i+1) and -!> X(:,1:K)*W(:,i)-sqrt(-1)*X(:,1:K)*W(:,i+1) -!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). -!> See the descriptions of REIG, IMEIG, X and W. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) N-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs. -!> If LAMBDA(i) is real, then -!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. -!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair -!> then -!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F -!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] -!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. -!> It holds that -!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 -!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 -!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) -!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) -!> See the description of REIG, IMEIG and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) REAL(KIND=WP) M-by-N array. -!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:M,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> If JOBF =='N', then B is not referenced. -!> See the descriptions of X, W, K. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= M -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] W -!> \verbatim -!> W (workspace/output) REAL(KIND=WP) N-by-N array -!> On exit, W(1:K,1:K) contains the K computed -!> eigenvectors of the matrix Rayleigh quotient (real and -!> imaginary parts for each complex conjugate pair of the -!> eigenvalues). The Ritz vectors (returned in Z) are the -!> product of X (containing a POD basis for the input -!> matrix X) and W. See the descriptions of K, S, X and Z. -!> W is also used as a workspace to temporarily store the -!> left singular vectors of X. -!> \endverbatim -!..... -!> \param[in] LDW -!> \verbatim -!> LDW (input) INTEGER, LDW >= N -!> The leading dimension of the array W. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (workspace/output) REAL(KIND=WP) N-by-N array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by SGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, WORK(1:N) contains the singular values of -!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). -!> If WHTSVD==4, then WORK(N+1) and WORK(N+2) contain -!> scaling factor WORK(N+2)/WORK(N+1) used to scale X -!> and Y to avoid overflow in the SVD of X. -!> This may be of interest if the scaling option is off -!> and as many as possible smallest eigenvalues are -!> desired to the highest feasible accuracy. -!> If the call to SGEDMD is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. Hence, the -!> length of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is calculated as follows: -!> If WHTSVD == 1 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)). -!> If JOBZ == 'N' then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)). -!> Here LWORK_SVD = MAX(1,3*N+M,5*N) is the minimal -!> workspace length of SGESVD. -!> If WHTSVD == 2 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)) -!> Here LWORK_SVD = MAX(M, 5*N*N+4*N)+3*N*N is the -!> minimal workspace length of SGESDD. -!> If WHTSVD == 3 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) -!> Here LWORK_SVD = N+M+MAX(3*N+1, -!> MAX(1,3*N+M,5*N),MAX(1,N)) -!> is the minimal workspace length of SGESVDQ. -!> If WHTSVD == 4 :: -!> If JOBZ == 'V', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) -!> If JOBZ == 'N', then -!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) -!> Here LWORK_SVD = MAX(7,2*M+N,6*N+2*N*N) is the -!> minimal workspace length of SGEJSV. -!> The above expressions are not simplified in order to -!> make the usage of WORK more transparent, and for -!> easier checking. In any case, LWORK >= 2. -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. - SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, REIG, IMEIG, Z, LDZ, RES, & - B, LDB, W, LDW, S, LDS, & - WORK, LWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real32 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & - NRNK, LDZ, LDB, LDW, LDS, & - LWORK, LIWORK - INTEGER, INTENT(OUT) :: K, INFO - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) - REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & - W(LDW,*), S(LDS,*) - REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & - RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! -! Local scalars -! ~~~~~~~~~~~~~ - REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & - SSUM, XSCL1, XSCL2 - INTEGER :: i, j, IMINWR, INFO1, INFO2, & - LWRKEV, LWRSDD, LWRSVD, & - LWRSVQ, MLWORK, MWRKEV, MWRSDD, & - MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & - OLWORK - LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & - WNTEX, WNTREF, WNTRES, WNTVEC - CHARACTER :: JOBZL, T_OR_N - CHARACTER :: JSVOPT -! -! Local arrays -! ~~~~~~~~~~~~ - REAL(KIND=WP) :: AB(2,2), RDUMMY(2), RDUMMY2(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - REAL(KIND=WP) SLANGE, SLAMCH, SNRM2 - EXTERNAL SLANGE, SLAMCH, SNRM2, ISAMAX - INTEGER ISAMAX - LOGICAL SISNAN, LSAME - EXTERNAL SISNAN, LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL SAXPY, SGEMM, SSCAL - EXTERNAL SGEEV, SGEJSV, SGESDD, SGESVD, SGESVDQ, & - SLACPY, SLASCL, SLASSQ, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC INT, FLOAT, MAX, SQRT -!............................................................ -! -! Test the input arguments -! - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - INFO = 0 - LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & - .OR. LSAME(JOBZ,'F')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -4 - ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & - (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN - INFO = -5 - ELSE IF ( M < 0 ) THEN - INFO = -6 - ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN - INFO = -7 - ELSE IF ( LDX < M ) THEN - INFO = -9 - ELSE IF ( LDY < M ) THEN - INFO = -11 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -12 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -13 - ELSE IF ( LDZ < M ) THEN - INFO = -18 - ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN - INFO = -21 - ELSE IF ( LDW < N ) THEN - INFO = -23 - ELSE IF ( LDS < N ) THEN - INFO = -25 - END IF -! - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( N == 0 ) THEN - ! Quick return. All output except K is void. - ! INFO=1 signals the void input. - ! In case of a workspace query, the default - ! minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - MLWORK = MAX(2,N) - OLWORK = MAX(2,N) - IMINWR = 1 - SELECT CASE ( WHTSVD ) - CASE (1) - ! The following is specified as the minimal - ! length of WORK in the definition of SGESVD: - ! MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - MLWORK = MAX(MLWORK,N + MWRSVD) - IF ( LQUERY ) THEN - CALL SGESVD( 'O', 'S', M, N, X, LDX, WORK, & - B, LDB, W, LDW, RDUMMY, -1, INFO1 ) - LWRSVD = MAX( MWRSVD, INT( RDUMMY(1) ) ) - OLWORK = MAX(OLWORK,N + LWRSVD) - END IF - CASE (2) - ! The following is specified as the minimal - ! length of WORK in the definition of SGESDD: - ! MWRSDD = 3*MIN(M,N)*MIN(M,N) + - ! MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) - ! IMINWR = 8*MIN(M,N) - MWRSDD = 3*MIN(M,N)*MIN(M,N) + & - MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) - MLWORK = MAX(MLWORK,N + MWRSDD) - IMINWR = 8*MIN(M,N) - IF ( LQUERY ) THEN - CALL SGESDD( 'O', M, N, X, LDX, WORK, B, & - LDB, W, LDW, RDUMMY, -1, IWORK, INFO1 ) - LWRSDD = MAX( MWRSDD, INT( RDUMMY(1) ) ) - OLWORK = MAX(OLWORK,N + LWRSDD) - END IF - CASE (3) - !LWQP3 = 3*N+1 - !LWORQ = MAX(N, 1) - !MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) - !MWRSVQ = N + MAX( LWQP3, MWRSVD, LWORQ )+ MAX(M,2) - !MLWORK = N + MWRSVQ - !IMINWR = M+N-1 - CALL SGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, WORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, -1, RDUMMY, & - -1, RDUMMY2, -1, INFO1 ) - IMINWR = IWORK(1) - MWRSVQ = INT(RDUMMY(2)) - MLWORK = MAX(MLWORK,N+MWRSVQ+INT(RDUMMY2(1))) - IF ( LQUERY ) THEN - LWRSVQ = INT(RDUMMY(1)) - OLWORK = MAX(OLWORK,N+LWRSVQ+INT(RDUMMY2(1))) - END IF - CASE (4) - JSVOPT = 'J' - !MWRSVJ = MAX( 7, 2*M+N, 6*N+2*N*N )! for JSVOPT='V' - MWRSVJ = MAX( 7, 2*M+N, 4*N+N*N, 2*N+N*N+6 ) - MLWORK = MAX(MLWORK,N+MWRSVJ) - IMINWR = MAX( 3, M+3*N ) - IF ( LQUERY ) THEN - OLWORK = MAX(OLWORK,N+MWRSVJ) - END IF - END SELECT - IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN - JOBZL = 'V' - ELSE - JOBZL = 'N' - END IF - ! Workspace calculation to the SGEEV call - IF ( LSAME(JOBZL,'V') ) THEN - MWRKEV = MAX( 1, 4*N ) - ELSE - MWRKEV = MAX( 1, 3*N ) - END IF - MLWORK = MAX(MLWORK,N+MWRKEV) - IF ( LQUERY ) THEN - CALL SGEEV( 'N', JOBZL, N, S, LDS, REIG, & - IMEIG, W, LDW, W, LDW, RDUMMY, -1, INFO1 ) - LWRKEV = MAX( MWRKEV, INT(RDUMMY(1)) ) - OLWORK = MAX( OLWORK, N+LWRKEV ) - END IF -! - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -29 - IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -27 - END IF -! - IF( INFO /= 0 ) THEN - CALL XERBLA( 'SGEDMD', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK - RETURN - END IF -!............................................................ -! - OFL = SLAMCH('O') - SMALL = SLAMCH('S') - BADXY = .FALSE. -! -! <1> Optional scaling of the snapshots (columns of X, Y) -! ========================================================== - IF ( SCCOLX ) THEN - ! The columns of X will be normalized. - ! To prevent overflows, the column norms of X are - ! carefully computed using SLASSQ. - K = 0 - DO i = 1, N - !WORK(i) = DNRM2( M, X(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL SLASSQ( M, X(1,i), 1, SCALE, SSUM ) - IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN - K = 0 - INFO = -8 - CALL XERBLA('SGEDMD',-INFO) - END IF - IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of X(:,i) overflows. First, X(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. -! Next, the norm of X(:,i) is stored without -! overflow as WORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of X(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL SLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, X(1,i), M, INFO2 ) - WORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - WORK(i) = SCALE * ROOTSC - CALL SLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & - X(1,i), M, INFO2 ) ! LAPACK CALL -! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC - END IF - ELSE - WORK(i) = ZERO - K = K + 1 - END IF - END DO - IF ( K == N ) THEN - ! All columns of X are zero. Return error code -8. - ! (the 8th input variable had an illegal value) - K = 0 - INFO = -8 - CALL XERBLA('SGEDMD',-INFO) - RETURN - END IF - DO i = 1, N -! Now, apply the same scaling to the columns of Y. - IF ( WORK(i) > ZERO ) THEN - CALL SSCAL( M, ONE/WORK(i), Y(1,i), 1 ) ! BLAS CALL -! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC - ELSE IF ( WORK(i) < ZERO ) THEN - CALL SLASCL( 'G', 0, 0, -WORK(i), & - ONE/FLOAT(M), M, 1, Y(1,i), M, INFO2 ) ! LAPACK CALL - ELSE IF ( Y(ISAMAX(M, Y(1,i),1),i ) & - /= ZERO ) THEN -! X(:,i) is zero vector. For consistency, -! Y(:,i) should also be zero. If Y(:,i) is not -! zero, then the data might be inconsistent or -! corrupted. If JOBS == 'C', Y(:,i) is set to -! zero and a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - IF ( LSAME(JOBS,'C')) & - CALL SSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL - END IF - END DO - END IF - ! - IF ( SCCOLY ) THEN - ! The columns of Y will be normalized. - ! To prevent overflows, the column norms of Y are - ! carefully computed using SLASSQ. - DO i = 1, N - !WORK(i) = DNRM2( M, Y(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL SLASSQ( M, Y(1,i), 1, SCALE, SSUM ) - IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN - K = 0 - INFO = -10 - CALL XERBLA('SGEDMD',-INFO) - END IF - IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of Y(:,i) overflows. First, Y(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. -! Next, the norm of Y(:,i) is stored without -! overflow as WORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of Y(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL SLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, Y(1,i), M, INFO2 ) - WORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - WORK(i) = SCALE * ROOTSC - CALL SLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & - Y(1,i), M, INFO2 ) ! LAPACK CALL -! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC - END IF - ELSE - WORK(i) = ZERO - END IF - END DO - DO i = 1, N -! Now, apply the same scaling to the columns of X. - IF ( WORK(i) > ZERO ) THEN - CALL SSCAL( M, ONE/WORK(i), X(1,i), 1 ) ! BLAS CALL -! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC - ELSE IF ( WORK(i) < ZERO ) THEN - CALL SLASCL( 'G', 0, 0, -WORK(i), & - ONE/FLOAT(M), M, 1, X(1,i), M, INFO2 ) ! LAPACK CALL - ELSE IF ( X(ISAMAX(M, X(1,i),1),i ) & - /= ZERO ) THEN -! Y(:,i) is zero vector. If X(:,i) is not -! zero, then a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - END IF - END DO - END IF -! -! <2> SVD of the data snapshot matrix X. -! ===================================== -! The left singular vectors are stored in the array X. -! The right singular vectors are in the array W. -! The array W will later on contain the eigenvectors -! of a Rayleigh quotient. - NUMRNK = N - SELECT CASE ( WHTSVD ) - CASE (1) - CALL SGESVD( 'O', 'S', M, N, X, LDX, WORK, B, & - LDB, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL - T_OR_N = 'T' - CASE (2) - CALL SGESDD( 'O', M, N, X, LDX, WORK, B, LDB, W, & - LDW, WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL - T_OR_N = 'T' - CASE (3) - CALL SGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, WORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, LIWORK, WORK(N+MAX(2,M)+1),& - LWORK-N-MAX(2,M), WORK(N+1), MAX(2,M), INFO1) ! LAPACK CALL - CALL SLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'T' - CASE (4) - CALL SGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & - N, X, LDX, WORK, Z, LDZ, W, LDW, & - WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL - CALL SLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'N' - XSCL1 = WORK(N+1) - XSCL2 = WORK(N+2) - IF ( XSCL1 /= XSCL2 ) THEN - ! This is an exceptional situation. If the - ! data matrices are not scaled and the - ! largest singular value of X overflows. - ! In that case SGEJSV can return the SVD - ! in scaled form. The scaling factor can be used - ! to rescale the data (X and Y). - CALL SLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) - END IF - END SELECT -! - IF ( INFO1 > 0 ) THEN - ! The SVD selected subroutine did not converge. - ! Return with an error code. - INFO = 2 - RETURN - END IF -! - IF ( WORK(1) == ZERO ) THEN - ! The largest computed singular value of (scaled) - ! X is zero. Return error code -8 - ! (the 8th input variable had an illegal value). - K = 0 - INFO = -8 - CALL XERBLA('SGEDMD',-INFO) - RETURN - END IF -! - !<3> Determine the numerical rank of the data - ! snapshots matrix X. This depends on the - ! parameters NRNK and TOL. - - SELECT CASE ( NRNK ) - CASE ( -1 ) - K = 1 - DO i = 2, NUMRNK - IF ( ( WORK(i) <= WORK(1)*TOL ) .OR. & - ( WORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE ( -2 ) - K = 1 - DO i = 1, NUMRNK-1 - IF ( ( WORK(i+1) <= WORK(i)*TOL ) .OR. & - ( WORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE DEFAULT - K = 1 - DO i = 2, NRNK - IF ( WORK(i) <= SMALL ) EXIT - K = K + 1 - END DO - END SELECT - ! Now, U = X(1:M,1:K) is the SVD/POD basis for the - ! snapshot data in the input matrix X. - - !<4> Compute the Rayleigh quotient S = U^T * A * U. - ! Depending on the requested outputs, the computation - ! is organized to compute additional auxiliary - ! matrices (for the residuals and refinements). - ! - ! In all formulas below, we need V_k*Sigma_k^(-1) - ! where either V_k is in W(1:N,1:K), or V_k^T is in - ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). - IF ( LSAME(T_OR_N, 'N') ) THEN - DO i = 1, K - CALL SSCAL( N, ONE/WORK(i), W(1,i), 1 ) ! BLAS CALL - ! W(1:N,i) = (ONE/WORK(i)) * W(1:N,i) ! INTRINSIC - END DO - ELSE - ! This non-unit stride access is due to the fact - ! that SGESVD, SGESVDQ and SGESDD return the - ! transposed matrix of the right singular vectors. - !DO i = 1, K - ! CALL SSCAL( N, ONE/WORK(i), W(i,1), LDW ) ! BLAS CALL - ! ! W(i,1:N) = (ONE/WORK(i)) * W(i,1:N) ! INTRINSIC - !END DO - DO i = 1, K - WORK(N+i) = ONE/WORK(i) - END DO - DO j = 1, N - DO i = 1, K - W(i,j) = (WORK(N+i))*W(i,j) - END DO - END DO - END IF -! - IF ( WNTREF ) THEN - ! - ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) - ! for computing the refined Ritz vectors - ! (optionally, outside SGEDMD). - CALL SGEMM( 'N', T_OR_N, M, K, N, ONE, Y, LDY, W, & - LDW, ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' - ! - ! At this point Z contains - ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and - ! this is needed for computing the residuals. - ! This matrix is returned in the array B and - ! it can be used to compute refined Ritz vectors. - CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL - ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC - - CALL SGEMM( 'T', 'N', K, K, M, ONE, X, LDX, Z, & - LDZ, ZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC - ! At this point S = U^T * A * U is the Rayleigh quotient. - ELSE - ! A * U(:,1:K) is not explicitly needed and the - ! computation is organized differently. The Rayleigh - ! quotient is computed more efficiently. - CALL SGEMM( 'T', 'N', K, N, M, ONE, X, LDX, Y, LDY, & - ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC - ! In the two SGEMM calls here, can use K for LDZ - CALL SGEMM( 'N', T_OR_N, K, K, N, ONE, Z, LDZ, W, & - LDW, ZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' - ! At this point S = U^T * A * U is the Rayleigh quotient. - ! If the residuals are requested, save scaled V_k into Z. - ! Recall that V_k or V_k^T is stored in W. - IF ( WNTRES .OR. WNTEX ) THEN - IF ( LSAME(T_OR_N, 'N') ) THEN - CALL SLACPY( 'A', N, K, W, LDW, Z, LDZ ) - ELSE - CALL SLACPY( 'A', K, N, W, LDW, Z, LDZ ) - END IF - END IF - END IF -! - !<5> Compute the Ritz values and (if requested) the - ! right eigenvectors of the Rayleigh quotient. - ! - CALL SGEEV( 'N', JOBZL, K, S, LDS, REIG, IMEIG, W, & - LDW, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL - ! - ! W(1:K,1:K) contains the eigenvectors of the Rayleigh - ! quotient. Even in the case of complex spectrum, all - ! computation is done in real arithmetic. REIG and - ! IMEIG are the real and the imaginary parts of the - ! eigenvalues, so that the spectrum is given as - ! REIG(:) + sqrt(-1)*IMEIG(:). Complex conjugate pairs - ! are listed at consecutive positions. For such a - ! complex conjugate pair of the eigenvalues, the - ! corresponding eigenvectors are also a complex - ! conjugate pair with the real and imaginary parts - ! stored column-wise in W at the corresponding - ! consecutive column indices. See the description of Z. - ! Also, see the description of SGEEV. - IF ( INFO1 > 0 ) THEN - ! SGEEV failed to compute the eigenvalues and - ! eigenvectors of the Rayleigh quotient. - INFO = 3 - RETURN - END IF -! - ! <6> Compute the eigenvectors (if requested) and, - ! the residuals (if requested). - ! - IF ( WNTVEC .OR. WNTEX ) THEN - IF ( WNTRES ) THEN - IF ( WNTREF ) THEN - ! Here, if the refinement is requested, we have - ! A*U(:,1:K) already computed and stored in Z. - ! For the residuals, need Y = A * U(:,1;K) * W. - CALL SGEMM( 'N', 'N', M, K, K, ONE, Z, LDZ, W, & - LDW, ZERO, Y, LDY ) ! BLAS CALL - ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC - ! This frees Z; Y contains A * U(:,1:K) * W. - ELSE - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL SGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & - W, LDW, ZERO, S, LDS ) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - LDS, ZERO, Z, LDZ ) - ! Save a copy of Z into Y and free Z for holding - ! the Ritz vectors. - CALL SLACPY( 'A', M, K, Z, LDZ, Y, LDY ) - IF ( WNTEX ) CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF - ELSE IF ( WNTEX ) THEN - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL SGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & - W, LDW, ZERO, S, LDS ) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - LDS, ZERO, B, LDB ) - ! The above call replaces the following two calls - ! that were used in the developing-testing phase. - ! CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & - ! LDS, ZERO, Z, LDZ) - ! Save a copy of Z into B and free Z for holding - ! the Ritz vectors. - ! CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF -! - ! Compute the real form of the Ritz vectors - IF ( WNTVEC ) CALL SGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & - ZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC -! - IF ( WNTRES ) THEN - i = 1 - DO WHILE ( i <= K ) - IF ( IMEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL SAXPY( M, -REIG(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL - ! Y(1:M,i) = Y(1:M,i) - REIG(i) * Z(1:M,i) ! INTRINSIC - RES(i) = SNRM2( M, Y(1,i), 1 ) ! BLAS CALL - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IMEIG(i) - AB(1,2) = IMEIG(i) - AB(2,2) = REIG(i) - CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - LDZ, AB, 2, ONE, Y(1,i), LDY ) ! BLAS CALL - ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC - RES(i) = SLANGE( 'F', M, 2, Y(1,i), LDY, & - WORK(N+1) ) ! LAPACK CALL - RES(i+1) = RES(i) - i = i + 2 - END IF - END DO - END IF - END IF -! - IF ( WHTSVD == 4 ) THEN - WORK(N+1) = XSCL1 - WORK(N+2) = XSCL2 - END IF -! -! Successful exit. - IF ( .NOT. BADXY ) THEN - INFO = 0 - ELSE - ! A warning on possible data inconsistency. - ! This should be a rare event. - INFO = 4 - END IF -!............................................................ - RETURN -! ...... - END SUBROUTINE SGEDMD - +!> \brief \b SGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & +! M, N, X, LDX, Y, LDY, NRNK, TOL, & +! K, REIG, IMEIG, Z, LDZ, RES, & +! B, LDB, W, LDW, S, LDS, & +! WORK, LWORK, IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real32 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & +! NRNK, LDZ, LDB, LDW, LDS, & +! LWORK, LIWORK +! INTEGER, INTENT(OUT) :: K, INFO +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) +! REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & +! W(LDW,*), S(LDS,*) +! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & +! RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> SGEDMD computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, SGEDMD computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, SGEDMD returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Distribution Statement A: +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!============================================================ +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product X(:,1:K)*W, where X +!> contains a POD basis (leading left singular vectors +!> of the data matrix X) and W contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of K, X, W, Z. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will be +!> computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: SGESVD (the QR SVD algorithm) +!> 2 :: SGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: SGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: SGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M>= 0 +!> The state space dimension (the row dimension of X, Y). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshot pairs +!> (the number of columns of X and Y). +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (input/output) REAL(KIND=WP) M-by-N array +!> > On entry, X contains the data snapshot matrix X. It is +!> assumed that the column norms of X are in the range of +!> the normalized floating point numbers. +!> < On exit, the leading K columns of X contain a POD basis, +!> i.e. the leading K left singular vectors of the input +!> data matrix X, U(:,1:K). All N columns of X contain all +!> left singular vectors of the input matrix X. +!> See the descriptions of K, Z and W. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= M +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (input/workspace/output) REAL(KIND=WP) M-by-N array +!> > On entry, Y contains the data snapshot matrix Y +!> < On exit, +!> If JOBR == 'R', the leading K columns of Y contain +!> the residual vectors for the computed Ritz pairs. +!> See the description of RES. +!> If JOBR == 'N', Y contains the original input data, +!> scaled according to the value of JOBS. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= M +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the descriptions of TOL and K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the POD basis for the data snapshot +!> matrix X and the number of the computed Ritz pairs. +!> The value of K is determined according to the rule set +!> by the parameters NRNK and TOL. +!> See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] REIG +!> \verbatim +!> REIG (output) REAL(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of REIG contain +!> the real parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> See the descriptions of K, IMEIG, and Z. +!> \endverbatim +!..... +!> \param[out] IMEIG +!> \verbatim +!> IMEIG (output) REAL(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of IMEIG contain +!> the imaginary parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> The eigenvalues are determined as follows: +!> If IMEIG(i) == 0, then the corresponding eigenvalue is +!> real, LAMBDA(i) = REIG(i). +!> If IMEIG(i)>0, then the corresponding complex +!> conjugate pair of eigenvalues reads +!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) +!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) +!> That is, complex conjugate pairs have consecutive +!> indices (i,i+1), with the positive imaginary part +!> listed first. +!> See the descriptions of K, REIG, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) REAL(KIND=WP) M-by-N array +!> If JOBZ =='V' then +!> Z contains real Ritz vectors as follows: +!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of +!> the i-th Ritz value; ||Z(:,i)||_2=1. +!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then +!> [Z(:,i) Z(:,i+1)] span an invariant subspace and +!> the Ritz values extracted from this subspace are +!> REIG(i) + sqrt(-1)*IMEIG(i) and +!> REIG(i) - sqrt(-1)*IMEIG(i). +!> The corresponding eigenvectors are +!> Z(:,i) + sqrt(-1)*Z(:,i+1) and +!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. +!> || Z(:,i:i+1)||_F = 1. +!> If JOBZ == 'F', then the above descriptions hold for +!> the columns of X(:,1:K)*W(1:K,1:K), where the columns +!> of W(1:k,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. The columns of W(1:K,1:K) +!> are similarly structured: If IMEIG(i) == 0 then +!> X(:,1:K)*W(:,i) is an eigenvector, and if IMEIG(i)>0 +!> then X(:,1:K)*W(:,i)+sqrt(-1)*X(:,1:K)*W(:,i+1) and +!> X(:,1:K)*W(:,i)-sqrt(-1)*X(:,1:K)*W(:,i+1) +!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). +!> See the descriptions of REIG, IMEIG, X and W. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) N-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs. +!> If LAMBDA(i) is real, then +!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. +!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair +!> then +!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F +!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] +!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. +!> It holds that +!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 +!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 +!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) +!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) +!> See the description of REIG, IMEIG and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) REAL(KIND=WP) M-by-N array. +!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:M,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> If JOBF =='N', then B is not referenced. +!> See the descriptions of X, W, K. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= M +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] W +!> \verbatim +!> W (workspace/output) REAL(KIND=WP) N-by-N array +!> On exit, W(1:K,1:K) contains the K computed +!> eigenvectors of the matrix Rayleigh quotient (real and +!> imaginary parts for each complex conjugate pair of the +!> eigenvalues). The Ritz vectors (returned in Z) are the +!> product of X (containing a POD basis for the input +!> matrix X) and W. See the descriptions of K, S, X and Z. +!> W is also used as a workspace to temporarily store the +!> left singular vectors of X. +!> \endverbatim +!..... +!> \param[in] LDW +!> \verbatim +!> LDW (input) INTEGER, LDW >= N +!> The leading dimension of the array W. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (workspace/output) REAL(KIND=WP) N-by-N array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by SGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, WORK(1:N) contains the singular values of +!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). +!> If WHTSVD==4, then WORK(N+1) and WORK(N+2) contain +!> scaling factor WORK(N+2)/WORK(N+1) used to scale X +!> and Y to avoid overflow in the SVD of X. +!> This may be of interest if the scaling option is off +!> and as many as possible smallest eigenvalues are +!> desired to the highest feasible accuracy. +!> If the call to SGEDMD is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. Hence, the +!> length of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is calculated as follows: +!> If WHTSVD == 1 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)). +!> If JOBZ == 'N' then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)). +!> Here LWORK_SVD = MAX(1,3*N+M,5*N) is the minimal +!> workspace length of SGESVD. +!> If WHTSVD == 2 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N + LWORK_SVD, N+MAX(1,3*N)) +!> Here LWORK_SVD = MAX(M, 5*N*N+4*N)+3*N*N is the +!> minimal workspace length of SGESDD. +!> If WHTSVD == 3 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) +!> Here LWORK_SVD = N+M+MAX(3*N+1, +!> MAX(1,3*N+M,5*N),MAX(1,N)) +!> is the minimal workspace length of SGESVDQ. +!> If WHTSVD == 4 :: +!> If JOBZ == 'V', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,4*N)) +!> If JOBZ == 'N', then +!> LWORK >= MAX(2, N+LWORK_SVD,N+MAX(1,3*N)) +!> Here LWORK_SVD = MAX(7,2*M+N,6*N+2*N*N) is the +!> minimal workspace length of SGEJSV. +!> The above expressions are not simplified in order to +!> make the usage of WORK more transparent, and for +!> easier checking. In any case, LWORK >= 2. +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. + SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, REIG, IMEIG, Z, LDZ, RES, & + B, LDB, W, LDW, S, LDS, & + WORK, LWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real32 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & + NRNK, LDZ, LDB, LDW, LDS, & + LWORK, LIWORK + INTEGER, INTENT(OUT) :: K, INFO + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + REAL(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) + REAL(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & + W(LDW,*), S(LDS,*) + REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & + RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! +! Local scalars +! ~~~~~~~~~~~~~ + REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & + SSUM, XSCL1, XSCL2 + INTEGER :: i, j, IMINWR, INFO1, INFO2, & + LWRKEV, LWRSDD, LWRSVD, & + LWRSVQ, MLWORK, MWRKEV, MWRSDD, & + MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & + OLWORK + LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & + WNTEX, WNTREF, WNTRES, WNTVEC + CHARACTER :: JOBZL, T_OR_N + CHARACTER :: JSVOPT +! +! Local arrays +! ~~~~~~~~~~~~ + REAL(KIND=WP) :: AB(2,2), RDUMMY(2), RDUMMY2(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + REAL(KIND=WP) SLANGE, SLAMCH, SNRM2 + EXTERNAL SLANGE, SLAMCH, SNRM2, ISAMAX + INTEGER ISAMAX + LOGICAL SISNAN, LSAME + EXTERNAL SISNAN, LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL SAXPY, SGEMM, SSCAL + EXTERNAL SGEEV, SGEJSV, SGESDD, SGESVD, SGESVDQ, & + SLACPY, SLASCL, SLASSQ, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC INT, FLOAT, MAX, SQRT +!............................................................ +! +! Test the input arguments +! + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + INFO = 0 + LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & + .OR. LSAME(JOBZ,'F')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -4 + ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & + (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN + INFO = -5 + ELSE IF ( M < 0 ) THEN + INFO = -6 + ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN + INFO = -7 + ELSE IF ( LDX < M ) THEN + INFO = -9 + ELSE IF ( LDY < M ) THEN + INFO = -11 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -12 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -13 + ELSE IF ( LDZ < M ) THEN + INFO = -18 + ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN + INFO = -21 + ELSE IF ( LDW < N ) THEN + INFO = -23 + ELSE IF ( LDS < N ) THEN + INFO = -25 + END IF +! + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( N == 0 ) THEN + ! Quick return. All output except K is void. + ! INFO=1 signals the void input. + ! In case of a workspace query, the default + ! minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + MLWORK = MAX(2,N) + OLWORK = MAX(2,N) + IMINWR = 1 + SELECT CASE ( WHTSVD ) + CASE (1) + ! The following is specified as the minimal + ! length of WORK in the definition of SGESVD: + ! MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + MLWORK = MAX(MLWORK,N + MWRSVD) + IF ( LQUERY ) THEN + CALL SGESVD( 'O', 'S', M, N, X, LDX, WORK, & + B, LDB, W, LDW, RDUMMY, -1, INFO1 ) + LWRSVD = MAX( MWRSVD, INT( RDUMMY(1) ) ) + OLWORK = MAX(OLWORK,N + LWRSVD) + END IF + CASE (2) + ! The following is specified as the minimal + ! length of WORK in the definition of SGESDD: + ! MWRSDD = 3*MIN(M,N)*MIN(M,N) + + ! MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) + ! IMINWR = 8*MIN(M,N) + MWRSDD = 3*MIN(M,N)*MIN(M,N) + & + MAX( MAX(M,N),5*MIN(M,N)*MIN(M,N)+4*MIN(M,N) ) + MLWORK = MAX(MLWORK,N + MWRSDD) + IMINWR = 8*MIN(M,N) + IF ( LQUERY ) THEN + CALL SGESDD( 'O', M, N, X, LDX, WORK, B, & + LDB, W, LDW, RDUMMY, -1, IWORK, INFO1 ) + LWRSDD = MAX( MWRSDD, INT( RDUMMY(1) ) ) + OLWORK = MAX(OLWORK,N + LWRSDD) + END IF + CASE (3) + !LWQP3 = 3*N+1 + !LWORQ = MAX(N, 1) + !MWRSVD = MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) + !MWRSVQ = N + MAX( LWQP3, MWRSVD, LWORQ )+ MAX(M,2) + !MLWORK = N + MWRSVQ + !IMINWR = M+N-1 + CALL SGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, WORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, -1, RDUMMY, & + -1, RDUMMY2, -1, INFO1 ) + IMINWR = IWORK(1) + MWRSVQ = INT(RDUMMY(2)) + MLWORK = MAX(MLWORK,N+MWRSVQ+INT(RDUMMY2(1))) + IF ( LQUERY ) THEN + LWRSVQ = INT(RDUMMY(1)) + OLWORK = MAX(OLWORK,N+LWRSVQ+INT(RDUMMY2(1))) + END IF + CASE (4) + JSVOPT = 'J' + !MWRSVJ = MAX( 7, 2*M+N, 6*N+2*N*N )! for JSVOPT='V' + MWRSVJ = MAX( 7, 2*M+N, 4*N+N*N, 2*N+N*N+6 ) + MLWORK = MAX(MLWORK,N+MWRSVJ) + IMINWR = MAX( 3, M+3*N ) + IF ( LQUERY ) THEN + OLWORK = MAX(OLWORK,N+MWRSVJ) + END IF + END SELECT + IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN + JOBZL = 'V' + ELSE + JOBZL = 'N' + END IF + ! Workspace calculation to the SGEEV call + IF ( LSAME(JOBZL,'V') ) THEN + MWRKEV = MAX( 1, 4*N ) + ELSE + MWRKEV = MAX( 1, 3*N ) + END IF + MLWORK = MAX(MLWORK,N+MWRKEV) + IF ( LQUERY ) THEN + CALL SGEEV( 'N', JOBZL, N, S, LDS, REIG, & + IMEIG, W, LDW, W, LDW, RDUMMY, -1, INFO1 ) + LWRKEV = MAX( MWRKEV, INT(RDUMMY(1)) ) + OLWORK = MAX( OLWORK, N+LWRKEV ) + END IF +! + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -29 + IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -27 + END IF +! + IF( INFO /= 0 ) THEN + CALL XERBLA( 'SGEDMD', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + WORK(1) = MLWORK + WORK(2) = OLWORK + RETURN + END IF +!............................................................ +! + OFL = SLAMCH('O') + SMALL = SLAMCH('S') + BADXY = .FALSE. +! +! <1> Optional scaling of the snapshots (columns of X, Y) +! ========================================================== + IF ( SCCOLX ) THEN + ! The columns of X will be normalized. + ! To prevent overflows, the column norms of X are + ! carefully computed using SLASSQ. + K = 0 + DO i = 1, N + !WORK(i) = DNRM2( M, X(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL SLASSQ( M, X(1,i), 1, SCALE, SSUM ) + IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN + K = 0 + INFO = -8 + CALL XERBLA('SGEDMD',-INFO) + END IF + IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of X(:,i) overflows. First, X(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. +! Next, the norm of X(:,i) is stored without +! overflow as WORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of X(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL SLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, X(1,i), M, INFO2 ) + WORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + WORK(i) = SCALE * ROOTSC + CALL SLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & + X(1,i), M, INFO2 ) ! LAPACK CALL +! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC + END IF + ELSE + WORK(i) = ZERO + K = K + 1 + END IF + END DO + IF ( K == N ) THEN + ! All columns of X are zero. Return error code -8. + ! (the 8th input variable had an illegal value) + K = 0 + INFO = -8 + CALL XERBLA('SGEDMD',-INFO) + RETURN + END IF + DO i = 1, N +! Now, apply the same scaling to the columns of Y. + IF ( WORK(i) > ZERO ) THEN + CALL SSCAL( M, ONE/WORK(i), Y(1,i), 1 ) ! BLAS CALL +! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC + ELSE IF ( WORK(i) < ZERO ) THEN + CALL SLASCL( 'G', 0, 0, -WORK(i), & + ONE/FLOAT(M), M, 1, Y(1,i), M, INFO2 ) ! LAPACK CALL + ELSE IF ( Y(ISAMAX(M, Y(1,i),1),i ) & + /= ZERO ) THEN +! X(:,i) is zero vector. For consistency, +! Y(:,i) should also be zero. If Y(:,i) is not +! zero, then the data might be inconsistent or +! corrupted. If JOBS == 'C', Y(:,i) is set to +! zero and a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + IF ( LSAME(JOBS,'C')) & + CALL SSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL + END IF + END DO + END IF + ! + IF ( SCCOLY ) THEN + ! The columns of Y will be normalized. + ! To prevent overflows, the column norms of Y are + ! carefully computed using SLASSQ. + DO i = 1, N + !WORK(i) = DNRM2( M, Y(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL SLASSQ( M, Y(1,i), 1, SCALE, SSUM ) + IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN + K = 0 + INFO = -10 + CALL XERBLA('SGEDMD',-INFO) + END IF + IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of Y(:,i) overflows. First, Y(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. +! Next, the norm of Y(:,i) is stored without +! overflow as WORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of Y(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL SLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, Y(1,i), M, INFO2 ) + WORK(i) = - SCALE * ( ROOTSC / FLOAT(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + WORK(i) = SCALE * ROOTSC + CALL SLASCL( 'G',0, 0, WORK(i), ONE, M, 1, & + Y(1,i), M, INFO2 ) ! LAPACK CALL +! Y(1:M,i) = (ONE/WORK(i)) * Y(1:M,i) ! INTRINSIC + END IF + ELSE + WORK(i) = ZERO + END IF + END DO + DO i = 1, N +! Now, apply the same scaling to the columns of X. + IF ( WORK(i) > ZERO ) THEN + CALL SSCAL( M, ONE/WORK(i), X(1,i), 1 ) ! BLAS CALL +! X(1:M,i) = (ONE/WORK(i)) * X(1:M,i) ! INTRINSIC + ELSE IF ( WORK(i) < ZERO ) THEN + CALL SLASCL( 'G', 0, 0, -WORK(i), & + ONE/FLOAT(M), M, 1, X(1,i), M, INFO2 ) ! LAPACK CALL + ELSE IF ( X(ISAMAX(M, X(1,i),1),i ) & + /= ZERO ) THEN +! Y(:,i) is zero vector. If X(:,i) is not +! zero, then a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + END IF + END DO + END IF +! +! <2> SVD of the data snapshot matrix X. +! ===================================== +! The left singular vectors are stored in the array X. +! The right singular vectors are in the array W. +! The array W will later on contain the eigenvectors +! of a Rayleigh quotient. + NUMRNK = N + SELECT CASE ( WHTSVD ) + CASE (1) + CALL SGESVD( 'O', 'S', M, N, X, LDX, WORK, B, & + LDB, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL + T_OR_N = 'T' + CASE (2) + CALL SGESDD( 'O', M, N, X, LDX, WORK, B, LDB, W, & + LDW, WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL + T_OR_N = 'T' + CASE (3) + CALL SGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, WORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, LIWORK, WORK(N+MAX(2,M)+1),& + LWORK-N-MAX(2,M), WORK(N+1), MAX(2,M), INFO1) ! LAPACK CALL + CALL SLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'T' + CASE (4) + CALL SGEJSV( 'F', 'U', JSVOPT, 'N', 'N', 'P', M, & + N, X, LDX, WORK, Z, LDZ, W, LDW, & + WORK(N+1), LWORK-N, IWORK, INFO1 ) ! LAPACK CALL + CALL SLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'N' + XSCL1 = WORK(N+1) + XSCL2 = WORK(N+2) + IF ( XSCL1 /= XSCL2 ) THEN + ! This is an exceptional situation. If the + ! data matrices are not scaled and the + ! largest singular value of X overflows. + ! In that case SGEJSV can return the SVD + ! in scaled form. The scaling factor can be used + ! to rescale the data (X and Y). + CALL SLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) + END IF + END SELECT +! + IF ( INFO1 > 0 ) THEN + ! The SVD selected subroutine did not converge. + ! Return with an error code. + INFO = 2 + RETURN + END IF +! + IF ( WORK(1) == ZERO ) THEN + ! The largest computed singular value of (scaled) + ! X is zero. Return error code -8 + ! (the 8th input variable had an illegal value). + K = 0 + INFO = -8 + CALL XERBLA('SGEDMD',-INFO) + RETURN + END IF +! + !<3> Determine the numerical rank of the data + ! snapshots matrix X. This depends on the + ! parameters NRNK and TOL. + + SELECT CASE ( NRNK ) + CASE ( -1 ) + K = 1 + DO i = 2, NUMRNK + IF ( ( WORK(i) <= WORK(1)*TOL ) .OR. & + ( WORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE ( -2 ) + K = 1 + DO i = 1, NUMRNK-1 + IF ( ( WORK(i+1) <= WORK(i)*TOL ) .OR. & + ( WORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE DEFAULT + K = 1 + DO i = 2, NRNK + IF ( WORK(i) <= SMALL ) EXIT + K = K + 1 + END DO + END SELECT + ! Now, U = X(1:M,1:K) is the SVD/POD basis for the + ! snapshot data in the input matrix X. + + !<4> Compute the Rayleigh quotient S = U^T * A * U. + ! Depending on the requested outputs, the computation + ! is organized to compute additional auxiliary + ! matrices (for the residuals and refinements). + ! + ! In all formulas below, we need V_k*Sigma_k^(-1) + ! where either V_k is in W(1:N,1:K), or V_k^T is in + ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). + IF ( LSAME(T_OR_N, 'N') ) THEN + DO i = 1, K + CALL SSCAL( N, ONE/WORK(i), W(1,i), 1 ) ! BLAS CALL + ! W(1:N,i) = (ONE/WORK(i)) * W(1:N,i) ! INTRINSIC + END DO + ELSE + ! This non-unit stride access is due to the fact + ! that SGESVD, SGESVDQ and SGESDD return the + ! transposed matrix of the right singular vectors. + !DO i = 1, K + ! CALL SSCAL( N, ONE/WORK(i), W(i,1), LDW ) ! BLAS CALL + ! ! W(i,1:N) = (ONE/WORK(i)) * W(i,1:N) ! INTRINSIC + !END DO + DO i = 1, K + WORK(N+i) = ONE/WORK(i) + END DO + DO j = 1, N + DO i = 1, K + W(i,j) = (WORK(N+i))*W(i,j) + END DO + END DO + END IF +! + IF ( WNTREF ) THEN + ! + ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) + ! for computing the refined Ritz vectors + ! (optionally, outside SGEDMD). + CALL SGEMM( 'N', T_OR_N, M, K, N, ONE, Y, LDY, W, & + LDW, ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' + ! + ! At this point Z contains + ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and + ! this is needed for computing the residuals. + ! This matrix is returned in the array B and + ! it can be used to compute refined Ritz vectors. + CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL + ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC + + CALL SGEMM( 'T', 'N', K, K, M, ONE, X, LDX, Z, & + LDZ, ZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(TANSPOSE(X(1:M,1:K)),Z(1:M,1:K)) ! INTRINSIC + ! At this point S = U^T * A * U is the Rayleigh quotient. + ELSE + ! A * U(:,1:K) is not explicitly needed and the + ! computation is organized differently. The Rayleigh + ! quotient is computed more efficiently. + CALL SGEMM( 'T', 'N', K, N, M, ONE, X, LDX, Y, LDY, & + ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:K,1:N) = MATMUL( TRANSPOSE(X(1:M,1:K)), Y(1:M,1:N) ) ! INTRINSIC + ! In the two SGEMM calls here, can use K for LDZ + CALL SGEMM( 'N', T_OR_N, K, K, N, ONE, Z, LDZ, W, & + LDW, ZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(W(1:K,1:N))) ! INTRINSIC, for T_OR_N=='T' + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' + ! At this point S = U^T * A * U is the Rayleigh quotient. + ! If the residuals are requested, save scaled V_k into Z. + ! Recall that V_k or V_k^T is stored in W. + IF ( WNTRES .OR. WNTEX ) THEN + IF ( LSAME(T_OR_N, 'N') ) THEN + CALL SLACPY( 'A', N, K, W, LDW, Z, LDZ ) + ELSE + CALL SLACPY( 'A', K, N, W, LDW, Z, LDZ ) + END IF + END IF + END IF +! + !<5> Compute the Ritz values and (if requested) the + ! right eigenvectors of the Rayleigh quotient. + ! + CALL SGEEV( 'N', JOBZL, K, S, LDS, REIG, IMEIG, W, & + LDW, W, LDW, WORK(N+1), LWORK-N, INFO1 ) ! LAPACK CALL + ! + ! W(1:K,1:K) contains the eigenvectors of the Rayleigh + ! quotient. Even in the case of complex spectrum, all + ! computation is done in real arithmetic. REIG and + ! IMEIG are the real and the imaginary parts of the + ! eigenvalues, so that the spectrum is given as + ! REIG(:) + sqrt(-1)*IMEIG(:). Complex conjugate pairs + ! are listed at consecutive positions. For such a + ! complex conjugate pair of the eigenvalues, the + ! corresponding eigenvectors are also a complex + ! conjugate pair with the real and imaginary parts + ! stored column-wise in W at the corresponding + ! consecutive column indices. See the description of Z. + ! Also, see the description of SGEEV. + IF ( INFO1 > 0 ) THEN + ! SGEEV failed to compute the eigenvalues and + ! eigenvectors of the Rayleigh quotient. + INFO = 3 + RETURN + END IF +! + ! <6> Compute the eigenvectors (if requested) and, + ! the residuals (if requested). + ! + IF ( WNTVEC .OR. WNTEX ) THEN + IF ( WNTRES ) THEN + IF ( WNTREF ) THEN + ! Here, if the refinement is requested, we have + ! A*U(:,1:K) already computed and stored in Z. + ! For the residuals, need Y = A * U(:,1;K) * W. + CALL SGEMM( 'N', 'N', M, K, K, ONE, Z, LDZ, W, & + LDW, ZERO, Y, LDY ) ! BLAS CALL + ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC + ! This frees Z; Y contains A * U(:,1:K) * W. + ELSE + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL SGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & + W, LDW, ZERO, S, LDS ) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + LDS, ZERO, Z, LDZ ) + ! Save a copy of Z into Y and free Z for holding + ! the Ritz vectors. + CALL SLACPY( 'A', M, K, Z, LDZ, Y, LDY ) + IF ( WNTEX ) CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF + ELSE IF ( WNTEX ) THEN + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL SGEMM( T_OR_N, 'N', N, K, K, ONE, Z, LDZ, & + W, LDW, ZERO, S, LDS ) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + LDS, ZERO, B, LDB ) + ! The above call replaces the following two calls + ! that were used in the developing-testing phase. + ! CALL SGEMM( 'N', 'N', M, K, N, ONE, Y, LDY, S, & + ! LDS, ZERO, Z, LDZ) + ! Save a copy of Z into B and free Z for holding + ! the Ritz vectors. + ! CALL SLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF +! + ! Compute the real form of the Ritz vectors + IF ( WNTVEC ) CALL SGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & + ZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC +! + IF ( WNTRES ) THEN + i = 1 + DO WHILE ( i <= K ) + IF ( IMEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL SAXPY( M, -REIG(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL + ! Y(1:M,i) = Y(1:M,i) - REIG(i) * Z(1:M,i) ! INTRINSIC + RES(i) = SNRM2( M, Y(1,i), 1 ) ! BLAS CALL + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IMEIG(i) + AB(1,2) = IMEIG(i) + AB(2,2) = REIG(i) + CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + LDZ, AB, 2, ONE, Y(1,i), LDY ) ! BLAS CALL + ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC + RES(i) = SLANGE( 'F', M, 2, Y(1,i), LDY, & + WORK(N+1) ) ! LAPACK CALL + RES(i+1) = RES(i) + i = i + 2 + END IF + END DO + END IF + END IF +! + IF ( WHTSVD == 4 ) THEN + WORK(N+1) = XSCL1 + WORK(N+2) = XSCL2 + END IF +! +! Successful exit. + IF ( .NOT. BADXY ) THEN + INFO = 0 + ELSE + ! A warning on possible data inconsistency. + ! This should be a rare event. + INFO = 4 + END IF +!............................................................ + RETURN +! ...... + END SUBROUTINE SGEDMD diff --git a/SRC/sgedmdq.f90 b/SRC/sgedmdq.f90 index 5ee337b289..2506149cc7 100644 --- a/SRC/sgedmdq.f90 +++ b/SRC/sgedmdq.f90 @@ -1,863 +1,862 @@ -!> \brief \b SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & -! WHTSVD, M, N, F, LDF, X, LDX, Y, & -! LDY, NRNK, TOL, K, REIG, IMEIG, & -! Z, LDZ, RES, B, LDB, V, LDV, & -! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real32 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & -! JOBT, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & -! LDY, NRNK, LDZ, LDB, LDV, & -! LDS, LWORK, LIWORK -! INTEGER, INTENT(OUT) :: INFO, K -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) -! REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & -! Z(LDZ,*), B(LDB,*), & -! V(LDV,*), S(LDS,*) -! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & -! RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices, using a QR factorization -!> based compression of the data. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, SGEDMDQ computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, SGEDMDQ returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office. -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!...................................................................... -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. The data snapshots are the columns -!> of F. The leading N-1 columns of F are denoted X and the -!> trailing N-1 columns are denoted Y. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Z*V, where Z -!> is orthonormal and V contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of F, V, Z. -!> 'Q' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Q*Z, where Z -!> contains the eigenvectors of the compression of the -!> underlying discretized operator onto the span of -!> the data snapshots. See the descriptions of F, V, Z. -!> Q is from the initial QR factorization. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will -!> be computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBQ -!> \verbatim -!> JOBQ (input) CHARACTER*1 -!> Specifies whether to explicitly compute and return the -!> orthogonal matrix from the QR factorization. -!> 'Q' :: The matrix Q of the QR factorization of the data -!> snapshot matrix is computed and stored in the -!> array F. See the description of F. -!> 'N' :: The matrix Q is not explicitly computed. -!> \endverbatim -!..... -!> \param[in] JOBT -!> \verbatim -!> JOBT (input) CHARACTER*1 -!> Specifies whether to return the upper triangular factor -!> from the QR factorization. -!> 'R' :: The matrix R of the QR factorization of the data -!> snapshot matrix F is returned in the array Y. -!> See the description of Y and Further details. -!> 'N' :: The matrix R is not returned. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> To be useful on exit, this option needs JOBQ='Q'. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: SGESVD (the QR SVD algorithm) -!> 2 :: SGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: SGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: SGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M >= 0 -!> The state space dimension (the number of rows of F) -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshots from a single trajectory, -!> taken at equidistant discrete times. This is the -!> number of columns of F. -!> \endverbatim -!..... -!> \param[in,out] F -!> \verbatim -!> F (input/output) REAL(KIND=WP) M-by-N array -!> > On entry, -!> the columns of F are the sequence of data snapshots -!> from a single trajectory, taken at equidistant discrete -!> times. It is assumed that the column norms of F are -!> in the range of the normalized floating point numbers. -!> < On exit, -!> If JOBQ == 'Q', the array F contains the orthogonal -!> matrix/factor of the QR factorization of the initial -!> data snapshots matrix F. See the description of JOBQ. -!> If JOBQ == 'N', the entries in F strictly below the main -!> diagonal contain, column-wise, the information on the -!> Householder vectors, as returned by SGEQRF. The -!> remaining information to restore the orthogonal matrix -!> of the initial QR factorization is stored in WORK(1:N). -!> See the description of WORK. -!> \endverbatim -!..... -!> \param[in] LDF -!> \verbatim -!> LDF (input) INTEGER, LDF >= M -!> The leading dimension of the array F. -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array -!> X is used as workspace to hold representations of the -!> leading N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, the leading K columns of X contain the leading -!> K left singular vectors of the above described content -!> of X. To lift them to the space of the left singular -!> vectors U(:,1:K)of the input data, pre-multiply with the -!> Q factor from the initial QR factorization. -!> See the descriptions of F, K, V and Z. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= N -!> The leading dimension of the array X -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array -!> Y is used as workspace to hold representations of the -!> trailing N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, -!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper -!> triangular factor from the QR factorization of the data -!> snapshot matrix F. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= N -!> The leading dimension of the array Y -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N-1 :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the description of K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the SVD/POD basis for the leading N-1 -!> data snapshots (columns of F) and the number of the -!> computed Ritz pairs. The value of K is determined -!> according to the rule set by the parameters NRNK and -!> TOL. See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] REIG -!> \verbatim -!> REIG (output) REAL(KIND=WP) (N-1)-by-1 array -!> The leading K (K<=N) entries of REIG contain -!> the real parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> See the descriptions of K, IMEIG, Z. -!> \endverbatim -!..... -!> \param[out] IMEIG -!> \verbatim -!> IMEIG (output) REAL(KIND=WP) (N-1)-by-1 array -!> The leading K (K the imaginary parts of the computed eigenvalues -!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). -!> The eigenvalues are determined as follows: -!> If IMEIG(i) == 0, then the corresponding eigenvalue is -!> real, LAMBDA(i) = REIG(i). -!> If IMEIG(i)>0, then the corresponding complex -!> conjugate pair of eigenvalues reads -!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) -!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) -!> That is, complex conjugate pairs have consecutive -!> indices (i,i+1), with the positive imaginary part -!> listed first. -!> See the descriptions of K, REIG, Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) REAL(KIND=WP) M-by-(N-1) array -!> If JOBZ =='V' then -!> Z contains real Ritz vectors as follows: -!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of -!> the i-th Ritz value. -!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then -!> [Z(:,i) Z(:,i+1)] span an invariant subspace and -!> the Ritz values extracted from this subspace are -!> REIG(i) + sqrt(-1)*IMEIG(i) and -!> REIG(i) - sqrt(-1)*IMEIG(i). -!> The corresponding eigenvectors are -!> Z(:,i) + sqrt(-1)*Z(:,i+1) and -!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. -!> If JOBZ == 'F', then the above descriptions hold for -!> the columns of Z*V, where the columns of V are the -!> eigenvectors of the K-by-K Rayleigh quotient, and Z is -!> orthonormal. The columns of V are similarly structured: -!> If IMEIG(i) == 0 then Z*V(:,i) is an eigenvector, and if -!> IMEIG(i) > 0 then Z*V(:,i)+sqrt(-1)*Z*V(:,i+1) and -!> Z*V(:,i)-sqrt(-1)*Z*V(:,i+1) -!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). -!> See the descriptions of REIG, IMEIG, X and V. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) (N-1)-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs. -!> If LAMBDA(i) is real, then -!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. -!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair -!> then -!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F -!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] -!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. -!> It holds that -!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 -!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 -!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) -!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) -!> See the description of Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array. -!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:N,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> In both cases, the content of B can be lifted to the -!> original dimension of the input data by pre-multiplying -!> with the Q factor from the initial QR factorization. -!> Here A denotes a compression of the underlying operator. -!> See the descriptions of F and X. -!> If JOBF =='N', then B is not referenced. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= MIN(M,N) -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] V -!> \verbatim -!> V (workspace/output) REAL(KIND=WP) (N-1)-by-(N-1) array -!> On exit, V(1:K,1:K) contains the K eigenvectors of -!> the Rayleigh quotient. The eigenvectors of a complex -!> conjugate pair of eigenvalues are returned in real form -!> as explained in the description of Z. The Ritz vectors -!> (returned in Z) are the product of X and V; see -!> the descriptions of X and Z. -!> \endverbatim -!..... -!> \param[in] LDV -!> \verbatim -!> LDV (input) INTEGER, LDV >= N-1 -!> The leading dimension of the array V. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (output) REAL(KIND=WP) (N-1)-by-(N-1) array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by SGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N-1 -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, -!> WORK(1:MIN(M,N)) contains the scalar factors of the -!> elementary reflectors as returned by SGEQRF of the -!> M-by-N input matrix F. -!> WORK(MIN(M,N)+1:MIN(M,N)+N-1) contains the singular values of -!> the input submatrix F(1:M,1:N-1). -!> If the call to SGEDMDQ is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. Hence, the -!> length of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is calculated as follows: -!> Let MLWQR = N (minimal workspace for SGEQRF[M,N]) -!> MLWDMD = minimal workspace for SGEDMD (see the -!> description of LWORK in SGEDMD) for -!> snapshots of dimensions MIN(M,N)-by-(N-1) -!> MLWMQR = N (minimal workspace for -!> SORMQR['L','N',M,N,N]) -!> MLWGQR = N (minimal workspace for SORGQR[M,N,N]) -!> Then -!> LWORK = MAX(N+MLWQR, N+MLWDMD) -!> is updated as follows: -!> if JOBZ == 'V' or JOBZ == 'F' THEN -!> LWORK = MAX( LWORK,MIN(M,N)+N-1 +MLWMQR ) -!> if JOBQ == 'Q' THEN -!> LWORK = MAX( LWORK,MIN(M,N)+N-1+MLWGQR) -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> Let M1=MIN(M,N), N1=N-1. Then -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) -!> If on entry LIWORK = -1, then a worskpace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. -SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & - WHTSVD, M, N, F, LDF, X, LDX, Y, & - LDY, NRNK, TOL, K, REIG, IMEIG, & - Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real32 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & - JOBT, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & - LDY, NRNK, LDZ, LDB, LDV, & - LDS, LWORK, LIWORK - INTEGER, INTENT(OUT) :: INFO, K - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~~ - REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) - REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & - Z(LDZ,*), B(LDB,*), & - V(LDV,*), S(LDS,*) - REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & - RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! -! Local scalars -! ~~~~~~~~~~~~~ - INTEGER :: IMINWR, INFO1, MLWDMD, MLWGQR, & - MLWMQR, MLWORK, MLWQR, MINMN, & - OLWDMD, OLWGQR, OLWMQR, OLWORK, & - OLWQR - LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & - WNTTRF, WNTRES, WNTVEC, WNTVCF, & - WNTVCQ, WNTREF, WNTEX - CHARACTER(LEN=1) :: JOBVL -! -! Local array -! ~~~~~~~~~~~ - REAL(KIND=WP) :: RDUMMY(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - LOGICAL LSAME - EXTERNAL LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL SGEMM - EXTERNAL SGEDMD, SGEQRF, SLACPY, SLASET, SORGQR, & - SORMQR, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC MAX, MIN, INT -!.......................................................... -! -! Test the input arguments - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTVCF = LSAME(JOBZ,'F') - WNTVCQ = LSAME(JOBZ,'Q') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - WANTQ = LSAME(JOBQ,'Q') - WNTTRF = LSAME(JOBT,'R') - MINMN = MIN(M,N) - INFO = 0 - LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & - .OR. LSAME(JOBZ,'N')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN - INFO = -4 - ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN - INFO = -5 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -6 - ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & - (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN - INFO = -7 - ELSE IF ( M < 0 ) THEN - INFO = -8 - ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN - INFO = -9 - ELSE IF ( LDF < M ) THEN - INFO = -11 - ELSE IF ( LDX < MINMN ) THEN - INFO = -13 - ELSE IF ( LDY < MINMN ) THEN - INFO = -15 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -16 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -17 - ELSE IF ( LDZ < M ) THEN - INFO = -22 - ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN - INFO = -25 - ELSE IF ( LDV < N-1 ) THEN - INFO = -27 - ELSE IF ( LDS < N-1 ) THEN - INFO = -29 - END IF -! - IF ( WNTVEC .OR. WNTVCF ) THEN - JOBVL = 'V' - ELSE - JOBVL = 'N' - END IF - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN - ! All output except K is void. INFO=1 signals - ! the void input. In case of a workspace query, - ! the minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - MLWQR = MAX(1,N) ! Minimal workspace length for SGEQRF. - MLWORK = MIN(M,N) + MLWQR - IF ( LQUERY ) THEN - CALL SGEQRF( M, N, F, LDF, WORK, RDUMMY, -1, & - INFO1 ) - OLWQR = INT(RDUMMY(1)) - OLWORK = MIN(M,N) + OLWQR - END IF - CALL SGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - REIG, IMEIG, Z, LDZ, RES, B, LDB, & - V, LDV, S, LDS, WORK, -1, IWORK, & - LIWORK, INFO1 ) - MLWDMD = INT(WORK(1)) - MLWORK = MAX(MLWORK, MINMN + MLWDMD) - IMINWR = IWORK(1) - IF ( LQUERY ) THEN - OLWDMD = INT(WORK(2)) - OLWORK = MAX(OLWORK, MINMN+OLWDMD) - END IF - IF ( WNTVEC .OR. WNTVCF ) THEN - MLWMQR = MAX(1,N) - MLWORK = MAX(MLWORK,MINMN+N-1+MLWMQR) - IF ( LQUERY ) THEN - CALL SORMQR( 'L','N', M, N, MINMN, F, LDF, & - WORK, Z, LDZ, WORK, -1, INFO1 ) - OLWMQR = INT(WORK(1)) - OLWORK = MAX(OLWORK,MINMN+N-1+OLWMQR) - END IF - END IF - IF ( WANTQ ) THEN - MLWGQR = N - MLWORK = MAX(MLWORK,MINMN+N-1+MLWGQR) - IF ( LQUERY ) THEN - CALL SORGQR( M, MINMN, MINMN, F, LDF, WORK, & - WORK, -1, INFO1 ) - OLWGQR = INT(WORK(1)) - OLWORK = MAX(OLWORK,MINMN+N-1+OLWGQR) - END IF - END IF - IMINWR = MAX( 1, IMINWR ) - MLWORK = MAX( 2, MLWORK ) - IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -31 - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -33 - END IF - IF( INFO /= 0 ) THEN - CALL XERBLA( 'SGEDMDQ', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK - RETURN - END IF -!..... -! Initial QR factorization that is used to represent the -! snapshots as elements of lower dimensional subspace. -! For large scale computation with M >>N , at this place -! one can use an out of core QRF. -! - CALL SGEQRF( M, N, F, LDF, WORK, & - WORK(MINMN+1), LWORK-MINMN, INFO1 ) -! -! Define X and Y as the snapshots representations in the -! orthogonal basis computed in the QR factorization. -! X corresponds to the leading N-1 and Y to the trailing -! N-1 snapshots. - CALL SLASET( 'L', MINMN, N-1, ZERO, ZERO, X, LDX ) - CALL SLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) - CALL SLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) - IF ( M >= 3 ) THEN - CALL SLASET( 'L', MINMN-2, N-2, ZERO, ZERO, & - Y(3,1), LDY ) - END IF -! -! Compute the DMD of the projected snapshot pairs (X,Y) - CALL SGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - REIG, IMEIG, Z, LDZ, RES, B, LDB, V, & - LDV, S, LDS, WORK(MINMN+1), LWORK-MINMN, IWORK, & - LIWORK, INFO1 ) - IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN - ! Return with error code. - INFO = INFO1 - RETURN - ELSE - INFO = INFO1 - END IF -! -! The Ritz vectors (Koopman modes) can be explicitly -! formed or returned in factored form. - IF ( WNTVEC ) THEN - ! Compute the eigenvectors explicitly. - IF ( M > MINMN ) CALL SLASET( 'A', M-MINMN, K, ZERO, & - ZERO, Z(MINMN+1,1), LDZ ) - CALL SORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & - LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - ELSE IF ( WNTVCF ) THEN - ! Return the Ritz vectors (eigenvectors) in factored - ! form Z*V, where Z contains orthonormal matrix (the - ! product of Q from the initial QR factorization and - ! the SVD/POD_basis returned by SGEDMD in X) and the - ! second factor (the eigenvectors of the Rayleigh - ! quotient) is in the array V, as returned by SGEDMD. - CALL SLACPY( 'A', N, K, X, LDX, Z, LDZ ) - IF ( M > N ) CALL SLASET( 'A', M-N, K, ZERO, ZERO, & - Z(N+1,1), LDZ ) - CALL SORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & - LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - END IF -! -! Some optional output variables: -! -! The upper triangular factor in the initial QR -! factorization is optionally returned in the array Y. -! This is useful if this call to SGEDMDQ is to be -! followed by a streaming DMD that is implemented in a -! QR compressed form. - IF ( WNTTRF ) THEN ! Return the upper triangular R in Y - CALL SLASET( 'A', MINMN, N, ZERO, ZERO, Y, LDY ) - CALL SLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) - END IF -! -! The orthonormal/orthogonal factor in the initial QR -! factorization is optionally returned in the array F. -! Same as with the triangular factor above, this is -! useful in a streaming DMD. - IF ( WANTQ ) THEN ! Q overwrites F - CALL SORGQR( M, MINMN, MINMN, F, LDF, WORK, & - WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) - END IF -! - RETURN -! - END SUBROUTINE SGEDMDQ - +!> \brief \b SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & +! WHTSVD, M, N, F, LDF, X, LDX, Y, & +! LDY, NRNK, TOL, K, REIG, IMEIG, & +! Z, LDZ, RES, B, LDB, V, LDV, & +! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real32 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & +! JOBT, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & +! LDY, NRNK, LDZ, LDB, LDV, & +! LDS, LWORK, LIWORK +! INTEGER, INTENT(OUT) :: INFO, K +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) +! REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & +! Z(LDZ,*), B(LDB,*), & +! V(LDV,*), S(LDS,*) +! REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & +! RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices, using a QR factorization +!> based compression of the data. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, SGEDMDQ computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, SGEDMDQ returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office. +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!...................................................................... +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. The data snapshots are the columns +!> of F. The leading N-1 columns of F are denoted X and the +!> trailing N-1 columns are denoted Y. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Z*V, where Z +!> is orthonormal and V contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of F, V, Z. +!> 'Q' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Q*Z, where Z +!> contains the eigenvectors of the compression of the +!> underlying discretized operator onto the span of +!> the data snapshots. See the descriptions of F, V, Z. +!> Q is from the initial QR factorization. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will +!> be computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBQ +!> \verbatim +!> JOBQ (input) CHARACTER*1 +!> Specifies whether to explicitly compute and return the +!> orthogonal matrix from the QR factorization. +!> 'Q' :: The matrix Q of the QR factorization of the data +!> snapshot matrix is computed and stored in the +!> array F. See the description of F. +!> 'N' :: The matrix Q is not explicitly computed. +!> \endverbatim +!..... +!> \param[in] JOBT +!> \verbatim +!> JOBT (input) CHARACTER*1 +!> Specifies whether to return the upper triangular factor +!> from the QR factorization. +!> 'R' :: The matrix R of the QR factorization of the data +!> snapshot matrix F is returned in the array Y. +!> See the description of Y and Further details. +!> 'N' :: The matrix R is not returned. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> To be useful on exit, this option needs JOBQ='Q'. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: SGESVD (the QR SVD algorithm) +!> 2 :: SGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: SGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: SGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M >= 0 +!> The state space dimension (the number of rows of F) +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshots from a single trajectory, +!> taken at equidistant discrete times. This is the +!> number of columns of F. +!> \endverbatim +!..... +!> \param[in,out] F +!> \verbatim +!> F (input/output) REAL(KIND=WP) M-by-N array +!> > On entry, +!> the columns of F are the sequence of data snapshots +!> from a single trajectory, taken at equidistant discrete +!> times. It is assumed that the column norms of F are +!> in the range of the normalized floating point numbers. +!> < On exit, +!> If JOBQ == 'Q', the array F contains the orthogonal +!> matrix/factor of the QR factorization of the initial +!> data snapshots matrix F. See the description of JOBQ. +!> If JOBQ == 'N', the entries in F strictly below the main +!> diagonal contain, column-wise, the information on the +!> Householder vectors, as returned by SGEQRF. The +!> remaining information to restore the orthogonal matrix +!> of the initial QR factorization is stored in WORK(1:N). +!> See the description of WORK. +!> \endverbatim +!..... +!> \param[in] LDF +!> \verbatim +!> LDF (input) INTEGER, LDF >= M +!> The leading dimension of the array F. +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array +!> X is used as workspace to hold representations of the +!> leading N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, the leading K columns of X contain the leading +!> K left singular vectors of the above described content +!> of X. To lift them to the space of the left singular +!> vectors U(:,1:K)of the input data, pre-multiply with the +!> Q factor from the initial QR factorization. +!> See the descriptions of F, K, V and Z. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= N +!> The leading dimension of the array X +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (workspace/output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array +!> Y is used as workspace to hold representations of the +!> trailing N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, +!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper +!> triangular factor from the QR factorization of the data +!> snapshot matrix F. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= N +!> The leading dimension of the array Y +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N-1 :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the description of K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the SVD/POD basis for the leading N-1 +!> data snapshots (columns of F) and the number of the +!> computed Ritz pairs. The value of K is determined +!> according to the rule set by the parameters NRNK and +!> TOL. See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] REIG +!> \verbatim +!> REIG (output) REAL(KIND=WP) (N-1)-by-1 array +!> The leading K (K<=N) entries of REIG contain +!> the real parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> See the descriptions of K, IMEIG, Z. +!> \endverbatim +!..... +!> \param[out] IMEIG +!> \verbatim +!> IMEIG (output) REAL(KIND=WP) (N-1)-by-1 array +!> The leading K (K the imaginary parts of the computed eigenvalues +!> REIG(1:K) + sqrt(-1)*IMEIG(1:K). +!> The eigenvalues are determined as follows: +!> If IMEIG(i) == 0, then the corresponding eigenvalue is +!> real, LAMBDA(i) = REIG(i). +!> If IMEIG(i)>0, then the corresponding complex +!> conjugate pair of eigenvalues reads +!> LAMBDA(i) = REIG(i) + sqrt(-1)*IMAG(i) +!> LAMBDA(i+1) = REIG(i) - sqrt(-1)*IMAG(i) +!> That is, complex conjugate pairs have consecutive +!> indices (i,i+1), with the positive imaginary part +!> listed first. +!> See the descriptions of K, REIG, Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) REAL(KIND=WP) M-by-(N-1) array +!> If JOBZ =='V' then +!> Z contains real Ritz vectors as follows: +!> If IMEIG(i)=0, then Z(:,i) is an eigenvector of +!> the i-th Ritz value. +!> If IMEIG(i) > 0 (and IMEIG(i+1) < 0) then +!> [Z(:,i) Z(:,i+1)] span an invariant subspace and +!> the Ritz values extracted from this subspace are +!> REIG(i) + sqrt(-1)*IMEIG(i) and +!> REIG(i) - sqrt(-1)*IMEIG(i). +!> The corresponding eigenvectors are +!> Z(:,i) + sqrt(-1)*Z(:,i+1) and +!> Z(:,i) - sqrt(-1)*Z(:,i+1), respectively. +!> If JOBZ == 'F', then the above descriptions hold for +!> the columns of Z*V, where the columns of V are the +!> eigenvectors of the K-by-K Rayleigh quotient, and Z is +!> orthonormal. The columns of V are similarly structured: +!> If IMEIG(i) == 0 then Z*V(:,i) is an eigenvector, and if +!> IMEIG(i) > 0 then Z*V(:,i)+sqrt(-1)*Z*V(:,i+1) and +!> Z*V(:,i)-sqrt(-1)*Z*V(:,i+1) +!> are the eigenvectors of LAMBDA(i), LAMBDA(i+1). +!> See the descriptions of REIG, IMEIG, X and V. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) (N-1)-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs. +!> If LAMBDA(i) is real, then +!> RES(i) = || A * Z(:,i) - LAMBDA(i)*Z(:,i))||_2. +!> If [LAMBDA(i), LAMBDA(i+1)] is a complex conjugate pair +!> then +!> RES(i)=RES(i+1) = || A * Z(:,i:i+1) - Z(:,i:i+1) *B||_F +!> where B = [ real(LAMBDA(i)) imag(LAMBDA(i)) ] +!> [-imag(LAMBDA(i)) real(LAMBDA(i)) ]. +!> It holds that +!> RES(i) = || A*ZC(:,i) - LAMBDA(i) *ZC(:,i) ||_2 +!> RES(i+1) = || A*ZC(:,i+1) - LAMBDA(i+1)*ZC(:,i+1) ||_2 +!> where ZC(:,i) = Z(:,i) + sqrt(-1)*Z(:,i+1) +!> ZC(:,i+1) = Z(:,i) - sqrt(-1)*Z(:,i+1) +!> See the description of Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) REAL(KIND=WP) MIN(M,N)-by-(N-1) array. +!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:N,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> In both cases, the content of B can be lifted to the +!> original dimension of the input data by pre-multiplying +!> with the Q factor from the initial QR factorization. +!> Here A denotes a compression of the underlying operator. +!> See the descriptions of F and X. +!> If JOBF =='N', then B is not referenced. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= MIN(M,N) +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] V +!> \verbatim +!> V (workspace/output) REAL(KIND=WP) (N-1)-by-(N-1) array +!> On exit, V(1:K,1:K) contains the K eigenvectors of +!> the Rayleigh quotient. The eigenvectors of a complex +!> conjugate pair of eigenvalues are returned in real form +!> as explained in the description of Z. The Ritz vectors +!> (returned in Z) are the product of X and V; see +!> the descriptions of X and Z. +!> \endverbatim +!..... +!> \param[in] LDV +!> \verbatim +!> LDV (input) INTEGER, LDV >= N-1 +!> The leading dimension of the array V. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (output) REAL(KIND=WP) (N-1)-by-(N-1) array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by SGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N-1 +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, +!> WORK(1:MIN(M,N)) contains the scalar factors of the +!> elementary reflectors as returned by SGEQRF of the +!> M-by-N input matrix F. +!> WORK(MIN(M,N)+1:MIN(M,N)+N-1) contains the singular values of +!> the input submatrix F(1:M,1:N-1). +!> If the call to SGEDMDQ is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. Hence, the +!> length of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is calculated as follows: +!> Let MLWQR = N (minimal workspace for SGEQRF[M,N]) +!> MLWDMD = minimal workspace for SGEDMD (see the +!> description of LWORK in SGEDMD) for +!> snapshots of dimensions MIN(M,N)-by-(N-1) +!> MLWMQR = N (minimal workspace for +!> SORMQR['L','N',M,N,N]) +!> MLWGQR = N (minimal workspace for SORGQR[M,N,N]) +!> Then +!> LWORK = MAX(N+MLWQR, N+MLWDMD) +!> is updated as follows: +!> if JOBZ == 'V' or JOBZ == 'F' THEN +!> LWORK = MAX( LWORK,MIN(M,N)+N-1 +MLWMQR ) +!> if JOBQ == 'Q' THEN +!> LWORK = MAX( LWORK,MIN(M,N)+N-1+MLWGQR) +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> Let M1=MIN(M,N), N1=N-1. Then +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) +!> If on entry LIWORK = -1, then a worskpace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. +SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & + WHTSVD, M, N, F, LDF, X, LDX, Y, & + LDY, NRNK, TOL, K, REIG, IMEIG, & + Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real32 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & + JOBT, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & + LDY, NRNK, LDZ, LDB, LDV, & + LDS, LWORK, LIWORK + INTEGER, INTENT(OUT) :: INFO, K + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~~ + REAL(KIND=WP), INTENT(INOUT) :: F(LDF,*) + REAL(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & + Z(LDZ,*), B(LDB,*), & + V(LDV,*), S(LDS,*) + REAL(KIND=WP), INTENT(OUT) :: REIG(*), IMEIG(*), & + RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! +! Local scalars +! ~~~~~~~~~~~~~ + INTEGER :: IMINWR, INFO1, MLWDMD, MLWGQR, & + MLWMQR, MLWORK, MLWQR, MINMN, & + OLWDMD, OLWGQR, OLWMQR, OLWORK, & + OLWQR + LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & + WNTTRF, WNTRES, WNTVEC, WNTVCF, & + WNTVCQ, WNTREF, WNTEX + CHARACTER(LEN=1) :: JOBVL +! +! Local array +! ~~~~~~~~~~~ + REAL(KIND=WP) :: RDUMMY(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + LOGICAL LSAME + EXTERNAL LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL SGEMM + EXTERNAL SGEDMD, SGEQRF, SLACPY, SLASET, SORGQR, & + SORMQR, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC MAX, MIN, INT +!.......................................................... +! +! Test the input arguments + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTVCF = LSAME(JOBZ,'F') + WNTVCQ = LSAME(JOBZ,'Q') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + WANTQ = LSAME(JOBQ,'Q') + WNTTRF = LSAME(JOBT,'R') + MINMN = MIN(M,N) + INFO = 0 + LQUERY = ( ( LWORK == -1 ) .OR. ( LIWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & + .OR. LSAME(JOBZ,'N')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN + INFO = -4 + ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN + INFO = -5 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -6 + ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & + (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN + INFO = -7 + ELSE IF ( M < 0 ) THEN + INFO = -8 + ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN + INFO = -9 + ELSE IF ( LDF < M ) THEN + INFO = -11 + ELSE IF ( LDX < MINMN ) THEN + INFO = -13 + ELSE IF ( LDY < MINMN ) THEN + INFO = -15 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -16 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -17 + ELSE IF ( LDZ < M ) THEN + INFO = -22 + ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN + INFO = -25 + ELSE IF ( LDV < N-1 ) THEN + INFO = -27 + ELSE IF ( LDS < N-1 ) THEN + INFO = -29 + END IF +! + IF ( WNTVEC .OR. WNTVCF ) THEN + JOBVL = 'V' + ELSE + JOBVL = 'N' + END IF + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN + ! All output except K is void. INFO=1 signals + ! the void input. In case of a workspace query, + ! the minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + MLWQR = MAX(1,N) ! Minimal workspace length for SGEQRF. + MLWORK = MIN(M,N) + MLWQR + IF ( LQUERY ) THEN + CALL SGEQRF( M, N, F, LDF, WORK, RDUMMY, -1, & + INFO1 ) + OLWQR = INT(RDUMMY(1)) + OLWORK = MIN(M,N) + OLWQR + END IF + CALL SGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + REIG, IMEIG, Z, LDZ, RES, B, LDB, & + V, LDV, S, LDS, WORK, -1, IWORK, & + LIWORK, INFO1 ) + MLWDMD = INT(WORK(1)) + MLWORK = MAX(MLWORK, MINMN + MLWDMD) + IMINWR = IWORK(1) + IF ( LQUERY ) THEN + OLWDMD = INT(WORK(2)) + OLWORK = MAX(OLWORK, MINMN+OLWDMD) + END IF + IF ( WNTVEC .OR. WNTVCF ) THEN + MLWMQR = MAX(1,N) + MLWORK = MAX(MLWORK,MINMN+N-1+MLWMQR) + IF ( LQUERY ) THEN + CALL SORMQR( 'L','N', M, N, MINMN, F, LDF, & + WORK, Z, LDZ, WORK, -1, INFO1 ) + OLWMQR = INT(WORK(1)) + OLWORK = MAX(OLWORK,MINMN+N-1+OLWMQR) + END IF + END IF + IF ( WANTQ ) THEN + MLWGQR = N + MLWORK = MAX(MLWORK,MINMN+N-1+MLWGQR) + IF ( LQUERY ) THEN + CALL SORGQR( M, MINMN, MINMN, F, LDF, WORK, & + WORK, -1, INFO1 ) + OLWGQR = INT(WORK(1)) + OLWORK = MAX(OLWORK,MINMN+N-1+OLWGQR) + END IF + END IF + IMINWR = MAX( 1, IMINWR ) + MLWORK = MAX( 2, MLWORK ) + IF ( LWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -31 + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -33 + END IF + IF( INFO /= 0 ) THEN + CALL XERBLA( 'SGEDMDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + WORK(1) = MLWORK + WORK(2) = OLWORK + RETURN + END IF +!..... +! Initial QR factorization that is used to represent the +! snapshots as elements of lower dimensional subspace. +! For large scale computation with M >>N , at this place +! one can use an out of core QRF. +! + CALL SGEQRF( M, N, F, LDF, WORK, & + WORK(MINMN+1), LWORK-MINMN, INFO1 ) +! +! Define X and Y as the snapshots representations in the +! orthogonal basis computed in the QR factorization. +! X corresponds to the leading N-1 and Y to the trailing +! N-1 snapshots. + CALL SLASET( 'L', MINMN, N-1, ZERO, ZERO, X, LDX ) + CALL SLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) + CALL SLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) + IF ( M >= 3 ) THEN + CALL SLASET( 'L', MINMN-2, N-2, ZERO, ZERO, & + Y(3,1), LDY ) + END IF +! +! Compute the DMD of the projected snapshot pairs (X,Y) + CALL SGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + REIG, IMEIG, Z, LDZ, RES, B, LDB, V, & + LDV, S, LDS, WORK(MINMN+1), LWORK-MINMN, IWORK, & + LIWORK, INFO1 ) + IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN + ! Return with error code. + INFO = INFO1 + RETURN + ELSE + INFO = INFO1 + END IF +! +! The Ritz vectors (Koopman modes) can be explicitly +! formed or returned in factored form. + IF ( WNTVEC ) THEN + ! Compute the eigenvectors explicitly. + IF ( M > MINMN ) CALL SLASET( 'A', M-MINMN, K, ZERO, & + ZERO, Z(MINMN+1,1), LDZ ) + CALL SORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & + LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + ELSE IF ( WNTVCF ) THEN + ! Return the Ritz vectors (eigenvectors) in factored + ! form Z*V, where Z contains orthonormal matrix (the + ! product of Q from the initial QR factorization and + ! the SVD/POD_basis returned by SGEDMD in X) and the + ! second factor (the eigenvectors of the Rayleigh + ! quotient) is in the array V, as returned by SGEDMD. + CALL SLACPY( 'A', N, K, X, LDX, Z, LDZ ) + IF ( M > N ) CALL SLASET( 'A', M-N, K, ZERO, ZERO, & + Z(N+1,1), LDZ ) + CALL SORMQR( 'L','N', M, K, MINMN, F, LDF, WORK, Z, & + LDZ, WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + END IF +! +! Some optional output variables: +! +! The upper triangular factor in the initial QR +! factorization is optionally returned in the array Y. +! This is useful if this call to SGEDMDQ is to be +! followed by a streaming DMD that is implemented in a +! QR compressed form. + IF ( WNTTRF ) THEN ! Return the upper triangular R in Y + CALL SLASET( 'A', MINMN, N, ZERO, ZERO, Y, LDY ) + CALL SLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) + END IF +! +! The orthonormal/orthogonal factor in the initial QR +! factorization is optionally returned in the array F. +! Same as with the triangular factor above, this is +! useful in a streaming DMD. + IF ( WANTQ ) THEN ! Q overwrites F + CALL SORGQR( M, MINMN, MINMN, F, LDF, WORK, & + WORK(MINMN+N), LWORK-(MINMN+N-1), INFO1 ) + END IF +! + RETURN +! + END SUBROUTINE SGEDMDQ diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index 5045cb166c..385b82061f 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -1,1148 +1,1147 @@ -!> \brief \b ZGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & -! M, N, X, LDX, Y, LDY, NRNK, TOL, & -! K, EIGS, Z, LDZ, RES, B, LDB, & -! W, LDW, S, LDS, ZWORK, LZWORK, & -! RWORK, LRWORK, IWORK, LIWORK, INFO ) -!...... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real64 -! -!...... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & -! NRNK, LDZ, LDB, LDW, LDS, & -! LIWORK, LRWORK, LZWORK -! INTEGER, INTENT(OUT) :: K, INFO -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & -! W(LDW,*), S(LDS,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) -! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) -! REAL(KIND=WP), INTENT(OUT) :: RES(*) -! REAL(KIND=WP), INTENT(OUT) :: RWORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -! -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> ZGEDMD computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, ZGEDMD computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, ZGEDMD returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office -!> \endverbatim -!...................................................................... -!> \par Distribution Statement A: -! ============================== -!> \verbatim -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!............................................................ -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product X(:,1:K)*W, where X -!> contains a POD basis (leading left singular vectors -!> of the data matrix X) and W contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of K, X, W, Z. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will be -!> computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> \verbatim -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: ZGESVD (the QR SVD algorithm) -!> 2 :: ZGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: ZGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: ZGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M>= 0 -!> The state space dimension (the row dimension of X, Y). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshot pairs -!> (the number of columns of X and Y). -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> X (input/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, X contains the data snapshot matrix X. It is -!> assumed that the column norms of X are in the range of -!> the normalized floating point numbers. -!> < On exit, the leading K columns of X contain a POD basis, -!> i.e. the leading K left singular vectors of the input -!> data matrix X, U(:,1:K). All N columns of X contain all -!> left singular vectors of the input matrix X. -!> See the descriptions of K, Z and W. -!..... -!> LDX (input) INTEGER, LDX >= M -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (input/workspace/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, Y contains the data snapshot matrix Y -!> < On exit, -!> If JOBR == 'R', the leading K columns of Y contain -!> the residual vectors for the computed Ritz pairs. -!> See the description of RES. -!> If JOBR == 'N', Y contains the original input data, -!> scaled according to the value of JOBS. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= M -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the descriptions of TOL and K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the POD basis for the data snapshot -!> matrix X and the number of the computed Ritz pairs. -!> The value of K is determined according to the rule set -!> by the parameters NRNK and TOL. -!> See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] EIGS -!> \verbatim -!> EIGS (output) COMPLEX(KIND=WP) N-by-1 array -!> The leading K (K<=N) entries of EIGS contain -!> the computed eigenvalues (Ritz values). -!> See the descriptions of K, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) COMPLEX(KIND=WP) M-by-N array -!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) -!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. -!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as -!> the columns of X(:,1:K)*W(1:K,1:K), i.e. X(:,1:K)*W(:,i) -!> is an eigenvector corresponding to EIGS(i). The columns -!> of W(1:k,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. -!> See the descriptions of EIGS, X and W. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) N-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs, -!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. -!> See the description of EIGS and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) COMPLEX(KIND=WP) M-by-N array. -!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:M,1:K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> If JOBF =='N', then B is not referenced. -!> See the descriptions of X, W, K. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= M -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] W -!> \verbatim -!> W (workspace/output) COMPLEX(KIND=WP) N-by-N array -!> On exit, W(1:K,1:K) contains the K computed -!> eigenvectors of the matrix Rayleigh quotient. -!> The Ritz vectors (returned in Z) are the -!> product of X (containing a POD basis for the input -!> matrix X) and W. See the descriptions of K, S, X and Z. -!> W is also used as a workspace to temporarily store the -!> right singular vectors of X. -!> \endverbatim -!..... -!> \param[in] LDW -!> \verbatim -!> LDW (input) INTEGER, LDW >= N -!> The leading dimension of the array W. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (workspace/output) COMPLEX(KIND=WP) N-by-N array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by ZGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] ZWORK -!> \verbatim -!> ZWORK (workspace/output) COMPLEX(KIND=WP) LZWORK-by-1 array -!> ZWORK is used as complex workspace in the complex SVD, as -!> specified by WHTSVD (1,2, 3 or 4) and for ZGEEV for computing -!> the eigenvalues of a Rayleigh quotient. -!> If the call to ZGEDMD is only workspace query, then -!> ZWORK(1) contains the minimal complex workspace length and -!> ZWORK(2) is the optimal complex workspace length. -!> Hence, the length of work is at least 2. -!> See the description of LZWORK. -!> \endverbatim -!..... -!> \param[in] LZWORK -!> \verbatim -!> LZWORK (input) INTEGER -!> The minimal length of the workspace vector ZWORK. -!> LZWORK is calculated as MAX(LZWORK_SVD, LZWORK_ZGEEV), -!> where LZWORK_ZGEEV = MAX( 1, 2*N ) and the minimal -!> LZWORK_SVD is calculated as follows -!> If WHTSVD == 1 :: ZGESVD :: -!> LZWORK_SVD = MAX(1,2*MIN(M,N)+MAX(M,N)) -!> If WHTSVD == 2 :: ZGESDD :: -!> LZWORK_SVD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) -!> If WHTSVD == 3 :: ZGESVDQ :: -!> LZWORK_SVD = obtainable by a query -!> If WHTSVD == 4 :: ZGEJSV :: -!> LZWORK_SVD = obtainable by a query -!> If on entry LZWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths and returns them in -!> LZWORK(1) and LZWORK(2), respectively. -!> \endverbatim -!..... -!> \param[out] RWORK -!> \verbatim -!> RWORK (workspace/output) REAL(KIND=WP) LRWORK-by-1 array -!> On exit, RWORK(1:N) contains the singular values of -!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). -!> If WHTSVD==4, then RWORK(N+1) and RWORK(N+2) contain -!> scaling factor RWORK(N+2)/RWORK(N+1) used to scale X -!> and Y to avoid overflow in the SVD of X. -!> This may be of interest if the scaling option is off -!> and as many as possible smallest eigenvalues are -!> desired to the highest feasible accuracy. -!> If the call to ZGEDMD is only workspace query, then -!> RWORK(1) contains the minimal workspace length. -!> See the description of LRWORK. -!> \endverbatim -!..... -!> \param[in] LRWORK -!> \verbatim -!> LRWORK (input) INTEGER -!> The minimal length of the workspace vector RWORK. -!> LRWORK is calculated as follows: -!> LRWORK = MAX(1, N+LRWORK_SVD,N+LRWORK_ZGEEV), where -!> LRWORK_ZGEEV = MAX(1,2*N) and RWORK_SVD is the real workspace -!> for the SVD subroutine determined by the input parameter -!> WHTSVD. -!> If WHTSVD == 1 :: ZGESVD :: -!> LRWORK_SVD = 5*MIN(M,N) -!> If WHTSVD == 2 :: ZGESDD :: -!> LRWORK_SVD = MAX(5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), -!> 2*MAX(M,N)*MIN(M,N)+2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) -!> If WHTSVD == 3 :: ZGESVDQ :: -!> LRWORK_SVD = obtainable by a query -!> If WHTSVD == 4 :: ZGEJSV :: -!> LRWORK_SVD = obtainable by a query -!> If on entry LRWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> real workspace length and returns it in RWORK(1). -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for ZWORK, RWORK and -!> IWORK. See the descriptions of ZWORK, RWORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. - SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, EIGS, Z, LDZ, RES, B, LDB, & - W, LDW, S, LDS, ZWORK, LZWORK, & - RWORK, LRWORK, IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real64 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & - NRNK, LDZ, LDB, LDW, LDS, & - LIWORK, LRWORK, LZWORK - INTEGER, INTENT(OUT) :: K, INFO - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) - COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & - W(LDW,*), S(LDS,*) - COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) - COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) - REAL(KIND=WP), INTENT(OUT) :: RES(*) - REAL(KIND=WP), INTENT(OUT) :: RWORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP - COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) -! -! Local scalars -! ~~~~~~~~~~~~~ - REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & - SSUM, XSCL1, XSCL2 - INTEGER :: i, j, IMINWR, INFO1, INFO2, & - LWRKEV, LWRSDD, LWRSVD, LWRSVJ, & - LWRSVQ, MLWORK, MWRKEV, MWRSDD, & - MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & - OLWORK, MLRWRK - LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & - WNTEX, WNTREF, WNTRES, WNTVEC - CHARACTER :: JOBZL, T_OR_N - CHARACTER :: JSVOPT -! -! Local arrays -! ~~~~~~~~~~~~ - REAL(KIND=WP) :: RDUMMY(2) -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - REAL(KIND=WP) ZLANGE, DLAMCH, DZNRM2 - EXTERNAL ZLANGE, DLAMCH, DZNRM2, IZAMAX - INTEGER IZAMAX - LOGICAL DISNAN, LSAME - EXTERNAL DISNAN, LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL ZAXPY, ZGEMM, ZDSCAL - EXTERNAL ZGEEV, ZGEJSV, ZGESDD, ZGESVD, ZGESVDQ, & - ZLACPY, ZLASCL, ZLASSQ, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC DBLE, INT, MAX, SQRT -!............................................................ -! -! Test the input arguments -! - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - INFO = 0 - LQUERY = ( ( LZWORK == -1 ) .OR. ( LIWORK == -1 ) & - .OR. ( LRWORK == -1 ) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & - .OR. LSAME(JOBZ,'F')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -4 - ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & - (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN - INFO = -5 - ELSE IF ( M < 0 ) THEN - INFO = -6 - ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN - INFO = -7 - ELSE IF ( LDX < M ) THEN - INFO = -9 - ELSE IF ( LDY < M ) THEN - INFO = -11 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -12 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -13 - ELSE IF ( LDZ < M ) THEN - INFO = -17 - ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN - INFO = -20 - ELSE IF ( LDW < N ) THEN - INFO = -22 - ELSE IF ( LDS < N ) THEN - INFO = -24 - END IF -! - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( N == 0 ) THEN - ! Quick return. All output except K is void. - ! INFO=1 signals the void input. - ! In case of a workspace query, the default - ! minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - RWORK(1) = 1 - ZWORK(1) = 2 - ZWORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - - IMINWR = 1 - MLRWRK = MAX(1,N) - MLWORK = 2 - OLWORK = 2 - SELECT CASE ( WHTSVD ) - CASE (1) - ! The following is specified as the minimal - ! length of WORK in the definition of ZGESVD: - ! MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) - MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) - MLWORK = MAX(MLWORK,MWRSVD) - MLRWRK = MAX(MLRWRK,N + 5*MIN(M,N)) - IF ( LQUERY ) THEN - CALL ZGESVD( 'O', 'S', M, N, X, LDX, RWORK, & - B, LDB, W, LDW, ZWORK, -1, RDUMMY, INFO1 ) - LWRSVD = INT( ZWORK(1) ) - OLWORK = MAX(OLWORK,LWRSVD) - END IF - CASE (2) - ! The following is specified as the minimal - ! length of WORK in the definition of ZGESDD: - ! MWRSDD = 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). - ! RWORK length: 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N) - ! In LAPACK 3.10.1 RWORK is defined differently. - ! Below we take max over the two versions. - ! IMINWR = 8*MIN(M,N) - MWRSDD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) - MLWORK = MAX(MLWORK,MWRSDD) - IMINWR = 8*MIN(M,N) - MLRWRK = MAX( MLRWRK, N + & - MAX( 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), & - 5*MIN(M,N)*MIN(M,N)+5*MIN(M,N), & - 2*MAX(M,N)*MIN(M,N)+ & - 2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) - IF ( LQUERY ) THEN - CALL ZGESDD( 'O', M, N, X, LDX, RWORK, B,LDB,& - W, LDW, ZWORK, -1, RDUMMY, IWORK, INFO1 ) - LWRSDD = MAX( MWRSDD,INT( ZWORK(1) )) - ! Possible bug in ZGESDD optimal workspace size. - OLWORK = MAX(OLWORK,LWRSDD) - END IF - CASE (3) - CALL ZGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, RWORK, Z, LDZ, W, LDW, NUMRNK, & - IWORK, -1, ZWORK, -1, RDUMMY, -1, INFO1 ) - IMINWR = IWORK(1) - MWRSVQ = INT(ZWORK(2)) - MLWORK = MAX(MLWORK,MWRSVQ) - MLRWRK = MAX(MLRWRK,N + INT(RDUMMY(1))) - IF ( LQUERY ) THEN - LWRSVQ = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,LWRSVQ) - END IF - CASE (4) - JSVOPT = 'J' - CALL ZGEJSV( 'F', 'U', JSVOPT, 'R', 'N', 'P', M, & - N, X, LDX, RWORK, Z, LDZ, W, LDW, & - ZWORK, -1, RDUMMY, -1, IWORK, INFO1 ) - IMINWR = IWORK(1) - MWRSVJ = INT(ZWORK(2)) - MLWORK = MAX(MLWORK,MWRSVJ) - MLRWRK = MAX(MLRWRK,N + MAX(7,INT(RDUMMY(1)))) - IF ( LQUERY ) THEN - LWRSVJ = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,LWRSVJ) - END IF - END SELECT - IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN - JOBZL = 'V' - ELSE - JOBZL = 'N' - END IF - ! Workspace calculation to the ZGEEV call - MWRKEV = MAX( 1, 2*N ) - MLWORK = MAX(MLWORK,MWRKEV) - MLRWRK = MAX(MLRWRK,N+2*N) - IF ( LQUERY ) THEN - CALL ZGEEV( 'N', JOBZL, N, S, LDS, EIGS, & - W, LDW, W, LDW, ZWORK, -1, RWORK, INFO1 ) - LWRKEV = INT(ZWORK(1)) - OLWORK = MAX( OLWORK, LWRKEV ) - END IF -! - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -30 - IF ( LRWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -28 - IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -26 - - END IF -! - IF( INFO /= 0 ) THEN - CALL XERBLA( 'ZGEDMD', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - RWORK(1) = MLRWRK - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK - RETURN - END IF -!............................................................ -! - OFL = DLAMCH('O') - SMALL = DLAMCH('S') - BADXY = .FALSE. -! -! <1> Optional scaling of the snapshots (columns of X, Y) -! ========================================================== - IF ( SCCOLX ) THEN - ! The columns of X will be normalized. - ! To prevent overflows, the column norms of X are - ! carefully computed using ZLASSQ. - K = 0 - DO i = 1, N - !WORK(i) = DZNRM2( M, X(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL ZLASSQ( M, X(1,i), 1, SCALE, SSUM ) - IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN - K = 0 - INFO = -8 - CALL XERBLA('ZGEDMD',-INFO) - END IF - IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of X(:,i) overflows. First, X(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. -! Next, the norm of X(:,i) is stored without -! overflow as RWORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of X(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL ZLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, X(1,i), LDX, INFO2 ) - RWORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) - ELSE -! X(:,i) will be scaled to unit 2-norm - RWORK(i) = SCALE * ROOTSC - CALL ZLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & - X(1,i), LDX, INFO2 ) ! LAPACK CALL -! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC - END IF - ELSE - RWORK(i) = ZERO - K = K + 1 - END IF - END DO - IF ( K == N ) THEN - ! All columns of X are zero. Return error code -8. - ! (the 8th input variable had an illegal value) - K = 0 - INFO = -8 - CALL XERBLA('ZGEDMD',-INFO) - RETURN - END IF - DO i = 1, N -! Now, apply the same scaling to the columns of Y. - IF ( RWORK(i) > ZERO ) THEN - CALL ZDSCAL( M, ONE/RWORK(i), Y(1,i), 1 ) ! BLAS CALL -! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC - ELSE IF ( RWORK(i) < ZERO ) THEN - CALL ZLASCL( 'G', 0, 0, -RWORK(i), & - ONE/DBLE(M), M, 1, Y(1,i), LDY, INFO2 ) ! LAPACK CALL - ELSE IF ( ABS(Y(IZAMAX(M, Y(1,i),1),i )) & - /= ZERO ) THEN -! X(:,i) is zero vector. For consistency, -! Y(:,i) should also be zero. If Y(:,i) is not -! zero, then the data might be inconsistent or -! corrupted. If JOBS == 'C', Y(:,i) is set to -! zero and a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - IF ( LSAME(JOBS,'C')) & - CALL ZDSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL - END IF - END DO - END IF - ! - IF ( SCCOLY ) THEN - ! The columns of Y will be normalized. - ! To prevent overflows, the column norms of Y are - ! carefully computed using ZLASSQ. - DO i = 1, N - !RWORK(i) = DZNRM2( M, Y(1,i), 1 ) - SSUM = ONE - SCALE = ZERO - CALL ZLASSQ( M, Y(1,i), 1, SCALE, SSUM ) - IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN - K = 0 - INFO = -10 - CALL XERBLA('ZGEDMD',-INFO) - END IF - IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN - ROOTSC = SQRT(SSUM) - IF ( SCALE .GE. (OFL / ROOTSC) ) THEN -! Norm of Y(:,i) overflows. First, Y(:,i) -! is scaled by -! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. -! Next, the norm of Y(:,i) is stored without -! overflow as RWORK(i) = - SCALE * (ROOTSC/M), -! the minus sign indicating the 1/M factor. -! Scaling is performed without overflow, and -! underflow may occur in the smallest entries -! of Y(:,i). The relative backward and forward -! errors are small in the ell_2 norm. - CALL ZLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & - M, 1, Y(1,i), LDY, INFO2 ) - RWORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) - ELSE -! Y(:,i) will be scaled to unit 2-norm - RWORK(i) = SCALE * ROOTSC - CALL ZLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & - Y(1,i), LDY, INFO2 ) ! LAPACK CALL -! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC - END IF - ELSE - RWORK(i) = ZERO - END IF - END DO - DO i = 1, N -! Now, apply the same scaling to the columns of X. - IF ( RWORK(i) > ZERO ) THEN - CALL ZDSCAL( M, ONE/RWORK(i), X(1,i), 1 ) ! BLAS CALL -! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC - ELSE IF ( RWORK(i) < ZERO ) THEN - CALL ZLASCL( 'G', 0, 0, -RWORK(i), & - ONE/DBLE(M), M, 1, X(1,i), LDX, INFO2 ) ! LAPACK CALL - ELSE IF ( ABS(X(IZAMAX(M, X(1,i),1),i )) & - /= ZERO ) THEN -! Y(:,i) is zero vector. If X(:,i) is not -! zero, then a warning flag is raised. -! The computation continues but the -! situation will be reported in the output. - BADXY = .TRUE. - END IF - END DO - END IF -! -! <2> SVD of the data snapshot matrix X. -! ===================================== -! The left singular vectors are stored in the array X. -! The right singular vectors are in the array W. -! The array W will later on contain the eigenvectors -! of a Rayleigh quotient. - NUMRNK = N - SELECT CASE ( WHTSVD ) - CASE (1) - CALL ZGESVD( 'O', 'S', M, N, X, LDX, RWORK, B, & - LDB, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL - T_OR_N = 'C' - CASE (2) - CALL ZGESDD( 'O', M, N, X, LDX, RWORK, B, LDB, W, & - LDW, ZWORK, LZWORK, RWORK(N+1), IWORK, INFO1 ) ! LAPACK CALL - T_OR_N = 'C' - CASE (3) - CALL ZGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & - X, LDX, RWORK, Z, LDZ, W, LDW, & - NUMRNK, IWORK, LIWORK, ZWORK, & - LZWORK, RWORK(N+1), LRWORK-N, INFO1) ! LAPACK CALL - CALL ZLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'C' - CASE (4) - CALL ZGEJSV( 'F', 'U', JSVOPT, 'R', 'N', 'P', M, & - N, X, LDX, RWORK, Z, LDZ, W, LDW, & - ZWORK, LZWORK, RWORK(N+1), LRWORK-N, IWORK, INFO1 ) ! LAPACK CALL - CALL ZLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL - T_OR_N = 'N' - XSCL1 = RWORK(N+1) - XSCL2 = RWORK(N+2) - IF ( XSCL1 /= XSCL2 ) THEN - ! This is an exceptional situation. If the - ! data matrices are not scaled and the - ! largest singular value of X overflows. - ! In that case ZGEJSV can return the SVD - ! in scaled form. The scaling factor can be used - ! to rescale the data (X and Y). - CALL ZLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) - END IF - END SELECT -! - IF ( INFO1 > 0 ) THEN - ! The SVD selected subroutine did not converge. - ! Return with an error code. - INFO = 2 - RETURN - END IF -! - IF ( RWORK(1) == ZERO ) THEN - ! The largest computed singular value of (scaled) - ! X is zero. Return error code -8 - ! (the 8th input variable had an illegal value). - K = 0 - INFO = -8 - CALL XERBLA('ZGEDMD',-INFO) - RETURN - END IF -! - !<3> Determine the numerical rank of the data - ! snapshots matrix X. This depends on the - ! parameters NRNK and TOL. - - SELECT CASE ( NRNK ) - CASE ( -1 ) - K = 1 - DO i = 2, NUMRNK - IF ( ( RWORK(i) <= RWORK(1)*TOL ) .OR. & - ( RWORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE ( -2 ) - K = 1 - DO i = 1, NUMRNK-1 - IF ( ( RWORK(i+1) <= RWORK(i)*TOL ) .OR. & - ( RWORK(i) <= SMALL ) ) EXIT - K = K + 1 - END DO - CASE DEFAULT - K = 1 - DO i = 2, NRNK - IF ( RWORK(i) <= SMALL ) EXIT - K = K + 1 - END DO - END SELECT - ! Now, U = X(1:M,1:K) is the SVD/POD basis for the - ! snapshot data in the input matrix X. - - !<4> Compute the Rayleigh quotient S = U^H * A * U. - ! Depending on the requested outputs, the computation - ! is organized to compute additional auxiliary - ! matrices (for the residuals and refinements). - ! - ! In all formulas below, we need V_k*Sigma_k^(-1) - ! where either V_k is in W(1:N,1:K), or V_k^H is in - ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). - IF ( LSAME(T_OR_N, 'N') ) THEN - DO i = 1, K - CALL ZDSCAL( N, ONE/RWORK(i), W(1,i), 1 ) ! BLAS CALL - ! W(1:N,i) = (ONE/RWORK(i)) * W(1:N,i) ! INTRINSIC - END DO - ELSE - ! This non-unit stride access is due to the fact - ! that ZGESVD, ZGESVDQ and ZGESDD return the - ! adjoint matrix of the right singular vectors. - !DO i = 1, K - ! CALL ZDSCAL( N, ONE/RWORK(i), W(i,1), LDW ) ! BLAS CALL - ! ! W(i,1:N) = (ONE/RWORK(i)) * W(i,1:N) ! INTRINSIC - !END DO - DO i = 1, K - RWORK(N+i) = ONE/RWORK(i) - END DO - DO j = 1, N - DO i = 1, K - W(i,j) = CMPLX(RWORK(N+i),ZERO,KIND=WP)*W(i,j) - END DO - END DO - END IF -! - IF ( WNTREF ) THEN - ! - ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) - ! for computing the refined Ritz vectors - ! (optionally, outside ZGEDMD). - CALL ZGEMM( 'N', T_OR_N, M, K, N, ZONE, Y, LDY, W, & - LDW, ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(CONJG(W(1:K,1:N)))) ! INTRINSIC, for T_OR_N=='C' - ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' - ! - ! At this point Z contains - ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and - ! this is needed for computing the residuals. - ! This matrix is returned in the array B and - ! it can be used to compute refined Ritz vectors. - CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL - ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC - - CALL ZGEMM( 'C', 'N', K, K, M, ZONE, X, LDX, Z, & - LDZ, ZZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(TRANSPOSE(CONJG(X(1:M,1:K))),Z(1:M,1:K)) ! INTRINSIC - ! At this point S = U^H * A * U is the Rayleigh quotient. - ELSE - ! A * U(:,1:K) is not explicitly needed and the - ! computation is organized differently. The Rayleigh - ! quotient is computed more efficiently. - CALL ZGEMM( 'C', 'N', K, N, M, ZONE, X, LDX, Y, LDY, & - ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:K,1:N) = MATMUL( TRANSPOSE(CONJG(X(1:M,1:K))), Y(1:M,1:N) ) ! INTRINSIC - ! - CALL ZGEMM( 'N', T_OR_N, K, K, N, ZONE, Z, LDZ, W, & - LDW, ZZERO, S, LDS ) ! BLAS CALL - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(CONJG(W(1:K,1:N)))) ! INTRINSIC, for T_OR_N=='T' - ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' - ! At this point S = U^H * A * U is the Rayleigh quotient. - ! If the residuals are requested, save scaled V_k into Z. - ! Recall that V_k or V_k^H is stored in W. - IF ( WNTRES .OR. WNTEX ) THEN - IF ( LSAME(T_OR_N, 'N') ) THEN - CALL ZLACPY( 'A', N, K, W, LDW, Z, LDZ ) - ELSE - CALL ZLACPY( 'A', K, N, W, LDW, Z, LDZ ) - END IF - END IF - END IF -! - !<5> Compute the Ritz values and (if requested) the - ! right eigenvectors of the Rayleigh quotient. - ! - CALL ZGEEV( 'N', JOBZL, K, S, LDS, EIGS, W, LDW, & - W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL - ! - ! W(1:K,1:K) contains the eigenvectors of the Rayleigh - ! quotient. See the description of Z. - ! Also, see the description of ZGEEV. - IF ( INFO1 > 0 ) THEN - ! ZGEEV failed to compute the eigenvalues and - ! eigenvectors of the Rayleigh quotient. - INFO = 3 - RETURN - END IF -! - ! <6> Compute the eigenvectors (if requested) and, - ! the residuals (if requested). - ! - IF ( WNTVEC .OR. WNTEX ) THEN - IF ( WNTRES ) THEN - IF ( WNTREF ) THEN - ! Here, if the refinement is requested, we have - ! A*U(:,1:K) already computed and stored in Z. - ! For the residuals, need Y = A * U(:,1;K) * W. - CALL ZGEMM( 'N', 'N', M, K, K, ZONE, Z, LDZ, W, & - LDW, ZZERO, Y, LDY ) ! BLAS CALL - ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC - ! This frees Z; Y contains A * U(:,1:K) * W. - ELSE - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) (or its adjoint) is stored in Z - CALL ZGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & - W, LDW, ZZERO, S, LDS ) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - LDS, ZZERO, Z, LDZ ) - ! Save a copy of Z into Y and free Z for holding - ! the Ritz vectors. - CALL ZLACPY( 'A', M, K, Z, LDZ, Y, LDY ) - IF ( WNTEX ) CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF - ELSE IF ( WNTEX ) THEN - ! Compute S = V_k * Sigma_k^(-1) * W, where - ! V_k * Sigma_k^(-1) is stored in Z - CALL ZGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & - W, LDW, ZZERO, S, LDS ) - ! Then, compute Z = Y * S = - ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = - ! = A * U(:,1:K) * W(1:K,1:K) - CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - LDS, ZZERO, B, LDB ) - ! The above call replaces the following two calls - ! that were used in the developing-testing phase. - ! CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & - ! LDS, ZZERO, Z, LDZ) - ! Save a copy of Z into B and free Z for holding - ! the Ritz vectors. - ! CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) - END IF -! - ! Compute the Ritz vectors - IF ( WNTVEC ) CALL ZGEMM( 'N', 'N', M, K, K, ZONE, X, LDX, W, LDW, & - ZZERO, Z, LDZ ) ! BLAS CALL - ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC -! - IF ( WNTRES ) THEN - DO i = 1, K - CALL ZAXPY( M, -EIGS(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL - ! Y(1:M,i) = Y(1:M,i) - EIGS(i) * Z(1:M,i) ! INTRINSIC - RES(i) = DZNRM2( M, Y(1,i), 1 ) ! BLAS CALL - END DO - END IF - END IF -! - IF ( WHTSVD == 4 ) THEN - RWORK(N+1) = XSCL1 - RWORK(N+2) = XSCL2 - END IF -! -! Successful exit. - IF ( .NOT. BADXY ) THEN - INFO = 0 - ELSE - ! A warning on possible data inconsistency. - ! This should be a rare event. - INFO = 4 - END IF -!............................................................ - RETURN -! ...... - END SUBROUTINE ZGEDMD - +!> \brief \b ZGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & +! M, N, X, LDX, Y, LDY, NRNK, TOL, & +! K, EIGS, Z, LDZ, RES, B, LDB, & +! W, LDW, S, LDS, ZWORK, LZWORK, & +! RWORK, LRWORK, IWORK, LIWORK, INFO ) +!...... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real64 +! +!...... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & +! NRNK, LDZ, LDB, LDW, LDS, & +! LIWORK, LRWORK, LZWORK +! INTEGER, INTENT(OUT) :: K, INFO +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & +! W(LDW,*), S(LDS,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) +! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) +! REAL(KIND=WP), INTENT(OUT) :: RES(*) +! REAL(KIND=WP), INTENT(OUT) :: RWORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +! +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> ZGEDMD computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, ZGEDMD computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, ZGEDMD returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office +!> \endverbatim +!...................................................................... +!> \par Distribution Statement A: +! ============================== +!> \verbatim +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!............................................................ +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product X(:,1:K)*W, where X +!> contains a POD basis (leading left singular vectors +!> of the data matrix X) and W contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of K, X, W, Z. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will be +!> computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> \verbatim +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: ZGESVD (the QR SVD algorithm) +!> 2 :: ZGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: ZGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: ZGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M>= 0 +!> The state space dimension (the row dimension of X, Y). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshot pairs +!> (the number of columns of X and Y). +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> X (input/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, X contains the data snapshot matrix X. It is +!> assumed that the column norms of X are in the range of +!> the normalized floating point numbers. +!> < On exit, the leading K columns of X contain a POD basis, +!> i.e. the leading K left singular vectors of the input +!> data matrix X, U(:,1:K). All N columns of X contain all +!> left singular vectors of the input matrix X. +!> See the descriptions of K, Z and W. +!..... +!> LDX (input) INTEGER, LDX >= M +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (input/workspace/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, Y contains the data snapshot matrix Y +!> < On exit, +!> If JOBR == 'R', the leading K columns of Y contain +!> the residual vectors for the computed Ritz pairs. +!> See the description of RES. +!> If JOBR == 'N', Y contains the original input data, +!> scaled according to the value of JOBS. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= M +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the descriptions of TOL and K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the POD basis for the data snapshot +!> matrix X and the number of the computed Ritz pairs. +!> The value of K is determined according to the rule set +!> by the parameters NRNK and TOL. +!> See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] EIGS +!> \verbatim +!> EIGS (output) COMPLEX(KIND=WP) N-by-1 array +!> The leading K (K<=N) entries of EIGS contain +!> the computed eigenvalues (Ritz values). +!> See the descriptions of K, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) COMPLEX(KIND=WP) M-by-N array +!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) +!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. +!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as +!> the columns of X(:,1:K)*W(1:K,1:K), i.e. X(:,1:K)*W(:,i) +!> is an eigenvector corresponding to EIGS(i). The columns +!> of W(1:k,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. +!> See the descriptions of EIGS, X and W. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) N-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs, +!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. +!> See the description of EIGS and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) COMPLEX(KIND=WP) M-by-N array. +!> IF JOBF =='R', B(1:M,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:M,1:K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> If JOBF =='N', then B is not referenced. +!> See the descriptions of X, W, K. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= M +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] W +!> \verbatim +!> W (workspace/output) COMPLEX(KIND=WP) N-by-N array +!> On exit, W(1:K,1:K) contains the K computed +!> eigenvectors of the matrix Rayleigh quotient. +!> The Ritz vectors (returned in Z) are the +!> product of X (containing a POD basis for the input +!> matrix X) and W. See the descriptions of K, S, X and Z. +!> W is also used as a workspace to temporarily store the +!> right singular vectors of X. +!> \endverbatim +!..... +!> \param[in] LDW +!> \verbatim +!> LDW (input) INTEGER, LDW >= N +!> The leading dimension of the array W. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (workspace/output) COMPLEX(KIND=WP) N-by-N array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by ZGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] ZWORK +!> \verbatim +!> ZWORK (workspace/output) COMPLEX(KIND=WP) LZWORK-by-1 array +!> ZWORK is used as complex workspace in the complex SVD, as +!> specified by WHTSVD (1,2, 3 or 4) and for ZGEEV for computing +!> the eigenvalues of a Rayleigh quotient. +!> If the call to ZGEDMD is only workspace query, then +!> ZWORK(1) contains the minimal complex workspace length and +!> ZWORK(2) is the optimal complex workspace length. +!> Hence, the length of work is at least 2. +!> See the description of LZWORK. +!> \endverbatim +!..... +!> \param[in] LZWORK +!> \verbatim +!> LZWORK (input) INTEGER +!> The minimal length of the workspace vector ZWORK. +!> LZWORK is calculated as MAX(LZWORK_SVD, LZWORK_ZGEEV), +!> where LZWORK_ZGEEV = MAX( 1, 2*N ) and the minimal +!> LZWORK_SVD is calculated as follows +!> If WHTSVD == 1 :: ZGESVD :: +!> LZWORK_SVD = MAX(1,2*MIN(M,N)+MAX(M,N)) +!> If WHTSVD == 2 :: ZGESDD :: +!> LZWORK_SVD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) +!> If WHTSVD == 3 :: ZGESVDQ :: +!> LZWORK_SVD = obtainable by a query +!> If WHTSVD == 4 :: ZGEJSV :: +!> LZWORK_SVD = obtainable by a query +!> If on entry LZWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths and returns them in +!> LZWORK(1) and LZWORK(2), respectively. +!> \endverbatim +!..... +!> \param[out] RWORK +!> \verbatim +!> RWORK (workspace/output) REAL(KIND=WP) LRWORK-by-1 array +!> On exit, RWORK(1:N) contains the singular values of +!> X (for JOBS=='N') or column scaled X (JOBS=='S', 'C'). +!> If WHTSVD==4, then RWORK(N+1) and RWORK(N+2) contain +!> scaling factor RWORK(N+2)/RWORK(N+1) used to scale X +!> and Y to avoid overflow in the SVD of X. +!> This may be of interest if the scaling option is off +!> and as many as possible smallest eigenvalues are +!> desired to the highest feasible accuracy. +!> If the call to ZGEDMD is only workspace query, then +!> RWORK(1) contains the minimal workspace length. +!> See the description of LRWORK. +!> \endverbatim +!..... +!> \param[in] LRWORK +!> \verbatim +!> LRWORK (input) INTEGER +!> The minimal length of the workspace vector RWORK. +!> LRWORK is calculated as follows: +!> LRWORK = MAX(1, N+LRWORK_SVD,N+LRWORK_ZGEEV), where +!> LRWORK_ZGEEV = MAX(1,2*N) and RWORK_SVD is the real workspace +!> for the SVD subroutine determined by the input parameter +!> WHTSVD. +!> If WHTSVD == 1 :: ZGESVD :: +!> LRWORK_SVD = 5*MIN(M,N) +!> If WHTSVD == 2 :: ZGESDD :: +!> LRWORK_SVD = MAX(5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), +!> 2*MAX(M,N)*MIN(M,N)+2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) +!> If WHTSVD == 3 :: ZGESVDQ :: +!> LRWORK_SVD = obtainable by a query +!> If WHTSVD == 4 :: ZGEJSV :: +!> LRWORK_SVD = obtainable by a query +!> If on entry LRWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> real workspace length and returns it in RWORK(1). +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M,N)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M+N-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M+3*N) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for ZWORK, RWORK and +!> IWORK. See the descriptions of ZWORK, RWORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. + SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, EIGS, Z, LDZ, RES, B, LDB, & + W, LDW, S, LDS, ZWORK, LZWORK, & + RWORK, LRWORK, IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real64 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDX, LDY, & + NRNK, LDZ, LDB, LDW, LDS, & + LIWORK, LRWORK, LZWORK + INTEGER, INTENT(OUT) :: K, INFO + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + COMPLEX(KIND=WP), INTENT(INOUT) :: X(LDX,*), Y(LDY,*) + COMPLEX(KIND=WP), INTENT(OUT) :: Z(LDZ,*), B(LDB,*), & + W(LDW,*), S(LDS,*) + COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) + COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) + REAL(KIND=WP), INTENT(OUT) :: RES(*) + REAL(KIND=WP), INTENT(OUT) :: RWORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP + COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) +! +! Local scalars +! ~~~~~~~~~~~~~ + REAL(KIND=WP) :: OFL, ROOTSC, SCALE, SMALL, & + SSUM, XSCL1, XSCL2 + INTEGER :: i, j, IMINWR, INFO1, INFO2, & + LWRKEV, LWRSDD, LWRSVD, LWRSVJ, & + LWRSVQ, MLWORK, MWRKEV, MWRSDD, & + MWRSVD, MWRSVJ, MWRSVQ, NUMRNK, & + OLWORK, MLRWRK + LOGICAL :: BADXY, LQUERY, SCCOLX, SCCOLY, & + WNTEX, WNTREF, WNTRES, WNTVEC + CHARACTER :: JOBZL, T_OR_N + CHARACTER :: JSVOPT +! +! Local arrays +! ~~~~~~~~~~~~ + REAL(KIND=WP) :: RDUMMY(2) +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + REAL(KIND=WP) ZLANGE, DLAMCH, DZNRM2 + EXTERNAL ZLANGE, DLAMCH, DZNRM2, IZAMAX + INTEGER IZAMAX + LOGICAL DISNAN, LSAME + EXTERNAL DISNAN, LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL ZAXPY, ZGEMM, ZDSCAL + EXTERNAL ZGEEV, ZGEJSV, ZGESDD, ZGESVD, ZGESVDQ, & + ZLACPY, ZLASCL, ZLASSQ, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC DBLE, INT, MAX, SQRT +!............................................................ +! +! Test the input arguments +! + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME(JOBS,'C') + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + INFO = 0 + LQUERY = ( ( LZWORK == -1 ) .OR. ( LIWORK == -1 ) & + .OR. ( LRWORK == -1 ) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. LSAME(JOBZ,'N') & + .OR. LSAME(JOBZ,'F')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. (.NOT.WNTVEC) ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -4 + ELSE IF ( .NOT.((WHTSVD == 1) .OR. (WHTSVD == 2) .OR. & + (WHTSVD == 3) .OR. (WHTSVD == 4) )) THEN + INFO = -5 + ELSE IF ( M < 0 ) THEN + INFO = -6 + ELSE IF ( ( N < 0 ) .OR. ( N > M ) ) THEN + INFO = -7 + ELSE IF ( LDX < M ) THEN + INFO = -9 + ELSE IF ( LDY < M ) THEN + INFO = -11 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -12 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -13 + ELSE IF ( LDZ < M ) THEN + INFO = -17 + ELSE IF ( (WNTREF .OR. WNTEX ) .AND. ( LDB < M ) ) THEN + INFO = -20 + ELSE IF ( LDW < N ) THEN + INFO = -22 + ELSE IF ( LDS < N ) THEN + INFO = -24 + END IF +! + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( N == 0 ) THEN + ! Quick return. All output except K is void. + ! INFO=1 signals the void input. + ! In case of a workspace query, the default + ! minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + RWORK(1) = 1 + ZWORK(1) = 2 + ZWORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + + IMINWR = 1 + MLRWRK = MAX(1,N) + MLWORK = 2 + OLWORK = 2 + SELECT CASE ( WHTSVD ) + CASE (1) + ! The following is specified as the minimal + ! length of WORK in the definition of ZGESVD: + ! MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) + MWRSVD = MAX(1,2*MIN(M,N)+MAX(M,N)) + MLWORK = MAX(MLWORK,MWRSVD) + MLRWRK = MAX(MLRWRK,N + 5*MIN(M,N)) + IF ( LQUERY ) THEN + CALL ZGESVD( 'O', 'S', M, N, X, LDX, RWORK, & + B, LDB, W, LDW, ZWORK, -1, RDUMMY, INFO1 ) + LWRSVD = INT( ZWORK(1) ) + OLWORK = MAX(OLWORK,LWRSVD) + END IF + CASE (2) + ! The following is specified as the minimal + ! length of WORK in the definition of ZGESDD: + ! MWRSDD = 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). + ! RWORK length: 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N) + ! In LAPACK 3.10.1 RWORK is defined differently. + ! Below we take max over the two versions. + ! IMINWR = 8*MIN(M,N) + MWRSDD = 2*MIN(M,N)*MIN(M,N)+2*MIN(M,N)+MAX(M,N) + MLWORK = MAX(MLWORK,MWRSDD) + IMINWR = 8*MIN(M,N) + MLRWRK = MAX( MLRWRK, N + & + MAX( 5*MIN(M,N)*MIN(M,N)+7*MIN(M,N), & + 5*MIN(M,N)*MIN(M,N)+5*MIN(M,N), & + 2*MAX(M,N)*MIN(M,N)+ & + 2*MIN(M,N)*MIN(M,N)+MIN(M,N) ) ) + IF ( LQUERY ) THEN + CALL ZGESDD( 'O', M, N, X, LDX, RWORK, B,LDB,& + W, LDW, ZWORK, -1, RDUMMY, IWORK, INFO1 ) + LWRSDD = MAX( MWRSDD,INT( ZWORK(1) )) + ! Possible bug in ZGESDD optimal workspace size. + OLWORK = MAX(OLWORK,LWRSDD) + END IF + CASE (3) + CALL ZGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, RWORK, Z, LDZ, W, LDW, NUMRNK, & + IWORK, -1, ZWORK, -1, RDUMMY, -1, INFO1 ) + IMINWR = IWORK(1) + MWRSVQ = INT(ZWORK(2)) + MLWORK = MAX(MLWORK,MWRSVQ) + MLRWRK = MAX(MLRWRK,N + INT(RDUMMY(1))) + IF ( LQUERY ) THEN + LWRSVQ = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,LWRSVQ) + END IF + CASE (4) + JSVOPT = 'J' + CALL ZGEJSV( 'F', 'U', JSVOPT, 'R', 'N', 'P', M, & + N, X, LDX, RWORK, Z, LDZ, W, LDW, & + ZWORK, -1, RDUMMY, -1, IWORK, INFO1 ) + IMINWR = IWORK(1) + MWRSVJ = INT(ZWORK(2)) + MLWORK = MAX(MLWORK,MWRSVJ) + MLRWRK = MAX(MLRWRK,N + MAX(7,INT(RDUMMY(1)))) + IF ( LQUERY ) THEN + LWRSVJ = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,LWRSVJ) + END IF + END SELECT + IF ( WNTVEC .OR. WNTEX .OR. LSAME(JOBZ,'F') ) THEN + JOBZL = 'V' + ELSE + JOBZL = 'N' + END IF + ! Workspace calculation to the ZGEEV call + MWRKEV = MAX( 1, 2*N ) + MLWORK = MAX(MLWORK,MWRKEV) + MLRWRK = MAX(MLRWRK,N+2*N) + IF ( LQUERY ) THEN + CALL ZGEEV( 'N', JOBZL, N, S, LDS, EIGS, & + W, LDW, W, LDW, ZWORK, -1, RWORK, INFO1 ) + LWRKEV = INT(ZWORK(1)) + OLWORK = MAX( OLWORK, LWRKEV ) + END IF +! + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -30 + IF ( LRWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -28 + IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -26 + + END IF +! + IF( INFO /= 0 ) THEN + CALL XERBLA( 'ZGEDMD', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + RWORK(1) = MLRWRK + ZWORK(1) = MLWORK + ZWORK(2) = OLWORK + RETURN + END IF +!............................................................ +! + OFL = DLAMCH('O') + SMALL = DLAMCH('S') + BADXY = .FALSE. +! +! <1> Optional scaling of the snapshots (columns of X, Y) +! ========================================================== + IF ( SCCOLX ) THEN + ! The columns of X will be normalized. + ! To prevent overflows, the column norms of X are + ! carefully computed using ZLASSQ. + K = 0 + DO i = 1, N + !WORK(i) = DZNRM2( M, X(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL ZLASSQ( M, X(1,i), 1, SCALE, SSUM ) + IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN + K = 0 + INFO = -8 + CALL XERBLA('ZGEDMD',-INFO) + END IF + IF ( (SCALE /= ZERO) .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of X(:,i) overflows. First, X(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||X(:,i)||_2. +! Next, the norm of X(:,i) is stored without +! overflow as RWORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of X(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL ZLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, X(1,i), LDX, INFO2 ) + RWORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) + ELSE +! X(:,i) will be scaled to unit 2-norm + RWORK(i) = SCALE * ROOTSC + CALL ZLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & + X(1,i), LDX, INFO2 ) ! LAPACK CALL +! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC + END IF + ELSE + RWORK(i) = ZERO + K = K + 1 + END IF + END DO + IF ( K == N ) THEN + ! All columns of X are zero. Return error code -8. + ! (the 8th input variable had an illegal value) + K = 0 + INFO = -8 + CALL XERBLA('ZGEDMD',-INFO) + RETURN + END IF + DO i = 1, N +! Now, apply the same scaling to the columns of Y. + IF ( RWORK(i) > ZERO ) THEN + CALL ZDSCAL( M, ONE/RWORK(i), Y(1,i), 1 ) ! BLAS CALL +! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC + ELSE IF ( RWORK(i) < ZERO ) THEN + CALL ZLASCL( 'G', 0, 0, -RWORK(i), & + ONE/DBLE(M), M, 1, Y(1,i), LDY, INFO2 ) ! LAPACK CALL + ELSE IF ( ABS(Y(IZAMAX(M, Y(1,i),1),i )) & + /= ZERO ) THEN +! X(:,i) is zero vector. For consistency, +! Y(:,i) should also be zero. If Y(:,i) is not +! zero, then the data might be inconsistent or +! corrupted. If JOBS == 'C', Y(:,i) is set to +! zero and a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + IF ( LSAME(JOBS,'C')) & + CALL ZDSCAL( M, ZERO, Y(1,i), 1 ) ! BLAS CALL + END IF + END DO + END IF + ! + IF ( SCCOLY ) THEN + ! The columns of Y will be normalized. + ! To prevent overflows, the column norms of Y are + ! carefully computed using ZLASSQ. + DO i = 1, N + !RWORK(i) = DZNRM2( M, Y(1,i), 1 ) + SSUM = ONE + SCALE = ZERO + CALL ZLASSQ( M, Y(1,i), 1, SCALE, SSUM ) + IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN + K = 0 + INFO = -10 + CALL XERBLA('ZGEDMD',-INFO) + END IF + IF ( SCALE /= ZERO .AND. (SSUM /= ZERO) ) THEN + ROOTSC = SQRT(SSUM) + IF ( SCALE .GE. (OFL / ROOTSC) ) THEN +! Norm of Y(:,i) overflows. First, Y(:,i) +! is scaled by +! ( ONE / ROOTSC ) / SCALE = 1/||Y(:,i)||_2. +! Next, the norm of Y(:,i) is stored without +! overflow as RWORK(i) = - SCALE * (ROOTSC/M), +! the minus sign indicating the 1/M factor. +! Scaling is performed without overflow, and +! underflow may occur in the smallest entries +! of Y(:,i). The relative backward and forward +! errors are small in the ell_2 norm. + CALL ZLASCL( 'G', 0, 0, SCALE, ONE/ROOTSC, & + M, 1, Y(1,i), LDY, INFO2 ) + RWORK(i) = - SCALE * ( ROOTSC / DBLE(M) ) + ELSE +! Y(:,i) will be scaled to unit 2-norm + RWORK(i) = SCALE * ROOTSC + CALL ZLASCL( 'G',0, 0, RWORK(i), ONE, M, 1, & + Y(1,i), LDY, INFO2 ) ! LAPACK CALL +! Y(1:M,i) = (ONE/RWORK(i)) * Y(1:M,i) ! INTRINSIC + END IF + ELSE + RWORK(i) = ZERO + END IF + END DO + DO i = 1, N +! Now, apply the same scaling to the columns of X. + IF ( RWORK(i) > ZERO ) THEN + CALL ZDSCAL( M, ONE/RWORK(i), X(1,i), 1 ) ! BLAS CALL +! X(1:M,i) = (ONE/RWORK(i)) * X(1:M,i) ! INTRINSIC + ELSE IF ( RWORK(i) < ZERO ) THEN + CALL ZLASCL( 'G', 0, 0, -RWORK(i), & + ONE/DBLE(M), M, 1, X(1,i), LDX, INFO2 ) ! LAPACK CALL + ELSE IF ( ABS(X(IZAMAX(M, X(1,i),1),i )) & + /= ZERO ) THEN +! Y(:,i) is zero vector. If X(:,i) is not +! zero, then a warning flag is raised. +! The computation continues but the +! situation will be reported in the output. + BADXY = .TRUE. + END IF + END DO + END IF +! +! <2> SVD of the data snapshot matrix X. +! ===================================== +! The left singular vectors are stored in the array X. +! The right singular vectors are in the array W. +! The array W will later on contain the eigenvectors +! of a Rayleigh quotient. + NUMRNK = N + SELECT CASE ( WHTSVD ) + CASE (1) + CALL ZGESVD( 'O', 'S', M, N, X, LDX, RWORK, B, & + LDB, W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL + T_OR_N = 'C' + CASE (2) + CALL ZGESDD( 'O', M, N, X, LDX, RWORK, B, LDB, W, & + LDW, ZWORK, LZWORK, RWORK(N+1), IWORK, INFO1 ) ! LAPACK CALL + T_OR_N = 'C' + CASE (3) + CALL ZGESVDQ( 'H', 'P', 'N', 'R', 'R', M, N, & + X, LDX, RWORK, Z, LDZ, W, LDW, & + NUMRNK, IWORK, LIWORK, ZWORK, & + LZWORK, RWORK(N+1), LRWORK-N, INFO1) ! LAPACK CALL + CALL ZLACPY( 'A', M, NUMRNK, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'C' + CASE (4) + CALL ZGEJSV( 'F', 'U', JSVOPT, 'R', 'N', 'P', M, & + N, X, LDX, RWORK, Z, LDZ, W, LDW, & + ZWORK, LZWORK, RWORK(N+1), LRWORK-N, IWORK, INFO1 ) ! LAPACK CALL + CALL ZLACPY( 'A', M, N, Z, LDZ, X, LDX ) ! LAPACK CALL + T_OR_N = 'N' + XSCL1 = RWORK(N+1) + XSCL2 = RWORK(N+2) + IF ( XSCL1 /= XSCL2 ) THEN + ! This is an exceptional situation. If the + ! data matrices are not scaled and the + ! largest singular value of X overflows. + ! In that case ZGEJSV can return the SVD + ! in scaled form. The scaling factor can be used + ! to rescale the data (X and Y). + CALL ZLASCL( 'G', 0, 0, XSCL1, XSCL2, M, N, Y, LDY, INFO2 ) + END IF + END SELECT +! + IF ( INFO1 > 0 ) THEN + ! The SVD selected subroutine did not converge. + ! Return with an error code. + INFO = 2 + RETURN + END IF +! + IF ( RWORK(1) == ZERO ) THEN + ! The largest computed singular value of (scaled) + ! X is zero. Return error code -8 + ! (the 8th input variable had an illegal value). + K = 0 + INFO = -8 + CALL XERBLA('ZGEDMD',-INFO) + RETURN + END IF +! + !<3> Determine the numerical rank of the data + ! snapshots matrix X. This depends on the + ! parameters NRNK and TOL. + + SELECT CASE ( NRNK ) + CASE ( -1 ) + K = 1 + DO i = 2, NUMRNK + IF ( ( RWORK(i) <= RWORK(1)*TOL ) .OR. & + ( RWORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE ( -2 ) + K = 1 + DO i = 1, NUMRNK-1 + IF ( ( RWORK(i+1) <= RWORK(i)*TOL ) .OR. & + ( RWORK(i) <= SMALL ) ) EXIT + K = K + 1 + END DO + CASE DEFAULT + K = 1 + DO i = 2, NRNK + IF ( RWORK(i) <= SMALL ) EXIT + K = K + 1 + END DO + END SELECT + ! Now, U = X(1:M,1:K) is the SVD/POD basis for the + ! snapshot data in the input matrix X. + + !<4> Compute the Rayleigh quotient S = U^H * A * U. + ! Depending on the requested outputs, the computation + ! is organized to compute additional auxiliary + ! matrices (for the residuals and refinements). + ! + ! In all formulas below, we need V_k*Sigma_k^(-1) + ! where either V_k is in W(1:N,1:K), or V_k^H is in + ! W(1:K,1:N). Here Sigma_k=diag(WORK(1:K)). + IF ( LSAME(T_OR_N, 'N') ) THEN + DO i = 1, K + CALL ZDSCAL( N, ONE/RWORK(i), W(1,i), 1 ) ! BLAS CALL + ! W(1:N,i) = (ONE/RWORK(i)) * W(1:N,i) ! INTRINSIC + END DO + ELSE + ! This non-unit stride access is due to the fact + ! that ZGESVD, ZGESVDQ and ZGESDD return the + ! adjoint matrix of the right singular vectors. + !DO i = 1, K + ! CALL ZDSCAL( N, ONE/RWORK(i), W(i,1), LDW ) ! BLAS CALL + ! ! W(i,1:N) = (ONE/RWORK(i)) * W(i,1:N) ! INTRINSIC + !END DO + DO i = 1, K + RWORK(N+i) = ONE/RWORK(i) + END DO + DO j = 1, N + DO i = 1, K + W(i,j) = CMPLX(RWORK(N+i),ZERO,KIND=WP)*W(i,j) + END DO + END DO + END IF +! + IF ( WNTREF ) THEN + ! + ! Need A*U(:,1:K)=Y*V_k*inv(diag(WORK(1:K))) + ! for computing the refined Ritz vectors + ! (optionally, outside ZGEDMD). + CALL ZGEMM( 'N', T_OR_N, M, K, N, ZONE, Y, LDY, W, & + LDW, ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),TRANSPOSE(CONJG(W(1:K,1:N)))) ! INTRINSIC, for T_OR_N=='C' + ! Z(1:M,1:K)=MATMUL(Y(1:M,1:N),W(1:N,1:K)) ! INTRINSIC, for T_OR_N=='N' + ! + ! At this point Z contains + ! A * U(:,1:K) = Y * V_k * Sigma_k^(-1), and + ! this is needed for computing the residuals. + ! This matrix is returned in the array B and + ! it can be used to compute refined Ritz vectors. + CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) ! BLAS CALL + ! B(1:M,1:K) = Z(1:M,1:K) ! INTRINSIC + + CALL ZGEMM( 'C', 'N', K, K, M, ZONE, X, LDX, Z, & + LDZ, ZZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(TRANSPOSE(CONJG(X(1:M,1:K))),Z(1:M,1:K)) ! INTRINSIC + ! At this point S = U^H * A * U is the Rayleigh quotient. + ELSE + ! A * U(:,1:K) is not explicitly needed and the + ! computation is organized differently. The Rayleigh + ! quotient is computed more efficiently. + CALL ZGEMM( 'C', 'N', K, N, M, ZONE, X, LDX, Y, LDY, & + ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:K,1:N) = MATMUL( TRANSPOSE(CONJG(X(1:M,1:K))), Y(1:M,1:N) ) ! INTRINSIC + ! + CALL ZGEMM( 'N', T_OR_N, K, K, N, ZONE, Z, LDZ, W, & + LDW, ZZERO, S, LDS ) ! BLAS CALL + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),TRANSPOSE(CONJG(W(1:K,1:N)))) ! INTRINSIC, for T_OR_N=='T' + ! S(1:K,1:K) = MATMUL(Z(1:K,1:N),(W(1:N,1:K))) ! INTRINSIC, for T_OR_N=='N' + ! At this point S = U^H * A * U is the Rayleigh quotient. + ! If the residuals are requested, save scaled V_k into Z. + ! Recall that V_k or V_k^H is stored in W. + IF ( WNTRES .OR. WNTEX ) THEN + IF ( LSAME(T_OR_N, 'N') ) THEN + CALL ZLACPY( 'A', N, K, W, LDW, Z, LDZ ) + ELSE + CALL ZLACPY( 'A', K, N, W, LDW, Z, LDZ ) + END IF + END IF + END IF +! + !<5> Compute the Ritz values and (if requested) the + ! right eigenvectors of the Rayleigh quotient. + ! + CALL ZGEEV( 'N', JOBZL, K, S, LDS, EIGS, W, LDW, & + W, LDW, ZWORK, LZWORK, RWORK(N+1), INFO1 ) ! LAPACK CALL + ! + ! W(1:K,1:K) contains the eigenvectors of the Rayleigh + ! quotient. See the description of Z. + ! Also, see the description of ZGEEV. + IF ( INFO1 > 0 ) THEN + ! ZGEEV failed to compute the eigenvalues and + ! eigenvectors of the Rayleigh quotient. + INFO = 3 + RETURN + END IF +! + ! <6> Compute the eigenvectors (if requested) and, + ! the residuals (if requested). + ! + IF ( WNTVEC .OR. WNTEX ) THEN + IF ( WNTRES ) THEN + IF ( WNTREF ) THEN + ! Here, if the refinement is requested, we have + ! A*U(:,1:K) already computed and stored in Z. + ! For the residuals, need Y = A * U(:,1;K) * W. + CALL ZGEMM( 'N', 'N', M, K, K, ZONE, Z, LDZ, W, & + LDW, ZZERO, Y, LDY ) ! BLAS CALL + ! Y(1:M,1:K) = Z(1:M,1:K) * W(1:K,1:K) ! INTRINSIC + ! This frees Z; Y contains A * U(:,1:K) * W. + ELSE + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) (or its adjoint) is stored in Z + CALL ZGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & + W, LDW, ZZERO, S, LDS ) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + LDS, ZZERO, Z, LDZ ) + ! Save a copy of Z into Y and free Z for holding + ! the Ritz vectors. + CALL ZLACPY( 'A', M, K, Z, LDZ, Y, LDY ) + IF ( WNTEX ) CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF + ELSE IF ( WNTEX ) THEN + ! Compute S = V_k * Sigma_k^(-1) * W, where + ! V_k * Sigma_k^(-1) is stored in Z + CALL ZGEMM( T_OR_N, 'N', N, K, K, ZONE, Z, LDZ, & + W, LDW, ZZERO, S, LDS ) + ! Then, compute Z = Y * S = + ! = Y * V_k * Sigma_k^(-1) * W(1:K,1:K) = + ! = A * U(:,1:K) * W(1:K,1:K) + CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + LDS, ZZERO, B, LDB ) + ! The above call replaces the following two calls + ! that were used in the developing-testing phase. + ! CALL ZGEMM( 'N', 'N', M, K, N, ZONE, Y, LDY, S, & + ! LDS, ZZERO, Z, LDZ) + ! Save a copy of Z into B and free Z for holding + ! the Ritz vectors. + ! CALL ZLACPY( 'A', M, K, Z, LDZ, B, LDB ) + END IF +! + ! Compute the Ritz vectors + IF ( WNTVEC ) CALL ZGEMM( 'N', 'N', M, K, K, ZONE, X, LDX, W, LDW, & + ZZERO, Z, LDZ ) ! BLAS CALL + ! Z(1:M,1:K) = MATMUL(X(1:M,1:K), W(1:K,1:K)) ! INTRINSIC +! + IF ( WNTRES ) THEN + DO i = 1, K + CALL ZAXPY( M, -EIGS(i), Z(1,i), 1, Y(1,i), 1 ) ! BLAS CALL + ! Y(1:M,i) = Y(1:M,i) - EIGS(i) * Z(1:M,i) ! INTRINSIC + RES(i) = DZNRM2( M, Y(1,i), 1 ) ! BLAS CALL + END DO + END IF + END IF +! + IF ( WHTSVD == 4 ) THEN + RWORK(N+1) = XSCL1 + RWORK(N+2) = XSCL2 + END IF +! +! Successful exit. + IF ( .NOT. BADXY ) THEN + INFO = 0 + ELSE + ! A warning on possible data inconsistency. + ! This should be a rare event. + INFO = 4 + END IF +!............................................................ + RETURN +! ...... + END SUBROUTINE ZGEDMD diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index 213caf8550..606c5666e7 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -1,852 +1,851 @@ -!> \brief \b ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. -! -! =========== DOCUMENTATION =========== -! -! Definition: -! =========== -! -! SUBROUTINE ZGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & -! WHTSVD, M, N, F, LDF, X, LDX, Y, & -! LDY, NRNK, TOL, K, EIGS, & -! Z, LDZ, RES, B, LDB, V, LDV, & -! S, LDS, ZWORK, LZWORK, WORK, LWORK, & -! IWORK, LIWORK, INFO ) -!..... -! USE iso_fortran_env -! IMPLICIT NONE -! INTEGER, PARAMETER :: WP = real64 -!..... -! Scalar arguments -! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & -! JOBT, JOBF -! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & -! LDY, NRNK, LDZ, LDB, LDV, & -! LDS, LZWORK, LWORK, LIWORK -! INTEGER, INTENT(OUT) :: INFO, K -! REAL(KIND=WP), INTENT(IN) :: TOL -! Array arguments -! COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & -! Z(LDZ,*), B(LDB,*), & -! V(LDV,*), S(LDS,*) -! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) -! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) -! REAL(KIND=WP), INTENT(OUT) :: RES(*) -! REAL(KIND=WP), INTENT(OUT) :: WORK(*) -! INTEGER, INTENT(OUT) :: IWORK(*) -!............................................................ -!> \par Purpose: -! ============= -!> \verbatim -!> ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for -!> a pair of data snapshot matrices, using a QR factorization -!> based compression of the data. For the input matrices -!> X and Y such that Y = A*X with an unaccessible matrix -!> A, ZGEDMDQ computes a certain number of Ritz pairs of A using -!> the standard Rayleigh-Ritz extraction from a subspace of -!> range(X) that is determined using the leading left singular -!> vectors of X. Optionally, ZGEDMDQ returns the residuals -!> of the computed Ritz pairs, the information needed for -!> a refinement of the Ritz vectors, or the eigenvectors of -!> the Exact DMD. -!> For further details see the references listed -!> below. For more details of the implementation see [3]. -!> \endverbatim -!............................................................ -!> \par References: -! ================ -!> \verbatim -!> [1] P. Schmid: Dynamic mode decomposition of numerical -!> and experimental data, -!> Journal of Fluid Mechanics 656, 5-28, 2010. -!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal -!> decompositions: analysis and enhancements, -!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. -!> [3] Z. Drmac: A LAPACK implementation of the Dynamic -!> Mode Decomposition I. Technical report. AIMDyn Inc. -!> and LAPACK Working Note 298. -!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. -!> Brunton, N. Kutz: On Dynamic Mode Decomposition: -!> Theory and Applications, Journal of Computational -!> Dynamics 1(2), 391 -421, 2014. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Developed and coded by Zlatko Drmac, Faculty of Science, -!> University of Zagreb; drmac@math.hr -!> In cooperation with -!> AIMdyn Inc., Santa Barbara, CA. -!> and supported by -!> - DARPA SBIR project "Koopman Operator-Based Forecasting -!> for Nonstationary Processes from Near-Term, Limited -!> Observational Data" Contract No: W31P4Q-21-C-0007 -!> - DARPA PAI project "Physics-Informed Machine Learning -!> Methodologies" Contract No: HR0011-18-9-0033 -!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic -!> Framework for Space-Time Analysis of Process Dynamics" -!> Contract No: HR0011-16-C-0116 -!> Any opinions, findings and conclusions or recommendations -!> expressed in this material are those of the author and -!> do not necessarily reflect the views of the DARPA SBIR -!> Program Office. -!> \endverbatim -!...................................................................... -!> \par Developed and supported by: -! ================================ -!> \verbatim -!> Distribution Statement A: -!> Approved for Public Release, Distribution Unlimited. -!> Cleared by DARPA on September 29, 2022 -!> \endverbatim -!============================================================ -! Arguments -! ========= -! -!> \param[in] JOBS -!> \verbatim -!> JOBS (input) CHARACTER*1 -!> Determines whether the initial data snapshots are scaled -!> by a diagonal matrix. The data snapshots are the columns -!> of F. The leading N-1 columns of F are denoted X and the -!> trailing N-1 columns are denoted Y. -!> 'S' :: The data snapshots matrices X and Y are multiplied -!> with a diagonal matrix D so that X*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'C' :: The snapshots are scaled as with the 'S' option. -!> If it is found that an i-th column of X is zero -!> vector and the corresponding i-th column of Y is -!> non-zero, then the i-th column of Y is set to -!> zero and a warning flag is raised. -!> 'Y' :: The data snapshots matrices X and Y are multiplied -!> by a diagonal matrix D so that Y*D has unit -!> nonzero columns (in the Euclidean 2-norm) -!> 'N' :: No data scaling. -!> \endverbatim -!..... -!> \param[in] JOBZ -!> \verbatim -!> JOBZ (input) CHARACTER*1 -!> Determines whether the eigenvectors (Koopman modes) will -!> be computed. -!> 'V' :: The eigenvectors (Koopman modes) will be computed -!> and returned in the matrix Z. -!> See the description of Z. -!> 'F' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Z*V, where Z -!> is orthonormal and V contains the eigenvectors -!> of the corresponding Rayleigh quotient. -!> See the descriptions of F, V, Z. -!> 'Q' :: The eigenvectors (Koopman modes) will be returned -!> in factored form as the product Q*Z, where Z -!> contains the eigenvectors of the compression of the -!> underlying discretized operator onto the span of -!> the data snapshots. See the descriptions of F, V, Z. -!> Q is from the initial QR factorization. -!> 'N' :: The eigenvectors are not computed. -!> \endverbatim -!..... -!> \param[in] JOBR -!> \verbatim -!> JOBR (input) CHARACTER*1 -!> Determines whether to compute the residuals. -!> 'R' :: The residuals for the computed eigenpairs will -!> be computed and stored in the array RES. -!> See the description of RES. -!> For this option to be legal, JOBZ must be 'V'. -!> 'N' :: The residuals are not computed. -!> \endverbatim -!..... -!> \param[in] JOBQ -!> \verbatim -!> JOBQ (input) CHARACTER*1 -!> Specifies whether to explicitly compute and return the -!> unitary matrix from the QR factorization. -!> 'Q' :: The matrix Q of the QR factorization of the data -!> snapshot matrix is computed and stored in the -!> array F. See the description of F. -!> 'N' :: The matrix Q is not explicitly computed. -!> \endverbatim -!..... -!> \param[in] JOBT -!> \verbatim -!> JOBT (input) CHARACTER*1 -!> Specifies whether to return the upper triangular factor -!> from the QR factorization. -!> 'R' :: The matrix R of the QR factorization of the data -!> snapshot matrix F is returned in the array Y. -!> See the description of Y and Further details. -!> 'N' :: The matrix R is not returned. -!> \endverbatim -!..... -!> \param[in] JOBF -!> \verbatim -!> JOBF (input) CHARACTER*1 -!> Specifies whether to store information needed for post- -!> processing (e.g. computing refined Ritz vectors) -!> 'R' :: The matrix needed for the refinement of the Ritz -!> vectors is computed and stored in the array B. -!> See the description of B. -!> 'E' :: The unscaled eigenvectors of the Exact DMD are -!> computed and returned in the array B. See the -!> description of B. -!> 'N' :: No eigenvector refinement data is computed. -!> To be useful on exit, this option needs JOBQ='Q'. -!> \endverbatim -!..... -!> \param[in] WHTSVD -!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } -!> Allows for a selection of the SVD algorithm from the -!> LAPACK library. -!> 1 :: ZGESVD (the QR SVD algorithm) -!> 2 :: ZGESDD (the Divide and Conquer algorithm; if enough -!> workspace available, this is the fastest option) -!> 3 :: ZGESVDQ (the preconditioned QR SVD ; this and 4 -!> are the most accurate options) -!> 4 :: ZGEJSV (the preconditioned Jacobi SVD; this and 3 -!> are the most accurate options) -!> For the four methods above, a significant difference in -!> the accuracy of small singular values is possible if -!> the snapshots vary in norm so that X is severely -!> ill-conditioned. If small (smaller than EPS*||X||) -!> singular values are of interest and JOBS=='N', then -!> the options (3, 4) give the most accurate results, where -!> the option 4 is slightly better and with stronger -!> theoretical background. -!> If JOBS=='S', i.e. the columns of X will be normalized, -!> then all methods give nearly equally accurate results. -!> \endverbatim -!..... -!> \param[in] M -!> \verbatim -!> M (input) INTEGER, M >= 0 -!> The state space dimension (the number of rows of F). -!> \endverbatim -!..... -!> \param[in] N -!> \verbatim -!> N (input) INTEGER, 0 <= N <= M -!> The number of data snapshots from a single trajectory, -!> taken at equidistant discrete times. This is the -!> number of columns of F. -!> \endverbatim -!..... -!> \param[in,out] F -!> \verbatim -!> F (input/output) COMPLEX(KIND=WP) M-by-N array -!> > On entry, -!> the columns of F are the sequence of data snapshots -!> from a single trajectory, taken at equidistant discrete -!> times. It is assumed that the column norms of F are -!> in the range of the normalized floating point numbers. -!> < On exit, -!> If JOBQ == 'Q', the array F contains the orthogonal -!> matrix/factor of the QR factorization of the initial -!> data snapshots matrix F. See the description of JOBQ. -!> If JOBQ == 'N', the entries in F strictly below the main -!> diagonal contain, column-wise, the information on the -!> Householder vectors, as returned by ZGEQRF. The -!> remaining information to restore the orthogonal matrix -!> of the initial QR factorization is stored in ZWORK(1:MIN(M,N)). -!> See the description of ZWORK. -!> \endverbatim -!..... -!> \param[in] LDF -!> \verbatim -!> LDF (input) INTEGER, LDF >= M -!> The leading dimension of the array F. -!> \endverbatim -!..... -!> \param[in,out] X -!> \verbatim -!> X (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array -!> X is used as workspace to hold representations of the -!> leading N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, the leading K columns of X contain the leading -!> K left singular vectors of the above described content -!> of X. To lift them to the space of the left singular -!> vectors U(:,1:K) of the input data, pre-multiply with the -!> Q factor from the initial QR factorization. -!> See the descriptions of F, K, V and Z. -!> \endverbatim -!..... -!> \param[in] LDX -!> \verbatim -!> LDX (input) INTEGER, LDX >= N -!> The leading dimension of the array X. -!> \endverbatim -!..... -!> \param[in,out] Y -!> \verbatim -!> Y (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N) array -!> Y is used as workspace to hold representations of the -!> trailing N-1 snapshots in the orthonormal basis computed -!> in the QR factorization of F. -!> On exit, -!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper -!> triangular factor from the QR factorization of the data -!> snapshot matrix F. -!> \endverbatim -!..... -!> \param[in] LDY -!> \verbatim -!> LDY (input) INTEGER , LDY >= N -!> The leading dimension of the array Y. -!> \endverbatim -!..... -!> \param[in] NRNK -!> \verbatim -!> NRNK (input) INTEGER -!> Determines the mode how to compute the numerical rank, -!> i.e. how to truncate small singular values of the input -!> matrix X. On input, if -!> NRNK = -1 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(1) -!> This option is recommended. -!> NRNK = -2 :: i-th singular value sigma(i) is truncated -!> if sigma(i) <= TOL*sigma(i-1) -!> This option is included for R&D purposes. -!> It requires highly accurate SVD, which -!> may not be feasible. -!> The numerical rank can be enforced by using positive -!> value of NRNK as follows: -!> 0 < NRNK <= N-1 :: at most NRNK largest singular values -!> will be used. If the number of the computed nonzero -!> singular values is less than NRNK, then only those -!> nonzero values will be used and the actually used -!> dimension is less than NRNK. The actual number of -!> the nonzero singular values is returned in the variable -!> K. See the description of K. -!> \endverbatim -!..... -!> \param[in] TOL -!> \verbatim -!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 -!> The tolerance for truncating small singular values. -!> See the description of NRNK. -!> \endverbatim -!..... -!> \param[out] K -!> \verbatim -!> K (output) INTEGER, 0 <= K <= N -!> The dimension of the SVD/POD basis for the leading N-1 -!> data snapshots (columns of F) and the number of the -!> computed Ritz pairs. The value of K is determined -!> according to the rule set by the parameters NRNK and -!> TOL. See the descriptions of NRNK and TOL. -!> \endverbatim -!..... -!> \param[out] EIGS -!> \verbatim -!> EIGS (output) COMPLEX(KIND=WP) (N-1)-by-1 array -!> The leading K (K<=N-1) entries of EIGS contain -!> the computed eigenvalues (Ritz values). -!> See the descriptions of K, and Z. -!> \endverbatim -!..... -!> \param[out] Z -!> \verbatim -!> Z (workspace/output) COMPLEX(KIND=WP) M-by-(N-1) array -!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) -!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. -!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as -!> Z*V, where Z contains orthonormal matrix (the product of -!> Q from the initial QR factorization and the SVD/POD_basis -!> returned by ZGEDMD in X) and the second factor (the -!> eigenvectors of the Rayleigh quotient) is in the array V, -!> as returned by ZGEDMD. That is, X(:,1:K)*V(:,i) -!> is an eigenvector corresponding to EIGS(i). The columns -!> of V(1:K,1:K) are the computed eigenvectors of the -!> K-by-K Rayleigh quotient. -!> See the descriptions of EIGS, X and V. -!> \endverbatim -!..... -!> \param[in] LDZ -!> \verbatim -!> LDZ (input) INTEGER , LDZ >= M -!> The leading dimension of the array Z. -!> \endverbatim -!..... -!> \param[out] RES -!> \verbatim -!> RES (output) REAL(KIND=WP) (N-1)-by-1 array -!> RES(1:K) contains the residuals for the K computed -!> Ritz pairs, -!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. -!> See the description of EIGS and Z. -!> \endverbatim -!..... -!> \param[out] B -!> \verbatim -!> B (output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array. -!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can -!> be used for computing the refined vectors; see further -!> details in the provided references. -!> If JOBF == 'E', B(1:N,1;K) contains -!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the -!> Exact DMD, up to scaling by the inverse eigenvalues. -!> In both cases, the content of B can be lifted to the -!> original dimension of the input data by pre-multiplying -!> with the Q factor from the initial QR factorization. -!> Here A denotes a compression of the underlying operator. -!> See the descriptions of F and X. -!> If JOBF =='N', then B is not referenced. -!> \endverbatim -!..... -!> \param[in] LDB -!> \verbatim -!> LDB (input) INTEGER, LDB >= MIN(M,N) -!> The leading dimension of the array B. -!> \endverbatim -!..... -!> \param[out] V -!> \verbatim -!> V (workspace/output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array -!> On exit, V(1:K,1:K) V contains the K eigenvectors of -!> the Rayleigh quotient. The Ritz vectors -!> (returned in Z) are the product of Q from the initial QR -!> factorization (see the description of F) X (see the -!> description of X) and V. -!> \endverbatim -!..... -!> \param[in] LDV -!> \verbatim -!> LDV (input) INTEGER, LDV >= N-1 -!> The leading dimension of the array V. -!> \endverbatim -!..... -!> \param[out] S -!> \verbatim -!> S (output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array -!> The array S(1:K,1:K) is used for the matrix Rayleigh -!> quotient. This content is overwritten during -!> the eigenvalue decomposition by ZGEEV. -!> See the description of K. -!> \endverbatim -!..... -!> \param[in] LDS -!> \verbatim -!> LDS (input) INTEGER, LDS >= N-1 -!> The leading dimension of the array S. -!> \endverbatim -!..... -!> \param[out] LZWORK -!> \verbatim -!> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array -!> On exit, -!> ZWORK(1:MIN(M,N)) contains the scalar factors of the -!> elementary reflectors as returned by ZGEQRF of the -!> M-by-N input matrix F. -!> If the call to ZGEDMDQ is only workspace query, then -!> ZWORK(1) contains the minimal complex workspace length and -!> ZWORK(2) is the optimal complex workspace length. -!> Hence, the length of work is at least 2. -!> See the description of LZWORK. -!> \endverbatim -!..... -!> \param[in] LZWORK -!> \verbatim -!> LZWORK (input) INTEGER -!> The minimal length of the workspace vector ZWORK. -!> LZWORK is calculated as follows: -!> Let MLWQR = N (minimal workspace for ZGEQRF[M,N]) -!> MLWDMD = minimal workspace for ZGEDMD (see the -!> description of LWORK in ZGEDMD) -!> MLWMQR = N (minimal workspace for -!> ZUNMQR['L','N',M,N,N]) -!> MLWGQR = N (minimal workspace for ZUNGQR[M,N,N]) -!> MINMN = MIN(M,N) -!> Then -!> LZWORK = MAX(2, MIN(M,N)+MLWQR, MINMN+MLWDMD) -!> is further updated as follows: -!> if JOBZ == 'V' or JOBZ == 'F' THEN -!> LZWORK = MAX(LZWORK, MINMN+MLWMQR) -!> if JOBQ == 'Q' THEN -!> LZWORK = MAX(ZLWORK, MINMN+MLWGQR) -!> \endverbatim -!..... -!> \param[out] WORK -!> \verbatim -!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array -!> On exit, -!> WORK(1:N-1) contains the singular values of -!> the input submatrix F(1:M,1:N-1). -!> If the call to ZGEDMDQ is only workspace query, then -!> WORK(1) contains the minimal workspace length and -!> WORK(2) is the optimal workspace length. hence, the -!> length of work is at least 2. -!> See the description of LWORK. -!> \endverbatim -!..... -!> \param[in] LWORK -!> \verbatim -!> LWORK (input) INTEGER -!> The minimal length of the workspace vector WORK. -!> LWORK is the same as in ZGEDMD, because in ZGEDMDQ -!> only ZGEDMD requires real workspace for snapshots -!> of dimensions MIN(M,N)-by-(N-1). -!> If on entry LWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace length for WORK. -!> \endverbatim -!..... -!> \param[out] IWORK -!> \verbatim -!> IWORK (workspace/output) INTEGER LIWORK-by-1 array -!> Workspace that is required only if WHTSVD equals -!> 2 , 3 or 4. (See the description of WHTSVD). -!> If on entry LWORK =-1 or LIWORK=-1, then the -!> minimal length of IWORK is computed and returned in -!> IWORK(1). See the description of LIWORK. -!> \endverbatim -!..... -!> \param[in] LIWORK -!> \verbatim -!> LIWORK (input) INTEGER -!> The minimal length of the workspace vector IWORK. -!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 -!> Let M1=MIN(M,N), N1=N-1. Then -!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) -!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) -!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) -!> If on entry LIWORK = -1, then a workspace query is -!> assumed and the procedure only computes the minimal -!> and the optimal workspace lengths for both WORK and -!> IWORK. See the descriptions of WORK and IWORK. -!> \endverbatim -!..... -!> \param[out] INFO -!> \verbatim -!> INFO (output) INTEGER -!> -i < 0 :: On entry, the i-th argument had an -!> illegal value -!> = 0 :: Successful return. -!> = 1 :: Void input. Quick exit (M=0 or N=0). -!> = 2 :: The SVD computation of X did not converge. -!> Suggestion: Check the input data and/or -!> repeat with different WHTSVD. -!> = 3 :: The computation of the eigenvalues did not -!> converge. -!> = 4 :: If data scaling was requested on input and -!> the procedure found inconsistency in the data -!> such that for some column index i, -!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set -!> to zero if JOBS=='C'. The computation proceeds -!> with original or modified data and warning -!> flag is set with INFO=4. -!> \endverbatim -! -! Authors: -! ======== -! -!> \author Zlatko Drmac -! -!> \ingroup gedmd -! -!............................................................. -!............................................................. -SUBROUTINE ZGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & - WHTSVD, M, N, F, LDF, X, LDX, Y, & - LDY, NRNK, TOL, K, EIGS, & - Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK, LZWORK, WORK, LWORK, & - IWORK, LIWORK, INFO ) -! -! -- LAPACK driver routine -- -! -! -- LAPACK is a software package provided by University of -- -! -- Tennessee, University of California Berkeley, University of -- -! -- Colorado Denver and NAG Ltd.. -- -! -!..... - USE iso_fortran_env - IMPLICIT NONE - INTEGER, PARAMETER :: WP = real64 -! -! Scalar arguments -! ~~~~~~~~~~~~~~~~ - CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & - JOBT, JOBF - INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & - LDY, NRNK, LDZ, LDB, LDV, & - LDS, LZWORK, LWORK, LIWORK - INTEGER, INTENT(OUT) :: INFO, K - REAL(KIND=WP), INTENT(IN) :: TOL -! -! Array arguments -! ~~~~~~~~~~~~~~~ - COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) - COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & - Z(LDZ,*), B(LDB,*), & - V(LDV,*), S(LDS,*) - COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) - COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) - REAL(KIND=WP), INTENT(OUT) :: RES(*) - REAL(KIND=WP), INTENT(OUT) :: WORK(*) - INTEGER, INTENT(OUT) :: IWORK(*) -! -! Parameters -! ~~~~~~~~~~ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -! COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) -! -! Local scalars -! ~~~~~~~~~~~~~ - INTEGER :: IMINWR, INFO1, MINMN, MLRWRK, & - MLWDMD, MLWGQR, MLWMQR, MLWORK, & - MLWQR, OLWDMD, OLWGQR, OLWMQR, & - OLWORK, OLWQR - LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & - WNTTRF, WNTRES, WNTVEC, WNTVCF, & - WNTVCQ, WNTREF, WNTEX - CHARACTER(LEN=1) :: JOBVL -! -! External functions (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~ - LOGICAL LSAME - EXTERNAL LSAME -! -! External subroutines (BLAS and LAPACK) -! ~~~~~~~~~~~~~~~~~~~~ - EXTERNAL ZGEDMD, ZGEQRF, ZLACPY, ZLASET, ZUNGQR, & - ZUNMQR, XERBLA -! -! Intrinsic functions -! ~~~~~~~~~~~~~~~~~~~ - INTRINSIC MAX, MIN, INT -!.......................................................... -! -! Test the input arguments - WNTRES = LSAME(JOBR,'R') - SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) - SCCOLY = LSAME(JOBS,'Y') - WNTVEC = LSAME(JOBZ,'V') - WNTVCF = LSAME(JOBZ,'F') - WNTVCQ = LSAME(JOBZ,'Q') - WNTREF = LSAME(JOBF,'R') - WNTEX = LSAME(JOBF,'E') - WANTQ = LSAME(JOBQ,'Q') - WNTTRF = LSAME(JOBT,'R') - MINMN = MIN(M,N) - INFO = 0 - LQUERY = ( (LZWORK == -1) .OR. (LWORK == -1) .OR. (LIWORK == -1) ) -! - IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & - LSAME(JOBS,'N')) ) THEN - INFO = -1 - ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & - .OR. LSAME(JOBZ,'N')) ) THEN - INFO = -2 - ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & - ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN - INFO = -3 - ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN - INFO = -4 - ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN - INFO = -5 - ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & - LSAME(JOBF,'N') ) ) THEN - INFO = -6 - ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & - (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN - INFO = -7 - ELSE IF ( M < 0 ) THEN - INFO = -8 - ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN - INFO = -9 - ELSE IF ( LDF < M ) THEN - INFO = -11 - ELSE IF ( LDX < MINMN ) THEN - INFO = -13 - ELSE IF ( LDY < MINMN ) THEN - INFO = -15 - ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & - ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN - INFO = -16 - ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN - INFO = -17 - ELSE IF ( LDZ < M ) THEN - INFO = -21 - ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN - INFO = -24 - ELSE IF ( LDV < N-1 ) THEN - INFO = -26 - ELSE IF ( LDS < N-1 ) THEN - INFO = -28 - END IF -! - IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN - JOBVL = 'V' - ELSE - JOBVL = 'N' - END IF - IF ( INFO == 0 ) THEN - ! Compute the minimal and the optimal workspace - ! requirements. Simulate running the code and - ! determine minimal and optimal sizes of the - ! workspace at any moment of the run. - IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN - ! All output except K is void. INFO=1 signals - ! the void input. In case of a workspace query, - ! the minimal workspace lengths are returned. - IF ( LQUERY ) THEN - IWORK(1) = 1 - ZWORK(1) = 2 - ZWORK(2) = 2 - WORK(1) = 2 - WORK(2) = 2 - ELSE - K = 0 - END IF - INFO = 1 - RETURN - END IF - - MLRWRK = 2 - MLWORK = 2 - OLWORK = 2 - IMINWR = 1 - MLWQR = MAX(1,N) ! Minimal workspace length for ZGEQRF. - MLWORK = MAX(MLWORK,MINMN + MLWQR) - - IF ( LQUERY ) THEN - CALL ZGEQRF( M, N, F, LDF, ZWORK, ZWORK, -1, & - INFO1 ) - OLWQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,MINMN + OLWQR) - END IF - CALL ZGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - EIGS, Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK, -1, WORK, -1, IWORK,& - -1, INFO1 ) - MLWDMD = INT(ZWORK(1)) - MLWORK = MAX(MLWORK, MINMN + MLWDMD) - MLRWRK = MAX(MLRWRK, INT(WORK(1))) - IMINWR = MAX(IMINWR, IWORK(1)) - IF ( LQUERY ) THEN - OLWDMD = INT(ZWORK(2)) - OLWORK = MAX(OLWORK, MINMN+OLWDMD) - END IF - IF ( WNTVEC .OR. WNTVCF ) THEN - MLWMQR = MAX(1,N) - MLWORK = MAX(MLWORK,MINMN+MLWMQR) - IF ( LQUERY ) THEN - CALL ZUNMQR( 'L','N', M, N, MINMN, F, LDF, & - ZWORK, Z, LDZ, ZWORK, -1, INFO1 ) - OLWMQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,MINMN+OLWMQR) - END IF - END IF - IF ( WANTQ ) THEN - MLWGQR = MAX(1,N) - MLWORK = MAX(MLWORK,MINMN+MLWGQR) - IF ( LQUERY ) THEN - CALL ZUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & - ZWORK, -1, INFO1 ) - OLWGQR = INT(ZWORK(1)) - OLWORK = MAX(OLWORK,MINMN+OLWGQR) - END IF - END IF - IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -34 - IF ( LWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -32 - IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -30 - END IF - IF( INFO /= 0 ) THEN - CALL XERBLA( 'ZGEDMDQ', -INFO ) - RETURN - ELSE IF ( LQUERY ) THEN -! Return minimal and optimal workspace sizes - IWORK(1) = IMINWR - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK - WORK(1) = MLRWRK - WORK(2) = MLRWRK - RETURN - END IF -!..... -! Initial QR factorization that is used to represent the -! snapshots as elements of lower dimensional subspace. -! For large scale computation with M >> N, at this place -! one can use an out of core QRF. -! - CALL ZGEQRF( M, N, F, LDF, ZWORK, & - ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) -! -! Define X and Y as the snapshots representations in the -! orthogonal basis computed in the QR factorization. -! X corresponds to the leading N-1 and Y to the trailing -! N-1 snapshots. - CALL ZLASET( 'L', MINMN, N-1, ZZERO, ZZERO, X, LDX ) - CALL ZLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) - CALL ZLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) - IF ( M >= 3 ) THEN - CALL ZLASET( 'L', MINMN-2, N-2, ZZERO, ZZERO, & - Y(3,1), LDY ) - END IF -! -! Compute the DMD of the projected snapshot pairs (X,Y) - CALL ZGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & - N-1, X, LDX, Y, LDY, NRNK, TOL, K, & - EIGS, Z, LDZ, RES, B, LDB, V, LDV, & - S, LDS, ZWORK(MINMN+1), LZWORK-MINMN, & - WORK, LWORK, IWORK, LIWORK, INFO1 ) - IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN - ! Return with error code. See ZGEDMD for details. - INFO = INFO1 - RETURN - ELSE - INFO = INFO1 - END IF -! -! The Ritz vectors (Koopman modes) can be explicitly -! formed or returned in factored form. - IF ( WNTVEC ) THEN - ! Compute the eigenvectors explicitly. - IF ( M > MINMN ) CALL ZLASET( 'A', M-MINMN, K, ZZERO, & - ZZERO, Z(MINMN+1,1), LDZ ) - CALL ZUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & - LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - ELSE IF ( WNTVCF ) THEN - ! Return the Ritz vectors (eigenvectors) in factored - ! form Z*V, where Z contains orthonormal matrix (the - ! product of Q from the initial QR factorization and - ! the SVD/POD_basis returned by ZGEDMD in X) and the - ! second factor (the eigenvectors of the Rayleigh - ! quotient) is in the array V, as returned by ZGEDMD. - CALL ZLACPY( 'A', N, K, X, LDX, Z, LDZ ) - IF ( M > N ) CALL ZLASET( 'A', M-N, K, ZZERO, ZZERO, & - Z(N+1,1), LDZ ) - CALL ZUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & - LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - END IF -! -! Some optional output variables: -! -! The upper triangular factor R in the initial QR -! factorization is optionally returned in the array Y. -! This is useful if this call to ZGEDMDQ is to be -! followed by a streaming DMD that is implemented in a -! QR compressed form. - IF ( WNTTRF ) THEN ! Return the upper triangular R in Y - CALL ZLASET( 'A', MINMN, N, ZZERO, ZZERO, Y, LDY ) - CALL ZLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) - END IF -! -! The orthonormal/unitary factor Q in the initial QR -! factorization is optionally returned in the array F. -! Same as with the triangular factor above, this is -! useful in a streaming DMD. - IF ( WANTQ ) THEN ! Q overwrites F - CALL ZUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & - ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) - END IF -! - RETURN -! - END SUBROUTINE ZGEDMDQ - +!> \brief \b ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. +! +! =========== DOCUMENTATION =========== +! +! Definition: +! =========== +! +! SUBROUTINE ZGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & +! WHTSVD, M, N, F, LDF, X, LDX, Y, & +! LDY, NRNK, TOL, K, EIGS, & +! Z, LDZ, RES, B, LDB, V, LDV, & +! S, LDS, ZWORK, LZWORK, WORK, LWORK, & +! IWORK, LIWORK, INFO ) +!..... +! USE iso_fortran_env +! IMPLICIT NONE +! INTEGER, PARAMETER :: WP = real64 +!..... +! Scalar arguments +! CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & +! JOBT, JOBF +! INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & +! LDY, NRNK, LDZ, LDB, LDV, & +! LDS, LZWORK, LWORK, LIWORK +! INTEGER, INTENT(OUT) :: INFO, K +! REAL(KIND=WP), INTENT(IN) :: TOL +! Array arguments +! COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & +! Z(LDZ,*), B(LDB,*), & +! V(LDV,*), S(LDS,*) +! COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) +! COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) +! REAL(KIND=WP), INTENT(OUT) :: RES(*) +! REAL(KIND=WP), INTENT(OUT) :: WORK(*) +! INTEGER, INTENT(OUT) :: IWORK(*) +!............................................................ +!> \par Purpose: +! ============= +!> \verbatim +!> ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for +!> a pair of data snapshot matrices, using a QR factorization +!> based compression of the data. For the input matrices +!> X and Y such that Y = A*X with an unaccessible matrix +!> A, ZGEDMDQ computes a certain number of Ritz pairs of A using +!> the standard Rayleigh-Ritz extraction from a subspace of +!> range(X) that is determined using the leading left singular +!> vectors of X. Optionally, ZGEDMDQ returns the residuals +!> of the computed Ritz pairs, the information needed for +!> a refinement of the Ritz vectors, or the eigenvectors of +!> the Exact DMD. +!> For further details see the references listed +!> below. For more details of the implementation see [3]. +!> \endverbatim +!............................................................ +!> \par References: +! ================ +!> \verbatim +!> [1] P. Schmid: Dynamic mode decomposition of numerical +!> and experimental data, +!> Journal of Fluid Mechanics 656, 5-28, 2010. +!> [2] Z. Drmac, I. Mezic, R. Mohr: Data driven modal +!> decompositions: analysis and enhancements, +!> SIAM J. on Sci. Comp. 40 (4), A2253-A2285, 2018. +!> [3] Z. Drmac: A LAPACK implementation of the Dynamic +!> Mode Decomposition I. Technical report. AIMDyn Inc. +!> and LAPACK Working Note 298. +!> [4] J. Tu, C. W. Rowley, D. M. Luchtenburg, S. L. +!> Brunton, N. Kutz: On Dynamic Mode Decomposition: +!> Theory and Applications, Journal of Computational +!> Dynamics 1(2), 391 -421, 2014. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Developed and coded by Zlatko Drmac, Faculty of Science, +!> University of Zagreb; drmac@math.hr +!> In cooperation with +!> AIMdyn Inc., Santa Barbara, CA. +!> and supported by +!> - DARPA SBIR project "Koopman Operator-Based Forecasting +!> for Nonstationary Processes from Near-Term, Limited +!> Observational Data" Contract No: W31P4Q-21-C-0007 +!> - DARPA PAI project "Physics-Informed Machine Learning +!> Methodologies" Contract No: HR0011-18-9-0033 +!> - DARPA MoDyL project "A Data-Driven, Operator-Theoretic +!> Framework for Space-Time Analysis of Process Dynamics" +!> Contract No: HR0011-16-C-0116 +!> Any opinions, findings and conclusions or recommendations +!> expressed in this material are those of the author and +!> do not necessarily reflect the views of the DARPA SBIR +!> Program Office. +!> \endverbatim +!...................................................................... +!> \par Developed and supported by: +! ================================ +!> \verbatim +!> Distribution Statement A: +!> Approved for Public Release, Distribution Unlimited. +!> Cleared by DARPA on September 29, 2022 +!> \endverbatim +!============================================================ +! Arguments +! ========= +! +!> \param[in] JOBS +!> \verbatim +!> JOBS (input) CHARACTER*1 +!> Determines whether the initial data snapshots are scaled +!> by a diagonal matrix. The data snapshots are the columns +!> of F. The leading N-1 columns of F are denoted X and the +!> trailing N-1 columns are denoted Y. +!> 'S' :: The data snapshots matrices X and Y are multiplied +!> with a diagonal matrix D so that X*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'C' :: The snapshots are scaled as with the 'S' option. +!> If it is found that an i-th column of X is zero +!> vector and the corresponding i-th column of Y is +!> non-zero, then the i-th column of Y is set to +!> zero and a warning flag is raised. +!> 'Y' :: The data snapshots matrices X and Y are multiplied +!> by a diagonal matrix D so that Y*D has unit +!> nonzero columns (in the Euclidean 2-norm) +!> 'N' :: No data scaling. +!> \endverbatim +!..... +!> \param[in] JOBZ +!> \verbatim +!> JOBZ (input) CHARACTER*1 +!> Determines whether the eigenvectors (Koopman modes) will +!> be computed. +!> 'V' :: The eigenvectors (Koopman modes) will be computed +!> and returned in the matrix Z. +!> See the description of Z. +!> 'F' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Z*V, where Z +!> is orthonormal and V contains the eigenvectors +!> of the corresponding Rayleigh quotient. +!> See the descriptions of F, V, Z. +!> 'Q' :: The eigenvectors (Koopman modes) will be returned +!> in factored form as the product Q*Z, where Z +!> contains the eigenvectors of the compression of the +!> underlying discretized operator onto the span of +!> the data snapshots. See the descriptions of F, V, Z. +!> Q is from the initial QR factorization. +!> 'N' :: The eigenvectors are not computed. +!> \endverbatim +!..... +!> \param[in] JOBR +!> \verbatim +!> JOBR (input) CHARACTER*1 +!> Determines whether to compute the residuals. +!> 'R' :: The residuals for the computed eigenpairs will +!> be computed and stored in the array RES. +!> See the description of RES. +!> For this option to be legal, JOBZ must be 'V'. +!> 'N' :: The residuals are not computed. +!> \endverbatim +!..... +!> \param[in] JOBQ +!> \verbatim +!> JOBQ (input) CHARACTER*1 +!> Specifies whether to explicitly compute and return the +!> unitary matrix from the QR factorization. +!> 'Q' :: The matrix Q of the QR factorization of the data +!> snapshot matrix is computed and stored in the +!> array F. See the description of F. +!> 'N' :: The matrix Q is not explicitly computed. +!> \endverbatim +!..... +!> \param[in] JOBT +!> \verbatim +!> JOBT (input) CHARACTER*1 +!> Specifies whether to return the upper triangular factor +!> from the QR factorization. +!> 'R' :: The matrix R of the QR factorization of the data +!> snapshot matrix F is returned in the array Y. +!> See the description of Y and Further details. +!> 'N' :: The matrix R is not returned. +!> \endverbatim +!..... +!> \param[in] JOBF +!> \verbatim +!> JOBF (input) CHARACTER*1 +!> Specifies whether to store information needed for post- +!> processing (e.g. computing refined Ritz vectors) +!> 'R' :: The matrix needed for the refinement of the Ritz +!> vectors is computed and stored in the array B. +!> See the description of B. +!> 'E' :: The unscaled eigenvectors of the Exact DMD are +!> computed and returned in the array B. See the +!> description of B. +!> 'N' :: No eigenvector refinement data is computed. +!> To be useful on exit, this option needs JOBQ='Q'. +!> \endverbatim +!..... +!> \param[in] WHTSVD +!> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } +!> Allows for a selection of the SVD algorithm from the +!> LAPACK library. +!> 1 :: ZGESVD (the QR SVD algorithm) +!> 2 :: ZGESDD (the Divide and Conquer algorithm; if enough +!> workspace available, this is the fastest option) +!> 3 :: ZGESVDQ (the preconditioned QR SVD ; this and 4 +!> are the most accurate options) +!> 4 :: ZGEJSV (the preconditioned Jacobi SVD; this and 3 +!> are the most accurate options) +!> For the four methods above, a significant difference in +!> the accuracy of small singular values is possible if +!> the snapshots vary in norm so that X is severely +!> ill-conditioned. If small (smaller than EPS*||X||) +!> singular values are of interest and JOBS=='N', then +!> the options (3, 4) give the most accurate results, where +!> the option 4 is slightly better and with stronger +!> theoretical background. +!> If JOBS=='S', i.e. the columns of X will be normalized, +!> then all methods give nearly equally accurate results. +!> \endverbatim +!..... +!> \param[in] M +!> \verbatim +!> M (input) INTEGER, M >= 0 +!> The state space dimension (the number of rows of F). +!> \endverbatim +!..... +!> \param[in] N +!> \verbatim +!> N (input) INTEGER, 0 <= N <= M +!> The number of data snapshots from a single trajectory, +!> taken at equidistant discrete times. This is the +!> number of columns of F. +!> \endverbatim +!..... +!> \param[in,out] F +!> \verbatim +!> F (input/output) COMPLEX(KIND=WP) M-by-N array +!> > On entry, +!> the columns of F are the sequence of data snapshots +!> from a single trajectory, taken at equidistant discrete +!> times. It is assumed that the column norms of F are +!> in the range of the normalized floating point numbers. +!> < On exit, +!> If JOBQ == 'Q', the array F contains the orthogonal +!> matrix/factor of the QR factorization of the initial +!> data snapshots matrix F. See the description of JOBQ. +!> If JOBQ == 'N', the entries in F strictly below the main +!> diagonal contain, column-wise, the information on the +!> Householder vectors, as returned by ZGEQRF. The +!> remaining information to restore the orthogonal matrix +!> of the initial QR factorization is stored in ZWORK(1:MIN(M,N)). +!> See the description of ZWORK. +!> \endverbatim +!..... +!> \param[in] LDF +!> \verbatim +!> LDF (input) INTEGER, LDF >= M +!> The leading dimension of the array F. +!> \endverbatim +!..... +!> \param[in,out] X +!> \verbatim +!> X (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array +!> X is used as workspace to hold representations of the +!> leading N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, the leading K columns of X contain the leading +!> K left singular vectors of the above described content +!> of X. To lift them to the space of the left singular +!> vectors U(:,1:K) of the input data, pre-multiply with the +!> Q factor from the initial QR factorization. +!> See the descriptions of F, K, V and Z. +!> \endverbatim +!..... +!> \param[in] LDX +!> \verbatim +!> LDX (input) INTEGER, LDX >= N +!> The leading dimension of the array X. +!> \endverbatim +!..... +!> \param[in,out] Y +!> \verbatim +!> Y (workspace/output) COMPLEX(KIND=WP) MIN(M,N)-by-(N) array +!> Y is used as workspace to hold representations of the +!> trailing N-1 snapshots in the orthonormal basis computed +!> in the QR factorization of F. +!> On exit, +!> If JOBT == 'R', Y contains the MIN(M,N)-by-N upper +!> triangular factor from the QR factorization of the data +!> snapshot matrix F. +!> \endverbatim +!..... +!> \param[in] LDY +!> \verbatim +!> LDY (input) INTEGER , LDY >= N +!> The leading dimension of the array Y. +!> \endverbatim +!..... +!> \param[in] NRNK +!> \verbatim +!> NRNK (input) INTEGER +!> Determines the mode how to compute the numerical rank, +!> i.e. how to truncate small singular values of the input +!> matrix X. On input, if +!> NRNK = -1 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(1) +!> This option is recommended. +!> NRNK = -2 :: i-th singular value sigma(i) is truncated +!> if sigma(i) <= TOL*sigma(i-1) +!> This option is included for R&D purposes. +!> It requires highly accurate SVD, which +!> may not be feasible. +!> The numerical rank can be enforced by using positive +!> value of NRNK as follows: +!> 0 < NRNK <= N-1 :: at most NRNK largest singular values +!> will be used. If the number of the computed nonzero +!> singular values is less than NRNK, then only those +!> nonzero values will be used and the actually used +!> dimension is less than NRNK. The actual number of +!> the nonzero singular values is returned in the variable +!> K. See the description of K. +!> \endverbatim +!..... +!> \param[in] TOL +!> \verbatim +!> TOL (input) REAL(KIND=WP), 0 <= TOL < 1 +!> The tolerance for truncating small singular values. +!> See the description of NRNK. +!> \endverbatim +!..... +!> \param[out] K +!> \verbatim +!> K (output) INTEGER, 0 <= K <= N +!> The dimension of the SVD/POD basis for the leading N-1 +!> data snapshots (columns of F) and the number of the +!> computed Ritz pairs. The value of K is determined +!> according to the rule set by the parameters NRNK and +!> TOL. See the descriptions of NRNK and TOL. +!> \endverbatim +!..... +!> \param[out] EIGS +!> \verbatim +!> EIGS (output) COMPLEX(KIND=WP) (N-1)-by-1 array +!> The leading K (K<=N-1) entries of EIGS contain +!> the computed eigenvalues (Ritz values). +!> See the descriptions of K, and Z. +!> \endverbatim +!..... +!> \param[out] Z +!> \verbatim +!> Z (workspace/output) COMPLEX(KIND=WP) M-by-(N-1) array +!> If JOBZ =='V' then Z contains the Ritz vectors. Z(:,i) +!> is an eigenvector of the i-th Ritz value; ||Z(:,i)||_2=1. +!> If JOBZ == 'F', then the Z(:,i)'s are given implicitly as +!> Z*V, where Z contains orthonormal matrix (the product of +!> Q from the initial QR factorization and the SVD/POD_basis +!> returned by ZGEDMD in X) and the second factor (the +!> eigenvectors of the Rayleigh quotient) is in the array V, +!> as returned by ZGEDMD. That is, X(:,1:K)*V(:,i) +!> is an eigenvector corresponding to EIGS(i). The columns +!> of V(1:K,1:K) are the computed eigenvectors of the +!> K-by-K Rayleigh quotient. +!> See the descriptions of EIGS, X and V. +!> \endverbatim +!..... +!> \param[in] LDZ +!> \verbatim +!> LDZ (input) INTEGER , LDZ >= M +!> The leading dimension of the array Z. +!> \endverbatim +!..... +!> \param[out] RES +!> \verbatim +!> RES (output) REAL(KIND=WP) (N-1)-by-1 array +!> RES(1:K) contains the residuals for the K computed +!> Ritz pairs, +!> RES(i) = || A * Z(:,i) - EIGS(i)*Z(:,i))||_2. +!> See the description of EIGS and Z. +!> \endverbatim +!..... +!> \param[out] B +!> \verbatim +!> B (output) COMPLEX(KIND=WP) MIN(M,N)-by-(N-1) array. +!> IF JOBF =='R', B(1:N,1:K) contains A*U(:,1:K), and can +!> be used for computing the refined vectors; see further +!> details in the provided references. +!> If JOBF == 'E', B(1:N,1;K) contains +!> A*U(:,1:K)*W(1:K,1:K), which are the vectors from the +!> Exact DMD, up to scaling by the inverse eigenvalues. +!> In both cases, the content of B can be lifted to the +!> original dimension of the input data by pre-multiplying +!> with the Q factor from the initial QR factorization. +!> Here A denotes a compression of the underlying operator. +!> See the descriptions of F and X. +!> If JOBF =='N', then B is not referenced. +!> \endverbatim +!..... +!> \param[in] LDB +!> \verbatim +!> LDB (input) INTEGER, LDB >= MIN(M,N) +!> The leading dimension of the array B. +!> \endverbatim +!..... +!> \param[out] V +!> \verbatim +!> V (workspace/output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array +!> On exit, V(1:K,1:K) V contains the K eigenvectors of +!> the Rayleigh quotient. The Ritz vectors +!> (returned in Z) are the product of Q from the initial QR +!> factorization (see the description of F) X (see the +!> description of X) and V. +!> \endverbatim +!..... +!> \param[in] LDV +!> \verbatim +!> LDV (input) INTEGER, LDV >= N-1 +!> The leading dimension of the array V. +!> \endverbatim +!..... +!> \param[out] S +!> \verbatim +!> S (output) COMPLEX(KIND=WP) (N-1)-by-(N-1) array +!> The array S(1:K,1:K) is used for the matrix Rayleigh +!> quotient. This content is overwritten during +!> the eigenvalue decomposition by ZGEEV. +!> See the description of K. +!> \endverbatim +!..... +!> \param[in] LDS +!> \verbatim +!> LDS (input) INTEGER, LDS >= N-1 +!> The leading dimension of the array S. +!> \endverbatim +!..... +!> \param[out] LZWORK +!> \verbatim +!> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array +!> On exit, +!> ZWORK(1:MIN(M,N)) contains the scalar factors of the +!> elementary reflectors as returned by ZGEQRF of the +!> M-by-N input matrix F. +!> If the call to ZGEDMDQ is only workspace query, then +!> ZWORK(1) contains the minimal complex workspace length and +!> ZWORK(2) is the optimal complex workspace length. +!> Hence, the length of work is at least 2. +!> See the description of LZWORK. +!> \endverbatim +!..... +!> \param[in] LZWORK +!> \verbatim +!> LZWORK (input) INTEGER +!> The minimal length of the workspace vector ZWORK. +!> LZWORK is calculated as follows: +!> Let MLWQR = N (minimal workspace for ZGEQRF[M,N]) +!> MLWDMD = minimal workspace for ZGEDMD (see the +!> description of LWORK in ZGEDMD) +!> MLWMQR = N (minimal workspace for +!> ZUNMQR['L','N',M,N,N]) +!> MLWGQR = N (minimal workspace for ZUNGQR[M,N,N]) +!> MINMN = MIN(M,N) +!> Then +!> LZWORK = MAX(2, MIN(M,N)+MLWQR, MINMN+MLWDMD) +!> is further updated as follows: +!> if JOBZ == 'V' or JOBZ == 'F' THEN +!> LZWORK = MAX(LZWORK, MINMN+MLWMQR) +!> if JOBQ == 'Q' THEN +!> LZWORK = MAX(ZLWORK, MINMN+MLWGQR) +!> \endverbatim +!..... +!> \param[out] WORK +!> \verbatim +!> WORK (workspace/output) REAL(KIND=WP) LWORK-by-1 array +!> On exit, +!> WORK(1:N-1) contains the singular values of +!> the input submatrix F(1:M,1:N-1). +!> If the call to ZGEDMDQ is only workspace query, then +!> WORK(1) contains the minimal workspace length and +!> WORK(2) is the optimal workspace length. hence, the +!> length of work is at least 2. +!> See the description of LWORK. +!> \endverbatim +!..... +!> \param[in] LWORK +!> \verbatim +!> LWORK (input) INTEGER +!> The minimal length of the workspace vector WORK. +!> LWORK is the same as in ZGEDMD, because in ZGEDMDQ +!> only ZGEDMD requires real workspace for snapshots +!> of dimensions MIN(M,N)-by-(N-1). +!> If on entry LWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace length for WORK. +!> \endverbatim +!..... +!> \param[out] IWORK +!> \verbatim +!> IWORK (workspace/output) INTEGER LIWORK-by-1 array +!> Workspace that is required only if WHTSVD equals +!> 2 , 3 or 4. (See the description of WHTSVD). +!> If on entry LWORK =-1 or LIWORK=-1, then the +!> minimal length of IWORK is computed and returned in +!> IWORK(1). See the description of LIWORK. +!> \endverbatim +!..... +!> \param[in] LIWORK +!> \verbatim +!> LIWORK (input) INTEGER +!> The minimal length of the workspace vector IWORK. +!> If WHTSVD == 1, then only IWORK(1) is used; LIWORK >=1 +!> Let M1=MIN(M,N), N1=N-1. Then +!> If WHTSVD == 2, then LIWORK >= MAX(1,8*MIN(M1,N1)) +!> If WHTSVD == 3, then LIWORK >= MAX(1,M1+N1-1) +!> If WHTSVD == 4, then LIWORK >= MAX(3,M1+3*N1) +!> If on entry LIWORK = -1, then a workspace query is +!> assumed and the procedure only computes the minimal +!> and the optimal workspace lengths for both WORK and +!> IWORK. See the descriptions of WORK and IWORK. +!> \endverbatim +!..... +!> \param[out] INFO +!> \verbatim +!> INFO (output) INTEGER +!> -i < 0 :: On entry, the i-th argument had an +!> illegal value +!> = 0 :: Successful return. +!> = 1 :: Void input. Quick exit (M=0 or N=0). +!> = 2 :: The SVD computation of X did not converge. +!> Suggestion: Check the input data and/or +!> repeat with different WHTSVD. +!> = 3 :: The computation of the eigenvalues did not +!> converge. +!> = 4 :: If data scaling was requested on input and +!> the procedure found inconsistency in the data +!> such that for some column index i, +!> X(:,i) = 0 but Y(:,i) /= 0, then Y(:,i) is set +!> to zero if JOBS=='C'. The computation proceeds +!> with original or modified data and warning +!> flag is set with INFO=4. +!> \endverbatim +! +! Authors: +! ======== +! +!> \author Zlatko Drmac +! +!> \ingroup gedmd +! +!............................................................. +!............................................................. +SUBROUTINE ZGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & + WHTSVD, M, N, F, LDF, X, LDX, Y, & + LDY, NRNK, TOL, K, EIGS, & + Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK, LZWORK, WORK, LWORK, & + IWORK, LIWORK, INFO ) +! +! -- LAPACK driver routine -- +! +! -- LAPACK is a software package provided by University of -- +! -- Tennessee, University of California Berkeley, University of -- +! -- Colorado Denver and NAG Ltd.. -- +! +!..... + USE iso_fortran_env + IMPLICIT NONE + INTEGER, PARAMETER :: WP = real64 +! +! Scalar arguments +! ~~~~~~~~~~~~~~~~ + CHARACTER, INTENT(IN) :: JOBS, JOBZ, JOBR, JOBQ, & + JOBT, JOBF + INTEGER, INTENT(IN) :: WHTSVD, M, N, LDF, LDX, & + LDY, NRNK, LDZ, LDB, LDV, & + LDS, LZWORK, LWORK, LIWORK + INTEGER, INTENT(OUT) :: INFO, K + REAL(KIND=WP), INTENT(IN) :: TOL +! +! Array arguments +! ~~~~~~~~~~~~~~~ + COMPLEX(KIND=WP), INTENT(INOUT) :: F(LDF,*) + COMPLEX(KIND=WP), INTENT(OUT) :: X(LDX,*), Y(LDY,*), & + Z(LDZ,*), B(LDB,*), & + V(LDV,*), S(LDS,*) + COMPLEX(KIND=WP), INTENT(OUT) :: EIGS(*) + COMPLEX(KIND=WP), INTENT(OUT) :: ZWORK(*) + REAL(KIND=WP), INTENT(OUT) :: RES(*) + REAL(KIND=WP), INTENT(OUT) :: WORK(*) + INTEGER, INTENT(OUT) :: IWORK(*) +! +! Parameters +! ~~~~~~~~~~ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +! COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) +! +! Local scalars +! ~~~~~~~~~~~~~ + INTEGER :: IMINWR, INFO1, MINMN, MLRWRK, & + MLWDMD, MLWGQR, MLWMQR, MLWORK, & + MLWQR, OLWDMD, OLWGQR, OLWMQR, & + OLWORK, OLWQR + LOGICAL :: LQUERY, SCCOLX, SCCOLY, WANTQ, & + WNTTRF, WNTRES, WNTVEC, WNTVCF, & + WNTVCQ, WNTREF, WNTEX + CHARACTER(LEN=1) :: JOBVL +! +! External functions (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~ + LOGICAL LSAME + EXTERNAL LSAME +! +! External subroutines (BLAS and LAPACK) +! ~~~~~~~~~~~~~~~~~~~~ + EXTERNAL ZGEDMD, ZGEQRF, ZLACPY, ZLASET, ZUNGQR, & + ZUNMQR, XERBLA +! +! Intrinsic functions +! ~~~~~~~~~~~~~~~~~~~ + INTRINSIC MAX, MIN, INT +!.......................................................... +! +! Test the input arguments + WNTRES = LSAME(JOBR,'R') + SCCOLX = LSAME(JOBS,'S') .OR. LSAME( JOBS, 'C' ) + SCCOLY = LSAME(JOBS,'Y') + WNTVEC = LSAME(JOBZ,'V') + WNTVCF = LSAME(JOBZ,'F') + WNTVCQ = LSAME(JOBZ,'Q') + WNTREF = LSAME(JOBF,'R') + WNTEX = LSAME(JOBF,'E') + WANTQ = LSAME(JOBQ,'Q') + WNTTRF = LSAME(JOBT,'R') + MINMN = MIN(M,N) + INFO = 0 + LQUERY = ( (LZWORK == -1) .OR. (LWORK == -1) .OR. (LIWORK == -1) ) +! + IF ( .NOT. (SCCOLX .OR. SCCOLY .OR. & + LSAME(JOBS,'N')) ) THEN + INFO = -1 + ELSE IF ( .NOT. (WNTVEC .OR. WNTVCF .OR. WNTVCQ & + .OR. LSAME(JOBZ,'N')) ) THEN + INFO = -2 + ELSE IF ( .NOT. (WNTRES .OR. LSAME(JOBR,'N')) .OR. & + ( WNTRES .AND. LSAME(JOBZ,'N') ) ) THEN + INFO = -3 + ELSE IF ( .NOT. (WANTQ .OR. LSAME(JOBQ,'N')) ) THEN + INFO = -4 + ELSE IF ( .NOT. ( WNTTRF .OR. LSAME(JOBT,'N') ) ) THEN + INFO = -5 + ELSE IF ( .NOT. (WNTREF .OR. WNTEX .OR. & + LSAME(JOBF,'N') ) ) THEN + INFO = -6 + ELSE IF ( .NOT. ((WHTSVD == 1).OR.(WHTSVD == 2).OR. & + (WHTSVD == 3).OR.(WHTSVD == 4)) ) THEN + INFO = -7 + ELSE IF ( M < 0 ) THEN + INFO = -8 + ELSE IF ( ( N < 0 ) .OR. ( N > M+1 ) ) THEN + INFO = -9 + ELSE IF ( LDF < M ) THEN + INFO = -11 + ELSE IF ( LDX < MINMN ) THEN + INFO = -13 + ELSE IF ( LDY < MINMN ) THEN + INFO = -15 + ELSE IF ( .NOT. (( NRNK == -2).OR.(NRNK == -1).OR. & + ((NRNK >= 1).AND.(NRNK <=N ))) ) THEN + INFO = -16 + ELSE IF ( ( TOL < ZERO ) .OR. ( TOL >= ONE ) ) THEN + INFO = -17 + ELSE IF ( LDZ < M ) THEN + INFO = -21 + ELSE IF ( (WNTREF.OR.WNTEX ).AND.( LDB < MINMN ) ) THEN + INFO = -24 + ELSE IF ( LDV < N-1 ) THEN + INFO = -26 + ELSE IF ( LDS < N-1 ) THEN + INFO = -28 + END IF +! + IF ( WNTVEC .OR. WNTVCF .OR. WNTVCQ ) THEN + JOBVL = 'V' + ELSE + JOBVL = 'N' + END IF + IF ( INFO == 0 ) THEN + ! Compute the minimal and the optimal workspace + ! requirements. Simulate running the code and + ! determine minimal and optimal sizes of the + ! workspace at any moment of the run. + IF ( ( N == 0 ) .OR. ( N == 1 ) ) THEN + ! All output except K is void. INFO=1 signals + ! the void input. In case of a workspace query, + ! the minimal workspace lengths are returned. + IF ( LQUERY ) THEN + IWORK(1) = 1 + ZWORK(1) = 2 + ZWORK(2) = 2 + WORK(1) = 2 + WORK(2) = 2 + ELSE + K = 0 + END IF + INFO = 1 + RETURN + END IF + + MLRWRK = 2 + MLWORK = 2 + OLWORK = 2 + IMINWR = 1 + MLWQR = MAX(1,N) ! Minimal workspace length for ZGEQRF. + MLWORK = MAX(MLWORK,MINMN + MLWQR) + + IF ( LQUERY ) THEN + CALL ZGEQRF( M, N, F, LDF, ZWORK, ZWORK, -1, & + INFO1 ) + OLWQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,MINMN + OLWQR) + END IF + CALL ZGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN,& + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + EIGS, Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK, -1, WORK, -1, IWORK,& + -1, INFO1 ) + MLWDMD = INT(ZWORK(1)) + MLWORK = MAX(MLWORK, MINMN + MLWDMD) + MLRWRK = MAX(MLRWRK, INT(WORK(1))) + IMINWR = MAX(IMINWR, IWORK(1)) + IF ( LQUERY ) THEN + OLWDMD = INT(ZWORK(2)) + OLWORK = MAX(OLWORK, MINMN+OLWDMD) + END IF + IF ( WNTVEC .OR. WNTVCF ) THEN + MLWMQR = MAX(1,N) + MLWORK = MAX(MLWORK,MINMN+MLWMQR) + IF ( LQUERY ) THEN + CALL ZUNMQR( 'L','N', M, N, MINMN, F, LDF, & + ZWORK, Z, LDZ, ZWORK, -1, INFO1 ) + OLWMQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,MINMN+OLWMQR) + END IF + END IF + IF ( WANTQ ) THEN + MLWGQR = MAX(1,N) + MLWORK = MAX(MLWORK,MINMN+MLWGQR) + IF ( LQUERY ) THEN + CALL ZUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & + ZWORK, -1, INFO1 ) + OLWGQR = INT(ZWORK(1)) + OLWORK = MAX(OLWORK,MINMN+OLWGQR) + END IF + END IF + IF ( LIWORK < IMINWR .AND. (.NOT.LQUERY) ) INFO = -34 + IF ( LWORK < MLRWRK .AND. (.NOT.LQUERY) ) INFO = -32 + IF ( LZWORK < MLWORK .AND. (.NOT.LQUERY) ) INFO = -30 + END IF + IF( INFO /= 0 ) THEN + CALL XERBLA( 'ZGEDMDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +! Return minimal and optimal workspace sizes + IWORK(1) = IMINWR + ZWORK(1) = MLWORK + ZWORK(2) = OLWORK + WORK(1) = MLRWRK + WORK(2) = MLRWRK + RETURN + END IF +!..... +! Initial QR factorization that is used to represent the +! snapshots as elements of lower dimensional subspace. +! For large scale computation with M >> N, at this place +! one can use an out of core QRF. +! + CALL ZGEQRF( M, N, F, LDF, ZWORK, & + ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) +! +! Define X and Y as the snapshots representations in the +! orthogonal basis computed in the QR factorization. +! X corresponds to the leading N-1 and Y to the trailing +! N-1 snapshots. + CALL ZLASET( 'L', MINMN, N-1, ZZERO, ZZERO, X, LDX ) + CALL ZLACPY( 'U', MINMN, N-1, F, LDF, X, LDX ) + CALL ZLACPY( 'A', MINMN, N-1, F(1,2), LDF, Y, LDY ) + IF ( M >= 3 ) THEN + CALL ZLASET( 'L', MINMN-2, N-2, ZZERO, ZZERO, & + Y(3,1), LDY ) + END IF +! +! Compute the DMD of the projected snapshot pairs (X,Y) + CALL ZGEDMD( JOBS, JOBVL, JOBR, JOBF, WHTSVD, MINMN, & + N-1, X, LDX, Y, LDY, NRNK, TOL, K, & + EIGS, Z, LDZ, RES, B, LDB, V, LDV, & + S, LDS, ZWORK(MINMN+1), LZWORK-MINMN, & + WORK, LWORK, IWORK, LIWORK, INFO1 ) + IF ( INFO1 == 2 .OR. INFO1 == 3 ) THEN + ! Return with error code. See ZGEDMD for details. + INFO = INFO1 + RETURN + ELSE + INFO = INFO1 + END IF +! +! The Ritz vectors (Koopman modes) can be explicitly +! formed or returned in factored form. + IF ( WNTVEC ) THEN + ! Compute the eigenvectors explicitly. + IF ( M > MINMN ) CALL ZLASET( 'A', M-MINMN, K, ZZERO, & + ZZERO, Z(MINMN+1,1), LDZ ) + CALL ZUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & + LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + ELSE IF ( WNTVCF ) THEN + ! Return the Ritz vectors (eigenvectors) in factored + ! form Z*V, where Z contains orthonormal matrix (the + ! product of Q from the initial QR factorization and + ! the SVD/POD_basis returned by ZGEDMD in X) and the + ! second factor (the eigenvectors of the Rayleigh + ! quotient) is in the array V, as returned by ZGEDMD. + CALL ZLACPY( 'A', N, K, X, LDX, Z, LDZ ) + IF ( M > N ) CALL ZLASET( 'A', M-N, K, ZZERO, ZZERO, & + Z(N+1,1), LDZ ) + CALL ZUNMQR( 'L','N', M, K, MINMN, F, LDF, ZWORK, Z, & + LDZ, ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + END IF +! +! Some optional output variables: +! +! The upper triangular factor R in the initial QR +! factorization is optionally returned in the array Y. +! This is useful if this call to ZGEDMDQ is to be +! followed by a streaming DMD that is implemented in a +! QR compressed form. + IF ( WNTTRF ) THEN ! Return the upper triangular R in Y + CALL ZLASET( 'A', MINMN, N, ZZERO, ZZERO, Y, LDY ) + CALL ZLACPY( 'U', MINMN, N, F, LDF, Y, LDY ) + END IF +! +! The orthonormal/unitary factor Q in the initial QR +! factorization is optionally returned in the array F. +! Same as with the triangular factor above, this is +! useful in a streaming DMD. + IF ( WANTQ ) THEN ! Q overwrites F + CALL ZUNGQR( M, MINMN, MINMN, F, LDF, ZWORK, & + ZWORK(MINMN+1), LZWORK-MINMN, INFO1 ) + END IF +! + RETURN +! + END SUBROUTINE ZGEDMDQ diff --git a/TESTING/EIG/cchkdmd.f90 b/TESTING/EIG/cchkdmd.f90 index a9c181da9b..aa90046ff7 100644 --- a/TESTING/EIG/cchkdmd.f90 +++ b/TESTING/EIG/cchkdmd.f90 @@ -1,721 +1,721 @@ -! This is a test program for checking the implementations of -! the implementations of the following subroutines -! -! CGEDMD, for computation of the -! Dynamic Mode Decomposition (DMD) -! CGEDMDQ, for computation of a -! QR factorization based compressed DMD -! -! Developed and supported by: -! =========================== -! Developed and coded by Zlatko Drmac, Faculty of Science, -! University of Zagreb; drmac@math.hr -! In cooperation with -! AIMdyn Inc., Santa Barbara, CA. -! ======================================================== -! How to run the code (compiler, link info) -! ======================================================== -! Compile as FORTRAN 90 (or later) and link with BLAS and -! LAPACK libraries. -! NOTE: The code is developed and tested on top of the -! Intel MKL library (versions 2022.0.3 and 2022.2.0), -! using the Intel Fortran compiler. -! -! For developers of the C++ implementation -! ======================================================== -! See the LAPACK++ and Template Numerical Toolkit (TNT) -! -! Note on a development of the GPU HP implementation -! ======================================================== -! Work in progress. See CUDA, MAGMA, SLATE. -! NOTE: The four SVD subroutines used in this code are -! included as a part of R&D and for the completeness. -! This was also an opportunity to test those SVD codes. -! If the scaling option is used all four are essentially -! equally good. For implementations on HP platforms, -! one can use whichever SVD is available. -!............................................................ - -!............................................................ -!............................................................ -! - PROGRAM DMD_TEST - - use iso_fortran_env - IMPLICIT NONE - integer, parameter :: WP = real32 -!............................................................ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP - - COMPLEX(KIND=WP), PARAMETER :: CONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: CZERO = ( 0.0_WP, 0.0_WP ) -!............................................................ - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: RES, & - RES1, RESEX, SINGVX, SINGVQX, WORK - INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK - REAL(KIND=WP) :: WDUMMY(2) - INTEGER :: IDUMMY(4), ISEED(4) - REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, EPS, & - TOL, TOL2, SVDIFF, TMP, TMP_AU, & - TMP_FQR, TMP_REZ, TMP_REZQ, TMP_XW, & - TMP_EX -!............................................................ - COMPLEX(KIND=WP) :: CMAX - INTEGER :: LCWORK - COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: A, AC, & - AU, F, F0, F1, S, W, & - X, X0, Y, Y0, Y1, Z, Z1 - COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:) :: CDA, CDR, & - CDL, CEIGS, CEIGSA, CWORK - COMPLEX(KIND=WP) :: CDUMMY(22), CDUM2X2(2,2) -!............................................................ - INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & - LDZ, LIWORK, LWORK, M, N, LLOOP, NRNK - INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, & - NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & - NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & - NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD - INTEGER :: iNRNK, iWHTSVD, K_traj, LWMINOPT - CHARACTER :: GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & - SCALE, RESIDS, WANTQ, WANTR - LOGICAL :: TEST_QRDMD - -!..... external subroutines (BLAS and LAPACK) - EXTERNAL CAXPY, CGEEV, CGEMM, CGEMV, CLASCL -!.....external subroutines DMD package -! subroutines under test - EXTERNAL CGEDMD, CGEDMDQ -!..... external functions (BLAS and LAPACK) - EXTERNAL SCNRM2, SLAMCH - REAL(KIND=WP) :: SCNRM2, SLAMCH - EXTERNAL CLANGE - REAL(KIND=WP) :: CLANGE - EXTERNAL ICAMAX - INTEGER ICAMAX - EXTERNAL LSAME - LOGICAL LSAME - - INTRINSIC ABS, INT, MIN, MAX, SIGN -!............................................................ - - - WRITE(*,*) 'COMPLEX CODE TESTING' - - ! The test is always in pairs : ( CGEDMD and CGEDMDQ) - ! because the test includes comparing the results (in pairs). -!..................................................................................... - ! This code by default performs tests on CGEDMDQ - ! Since the QR factorizations based algorithm is designed for - ! single trajectory data, only single trajectory tests will - ! be performed with xGEDMDQ. - - WANTQ = 'Q' - WANTR = 'R' -!................................................................................. - - EPS = SLAMCH( 'P' ) ! machine precision WP - - ! Global counters of failures of some particular tests - NFAIL = 0 - NFAIL_REZ = 0 - NFAIL_REZQ = 0 - NFAIL_Z_XV = 0 - NFAIL_F_QR = 0 - NFAIL_AU = 0 - NFAIL_SVDIFF = 0 - NFAIL_TOTAL = 0 - NFAILQ_TOTAL = 0 - - DO LLOOP = 1, 4 - - WRITE(*,*) 'L Loop Index = ', LLOOP - - ! Set the dimensions of the problem ... - READ(*,*) M - WRITE(*,*) 'M = ', M - ! ... and the number of snapshots. - READ(*,*) N - WRITE(*,*) 'N = ', N - - ! Test the dimensions - IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN - WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' - STOP - END IF -!............. - ! The seed inside the LLOOP so that each pass can be reproduced easily. - ISEED(1) = 4 - ISEED(2) = 3 - ISEED(3) = 2 - ISEED(4) = 1 - - LDA = M - LDF = M - LDX = M - LDY = M - LDW = N - LDZ = M - LDAU = M - LDS = N - - TMP_XW = ZERO - TMP_AU = ZERO - TMP_REZ = ZERO - TMP_REZQ = ZERO - SVDIFF = ZERO - TMP_EX = ZERO - - ALLOCATE( A(LDA,M) ) - ALLOCATE( AC(LDA,M) ) - ALLOCATE( F(LDF,N+1) ) - ALLOCATE( F0(LDF,N+1) ) - ALLOCATE( F1(LDF,N+1) ) - ALLOCATE( X(LDX,N) ) - ALLOCATE( X0(LDX,N) ) - ALLOCATE( Y(LDY,N+1) ) - ALLOCATE( Y0(LDY,N+1) ) - ALLOCATE( Y1(LDY,N+1) ) - ALLOCATE( AU(LDAU,N) ) - ALLOCATE( W(LDW,N) ) - ALLOCATE( S(LDS,N) ) - ALLOCATE( Z(LDZ,N) ) - ALLOCATE( Z1(LDZ,N) ) - ALLOCATE( RES(N) ) - ALLOCATE( RES1(N) ) - ALLOCATE( RESEX(N) ) - ALLOCATE( CEIGS(N) ) - ALLOCATE( SINGVX(N) ) - ALLOCATE( SINGVQX(N) ) - - TOL = 10*M*EPS - TOL2 = 10*M*N*EPS - -!............. - - DO K_traj = 1, 2 - ! Number of intial conditions in the simulation/trajectories (1 or 2) - - COND = 1.0D4 - CMAX = (1.0D1,1.0D1) - RSIGN = 'F' - GRADE = 'N' - MODEL = 6 - CONDL = 1.0D1 - MODER = 6 - CONDR = 1.0D1 - PIVTNG = 'N' - ! Loop over all parameter MODE values for CLATMR (+-1,..,+-6) - - DO MODE = 1, 6 - - ALLOCATE( IWORK(2*M) ) - ALLOCATE( CDA(M) ) - ALLOCATE( CDL(M) ) - ALLOCATE( CDR(M) ) - - CALL CLATMR( M, M, 'N', ISEED, 'N', CDA, MODE, COND, & - CMAX, RSIGN, GRADE, CDL, MODEL, CONDL, & - CDR, MODER, CONDR, PIVTNG, IWORK, M, M, & - ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) - DEALLOCATE( CDR ) - DEALLOCATE( CDL ) - DEALLOCATE( CDA ) - DEALLOCATE( IWORK ) - - LCWORK = MAX(1,2*M) - ALLOCATE( CEIGSA(M) ) - ALLOCATE( CWORK(LCWORK) ) - ALLOCATE( WORK(2*M) ) - AC(1:M,1:M) = A(1:M,1:M) - CALL CGEEV( 'N','N', M, AC, LDA, CEIGSA, CDUM2X2, 2, & - CDUM2X2, 2, CWORK, LCWORK, WORK, INFO ) ! LAPACK CALL - DEALLOCATE(WORK) - DEALLOCATE(CWORK) - - TMP = ABS(CEIGSA(ICAMAX(M, CEIGSA, 1))) ! The spectral radius of A - ! Scale the matrix A to have unit spectral radius. - CALL CLASCL( 'G',0, 0, TMP, ONE, M, M, & - A, LDA, INFO ) - CALL CLASCL( 'G',0, 0, TMP, ONE, M, 1, & - CEIGSA, M, INFO ) - ANORM = CLANGE( 'F', M, M, A, LDA, WDUMMY ) - - IF ( K_traj == 2 ) THEN - ! generate data as two trajectories - ! with two inital conditions - CALL CLARNV(2, ISEED, M, F(1,1) ) - DO i = 1, N/2 - CALL CGEMV( 'N', M, M, CONE, A, LDA, F(1,i), 1, & - CZERO, F(1,i+1), 1 ) - END DO - X0(1:M,1:N/2) = F(1:M,1:N/2) - Y0(1:M,1:N/2) = F(1:M,2:N/2+1) - - CALL CLARNV(2, ISEED, M, F(1,1) ) - DO i = 1, N-N/2 - CALL CGEMV( 'N', M, M, CONE, A, LDA, F(1,i), 1, & - CZERO, F(1,i+1), 1 ) - END DO - X0(1:M,N/2+1:N) = F(1:M,1:N-N/2) - Y0(1:M,N/2+1:N) = F(1:M,2:N-N/2+1) - ELSE - CALL CLARNV(2, ISEED, M, F(1,1) ) - DO i = 1, N - CALL CGEMV( 'N', M, M, CONE, A, M, F(1,i), 1, & - CZERO, F(1,i+1), 1 ) - END DO - F0(1:M,1:N+1) = F(1:M,1:N+1) - X0(1:M,1:N) = F0(1:M,1:N) - Y0(1:M,1:N) = F0(1:M,2:N+1) - END IF - - DEALLOCATE( CEIGSA ) -!........................................................................ - - DO iJOBZ = 1, 4 - - SELECT CASE ( iJOBZ ) - CASE(1) - JOBZ = 'V' - RESIDS = 'R' - CASE(2) - JOBZ = 'V' - RESIDS = 'N' - CASE(3) - JOBZ = 'F' - RESIDS = 'N' - CASE(4) - JOBZ = 'N' - RESIDS = 'N' - END SELECT - - DO iJOBREF = 1, 3 - - SELECT CASE ( iJOBREF ) - CASE(1) - JOBREF = 'R' - CASE(2) - JOBREF = 'E' - CASE(3) - JOBREF = 'N' - END SELECT - - DO iSCALE = 1, 4 - - SELECT CASE ( iSCALE ) - CASE(1) - SCALE = 'S' - CASE(2) - SCALE = 'C' - CASE(3) - SCALE = 'Y' - CASE(4) - SCALE = 'N' - END SELECT - - DO iNRNK = -1, -2, -1 - NRNK = iNRNK - - DO iWHTSVD = 1, 3 - ! Check all four options to compute the POD basis - ! via the SVD. - WHTSVD = iWHTSVD - - DO LWMINOPT = 1, 2 - ! Workspace query for the minimal (1) and for the optimal - ! (2) workspace lengths determined by workspace query. - - ! CGEDMD is always tested and its results are also used for - ! comparisons with CGEDMDQ. - - X(1:M,1:N) = X0(1:M,1:N) - Y(1:M,1:N) = Y0(1:M,1:N) - - CALL CGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, CEIGS, Z, LDZ, RES, & - AU, LDAU, W, LDW, S, LDS, & - CDUMMY, -1, WDUMMY, -1, IDUMMY, -1, INFO ) - - IF ( (INFO .EQ. 2) .OR. ( INFO .EQ. 3 ) & - .OR. ( INFO < 0 ) ) THEN - WRITE(*,*) 'Call to CGEDMD workspace query failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ', & - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL, LDZ, LDAU, LDW, LDS - STOP - ELSE - !WRITE(*,*) '... done. Workspace length computed.' - END IF - - LCWORK = INT(CDUMMY(LWMINOPT)) - ALLOCATE(CWORK(LCWORK)) - LIWORK = IDUMMY(1) - ALLOCATE(IWORK(LIWORK)) - LWORK = INT(WDUMMY(1)) - ALLOCATE(WORK(LWORK)) - - CALL CGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, X, LDX, Y, LDY, NRNK, TOL, & - K, CEIGS, Z, LDZ, RES, & - AU, LDAU, W, LDW, S, LDS, & - CWORK, LCWORK, WORK, LWORK, IWORK, LIWORK, INFO ) - IF ( INFO /= 0 ) THEN - WRITE(*,*) 'Call to CGEDMD failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - STOP - END IF - SINGVX(1:N) = WORK(1:N) - - !...... CGEDMD check point - IF ( LSAME(JOBZ,'V') ) THEN - ! Check that Z = X*W, on return from CGEDMD - ! This checks that the returned eigenvectors in Z are - ! the product of the SVD'POD basis returned in X - ! and the eigenvectors of the Rayleigh quotient - ! returned in W - CALL CGEMM( 'N', 'N', M, K, K, CONE, X, LDX, W, LDW, & - CZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL CAXPY( M, -CONE, Z(1,i), 1, Z1(1,i), 1) - TMP = MAX(TMP, SCNRM2( M, Z1(1,i), 1 ) ) - END DO - TMP_XW = MAX(TMP_XW, TMP ) - IF ( TMP_XW <= TOL ) THEN - !WRITE(*,*) ' :) .... OK .........CGEDMD PASSED.' - ELSE - NFAIL_Z_XV = NFAIL_Z_XV + 1 - WRITE(*,*) ':( .................CGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - END IF - !...... CGEDMD check point - - IF ( LSAME(JOBREF,'R') ) THEN - ! The matrix A*U is returned for computing refined Ritz vectors. - ! Check that A*U is computed correctly using the formula - ! A*U = Y * V * inv(SIGMA). This depends on the - ! accuracy in the computed singular values and vectors of X. - ! See the paper for an error analysis. - ! Note that the left singular vectors of the input matrix X - ! are returned in the array X. - CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, X, LDX, & - CZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL CAXPY( M, -CONE, AU(1,i), 1, Z1(1,i), 1) - TMP = MAX( TMP, SCNRM2( M, Z1(1,i),1 ) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_AU = MAX( TMP_AU, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) ':) .... OK .........CGEDMD PASSED.' - ELSE - NFAIL_AU = NFAIL_AU + 1 - WRITE(*,*) ':( .................CGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL2 - END IF - ELSEIF ( LSAME(JOBREF,'E') ) THEN - ! The unscaled vectors of the Exact DMD are computed. - ! This option is included for the sake of completeness, - ! for users who prefer the Exact DMD vectors. The - ! returned vectors are in the real form, in the same way - ! as the Ritz vectors. Here we just save the vectors - ! and test them separately using a Matlab script. - CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, AU, LDAU, CZERO, Y1, LDY ) - - DO i=1, K - CALL CAXPY( M, -CEIGS(i), AU(1,i), 1, Y1(1,i), 1 ) - RESEX(i) = SCNRM2( M, Y1(1,i), 1) / SCNRM2(M,AU(1,i),1) - END DO - END IF - !...... CGEDMD check point - - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by CGEDMD with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, Z, LDZ, CZERO, Y1, LDY ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in CGEDMD,) - - DO i=1, K - ! have a real eigenvalue with real eigenvector - CALL CAXPY( M, -CEIGS(i), Z(1,i), 1, Y1(1,i), 1 ) - RES1(i) = SCNRM2( M, Y1(1,i), 1) - END DO - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_REZ = MAX( TMP_REZ, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) ':) .... OK ..........CGEDMD PASSED.' - ELSE - NFAIL_REZ = NFAIL_REZ + 1 - WRITE(*,*) ':( ..................CGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - - - IF ( LSAME(JOBREF,'E') ) THEN - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) - END DO - TMP_EX = MAX(TMP_EX,TMP) - END IF - - END IF - - DEALLOCATE(CWORK) - DEALLOCATE(WORK) - DEALLOCATE(IWORK) - -!....................................................................................................... - - IF ( K_traj == 1 ) THEN - - F(1:M,1:N+1) = F0(1:M,1:N+1) - CALL CGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & - WHTSVD, M, N+1, F, LDF, X, LDX, Y, LDY, & - NRNK, TOL, K, CEIGS, Z, LDZ, RES, AU, & - LDAU, W, LDW, S, LDS, CDUMMY, -1, & - WDUMMY, -1, IDUMMY, -1, INFO ) - - LCWORK = INT(CDUMMY(LWMINOPT)) - ALLOCATE(CWORK(LCWORK)) - LIWORK = IDUMMY(1) - ALLOCATE(IWORK(LIWORK)) - LWORK = INT(WDUMMY(1)) - ALLOCATE(WORK(LWORK)) - - CALL CGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & - WHTSVD, M, N+1, F, LDF, X, LDX, Y, LDY, & - NRNK, TOL, KQ, CEIGS, Z, LDZ, RES, AU, & - LDAU, W, LDW, S, LDS, CWORK, LCWORK, & - WORK, LWORK, IWORK, LIWORK, INFO ) - IF ( INFO /= 0 ) THEN - WRITE(*,*) 'Call to CGEDMDQ failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, WANTQ, WANTR, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - STOP - END IF - SINGVQX(1:N) =WORK(1:N) - - !..... ZGEDMDQ check point - - TMP = ZERO - DO i = 1, MIN(K, KQ) - TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & - SINGVX(1) ) - END DO - SVDIFF = MAX( SVDIFF, TMP ) - IF ( TMP > TOL2 ) THEN - WRITE(*,*) 'FAILED! Something was wrong with the run.' - NFAIL_SVDIFF = NFAIL_SVDIFF + 1 - END IF - !..... CGEDMDQ check point - - !..... CGEDMDQ check point - IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN - ! Check that the QR factors are computed and returned - ! as requested. The residual ||F-Q*R||_F / ||F||_F - ! is compared to M*N*EPS. - F1(1:M,1:N+1) = F0(1:M,1:N+1) - CALL CGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -CONE, F, & - LDF, Y, LDY, CONE, F1, LDF ) - TMP_FQR = CLANGE( 'F', M, N+1, F1, LDF, WORK ) / & - CLANGE( 'F', M, N+1, F0, LDF, WORK ) - IF ( TMP_FQR <= TOL2 ) THEN - !WRITE(*,*) ':) CGEDMDQ ........ PASSED.' - ELSE - WRITE(*,*) ':( CGEDMDQ ........ FAILED.' - NFAIL_F_QR = NFAIL_F_QR + 1 - END IF - END IF - !..... ZGEDMDQ checkpoint - !..... ZGEDMDQ checkpoint - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by ZGEDMDQ with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL CGEMM( 'N', 'N', M, KQ, M, CONE, A, LDA, Z, LDZ, CZERO, Y1, LDY ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in ZGEDMDQ) - DO i = 1, KQ - ! have a real eigenvalue with real eigenvector - CALL CAXPY( M, -CEIGS(i), Z(1,i), 1, Y1(1,i), 1 ) - ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) - RES1(i) = SCNRM2( M, Y1(1,i), 1) - END DO - TMP = ZERO - DO i = 1, KQ - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVQX(KQ)/(ANORM*SINGVQX(1)) ) - END DO - TMP_REZQ = MAX( TMP_REZQ, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) '.... OK ........ CGEDMDQ PASSED.' - ELSE - NFAIL_REZQ = NFAIL_REZQ + 1 - WRITE(*,*) '................ CGEDMDQ FAILED!', & - 'Check the code for implementation errors.' - END IF - END IF - - DEALLOCATE(CWORK) - DEALLOCATE(WORK) - DEALLOCATE(IWORK) - - END IF - - END DO ! LWMINOPT - !write(*,*) 'LWMINOPT loop completed' - END DO ! iWHTSVD - !write(*,*) 'WHTSVD loop completed' - END DO ! iNRNK -2:-1 - !write(*,*) 'NRNK loop completed' - END DO ! iSCALE 1:4 - !write(*,*) 'SCALE loop completed' - END DO - !write(*,*) 'JOBREF loop completed' - END DO ! iJOBZ - !write(*,*) 'JOBZ loop completed' - - END DO ! MODE -6:6 - !write(*,*) 'MODE loop completed' - END DO ! 1 or 2 trajectories - !write(*,*) 'trajectories loop completed' - - DEALLOCATE( A ) - DEALLOCATE( AC ) - DEALLOCATE( Z ) - DEALLOCATE( F ) - DEALLOCATE( F0 ) - DEALLOCATE( F1 ) - DEALLOCATE( X ) - DEALLOCATE( X0 ) - DEALLOCATE( Y ) - DEALLOCATE( Y0 ) - DEALLOCATE( Y1 ) - DEALLOCATE( AU ) - DEALLOCATE( W ) - DEALLOCATE( S ) - DEALLOCATE( Z1 ) - DEALLOCATE( RES ) - DEALLOCATE( RES1 ) - DEALLOCATE( RESEX ) - DEALLOCATE( CEIGS ) - DEALLOCATE( SINGVX ) - DEALLOCATE( SINGVQX ) - - END DO ! LLOOP - - WRITE(*,*) - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for CGEDMD :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - IF ( NFAIL_Z_XV == 0 ) THEN - WRITE(*,*) '>>>> Z - U*V test PASSED.' - ELSE - WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' - WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_XW - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_z_XV - END IF - - IF ( NFAIL_AU == 0 ) THEN - WRITE(*,*) '>>>> A*U test PASSED. ' - ELSE - WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' - WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU - END IF - - - IF ( NFAIL_REZ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ - END IF - IF ( NFAIL_TOTAL == 0 ) THEN - WRITE(*,*) '>>>> CGEDMD :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>>>>>>>>> CGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - WRITE(*,*) - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for CGEDMDQ :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - - IF ( NFAIL_SVDIFF == 0 ) THEN - WRITE(*,*) '>>>> CGEDMD and CGEDMDQ computed singular & - &values test PASSED.' - ELSE - WRITE(*,*) 'ZGEDMD and ZGEDMDQ discrepancies in & - &the singular values unacceptable ', & - NFAIL_SVDIFF, ' times. Test FAILED.' - WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF - END IF - IF ( NFAIL_F_QR == 0 ) THEN - WRITE(*,*) '>>>> F - Q*R test PASSED.' - ELSE - WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' - WRITE(*,*) 'The largest relative residual was ', TMP_FQR - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR - END IF - - IF ( NFAIL_REZQ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ - END IF - - IF ( NFAILQ_TOTAL == 0 ) THEN - WRITE(*,*) '>>>>>>> CGEDMDQ :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>> CGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - WRITE(*,*) - WRITE(*,*) 'Test completed.' - STOP - END +! This is a test program for checking the implementations of +! the implementations of the following subroutines +! +! CGEDMD, for computation of the +! Dynamic Mode Decomposition (DMD) +! CGEDMDQ, for computation of a +! QR factorization based compressed DMD +! +! Developed and supported by: +! =========================== +! Developed and coded by Zlatko Drmac, Faculty of Science, +! University of Zagreb; drmac@math.hr +! In cooperation with +! AIMdyn Inc., Santa Barbara, CA. +! ======================================================== +! How to run the code (compiler, link info) +! ======================================================== +! Compile as FORTRAN 90 (or later) and link with BLAS and +! LAPACK libraries. +! NOTE: The code is developed and tested on top of the +! Intel MKL library (versions 2022.0.3 and 2022.2.0), +! using the Intel Fortran compiler. +! +! For developers of the C++ implementation +! ======================================================== +! See the LAPACK++ and Template Numerical Toolkit (TNT) +! +! Note on a development of the GPU HP implementation +! ======================================================== +! Work in progress. See CUDA, MAGMA, SLATE. +! NOTE: The four SVD subroutines used in this code are +! included as a part of R&D and for the completeness. +! This was also an opportunity to test those SVD codes. +! If the scaling option is used all four are essentially +! equally good. For implementations on HP platforms, +! one can use whichever SVD is available. +!............................................................ + +!............................................................ +!............................................................ +! + PROGRAM DMD_TEST + + use iso_fortran_env + IMPLICIT NONE + integer, parameter :: WP = real32 +!............................................................ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP + + COMPLEX(KIND=WP), PARAMETER :: CONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: CZERO = ( 0.0_WP, 0.0_WP ) +!............................................................ + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: RES, & + RES1, RESEX, SINGVX, SINGVQX, WORK + INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK + REAL(KIND=WP) :: WDUMMY(2) + INTEGER :: IDUMMY(4), ISEED(4) + REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, EPS, & + TOL, TOL2, SVDIFF, TMP, TMP_AU, & + TMP_FQR, TMP_REZ, TMP_REZQ, TMP_XW, & + TMP_EX +!............................................................ + COMPLEX(KIND=WP) :: CMAX + INTEGER :: LCWORK + COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: A, AC, & + AU, F, F0, F1, S, W, & + X, X0, Y, Y0, Y1, Z, Z1 + COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:) :: CDA, CDR, & + CDL, CEIGS, CEIGSA, CWORK + COMPLEX(KIND=WP) :: CDUMMY(22), CDUM2X2(2,2) +!............................................................ + INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & + LDZ, LIWORK, LWORK, M, N, LLOOP, NRNK + INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, & + NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & + NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & + NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD + INTEGER :: iNRNK, iWHTSVD, K_traj, LWMINOPT + CHARACTER :: GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & + SCALE, RESIDS, WANTQ, WANTR + LOGICAL :: TEST_QRDMD + +!..... external subroutines (BLAS and LAPACK) + EXTERNAL CAXPY, CGEEV, CGEMM, CGEMV, CLASCL +!.....external subroutines DMD package +! subroutines under test + EXTERNAL CGEDMD, CGEDMDQ +!..... external functions (BLAS and LAPACK) + EXTERNAL SCNRM2, SLAMCH + REAL(KIND=WP) :: SCNRM2, SLAMCH + EXTERNAL CLANGE + REAL(KIND=WP) :: CLANGE + EXTERNAL ICAMAX + INTEGER ICAMAX + EXTERNAL LSAME + LOGICAL LSAME + + INTRINSIC ABS, INT, MIN, MAX, SIGN +!............................................................ + + + WRITE(*,*) 'COMPLEX CODE TESTING' + + ! The test is always in pairs : ( CGEDMD and CGEDMDQ) + ! because the test includes comparing the results (in pairs). +!..................................................................................... + ! This code by default performs tests on CGEDMDQ + ! Since the QR factorizations based algorithm is designed for + ! single trajectory data, only single trajectory tests will + ! be performed with xGEDMDQ. + + WANTQ = 'Q' + WANTR = 'R' +!................................................................................. + + EPS = SLAMCH( 'P' ) ! machine precision WP + + ! Global counters of failures of some particular tests + NFAIL = 0 + NFAIL_REZ = 0 + NFAIL_REZQ = 0 + NFAIL_Z_XV = 0 + NFAIL_F_QR = 0 + NFAIL_AU = 0 + NFAIL_SVDIFF = 0 + NFAIL_TOTAL = 0 + NFAILQ_TOTAL = 0 + + DO LLOOP = 1, 4 + + WRITE(*,*) 'L Loop Index = ', LLOOP + + ! Set the dimensions of the problem ... + READ(*,*) M + WRITE(*,*) 'M = ', M + ! ... and the number of snapshots. + READ(*,*) N + WRITE(*,*) 'N = ', N + + ! Test the dimensions + IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN + WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' + STOP + END IF +!............. + ! The seed inside the LLOOP so that each pass can be reproduced easily. + ISEED(1) = 4 + ISEED(2) = 3 + ISEED(3) = 2 + ISEED(4) = 1 + + LDA = M + LDF = M + LDX = M + LDY = M + LDW = N + LDZ = M + LDAU = M + LDS = N + + TMP_XW = ZERO + TMP_AU = ZERO + TMP_REZ = ZERO + TMP_REZQ = ZERO + SVDIFF = ZERO + TMP_EX = ZERO + + ALLOCATE( A(LDA,M) ) + ALLOCATE( AC(LDA,M) ) + ALLOCATE( F(LDF,N+1) ) + ALLOCATE( F0(LDF,N+1) ) + ALLOCATE( F1(LDF,N+1) ) + ALLOCATE( X(LDX,N) ) + ALLOCATE( X0(LDX,N) ) + ALLOCATE( Y(LDY,N+1) ) + ALLOCATE( Y0(LDY,N+1) ) + ALLOCATE( Y1(LDY,N+1) ) + ALLOCATE( AU(LDAU,N) ) + ALLOCATE( W(LDW,N) ) + ALLOCATE( S(LDS,N) ) + ALLOCATE( Z(LDZ,N) ) + ALLOCATE( Z1(LDZ,N) ) + ALLOCATE( RES(N) ) + ALLOCATE( RES1(N) ) + ALLOCATE( RESEX(N) ) + ALLOCATE( CEIGS(N) ) + ALLOCATE( SINGVX(N) ) + ALLOCATE( SINGVQX(N) ) + + TOL = 10*M*EPS + TOL2 = 10*M*N*EPS + +!............. + + DO K_traj = 1, 2 + ! Number of intial conditions in the simulation/trajectories (1 or 2) + + COND = 1.0D4 + CMAX = (1.0D1,1.0D1) + RSIGN = 'F' + GRADE = 'N' + MODEL = 6 + CONDL = 1.0D1 + MODER = 6 + CONDR = 1.0D1 + PIVTNG = 'N' + ! Loop over all parameter MODE values for CLATMR (+-1,..,+-6) + + DO MODE = 1, 6 + + ALLOCATE( IWORK(2*M) ) + ALLOCATE( CDA(M) ) + ALLOCATE( CDL(M) ) + ALLOCATE( CDR(M) ) + + CALL CLATMR( M, M, 'N', ISEED, 'N', CDA, MODE, COND, & + CMAX, RSIGN, GRADE, CDL, MODEL, CONDL, & + CDR, MODER, CONDR, PIVTNG, IWORK, M, M, & + ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) + DEALLOCATE( CDR ) + DEALLOCATE( CDL ) + DEALLOCATE( CDA ) + DEALLOCATE( IWORK ) + + LCWORK = MAX(1,2*M) + ALLOCATE( CEIGSA(M) ) + ALLOCATE( CWORK(LCWORK) ) + ALLOCATE( WORK(2*M) ) + AC(1:M,1:M) = A(1:M,1:M) + CALL CGEEV( 'N','N', M, AC, LDA, CEIGSA, CDUM2X2, 2, & + CDUM2X2, 2, CWORK, LCWORK, WORK, INFO ) ! LAPACK CALL + DEALLOCATE(WORK) + DEALLOCATE(CWORK) + + TMP = ABS(CEIGSA(ICAMAX(M, CEIGSA, 1))) ! The spectral radius of A + ! Scale the matrix A to have unit spectral radius. + CALL CLASCL( 'G',0, 0, TMP, ONE, M, M, & + A, LDA, INFO ) + CALL CLASCL( 'G',0, 0, TMP, ONE, M, 1, & + CEIGSA, M, INFO ) + ANORM = CLANGE( 'F', M, M, A, LDA, WDUMMY ) + + IF ( K_traj == 2 ) THEN + ! generate data as two trajectories + ! with two inital conditions + CALL CLARNV(2, ISEED, M, F(1,1) ) + DO i = 1, N/2 + CALL CGEMV( 'N', M, M, CONE, A, LDA, F(1,i), 1, & + CZERO, F(1,i+1), 1 ) + END DO + X0(1:M,1:N/2) = F(1:M,1:N/2) + Y0(1:M,1:N/2) = F(1:M,2:N/2+1) + + CALL CLARNV(2, ISEED, M, F(1,1) ) + DO i = 1, N-N/2 + CALL CGEMV( 'N', M, M, CONE, A, LDA, F(1,i), 1, & + CZERO, F(1,i+1), 1 ) + END DO + X0(1:M,N/2+1:N) = F(1:M,1:N-N/2) + Y0(1:M,N/2+1:N) = F(1:M,2:N-N/2+1) + ELSE + CALL CLARNV(2, ISEED, M, F(1,1) ) + DO i = 1, N + CALL CGEMV( 'N', M, M, CONE, A, M, F(1,i), 1, & + CZERO, F(1,i+1), 1 ) + END DO + F0(1:M,1:N+1) = F(1:M,1:N+1) + X0(1:M,1:N) = F0(1:M,1:N) + Y0(1:M,1:N) = F0(1:M,2:N+1) + END IF + + DEALLOCATE( CEIGSA ) +!........................................................................ + + DO iJOBZ = 1, 4 + + SELECT CASE ( iJOBZ ) + CASE(1) + JOBZ = 'V' + RESIDS = 'R' + CASE(2) + JOBZ = 'V' + RESIDS = 'N' + CASE(3) + JOBZ = 'F' + RESIDS = 'N' + CASE(4) + JOBZ = 'N' + RESIDS = 'N' + END SELECT + + DO iJOBREF = 1, 3 + + SELECT CASE ( iJOBREF ) + CASE(1) + JOBREF = 'R' + CASE(2) + JOBREF = 'E' + CASE(3) + JOBREF = 'N' + END SELECT + + DO iSCALE = 1, 4 + + SELECT CASE ( iSCALE ) + CASE(1) + SCALE = 'S' + CASE(2) + SCALE = 'C' + CASE(3) + SCALE = 'Y' + CASE(4) + SCALE = 'N' + END SELECT + + DO iNRNK = -1, -2, -1 + NRNK = iNRNK + + DO iWHTSVD = 1, 3 + ! Check all four options to compute the POD basis + ! via the SVD. + WHTSVD = iWHTSVD + + DO LWMINOPT = 1, 2 + ! Workspace query for the minimal (1) and for the optimal + ! (2) workspace lengths determined by workspace query. + + ! CGEDMD is always tested and its results are also used for + ! comparisons with CGEDMDQ. + + X(1:M,1:N) = X0(1:M,1:N) + Y(1:M,1:N) = Y0(1:M,1:N) + + CALL CGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, CEIGS, Z, LDZ, RES, & + AU, LDAU, W, LDW, S, LDS, & + CDUMMY, -1, WDUMMY, -1, IDUMMY, -1, INFO ) + + IF ( (INFO .EQ. 2) .OR. ( INFO .EQ. 3 ) & + .OR. ( INFO < 0 ) ) THEN + WRITE(*,*) 'Call to CGEDMD workspace query failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ', & + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL, LDZ, LDAU, LDW, LDS + STOP + ELSE + !WRITE(*,*) '... done. Workspace length computed.' + END IF + + LCWORK = INT(CDUMMY(LWMINOPT)) + ALLOCATE(CWORK(LCWORK)) + LIWORK = IDUMMY(1) + ALLOCATE(IWORK(LIWORK)) + LWORK = INT(WDUMMY(1)) + ALLOCATE(WORK(LWORK)) + + CALL CGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, X, LDX, Y, LDY, NRNK, TOL, & + K, CEIGS, Z, LDZ, RES, & + AU, LDAU, W, LDW, S, LDS, & + CWORK, LCWORK, WORK, LWORK, IWORK, LIWORK, INFO ) + IF ( INFO /= 0 ) THEN + WRITE(*,*) 'Call to CGEDMD failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + STOP + END IF + SINGVX(1:N) = WORK(1:N) + + !...... CGEDMD check point + IF ( LSAME(JOBZ,'V') ) THEN + ! Check that Z = X*W, on return from CGEDMD + ! This checks that the returned eigenvectors in Z are + ! the product of the SVD'POD basis returned in X + ! and the eigenvectors of the Rayleigh quotient + ! returned in W + CALL CGEMM( 'N', 'N', M, K, K, CONE, X, LDX, W, LDW, & + CZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL CAXPY( M, -CONE, Z(1,i), 1, Z1(1,i), 1) + TMP = MAX(TMP, SCNRM2( M, Z1(1,i), 1 ) ) + END DO + TMP_XW = MAX(TMP_XW, TMP ) + IF ( TMP_XW <= TOL ) THEN + !WRITE(*,*) ' :) .... OK .........CGEDMD PASSED.' + ELSE + NFAIL_Z_XV = NFAIL_Z_XV + 1 + WRITE(*,*) ':( .................CGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + END IF + !...... CGEDMD check point + + IF ( LSAME(JOBREF,'R') ) THEN + ! The matrix A*U is returned for computing refined Ritz vectors. + ! Check that A*U is computed correctly using the formula + ! A*U = Y * V * inv(SIGMA). This depends on the + ! accuracy in the computed singular values and vectors of X. + ! See the paper for an error analysis. + ! Note that the left singular vectors of the input matrix X + ! are returned in the array X. + CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, X, LDX, & + CZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL CAXPY( M, -CONE, AU(1,i), 1, Z1(1,i), 1) + TMP = MAX( TMP, SCNRM2( M, Z1(1,i),1 ) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_AU = MAX( TMP_AU, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) ':) .... OK .........CGEDMD PASSED.' + ELSE + NFAIL_AU = NFAIL_AU + 1 + WRITE(*,*) ':( .................CGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL2 + END IF + ELSEIF ( LSAME(JOBREF,'E') ) THEN + ! The unscaled vectors of the Exact DMD are computed. + ! This option is included for the sake of completeness, + ! for users who prefer the Exact DMD vectors. The + ! returned vectors are in the real form, in the same way + ! as the Ritz vectors. Here we just save the vectors + ! and test them separately using a Matlab script. + CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, AU, LDAU, CZERO, Y1, LDY ) + + DO i=1, K + CALL CAXPY( M, -CEIGS(i), AU(1,i), 1, Y1(1,i), 1 ) + RESEX(i) = SCNRM2( M, Y1(1,i), 1) / SCNRM2(M,AU(1,i),1) + END DO + END IF + !...... CGEDMD check point + + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by CGEDMD with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL CGEMM( 'N', 'N', M, K, M, CONE, A, LDA, Z, LDZ, CZERO, Y1, LDY ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in CGEDMD,) + + DO i=1, K + ! have a real eigenvalue with real eigenvector + CALL CAXPY( M, -CEIGS(i), Z(1,i), 1, Y1(1,i), 1 ) + RES1(i) = SCNRM2( M, Y1(1,i), 1) + END DO + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_REZ = MAX( TMP_REZ, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) ':) .... OK ..........CGEDMD PASSED.' + ELSE + NFAIL_REZ = NFAIL_REZ + 1 + WRITE(*,*) ':( ..................CGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + + + IF ( LSAME(JOBREF,'E') ) THEN + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) + END DO + TMP_EX = MAX(TMP_EX,TMP) + END IF + + END IF + + DEALLOCATE(CWORK) + DEALLOCATE(WORK) + DEALLOCATE(IWORK) + +!....................................................................................................... + + IF ( K_traj == 1 ) THEN + + F(1:M,1:N+1) = F0(1:M,1:N+1) + CALL CGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & + WHTSVD, M, N+1, F, LDF, X, LDX, Y, LDY, & + NRNK, TOL, K, CEIGS, Z, LDZ, RES, AU, & + LDAU, W, LDW, S, LDS, CDUMMY, -1, & + WDUMMY, -1, IDUMMY, -1, INFO ) + + LCWORK = INT(CDUMMY(LWMINOPT)) + ALLOCATE(CWORK(LCWORK)) + LIWORK = IDUMMY(1) + ALLOCATE(IWORK(LIWORK)) + LWORK = INT(WDUMMY(1)) + ALLOCATE(WORK(LWORK)) + + CALL CGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & + WHTSVD, M, N+1, F, LDF, X, LDX, Y, LDY, & + NRNK, TOL, KQ, CEIGS, Z, LDZ, RES, AU, & + LDAU, W, LDW, S, LDS, CWORK, LCWORK, & + WORK, LWORK, IWORK, LIWORK, INFO ) + IF ( INFO /= 0 ) THEN + WRITE(*,*) 'Call to CGEDMDQ failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, WANTQ, WANTR, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + STOP + END IF + SINGVQX(1:N) =WORK(1:N) + + !..... ZGEDMDQ check point + + TMP = ZERO + DO i = 1, MIN(K, KQ) + TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & + SINGVX(1) ) + END DO + SVDIFF = MAX( SVDIFF, TMP ) + IF ( TMP > TOL2 ) THEN + WRITE(*,*) 'FAILED! Something was wrong with the run.' + NFAIL_SVDIFF = NFAIL_SVDIFF + 1 + END IF + !..... CGEDMDQ check point + + !..... CGEDMDQ check point + IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN + ! Check that the QR factors are computed and returned + ! as requested. The residual ||F-Q*R||_F / ||F||_F + ! is compared to M*N*EPS. + F1(1:M,1:N+1) = F0(1:M,1:N+1) + CALL CGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -CONE, F, & + LDF, Y, LDY, CONE, F1, LDF ) + TMP_FQR = CLANGE( 'F', M, N+1, F1, LDF, WORK ) / & + CLANGE( 'F', M, N+1, F0, LDF, WORK ) + IF ( TMP_FQR <= TOL2 ) THEN + !WRITE(*,*) ':) CGEDMDQ ........ PASSED.' + ELSE + WRITE(*,*) ':( CGEDMDQ ........ FAILED.' + NFAIL_F_QR = NFAIL_F_QR + 1 + END IF + END IF + !..... ZGEDMDQ checkpoint + !..... ZGEDMDQ checkpoint + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by ZGEDMDQ with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL CGEMM( 'N', 'N', M, KQ, M, CONE, A, LDA, Z, LDZ, CZERO, Y1, LDY ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in ZGEDMDQ) + DO i = 1, KQ + ! have a real eigenvalue with real eigenvector + CALL CAXPY( M, -CEIGS(i), Z(1,i), 1, Y1(1,i), 1 ) + ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) + RES1(i) = SCNRM2( M, Y1(1,i), 1) + END DO + TMP = ZERO + DO i = 1, KQ + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVQX(KQ)/(ANORM*SINGVQX(1)) ) + END DO + TMP_REZQ = MAX( TMP_REZQ, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) '.... OK ........ CGEDMDQ PASSED.' + ELSE + NFAIL_REZQ = NFAIL_REZQ + 1 + WRITE(*,*) '................ CGEDMDQ FAILED!', & + 'Check the code for implementation errors.' + END IF + END IF + + DEALLOCATE(CWORK) + DEALLOCATE(WORK) + DEALLOCATE(IWORK) + + END IF + + END DO ! LWMINOPT + !write(*,*) 'LWMINOPT loop completed' + END DO ! iWHTSVD + !write(*,*) 'WHTSVD loop completed' + END DO ! iNRNK -2:-1 + !write(*,*) 'NRNK loop completed' + END DO ! iSCALE 1:4 + !write(*,*) 'SCALE loop completed' + END DO + !write(*,*) 'JOBREF loop completed' + END DO ! iJOBZ + !write(*,*) 'JOBZ loop completed' + + END DO ! MODE -6:6 + !write(*,*) 'MODE loop completed' + END DO ! 1 or 2 trajectories + !write(*,*) 'trajectories loop completed' + + DEALLOCATE( A ) + DEALLOCATE( AC ) + DEALLOCATE( Z ) + DEALLOCATE( F ) + DEALLOCATE( F0 ) + DEALLOCATE( F1 ) + DEALLOCATE( X ) + DEALLOCATE( X0 ) + DEALLOCATE( Y ) + DEALLOCATE( Y0 ) + DEALLOCATE( Y1 ) + DEALLOCATE( AU ) + DEALLOCATE( W ) + DEALLOCATE( S ) + DEALLOCATE( Z1 ) + DEALLOCATE( RES ) + DEALLOCATE( RES1 ) + DEALLOCATE( RESEX ) + DEALLOCATE( CEIGS ) + DEALLOCATE( SINGVX ) + DEALLOCATE( SINGVQX ) + + END DO ! LLOOP + + WRITE(*,*) + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for CGEDMD :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + IF ( NFAIL_Z_XV == 0 ) THEN + WRITE(*,*) '>>>> Z - U*V test PASSED.' + ELSE + WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' + WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_XW + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_z_XV + END IF + + IF ( NFAIL_AU == 0 ) THEN + WRITE(*,*) '>>>> A*U test PASSED. ' + ELSE + WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' + WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU + END IF + + + IF ( NFAIL_REZ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ + END IF + IF ( NFAIL_TOTAL == 0 ) THEN + WRITE(*,*) '>>>> CGEDMD :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>>>>>>>>> CGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + WRITE(*,*) + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for CGEDMDQ :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + + IF ( NFAIL_SVDIFF == 0 ) THEN + WRITE(*,*) '>>>> CGEDMD and CGEDMDQ computed singular & + &values test PASSED.' + ELSE + WRITE(*,*) 'ZGEDMD and ZGEDMDQ discrepancies in & + &the singular values unacceptable ', & + NFAIL_SVDIFF, ' times. Test FAILED.' + WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF + END IF + IF ( NFAIL_F_QR == 0 ) THEN + WRITE(*,*) '>>>> F - Q*R test PASSED.' + ELSE + WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' + WRITE(*,*) 'The largest relative residual was ', TMP_FQR + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR + END IF + + IF ( NFAIL_REZQ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ + END IF + + IF ( NFAILQ_TOTAL == 0 ) THEN + WRITE(*,*) '>>>>>>> CGEDMDQ :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>> CGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + WRITE(*,*) + WRITE(*,*) 'Test completed.' + STOP + END diff --git a/TESTING/EIG/dchkdmd.f90 b/TESTING/EIG/dchkdmd.f90 index 4fbf7531b3..c64d01a412 100644 --- a/TESTING/EIG/dchkdmd.f90 +++ b/TESTING/EIG/dchkdmd.f90 @@ -1,813 +1,813 @@ -! This is a test program for checking the implementations of -! the implementations of the following subroutines -! -! DGEDMD for computation of the -! Dynamic Mode Decomposition (DMD) -! DGEDMDQ for computation of a -! QR factorization based compressed DMD -! -! Developed and supported by: -! =========================== -! Developed and coded by Zlatko Drmac, Faculty of Science, -! University of Zagreb; drmac@math.hr -! In cooperation with -! AIMdyn Inc., Santa Barbara, CA. -! ======================================================== -! How to run the code (compiler, link info) -! ======================================================== -! Compile as FORTRAN 90 (or later) and link with BLAS and -! LAPACK libraries. -! NOTE: The code is developed and tested on top of the -! Intel MKL library (versions 2022.0.3 and 2022.2.0), -! using the Intel Fortran compiler. -! -! For developers of the C++ implementation -! ======================================================== -! See the LAPACK++ and Template Numerical Toolkit (TNT) -! -! Note on a development of the GPU HP implementation -! ======================================================== -! Work in progress. See CUDA, MAGMA, SLATE. -! NOTE: The four SVD subroutines used in this code are -! included as a part of R&D and for the completeness. -! This was also an opportunity to test those SVD codes. -! If the scaling option is used all four are essentially -! equally good. For implementations on HP platforms, -! one can use whichever SVD is available. -!... ......................................................... -! NOTE: -! When using the Intel MKL 2022.0.3 the subroutine xGESVDQ -! (optionally used in xGEDMD) may cause access violation -! error for x = S, D, C, Z, but only if called with the -! work space query. (At least in our Windows 10 MSVS 2019.) -! The problem can be mitigated by downloading the source -! code of xGESVDQ from the LAPACK repository and use it -! localy instead of the one in the MKL. This seems to -! indicate that the problem is indeed in the MKL. -! This problem did not appear whith Intel MKL 2022.2.0. -! -! NOTE: -! xGESDD seems to have a problem with workspace. In some -! cases the length of the optimal workspace is returned -! smaller than the minimal workspace, as specified in the -! code. As a precaution, all optimal workspaces are -! set as MAX(minimal, optimal). -! Latest implementations of complex xGESDD have different -! length of the real worksapce. We use max value over -! two versions. -!............................................................ -!............................................................ -! - PROGRAM DMD_TEST - use iso_fortran_env, only: real64 - IMPLICIT NONE - integer, parameter :: WP = real64 - -!............................................................ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -!............................................................ - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: & - A, AC, EIGA, LAMBDA, LAMBDAQ, F, F1, F2,& - Z, Z1, S, AU, W, VA, X, X0, Y, Y0, Y1 - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: & - DA, DL, DR, REIG, REIGA, REIGQ, IEIG, & - IEIGA, IEIGQ, RES, RES1, RESEX, SINGVX,& - SINGVQX, WORK - INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK - REAL(KIND=WP) :: AB(2,2), WDUMMY(2) - INTEGER :: IDUMMY(2), ISEED(4), RJOBDATA(8) - REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, DMAX, EPS, & - TOL, TOL2, SVDIFF, TMP, TMP_AU, & - TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & - TMP_EX, XNORM, YNORM -!............................................................ - INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & - LDZ, LIWORK, LWORK, M, N, L, LLOOP, NRNK - INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, KDIFF, & - NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & - NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & - NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD - INTEGER iNRNK, iWHTSVD, K_TRAJ, LWMINOPT - CHARACTER(LEN=1) GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & - SCALE, RESIDS, WANTQ, WANTR - - LOGICAL TEST_QRDMD -!..... external subroutines (BLAS and LAPACK) - EXTERNAL DAXPY, DGEEV, DGEMM, DGEMV, DLACPY, DLASCL - EXTERNAL DLARNV, DLATMR -!.....external subroutines DMD package, part 1 -! subroutines under test - EXTERNAL DGEDMD, DGEDMDQ - -!..... external functions (BLAS and LAPACK) - EXTERNAL DLAMCH, DLANGE, DNRM2 - REAL(KIND=WP) :: DLAMCH, DLANGE, DNRM2 - EXTERNAL LSAME - LOGICAL LSAME - - INTRINSIC ABS, INT, MIN, MAX -!............................................................ - - ! The test is always in pairs : ( DGEDMD and DGEDMDQ ) - ! because the test includes comparing the results (in pairs). -!..................................................................................... - TEST_QRDMD = .TRUE. ! This code by default performs tests on DGEDMDQ - ! Since the QR factorizations based algorithm is designed for - ! single trajectory data, only single trajectory tests will - ! be performed with xGEDMDQ. - WANTQ = 'Q' - WANTR = 'R' -!................................................................................. - - EPS = DLAMCH( 'P' ) ! machine precision DP - - ! Global counters of failures of some particular tests - NFAIL = 0 - NFAIL_REZ = 0 - NFAIL_REZQ = 0 - NFAIL_Z_XV = 0 - NFAIL_F_QR = 0 - NFAIL_AU = 0 - KDIFF = 0 - NFAIL_SVDIFF = 0 - NFAIL_TOTAL = 0 - NFAILQ_TOTAL = 0 - - - DO LLOOP = 1, 4 - - WRITE(*,*) 'L Loop Index = ', LLOOP - - ! Set the dimensions of the problem ... - WRITE(*,*) 'M = ' - READ(*,*) M - WRITE(*,*) M - ! ... and the number of snapshots. - WRITE(*,*) 'N = ' - READ(*,*) N - WRITE(*,*) N - - ! ... Test the dimensions - IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN - WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' - STOP - END IF -!............. - ! The seed inside the LLOOP so that each pass can be reproduced easily. - - ISEED(1) = 4 - ISEED(2) = 3 - ISEED(3) = 2 - ISEED(4) = 1 - - LDA = M - LDF = M - LDX = MAX(M,N+1) - LDY = MAX(M,N+1) - LDW = N - LDZ = M - LDAU = MAX(M,N+1) - LDS = N - - TMP_ZXW = ZERO - TMP_AU = ZERO - TMP_REZ = ZERO - TMP_REZQ = ZERO - SVDIFF = ZERO - TMP_EX = ZERO - - ! - ! Test the subroutines on real data snapshots. All - ! computation is done in real arithmetic, even when - ! Koopman eigenvalues and modes are real. - ! - ! Allocate memory space - ALLOCATE( A(LDA,M) ) - ALLOCATE( AC(LDA,M) ) - ALLOCATE( DA(M) ) - ALLOCATE( DL(M) ) - ALLOCATE( F(LDF,N+1) ) - ALLOCATE( F1(LDF,N+1) ) - ALLOCATE( F2(LDF,N+1) ) - ALLOCATE( X(LDX,N) ) - ALLOCATE( X0(LDX,N) ) - ALLOCATE( SINGVX(N) ) - ALLOCATE( SINGVQX(N) ) - ALLOCATE( Y(LDY,N+1) ) - ALLOCATE( Y0(LDY,N+1) ) - ALLOCATE( Y1(M,N+1) ) - ALLOCATE( Z(LDZ,N) ) - ALLOCATE( Z1(LDZ,N) ) - ALLOCATE( RES(N) ) - ALLOCATE( RES1(N) ) - ALLOCATE( RESEX(N) ) - ALLOCATE( REIG(N) ) - ALLOCATE( IEIG(N) ) - ALLOCATE( REIGQ(N) ) - ALLOCATE( IEIGQ(N) ) - ALLOCATE( REIGA(M) ) - ALLOCATE( IEIGA(M) ) - ALLOCATE( VA(LDA,M) ) - ALLOCATE( LAMBDA(N,2) ) - ALLOCATE( LAMBDAQ(N,2) ) - ALLOCATE( EIGA(M,2) ) - ALLOCATE( W(LDW,N) ) - ALLOCATE( AU(LDAU,N) ) - ALLOCATE( S(N,N) ) - - TOL = M*EPS - ! This mimics O(M*N)*EPS bound for accumulated roundoff error. - ! The factor 10 is somewhat arbitrary. - TOL2 = 10*M*N*EPS - -!............. - - DO K_TRAJ = 1, 2 - ! Number of intial conditions in the simulation/trajectories (1 or 2) - - COND = 1.0D8 - DMAX = 1.0D2 - RSIGN = 'F' - GRADE = 'N' - MODEL = 6 - CONDL = 1.0D2 - MODER = 6 - CONDR = 1.0D2 - PIVTNG = 'N' - - ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) - DO MODE = 1, 6 - - ALLOCATE( IWORK(2*M) ) - ALLOCATE(DR(N)) - CALL DLATMR( M, M, 'S', ISEED, 'N', DA, MODE, COND, & - DMAX, RSIGN, GRADE, DL, MODEL, CONDL, & - DR, MODER, CONDR, PIVTNG, IWORK, M, M, & - ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) - DEALLOCATE(IWORK) - DEALLOCATE(DR) - - LWORK = 4*M+1 - ALLOCATE(WORK(LWORK)) - AC = A - CALL DGEEV( 'N','V', M, AC, M, REIGA, IEIGA, VA, M, & - VA, M, WORK, LWORK, INFO ) ! LAPACK CALL - DEALLOCATE(WORK) - TMP = ZERO - DO i = 1, M - EIGA(i,1) = REIGA(i) - EIGA(i,2) = IEIGA(i) - TMP = MAX( TMP, SQRT(REIGA(i)**2+IEIGA(i)**2)) - END DO - - ! Scale A to have the desirable spectral radius. - CALL DLASCL( 'G', 0, 0, TMP, ONE, M, M, A, M, INFO ) - CALL DLASCL( 'G', 0, 0, TMP, ONE, M, 2, EIGA, M, INFO ) - - ! Compute the norm of A - ANORM = DLANGE( 'F', N, N, A, M, WDUMMY ) - - IF ( K_TRAJ == 2 ) THEN - ! generate data with two inital conditions - CALL DLARNV(2, ISEED, M, F1(1,1) ) - F1(1:M,1) = 1.0E-10*F1(1:M,1) - DO i = 1, N/2 - CALL DGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & - F1(1,i+1), 1 ) - END DO - X0(1:M,1:N/2) = F1(1:M,1:N/2) - Y0(1:M,1:N/2) = F1(1:M,2:N/2+1) - - CALL DLARNV(2, ISEED, M, F1(1,1) ) - DO i = 1, N-N/2 - CALL DGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & - F1(1,i+1), 1 ) - END DO - X0(1:M,N/2+1:N) = F1(1:M,1:N-N/2) - Y0(1:M,N/2+1:N) = F1(1:M,2:N-N/2+1) - ELSE - CALL DLARNV(2, ISEED, M, F(1,1) ) - DO i = 1, N - CALL DGEMV( 'N', M, M, ONE, A, M, F(1,i), 1, ZERO, & - F(1,i+1), 1 ) - END DO - X0(1:M,1:N) = F(1:M,1:N) - Y0(1:M,1:N) = F(1:M,2:N+1) - END IF - - XNORM = DLANGE( 'F', M, N, X0, LDX, WDUMMY ) - YNORM = DLANGE( 'F', M, N, Y0, LDX, WDUMMY ) -!............................................................ - - DO iJOBZ = 1, 4 - - SELECT CASE ( iJOBZ ) - CASE(1) - JOBZ = 'V' ! Ritz vectors will be computed - RESIDS = 'R' ! Residuals will be computed - CASE(2) - JOBZ = 'V' - RESIDS = 'N' - CASE(3) - JOBZ = 'F' ! Ritz vectors in factored form - RESIDS = 'N' - CASE(4) - JOBZ = 'N' - RESIDS = 'N' - END SELECT - - DO iJOBREF = 1, 3 - - SELECT CASE ( iJOBREF ) - CASE(1) - JOBREF = 'R' ! Data for refined Ritz vectors - CASE(2) - JOBREF = 'E' ! Exact DMD vectors - CASE(3) - JOBREF = 'N' - END SELECT - - DO iSCALE = 1, 4 - - SELECT CASE ( iSCALE ) - CASE(1) - SCALE = 'S' ! X data normalized - CASE(2) - SCALE = 'C' ! X normalized, consist. check - CASE(3) - SCALE = 'Y' ! Y data normalized - CASE(4) - SCALE = 'N' - END SELECT - - DO iNRNK = -1, -2, -1 - ! Two truncation strategies. The "-2" case for R&D - ! purposes only - it uses possibly low accuracy small - ! singular values, in which case the formulas used in - ! the DMD are highly sensitive. - NRNK = iNRNK - - DO iWHTSVD = 1, 4 - ! Check all four options to compute the POD basis - ! via the SVD. - WHTSVD = iWHTSVD - - DO LWMINOPT = 1, 2 - ! Workspace query for the minimal (1) and for the optimal - ! (2) workspace lengths determined by workspace query. - - X(1:M,1:N) = X0(1:M,1:N) - Y(1:M,1:N) = Y0(1:M,1:N) - - ! DGEDMD: Workspace query and workspace allocation - CALL DGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & - N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & - LDZ, RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, -1, & - IDUMMY, -1, INFO ) - - LIWORK = IDUMMY(1) - ALLOCATE( IWORK(LIWORK) ) - LWORK = INT(WDUMMY(LWMINOPT)) - ALLOCATE( WORK(LWORK) ) - - ! DGEDMD test: CALL DGEDMD - CALL DGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & - N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & - LDZ, RES, AU, LDAU, W, LDW, S, LDS, WORK, LWORK,& - IWORK, LIWORK, INFO ) - - SINGVX(1:N) = WORK(1:N) - - !...... DGEDMD check point - IF ( LSAME(JOBZ,'V') ) THEN - ! Check that Z = X*W, on return from DGEDMD - ! This checks that the returned aigenvectors in Z are - ! the product of the SVD'POD basis returned in X - ! and the eigenvectors of the rayleigh quotient - ! returned in W - CALL DGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & - ZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL DAXPY( M, -ONE, Z(1,i), 1, Z1(1,i), 1) - TMP = MAX(TMP, DNRM2( M, Z1(1,i), 1 ) ) - END DO - TMP_ZXW = MAX(TMP_ZXW, TMP ) - - IF ( TMP_ZXW > 10*M*EPS ) THEN - NFAIL_Z_XV = NFAIL_Z_XV + 1 - WRITE(*,*) ':( .................DGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - - END IF - - !...... DGEDMD check point - IF ( LSAME(JOBREF,'R') ) THEN - ! The matrix A*U is returned for computing refined Ritz vectors. - ! Check that A*U is computed correctly using the formula - ! A*U = Y * V * inv(SIGMA). This depends on the - ! accuracy in the computed singular values and vectors of X. - ! See the paper for an error analysis. - ! Note that the left singular vectors of the input matrix X - ! are returned in the array X. - CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, X, LDX, & - ZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL DAXPY( M, -ONE, AU(1,i), 1, Z1(1,i), 1) - TMP = MAX( TMP, DNRM2( M, Z1(1,i),1 ) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_AU = MAX( TMP_AU, TMP ) - - IF ( TMP > TOL2 ) THEN - NFAIL_AU = NFAIL_AU + 1 - WRITE(*,*) ':( .................DGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - - ELSEIF ( LSAME(JOBREF,'E') ) THEN - ! The unscaled vectors of the Exact DMD are computed. - ! This option is included for the sake of completeness, - ! for users who prefer the Exact DMD vectors. The - ! returned vectors are in the real form, in the same way - ! as the Ritz vectors. Here we just save the vectors - ! and test them separately using a Matlab script. - - CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, AU, LDAU, ZERO, Y1, M ) - i=1 - DO WHILE ( i <= K ) - IF ( IEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL DAXPY( M, -REIG(i), AU(1,i), 1, Y1(1,i), 1 ) - RESEX(i) = DNRM2( M, Y1(1,i), 1) / DNRM2(M,AU(1,i),1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IEIG(i) - AB(1,2) = IEIG(i) - AB(2,2) = REIG(i) - CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, AU(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) - RESEX(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & - WORK )/ DLANGE( 'F', M, 2, AU(1,i), M, & - WORK ) - RESEX(i+1) = RESEX(i) - i = i + 2 - END IF - END DO - - END IF - - !...... DGEDMD check point - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by DGEDMD with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, Z, LDZ, ZERO, Y1, M ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in DGEDMD,) - i = 1 - DO WHILE ( i <= K ) - IF ( IEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL DAXPY( M, -REIG(i), Z(1,i), 1, Y1(1,i), 1 ) - RES1(i) = DNRM2( M, Y1(1,i), 1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IEIG(i) - AB(1,2) = IEIG(i) - AB(2,2) = REIG(i) - CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) - RES1(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & - WORK ) - RES1(i+1) = RES1(i) - i = i + 2 - END IF - END DO - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_REZ = MAX( TMP_REZ, TMP ) - - IF ( TMP > TOL2 ) THEN - NFAIL_REZ = NFAIL_REZ + 1 - WRITE(*,*) ':( ..................DGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - - IF ( LSAME(JOBREF,'E') ) THEN - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) - END DO - TMP_EX = MAX(TMP_EX,TMP) - END IF - - END IF - - !..... store the results for inspection - DO i = 1, K - LAMBDA(i,1) = REIG(i) - LAMBDA(i,2) = IEIG(i) - END DO - - DEALLOCATE(IWORK) - DEALLOCATE(WORK) - - !====================================================================== - ! Now test the DGEDMDQ - !====================================================================== - IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN - RJOBDATA(2) = 1 - F1 = F - - ! DGEDMDQ test: Workspace query and workspace allocation - CALL DGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & - JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & - LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & - RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, & - -1, IDUMMY, -1, INFO ) - LIWORK = IDUMMY(1) - ALLOCATE( IWORK(LIWORK) ) - LWORK = INT(WDUMMY(LWMINOPT)) - ALLOCATE(WORK(LWORK)) - ! DGEDMDQ test: CALL DGEDMDQ - CALL DGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & - JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & - LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & - RES, AU, LDAU, W, LDW, S, LDS, & - WORK, LWORK, IWORK, LIWORK, INFO ) - - SINGVQX(1:KQ) = WORK(MIN(M,N+1)+1: MIN(M,N+1)+KQ) - - !..... DGEDMDQ check point - IF ( KQ /= K ) THEN - KDIFF = KDIFF+1 - END IF - - TMP = ZERO - DO i = 1, MIN(K, KQ) - TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & - SINGVX(1) ) - END DO - SVDIFF = MAX( SVDIFF, TMP ) - IF ( TMP > M*N*EPS ) THEN - WRITE(*,*) 'FAILED! Something was wrong with the run.' - NFAIL_SVDIFF = NFAIL_SVDIFF + 1 - DO j =1, 3 - write(*,*) j, SINGVX(j), SINGVQX(j) - read(*,*) - END DO - END IF - - !..... DGEDMDQ check point - IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN - ! Check that the QR factors are computed and returned - ! as requested. The residual ||F-Q*R||_F / ||F||_F - ! is compared to M*N*EPS. - F2 = F - CALL DGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ONE, F1, & - LDF, Y, LDY, ONE, F2, LDF ) - TMP_FQR = DLANGE( 'F', M, N+1, F2, LDF, WORK ) / & - DLANGE( 'F', M, N+1, F, LDF, WORK ) - IF ( TMP_FQR > TOL2 ) THEN - WRITE(*,*) 'FAILED! Something was wrong with the run.' - NFAIL_F_QR = NFAIL_F_QR + 1 - END IF - END IF - - !..... DGEDMDQ check point - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by DGEDMDQ with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL DGEMM( 'N', 'N', M, KQ, M, ONE, A, M, Z, M, ZERO, Y1, M ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in DGEDMDQ) - i = 1 - DO WHILE ( i <= KQ ) - IF ( IEIGQ(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL DAXPY( M, -REIGQ(i), Z(1,i), 1, Y1(1,i), 1 ) - ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) - RES1(i) = DNRM2( M, Y1(1,i), 1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIGQ(i) - AB(2,1) = -IEIGQ(i) - AB(1,2) = IEIGQ(i) - AB(2,2) = REIGQ(i) - CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) ! BLAS CALL - ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC - RES1(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & - WORK ) ! LAPACK CALL - RES1(i+1) = RES1(i) - i = i + 2 - END IF - END DO - TMP = ZERO - DO i = 1, KQ - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVQX(K)/(ANORM*SINGVQX(1)) ) - END DO - TMP_REZQ = MAX( TMP_REZQ, TMP ) - IF ( TMP > TOL2 ) THEN - NFAIL_REZQ = NFAIL_REZQ + 1 - WRITE(*,*) '................ DGEDMDQ FAILED!', & - 'Check the code for implementation errors.' - STOP - END IF - - END IF - - DO i = 1, KQ - LAMBDAQ(i,1) = REIGQ(i) - LAMBDAQ(i,2) = IEIGQ(i) - END DO - - DEALLOCATE(WORK) - DEALLOCATE(IWORK) - END IF ! TEST_QRDMD -!====================================================================== - - END DO ! LWMINOPT - !write(*,*) 'LWMINOPT loop completed' - END DO ! WHTSVD LOOP - !write(*,*) 'WHTSVD loop completed' - END DO ! NRNK LOOP - !write(*,*) 'NRNK loop completed' - END DO ! SCALE LOOP - !write(*,*) 'SCALE loop completed' - END DO ! JOBF LOOP - !write(*,*) 'JOBREF loop completed' - END DO ! JOBZ LOOP - !write(*,*) 'JOBZ loop completed' - - END DO ! MODE -6:6 - !write(*,*) 'MODE loop completed' - END DO ! 1 or 2 trajectories - !write(*,*) 'trajectories loop completed' - - DEALLOCATE(A) - DEALLOCATE(AC) - DEALLOCATE(DA) - DEALLOCATE(DL) - DEALLOCATE(F) - DEALLOCATE(F1) - DEALLOCATE(F2) - DEALLOCATE(X) - DEALLOCATE(X0) - DEALLOCATE(SINGVX) - DEALLOCATE(SINGVQX) - DEALLOCATE(Y) - DEALLOCATE(Y0) - DEALLOCATE(Y1) - DEALLOCATE(Z) - DEALLOCATE(Z1) - DEALLOCATE(RES) - DEALLOCATE(RES1) - DEALLOCATE(RESEX) - DEALLOCATE(REIG) - DEALLOCATE(IEIG) - DEALLOCATE(REIGQ) - DEALLOCATE(IEIGQ) - DEALLOCATE(REIGA) - DEALLOCATE(IEIGA) - DEALLOCATE(VA) - DEALLOCATE(LAMBDA) - DEALLOCATE(LAMBDAQ) - DEALLOCATE(EIGA) - DEALLOCATE(W) - DEALLOCATE(AU) - DEALLOCATE(S) - -!............................................................ - ! Generate random M-by-M matrix A. Use DLATMR from - END DO ! LLOOP - - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for DGEDMD :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - IF ( NFAIL_Z_XV == 0 ) THEN - WRITE(*,*) '>>>> Z - U*V test PASSED.' - ELSE - WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' - WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV - END IF - IF ( NFAIL_AU == 0 ) THEN - WRITE(*,*) '>>>> A*U test PASSED. ' - ELSE - WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' - WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU - END IF - - IF ( NFAIL_REZ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ - END IF - - IF ( NFAIL_TOTAL == 0 ) THEN - WRITE(*,*) '>>>> DGEDMD :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>>>>>>>>> DGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - IF ( TEST_QRDMD ) THEN - WRITE(*,*) - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for DGEDMDQ :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - - IF ( NFAIL_SVDIFF == 0 ) THEN - WRITE(*,*) '>>>> DGEDMD and DGEDMDQ computed singular & - &values test PASSED.' - ELSE - WRITE(*,*) 'DGEDMD and DGEDMDQ discrepancies in & - &the singular values unacceptable ', & - NFAIL_SVDIFF, ' times. Test FAILED.' - WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF - END IF - - IF ( NFAIL_F_QR == 0 ) THEN - WRITE(*,*) '>>>> F - Q*R test PASSED.' - ELSE - WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' - WRITE(*,*) 'The largest relative residual was ', TMP_FQR - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR - END IF - - IF ( NFAIL_REZQ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ - END IF - - IF ( NFAILQ_TOTAL == 0 ) THEN - WRITE(*,*) '>>>>>>> DGEDMDQ :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>> DGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - END IF - - WRITE(*,*) - WRITE(*,*) 'Test completed.' - STOP - END +! This is a test program for checking the implementations of +! the implementations of the following subroutines +! +! DGEDMD for computation of the +! Dynamic Mode Decomposition (DMD) +! DGEDMDQ for computation of a +! QR factorization based compressed DMD +! +! Developed and supported by: +! =========================== +! Developed and coded by Zlatko Drmac, Faculty of Science, +! University of Zagreb; drmac@math.hr +! In cooperation with +! AIMdyn Inc., Santa Barbara, CA. +! ======================================================== +! How to run the code (compiler, link info) +! ======================================================== +! Compile as FORTRAN 90 (or later) and link with BLAS and +! LAPACK libraries. +! NOTE: The code is developed and tested on top of the +! Intel MKL library (versions 2022.0.3 and 2022.2.0), +! using the Intel Fortran compiler. +! +! For developers of the C++ implementation +! ======================================================== +! See the LAPACK++ and Template Numerical Toolkit (TNT) +! +! Note on a development of the GPU HP implementation +! ======================================================== +! Work in progress. See CUDA, MAGMA, SLATE. +! NOTE: The four SVD subroutines used in this code are +! included as a part of R&D and for the completeness. +! This was also an opportunity to test those SVD codes. +! If the scaling option is used all four are essentially +! equally good. For implementations on HP platforms, +! one can use whichever SVD is available. +!... ......................................................... +! NOTE: +! When using the Intel MKL 2022.0.3 the subroutine xGESVDQ +! (optionally used in xGEDMD) may cause access violation +! error for x = S, D, C, Z, but only if called with the +! work space query. (At least in our Windows 10 MSVS 2019.) +! The problem can be mitigated by downloading the source +! code of xGESVDQ from the LAPACK repository and use it +! localy instead of the one in the MKL. This seems to +! indicate that the problem is indeed in the MKL. +! This problem did not appear whith Intel MKL 2022.2.0. +! +! NOTE: +! xGESDD seems to have a problem with workspace. In some +! cases the length of the optimal workspace is returned +! smaller than the minimal workspace, as specified in the +! code. As a precaution, all optimal workspaces are +! set as MAX(minimal, optimal). +! Latest implementations of complex xGESDD have different +! length of the real worksapce. We use max value over +! two versions. +!............................................................ +!............................................................ +! + PROGRAM DMD_TEST + use iso_fortran_env, only: real64 + IMPLICIT NONE + integer, parameter :: WP = real64 + +!............................................................ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +!............................................................ + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: & + A, AC, EIGA, LAMBDA, LAMBDAQ, F, F1, F2,& + Z, Z1, S, AU, W, VA, X, X0, Y, Y0, Y1 + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: & + DA, DL, DR, REIG, REIGA, REIGQ, IEIG, & + IEIGA, IEIGQ, RES, RES1, RESEX, SINGVX,& + SINGVQX, WORK + INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK + REAL(KIND=WP) :: AB(2,2), WDUMMY(2) + INTEGER :: IDUMMY(2), ISEED(4), RJOBDATA(8) + REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, DMAX, EPS, & + TOL, TOL2, SVDIFF, TMP, TMP_AU, & + TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & + TMP_EX, XNORM, YNORM +!............................................................ + INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & + LDZ, LIWORK, LWORK, M, N, L, LLOOP, NRNK + INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, KDIFF, & + NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & + NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & + NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD + INTEGER iNRNK, iWHTSVD, K_TRAJ, LWMINOPT + CHARACTER(LEN=1) GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & + SCALE, RESIDS, WANTQ, WANTR + + LOGICAL TEST_QRDMD +!..... external subroutines (BLAS and LAPACK) + EXTERNAL DAXPY, DGEEV, DGEMM, DGEMV, DLACPY, DLASCL + EXTERNAL DLARNV, DLATMR +!.....external subroutines DMD package, part 1 +! subroutines under test + EXTERNAL DGEDMD, DGEDMDQ + +!..... external functions (BLAS and LAPACK) + EXTERNAL DLAMCH, DLANGE, DNRM2 + REAL(KIND=WP) :: DLAMCH, DLANGE, DNRM2 + EXTERNAL LSAME + LOGICAL LSAME + + INTRINSIC ABS, INT, MIN, MAX +!............................................................ + + ! The test is always in pairs : ( DGEDMD and DGEDMDQ ) + ! because the test includes comparing the results (in pairs). +!..................................................................................... + TEST_QRDMD = .TRUE. ! This code by default performs tests on DGEDMDQ + ! Since the QR factorizations based algorithm is designed for + ! single trajectory data, only single trajectory tests will + ! be performed with xGEDMDQ. + WANTQ = 'Q' + WANTR = 'R' +!................................................................................. + + EPS = DLAMCH( 'P' ) ! machine precision DP + + ! Global counters of failures of some particular tests + NFAIL = 0 + NFAIL_REZ = 0 + NFAIL_REZQ = 0 + NFAIL_Z_XV = 0 + NFAIL_F_QR = 0 + NFAIL_AU = 0 + KDIFF = 0 + NFAIL_SVDIFF = 0 + NFAIL_TOTAL = 0 + NFAILQ_TOTAL = 0 + + + DO LLOOP = 1, 4 + + WRITE(*,*) 'L Loop Index = ', LLOOP + + ! Set the dimensions of the problem ... + WRITE(*,*) 'M = ' + READ(*,*) M + WRITE(*,*) M + ! ... and the number of snapshots. + WRITE(*,*) 'N = ' + READ(*,*) N + WRITE(*,*) N + + ! ... Test the dimensions + IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN + WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' + STOP + END IF +!............. + ! The seed inside the LLOOP so that each pass can be reproduced easily. + + ISEED(1) = 4 + ISEED(2) = 3 + ISEED(3) = 2 + ISEED(4) = 1 + + LDA = M + LDF = M + LDX = MAX(M,N+1) + LDY = MAX(M,N+1) + LDW = N + LDZ = M + LDAU = MAX(M,N+1) + LDS = N + + TMP_ZXW = ZERO + TMP_AU = ZERO + TMP_REZ = ZERO + TMP_REZQ = ZERO + SVDIFF = ZERO + TMP_EX = ZERO + + ! + ! Test the subroutines on real data snapshots. All + ! computation is done in real arithmetic, even when + ! Koopman eigenvalues and modes are real. + ! + ! Allocate memory space + ALLOCATE( A(LDA,M) ) + ALLOCATE( AC(LDA,M) ) + ALLOCATE( DA(M) ) + ALLOCATE( DL(M) ) + ALLOCATE( F(LDF,N+1) ) + ALLOCATE( F1(LDF,N+1) ) + ALLOCATE( F2(LDF,N+1) ) + ALLOCATE( X(LDX,N) ) + ALLOCATE( X0(LDX,N) ) + ALLOCATE( SINGVX(N) ) + ALLOCATE( SINGVQX(N) ) + ALLOCATE( Y(LDY,N+1) ) + ALLOCATE( Y0(LDY,N+1) ) + ALLOCATE( Y1(M,N+1) ) + ALLOCATE( Z(LDZ,N) ) + ALLOCATE( Z1(LDZ,N) ) + ALLOCATE( RES(N) ) + ALLOCATE( RES1(N) ) + ALLOCATE( RESEX(N) ) + ALLOCATE( REIG(N) ) + ALLOCATE( IEIG(N) ) + ALLOCATE( REIGQ(N) ) + ALLOCATE( IEIGQ(N) ) + ALLOCATE( REIGA(M) ) + ALLOCATE( IEIGA(M) ) + ALLOCATE( VA(LDA,M) ) + ALLOCATE( LAMBDA(N,2) ) + ALLOCATE( LAMBDAQ(N,2) ) + ALLOCATE( EIGA(M,2) ) + ALLOCATE( W(LDW,N) ) + ALLOCATE( AU(LDAU,N) ) + ALLOCATE( S(N,N) ) + + TOL = M*EPS + ! This mimics O(M*N)*EPS bound for accumulated roundoff error. + ! The factor 10 is somewhat arbitrary. + TOL2 = 10*M*N*EPS + +!............. + + DO K_TRAJ = 1, 2 + ! Number of intial conditions in the simulation/trajectories (1 or 2) + + COND = 1.0D8 + DMAX = 1.0D2 + RSIGN = 'F' + GRADE = 'N' + MODEL = 6 + CONDL = 1.0D2 + MODER = 6 + CONDR = 1.0D2 + PIVTNG = 'N' + + ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) + DO MODE = 1, 6 + + ALLOCATE( IWORK(2*M) ) + ALLOCATE(DR(N)) + CALL DLATMR( M, M, 'S', ISEED, 'N', DA, MODE, COND, & + DMAX, RSIGN, GRADE, DL, MODEL, CONDL, & + DR, MODER, CONDR, PIVTNG, IWORK, M, M, & + ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) + DEALLOCATE(IWORK) + DEALLOCATE(DR) + + LWORK = 4*M+1 + ALLOCATE(WORK(LWORK)) + AC = A + CALL DGEEV( 'N','V', M, AC, M, REIGA, IEIGA, VA, M, & + VA, M, WORK, LWORK, INFO ) ! LAPACK CALL + DEALLOCATE(WORK) + TMP = ZERO + DO i = 1, M + EIGA(i,1) = REIGA(i) + EIGA(i,2) = IEIGA(i) + TMP = MAX( TMP, SQRT(REIGA(i)**2+IEIGA(i)**2)) + END DO + + ! Scale A to have the desirable spectral radius. + CALL DLASCL( 'G', 0, 0, TMP, ONE, M, M, A, M, INFO ) + CALL DLASCL( 'G', 0, 0, TMP, ONE, M, 2, EIGA, M, INFO ) + + ! Compute the norm of A + ANORM = DLANGE( 'F', N, N, A, M, WDUMMY ) + + IF ( K_TRAJ == 2 ) THEN + ! generate data with two inital conditions + CALL DLARNV(2, ISEED, M, F1(1,1) ) + F1(1:M,1) = 1.0E-10*F1(1:M,1) + DO i = 1, N/2 + CALL DGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & + F1(1,i+1), 1 ) + END DO + X0(1:M,1:N/2) = F1(1:M,1:N/2) + Y0(1:M,1:N/2) = F1(1:M,2:N/2+1) + + CALL DLARNV(2, ISEED, M, F1(1,1) ) + DO i = 1, N-N/2 + CALL DGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & + F1(1,i+1), 1 ) + END DO + X0(1:M,N/2+1:N) = F1(1:M,1:N-N/2) + Y0(1:M,N/2+1:N) = F1(1:M,2:N-N/2+1) + ELSE + CALL DLARNV(2, ISEED, M, F(1,1) ) + DO i = 1, N + CALL DGEMV( 'N', M, M, ONE, A, M, F(1,i), 1, ZERO, & + F(1,i+1), 1 ) + END DO + X0(1:M,1:N) = F(1:M,1:N) + Y0(1:M,1:N) = F(1:M,2:N+1) + END IF + + XNORM = DLANGE( 'F', M, N, X0, LDX, WDUMMY ) + YNORM = DLANGE( 'F', M, N, Y0, LDX, WDUMMY ) +!............................................................ + + DO iJOBZ = 1, 4 + + SELECT CASE ( iJOBZ ) + CASE(1) + JOBZ = 'V' ! Ritz vectors will be computed + RESIDS = 'R' ! Residuals will be computed + CASE(2) + JOBZ = 'V' + RESIDS = 'N' + CASE(3) + JOBZ = 'F' ! Ritz vectors in factored form + RESIDS = 'N' + CASE(4) + JOBZ = 'N' + RESIDS = 'N' + END SELECT + + DO iJOBREF = 1, 3 + + SELECT CASE ( iJOBREF ) + CASE(1) + JOBREF = 'R' ! Data for refined Ritz vectors + CASE(2) + JOBREF = 'E' ! Exact DMD vectors + CASE(3) + JOBREF = 'N' + END SELECT + + DO iSCALE = 1, 4 + + SELECT CASE ( iSCALE ) + CASE(1) + SCALE = 'S' ! X data normalized + CASE(2) + SCALE = 'C' ! X normalized, consist. check + CASE(3) + SCALE = 'Y' ! Y data normalized + CASE(4) + SCALE = 'N' + END SELECT + + DO iNRNK = -1, -2, -1 + ! Two truncation strategies. The "-2" case for R&D + ! purposes only - it uses possibly low accuracy small + ! singular values, in which case the formulas used in + ! the DMD are highly sensitive. + NRNK = iNRNK + + DO iWHTSVD = 1, 4 + ! Check all four options to compute the POD basis + ! via the SVD. + WHTSVD = iWHTSVD + + DO LWMINOPT = 1, 2 + ! Workspace query for the minimal (1) and for the optimal + ! (2) workspace lengths determined by workspace query. + + X(1:M,1:N) = X0(1:M,1:N) + Y(1:M,1:N) = Y0(1:M,1:N) + + ! DGEDMD: Workspace query and workspace allocation + CALL DGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & + N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & + LDZ, RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, -1, & + IDUMMY, -1, INFO ) + + LIWORK = IDUMMY(1) + ALLOCATE( IWORK(LIWORK) ) + LWORK = INT(WDUMMY(LWMINOPT)) + ALLOCATE( WORK(LWORK) ) + + ! DGEDMD test: CALL DGEDMD + CALL DGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & + N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & + LDZ, RES, AU, LDAU, W, LDW, S, LDS, WORK, LWORK,& + IWORK, LIWORK, INFO ) + + SINGVX(1:N) = WORK(1:N) + + !...... DGEDMD check point + IF ( LSAME(JOBZ,'V') ) THEN + ! Check that Z = X*W, on return from DGEDMD + ! This checks that the returned aigenvectors in Z are + ! the product of the SVD'POD basis returned in X + ! and the eigenvectors of the rayleigh quotient + ! returned in W + CALL DGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & + ZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL DAXPY( M, -ONE, Z(1,i), 1, Z1(1,i), 1) + TMP = MAX(TMP, DNRM2( M, Z1(1,i), 1 ) ) + END DO + TMP_ZXW = MAX(TMP_ZXW, TMP ) + + IF ( TMP_ZXW > 10*M*EPS ) THEN + NFAIL_Z_XV = NFAIL_Z_XV + 1 + WRITE(*,*) ':( .................DGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + + END IF + + !...... DGEDMD check point + IF ( LSAME(JOBREF,'R') ) THEN + ! The matrix A*U is returned for computing refined Ritz vectors. + ! Check that A*U is computed correctly using the formula + ! A*U = Y * V * inv(SIGMA). This depends on the + ! accuracy in the computed singular values and vectors of X. + ! See the paper for an error analysis. + ! Note that the left singular vectors of the input matrix X + ! are returned in the array X. + CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, X, LDX, & + ZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL DAXPY( M, -ONE, AU(1,i), 1, Z1(1,i), 1) + TMP = MAX( TMP, DNRM2( M, Z1(1,i),1 ) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_AU = MAX( TMP_AU, TMP ) + + IF ( TMP > TOL2 ) THEN + NFAIL_AU = NFAIL_AU + 1 + WRITE(*,*) ':( .................DGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + + ELSEIF ( LSAME(JOBREF,'E') ) THEN + ! The unscaled vectors of the Exact DMD are computed. + ! This option is included for the sake of completeness, + ! for users who prefer the Exact DMD vectors. The + ! returned vectors are in the real form, in the same way + ! as the Ritz vectors. Here we just save the vectors + ! and test them separately using a Matlab script. + + CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, AU, LDAU, ZERO, Y1, M ) + i=1 + DO WHILE ( i <= K ) + IF ( IEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL DAXPY( M, -REIG(i), AU(1,i), 1, Y1(1,i), 1 ) + RESEX(i) = DNRM2( M, Y1(1,i), 1) / DNRM2(M,AU(1,i),1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IEIG(i) + AB(1,2) = IEIG(i) + AB(2,2) = REIG(i) + CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, AU(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) + RESEX(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & + WORK )/ DLANGE( 'F', M, 2, AU(1,i), M, & + WORK ) + RESEX(i+1) = RESEX(i) + i = i + 2 + END IF + END DO + + END IF + + !...... DGEDMD check point + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by DGEDMD with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL DGEMM( 'N', 'N', M, K, M, ONE, A, LDA, Z, LDZ, ZERO, Y1, M ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in DGEDMD,) + i = 1 + DO WHILE ( i <= K ) + IF ( IEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL DAXPY( M, -REIG(i), Z(1,i), 1, Y1(1,i), 1 ) + RES1(i) = DNRM2( M, Y1(1,i), 1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IEIG(i) + AB(1,2) = IEIG(i) + AB(2,2) = REIG(i) + CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) + RES1(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & + WORK ) + RES1(i+1) = RES1(i) + i = i + 2 + END IF + END DO + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_REZ = MAX( TMP_REZ, TMP ) + + IF ( TMP > TOL2 ) THEN + NFAIL_REZ = NFAIL_REZ + 1 + WRITE(*,*) ':( ..................DGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + + IF ( LSAME(JOBREF,'E') ) THEN + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) + END DO + TMP_EX = MAX(TMP_EX,TMP) + END IF + + END IF + + !..... store the results for inspection + DO i = 1, K + LAMBDA(i,1) = REIG(i) + LAMBDA(i,2) = IEIG(i) + END DO + + DEALLOCATE(IWORK) + DEALLOCATE(WORK) + + !====================================================================== + ! Now test the DGEDMDQ + !====================================================================== + IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN + RJOBDATA(2) = 1 + F1 = F + + ! DGEDMDQ test: Workspace query and workspace allocation + CALL DGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & + JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & + LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & + RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, & + -1, IDUMMY, -1, INFO ) + LIWORK = IDUMMY(1) + ALLOCATE( IWORK(LIWORK) ) + LWORK = INT(WDUMMY(LWMINOPT)) + ALLOCATE(WORK(LWORK)) + ! DGEDMDQ test: CALL DGEDMDQ + CALL DGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & + JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & + LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & + RES, AU, LDAU, W, LDW, S, LDS, & + WORK, LWORK, IWORK, LIWORK, INFO ) + + SINGVQX(1:KQ) = WORK(MIN(M,N+1)+1: MIN(M,N+1)+KQ) + + !..... DGEDMDQ check point + IF ( KQ /= K ) THEN + KDIFF = KDIFF+1 + END IF + + TMP = ZERO + DO i = 1, MIN(K, KQ) + TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & + SINGVX(1) ) + END DO + SVDIFF = MAX( SVDIFF, TMP ) + IF ( TMP > M*N*EPS ) THEN + WRITE(*,*) 'FAILED! Something was wrong with the run.' + NFAIL_SVDIFF = NFAIL_SVDIFF + 1 + DO j =1, 3 + write(*,*) j, SINGVX(j), SINGVQX(j) + read(*,*) + END DO + END IF + + !..... DGEDMDQ check point + IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN + ! Check that the QR factors are computed and returned + ! as requested. The residual ||F-Q*R||_F / ||F||_F + ! is compared to M*N*EPS. + F2 = F + CALL DGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ONE, F1, & + LDF, Y, LDY, ONE, F2, LDF ) + TMP_FQR = DLANGE( 'F', M, N+1, F2, LDF, WORK ) / & + DLANGE( 'F', M, N+1, F, LDF, WORK ) + IF ( TMP_FQR > TOL2 ) THEN + WRITE(*,*) 'FAILED! Something was wrong with the run.' + NFAIL_F_QR = NFAIL_F_QR + 1 + END IF + END IF + + !..... DGEDMDQ check point + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by DGEDMDQ with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL DGEMM( 'N', 'N', M, KQ, M, ONE, A, M, Z, M, ZERO, Y1, M ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in DGEDMDQ) + i = 1 + DO WHILE ( i <= KQ ) + IF ( IEIGQ(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL DAXPY( M, -REIGQ(i), Z(1,i), 1, Y1(1,i), 1 ) + ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) + RES1(i) = DNRM2( M, Y1(1,i), 1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIGQ(i) + AB(2,1) = -IEIGQ(i) + AB(1,2) = IEIGQ(i) + AB(2,2) = REIGQ(i) + CALL DGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) ! BLAS CALL + ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC + RES1(i) = DLANGE( 'F', M, 2, Y1(1,i), M, & + WORK ) ! LAPACK CALL + RES1(i+1) = RES1(i) + i = i + 2 + END IF + END DO + TMP = ZERO + DO i = 1, KQ + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVQX(K)/(ANORM*SINGVQX(1)) ) + END DO + TMP_REZQ = MAX( TMP_REZQ, TMP ) + IF ( TMP > TOL2 ) THEN + NFAIL_REZQ = NFAIL_REZQ + 1 + WRITE(*,*) '................ DGEDMDQ FAILED!', & + 'Check the code for implementation errors.' + STOP + END IF + + END IF + + DO i = 1, KQ + LAMBDAQ(i,1) = REIGQ(i) + LAMBDAQ(i,2) = IEIGQ(i) + END DO + + DEALLOCATE(WORK) + DEALLOCATE(IWORK) + END IF ! TEST_QRDMD +!====================================================================== + + END DO ! LWMINOPT + !write(*,*) 'LWMINOPT loop completed' + END DO ! WHTSVD LOOP + !write(*,*) 'WHTSVD loop completed' + END DO ! NRNK LOOP + !write(*,*) 'NRNK loop completed' + END DO ! SCALE LOOP + !write(*,*) 'SCALE loop completed' + END DO ! JOBF LOOP + !write(*,*) 'JOBREF loop completed' + END DO ! JOBZ LOOP + !write(*,*) 'JOBZ loop completed' + + END DO ! MODE -6:6 + !write(*,*) 'MODE loop completed' + END DO ! 1 or 2 trajectories + !write(*,*) 'trajectories loop completed' + + DEALLOCATE(A) + DEALLOCATE(AC) + DEALLOCATE(DA) + DEALLOCATE(DL) + DEALLOCATE(F) + DEALLOCATE(F1) + DEALLOCATE(F2) + DEALLOCATE(X) + DEALLOCATE(X0) + DEALLOCATE(SINGVX) + DEALLOCATE(SINGVQX) + DEALLOCATE(Y) + DEALLOCATE(Y0) + DEALLOCATE(Y1) + DEALLOCATE(Z) + DEALLOCATE(Z1) + DEALLOCATE(RES) + DEALLOCATE(RES1) + DEALLOCATE(RESEX) + DEALLOCATE(REIG) + DEALLOCATE(IEIG) + DEALLOCATE(REIGQ) + DEALLOCATE(IEIGQ) + DEALLOCATE(REIGA) + DEALLOCATE(IEIGA) + DEALLOCATE(VA) + DEALLOCATE(LAMBDA) + DEALLOCATE(LAMBDAQ) + DEALLOCATE(EIGA) + DEALLOCATE(W) + DEALLOCATE(AU) + DEALLOCATE(S) + +!............................................................ + ! Generate random M-by-M matrix A. Use DLATMR from + END DO ! LLOOP + + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for DGEDMD :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + IF ( NFAIL_Z_XV == 0 ) THEN + WRITE(*,*) '>>>> Z - U*V test PASSED.' + ELSE + WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' + WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV + END IF + IF ( NFAIL_AU == 0 ) THEN + WRITE(*,*) '>>>> A*U test PASSED. ' + ELSE + WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' + WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU + END IF + + IF ( NFAIL_REZ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ + END IF + + IF ( NFAIL_TOTAL == 0 ) THEN + WRITE(*,*) '>>>> DGEDMD :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>>>>>>>>> DGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + IF ( TEST_QRDMD ) THEN + WRITE(*,*) + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for DGEDMDQ :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + + IF ( NFAIL_SVDIFF == 0 ) THEN + WRITE(*,*) '>>>> DGEDMD and DGEDMDQ computed singular & + &values test PASSED.' + ELSE + WRITE(*,*) 'DGEDMD and DGEDMDQ discrepancies in & + &the singular values unacceptable ', & + NFAIL_SVDIFF, ' times. Test FAILED.' + WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF + END IF + + IF ( NFAIL_F_QR == 0 ) THEN + WRITE(*,*) '>>>> F - Q*R test PASSED.' + ELSE + WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' + WRITE(*,*) 'The largest relative residual was ', TMP_FQR + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR + END IF + + IF ( NFAIL_REZQ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ + END IF + + IF ( NFAILQ_TOTAL == 0 ) THEN + WRITE(*,*) '>>>>>>> DGEDMDQ :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>> DGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + END IF + + WRITE(*,*) + WRITE(*,*) 'Test completed.' + STOP + END diff --git a/TESTING/EIG/schkdmd.f90 b/TESTING/EIG/schkdmd.f90 index 77e3e46c05..855d981fda 100644 --- a/TESTING/EIG/schkdmd.f90 +++ b/TESTING/EIG/schkdmd.f90 @@ -1,792 +1,792 @@ -! This is a test program for checking the implementations of -! the implementations of the following subroutines -! -! SGEDMD for computation of the -! Dynamic Mode Decomposition (DMD) -! SGEDMDQ for computation of a -! QR factorization based compressed DMD -! -! Developed and supported by: -! =========================== -! Developed and coded by Zlatko Drmac, Faculty of Science, -! University of Zagreb; drmac@math.hr -! In cooperation with -! AIMdyn Inc., Santa Barbara, CA. -! ======================================================== -! How to run the code (compiler, link info) -! ======================================================== -! Compile as FORTRAN 90 (or later) and link with BLAS and -! LAPACK libraries. -! NOTE: The code is developed and tested on top of the -! Intel MKL library (versions 2022.0.3 and 2022.2.0), -! using the Intel Fortran compiler. -! -! For developers of the C++ implementation -! ======================================================== -! See the LAPACK++ and Template Numerical Toolkit (TNT) -! -! Note on a development of the GPU HP implementation -! ======================================================== -! Work in progress. See CUDA, MAGMA, SLATE. -! NOTE: The four SVD subroutines used in this code are -! included as a part of R&D and for the completeness. -! This was also an opportunity to test those SVD codes. -! If the scaling option is used all four are essentially -! equally good. For implementations on HP platforms, -! one can use whichever SVD is available. -!... ......................................................... -! NOTE: -! When using the Intel MKL 2022.0.3 the subroutine xGESVDQ -! (optionally used in xGEDMD) may cause access violation -! error for x = S, D, C, Z, but only if called with the -! work space query. (At least in our Windows 10 MSVS 2019.) -! The problem can be mitigated by downloading the source -! code of xGESVDQ from the LAPACK repository and use it -! localy instead of the one in the MKL. This seems to -! indicate that the problem is indeed in the MKL. -! This problem did not appear whith Intel MKL 2022.2.0. -! -! NOTE: -! xGESDD seems to have a problem with workspace. In some -! cases the length of the optimal workspace is returned -! smaller than the minimal workspace, as specified in the -! code. As a precaution, all optimal workspaces are -! set as MAX(minimal, optimal). -! Latest implementations of complex xGESDD have different -! length of the real worksapce. We use max value over -! two versions. -!............................................................ -!............................................................ -! - PROGRAM DMD_TEST - use iso_fortran_env, only: real32 - IMPLICIT NONE - integer, parameter :: WP = real32 - -!............................................................ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP -!............................................................ - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: & - A, AC, EIGA, LAMBDA, LAMBDAQ, F, F1, F2,& - Z, Z1, S, AU, W, VA, X, X0, Y, Y0, Y1 - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: & - DA, DL, DR, REIG, REIGA, REIGQ, IEIG, & - IEIGA, IEIGQ, RES, RES1, RESEX, SINGVX,& - SINGVQX, WORK - INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK - REAL(KIND=WP) :: AB(2,2), WDUMMY(2) - INTEGER :: IDUMMY(2), ISEED(4), RJOBDATA(8) - REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, DMAX, EPS, & - TOL, TOL2, SVDIFF, TMP, TMP_AU, & - TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & - TMP_EX, XNORM, YNORM -!............................................................ - INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & - LDZ, LIWORK, LWORK, M, N, L, LLOOP, NRNK - INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, KDIFF, & - NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & - NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & - NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD - INTEGER iNRNK, iWHTSVD, K_TRAJ, LWMINOPT - CHARACTER(LEN=1) GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & - SCALE, RESIDS, WANTQ, WANTR - - LOGICAL TEST_QRDMD -!..... external subroutines (BLAS and LAPACK) - EXTERNAL SAXPY, SGEEV, SGEMM, SGEMV, SLACPY, SLASCL - EXTERNAL SLARNV, SLATMR -!.....external subroutines DMD package, part 1 -! subroutines under test - EXTERNAL SGEDMD, SGEDMDQ - -!..... external functions (BLAS and LAPACK) - EXTERNAL SLAMCH, SLANGE, SNRM2 - REAL(KIND=WP) :: SLAMCH, SLANGE, SNRM2 - EXTERNAL LSAME - LOGICAL LSAME - - INTRINSIC ABS, INT, MIN, MAX -!............................................................ - - ! The test is always in pairs : ( SGEDMD and SGEDMDQ ) - ! because the test includes comparing the results (in pairs). -!..................................................................................... - TEST_QRDMD = .TRUE. ! This code by default performs tests on SGEDMDQ - ! Since the QR factorizations based algorithm is designed for - ! single trajectory data, only single trajectory tests will - ! be performed with xGEDMDQ. - WANTQ = 'Q' - WANTR = 'R' -!................................................................................. - - EPS = SLAMCH( 'P' ) ! machine precision SP - - ! Global counters of failures of some particular tests - NFAIL = 0 - NFAIL_REZ = 0 - NFAIL_REZQ = 0 - NFAIL_Z_XV = 0 - NFAIL_F_QR = 0 - NFAIL_AU = 0 - KDIFF = 0 - NFAIL_SVDIFF = 0 - NFAIL_TOTAL = 0 - NFAILQ_TOTAL = 0 - - - DO LLOOP = 1, 4 - - WRITE(*,*) 'L Loop Index = ', LLOOP - - ! Set the dimensions of the problem ... - WRITE(*,*) 'M = ' - READ(*,*) M - WRITE(*,*) M - ! ... and the number of snapshots. - WRITE(*,*) 'N = ' - READ(*,*) N - WRITE(*,*) N - - ! ... Test the dimensions - IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN - WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' - STOP - END IF -!............. - ! The seed inside the LLOOP so that each pass can be reproduced easily. - - ISEED(1) = 4 - ISEED(2) = 3 - ISEED(3) = 2 - ISEED(4) = 1 - - LDA = M - LDF = M - LDX = MAX(M,N+1) - LDY = MAX(M,N+1) - LDW = N - LDZ = M - LDAU = MAX(M,N+1) - LDS = N - - TMP_ZXW = ZERO - TMP_AU = ZERO - TMP_REZ = ZERO - TMP_REZQ = ZERO - SVDIFF = ZERO - TMP_EX = ZERO - - ! - ! Test the subroutines on real data snapshots. All - ! computation is done in real arithmetic, even when - ! Koopman eigenvalues and modes are real. - ! - ! Allocate memory space - ALLOCATE( A(LDA,M) ) - ALLOCATE( AC(LDA,M) ) - ALLOCATE( DA(M) ) - ALLOCATE( DL(M) ) - ALLOCATE( F(LDF,N+1) ) - ALLOCATE( F1(LDF,N+1) ) - ALLOCATE( F2(LDF,N+1) ) - ALLOCATE( X(LDX,N) ) - ALLOCATE( X0(LDX,N) ) - ALLOCATE( SINGVX(N) ) - ALLOCATE( SINGVQX(N) ) - ALLOCATE( Y(LDY,N+1) ) - ALLOCATE( Y0(LDY,N+1) ) - ALLOCATE( Y1(M,N+1) ) - ALLOCATE( Z(LDZ,N) ) - ALLOCATE( Z1(LDZ,N) ) - ALLOCATE( RES(N) ) - ALLOCATE( RES1(N) ) - ALLOCATE( RESEX(N) ) - ALLOCATE( REIG(N) ) - ALLOCATE( IEIG(N) ) - ALLOCATE( REIGQ(N) ) - ALLOCATE( IEIGQ(N) ) - ALLOCATE( REIGA(M) ) - ALLOCATE( IEIGA(M) ) - ALLOCATE( VA(LDA,M) ) - ALLOCATE( LAMBDA(N,2) ) - ALLOCATE( LAMBDAQ(N,2) ) - ALLOCATE( EIGA(M,2) ) - ALLOCATE( W(LDW,N) ) - ALLOCATE( AU(LDAU,N) ) - ALLOCATE( S(N,N) ) - - TOL = M*EPS - ! This mimics O(M*N)*EPS bound for accumulated roundoff error. - ! The factor 10 is somewhat arbitrary. - TOL2 = 10*M*N*EPS - -!............. - - DO K_TRAJ = 1, 2 - ! Number of intial conditions in the simulation/trajectories (1 or 2) - - COND = 1.0D8 - DMAX = 1.0D2 - RSIGN = 'F' - GRADE = 'N' - MODEL = 6 - CONDL = 1.0D2 - MODER = 6 - CONDR = 1.0D2 - PIVTNG = 'N' - - ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) - DO MODE = 1, 6 - - ALLOCATE( IWORK(2*M) ) - ALLOCATE(DR(N)) - CALL SLATMR( M, M, 'S', ISEED, 'N', DA, MODE, COND, & - DMAX, RSIGN, GRADE, DL, MODEL, CONDL, & - DR, MODER, CONDR, PIVTNG, IWORK, M, M, & - ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) - DEALLOCATE(IWORK) - DEALLOCATE(DR) - - LWORK = 4*M+1 - ALLOCATE(WORK(LWORK)) - AC = A - CALL SGEEV( 'N','V', M, AC, M, REIGA, IEIGA, VA, M, & - VA, M, WORK, LWORK, INFO ) ! LAPACK CALL - DEALLOCATE(WORK) - TMP = ZERO - DO i = 1, M - EIGA(i,1) = REIGA(i) - EIGA(i,2) = IEIGA(i) - TMP = MAX( TMP, SQRT(REIGA(i)**2+IEIGA(i)**2)) - END DO - - ! Scale A to have the desirable spectral radius. - CALL SLASCL( 'G', 0, 0, TMP, ONE, M, M, A, M, INFO ) - CALL SLASCL( 'G', 0, 0, TMP, ONE, M, 2, EIGA, M, INFO ) - - ! Compute the norm of A - ANORM = SLANGE( 'F', N, N, A, M, WDUMMY ) - - IF ( K_TRAJ == 2 ) THEN - ! generate data with two inital conditions - CALL SLARNV(2, ISEED, M, F1(1,1) ) - F1(1:M,1) = 1.0E-10*F1(1:M,1) - DO i = 1, N/2 - CALL SGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & - F1(1,i+1), 1 ) - END DO - X0(1:M,1:N/2) = F1(1:M,1:N/2) - Y0(1:M,1:N/2) = F1(1:M,2:N/2+1) - - CALL SLARNV(2, ISEED, M, F1(1,1) ) - DO i = 1, N-N/2 - CALL SGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & - F1(1,i+1), 1 ) - END DO - X0(1:M,N/2+1:N) = F1(1:M,1:N-N/2) - Y0(1:M,N/2+1:N) = F1(1:M,2:N-N/2+1) - ELSE - ! single trajectory - CALL SLARNV(2, ISEED, M, F(1,1) ) - DO i = 1, N - CALL SGEMV( 'N', M, M, ONE, A, M, F(1,i), 1, ZERO, & - F(1,i+1), 1 ) - END DO - X0(1:M,1:N) = F(1:M,1:N) - Y0(1:M,1:N) = F(1:M,2:N+1) - END IF - - XNORM = SLANGE( 'F', M, N, X0, LDX, WDUMMY ) - YNORM = SLANGE( 'F', M, N, Y0, LDX, WDUMMY ) -!............................................................ - - DO iJOBZ = 1, 4 - - SELECT CASE ( iJOBZ ) - CASE(1) - JOBZ = 'V' ! Ritz vectors will be computed - RESIDS = 'R' ! Residuals will be computed - CASE(2) - JOBZ = 'V' - RESIDS = 'N' - CASE(3) - JOBZ = 'F' ! Ritz vectors in factored form - RESIDS = 'N' - CASE(4) - JOBZ = 'N' - RESIDS = 'N' - END SELECT - - DO iJOBREF = 1, 3 - - SELECT CASE ( iJOBREF ) - CASE(1) - JOBREF = 'R' ! Data for refined Ritz vectors - CASE(2) - JOBREF = 'E' ! Exact DMD vectors - CASE(3) - JOBREF = 'N' - END SELECT - - DO iSCALE = 1, 4 - - SELECT CASE ( iSCALE ) - CASE(1) - SCALE = 'S' ! X data normalized - CASE(2) - SCALE = 'C' ! X normalized, consist. check - CASE(3) - SCALE = 'Y' ! Y data normalized - CASE(4) - SCALE = 'N' - END SELECT - - DO iNRNK = -1, -2, -1 - ! Two truncation strategies. The "-2" case for R&D - ! purposes only - it uses possibly low accuracy small - ! singular values, in which case the formulas used in - ! the DMD are highly sensitive. - NRNK = iNRNK - - DO iWHTSVD = 1, 4 - ! Check all four options to compute the POD basis - ! via the SVD. - WHTSVD = iWHTSVD - - DO LWMINOPT = 1, 2 - ! Workspace query for the minimal (1) and for the optimal - ! (2) workspace lengths determined by workspace query. - - X(1:M,1:N) = X0(1:M,1:N) - Y(1:M,1:N) = Y0(1:M,1:N) - - ! SGEDMD: Workspace query and workspace allocation - CALL SGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & - N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & - LDZ, RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, -1, & - IDUMMY, -1, INFO ) - - LIWORK = IDUMMY(1) - ALLOCATE( IWORK(LIWORK) ) - LWORK = INT(WDUMMY(LWMINOPT)) - ALLOCATE( WORK(LWORK) ) - - ! SGEDMD test: CALL SGEDMD - CALL SGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & - N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & - LDZ, RES, AU, LDAU, W, LDW, S, LDS, WORK, LWORK,& - IWORK, LIWORK, INFO ) - - SINGVX(1:N) = WORK(1:N) - - !...... SGEDMD check point - IF ( LSAME(JOBZ,'V') ) THEN - ! Check that Z = X*W, on return from SGEDMD - ! This checks that the returned aigenvectors in Z are - ! the product of the SVD'POD basis returned in X - ! and the eigenvectors of the rayleigh quotient - ! returned in W - CALL SGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & - ZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL SAXPY( M, -ONE, Z(1,i), 1, Z1(1,i), 1) - TMP = MAX(TMP, SNRM2( M, Z1(1,i), 1 ) ) - END DO - TMP_ZXW = MAX(TMP_ZXW, TMP ) - - IF ( TMP_ZXW > 10*M*EPS ) THEN - NFAIL_Z_XV = NFAIL_Z_XV + 1 - END IF - - END IF - - !...... SGEDMD check point - IF ( LSAME(JOBREF,'R') ) THEN - ! The matrix A*U is returned for computing refined Ritz vectors. - ! Check that A*U is computed correctly using the formula - ! A*U = Y * V * inv(SIGMA). This depends on the - ! accuracy in the computed singular values and vectors of X. - ! See the paper for an error analysis. - ! Note that the left singular vectors of the input matrix X - ! are returned in the array X. - CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, X, LDX, & - ZERO, Z1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL SAXPY( M, -ONE, AU(1,i), 1, Z1(1,i), 1) - TMP = MAX( TMP, SNRM2( M, Z1(1,i),1 ) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_AU = MAX( TMP_AU, TMP ) - - IF ( TMP > TOL2 ) THEN - NFAIL_AU = NFAIL_AU + 1 - END IF - - ELSEIF ( LSAME(JOBREF,'E') ) THEN - ! The unscaled vectors of the Exact DMD are computed. - ! This option is included for the sake of completeness, - ! for users who prefer the Exact DMD vectors. The - ! returned vectors are in the real form, in the same way - ! as the Ritz vectors. Here we just save the vectors - ! and test them separately using a Matlab script. - - CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, AU, LDAU, ZERO, Y1, M ) - i=1 - DO WHILE ( i <= K ) - IF ( IEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL SAXPY( M, -REIG(i), AU(1,i), 1, Y1(1,i), 1 ) - RESEX(i) = SNRM2( M, Y1(1,i), 1) / SNRM2(M,AU(1,i),1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IEIG(i) - AB(1,2) = IEIG(i) - AB(2,2) = REIG(i) - CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, AU(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) - RESEX(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & - WORK )/ SLANGE( 'F', M, 2, AU(1,i), M, & - WORK ) - RESEX(i+1) = RESEX(i) - i = i + 2 - END IF - END DO - - END IF - - !...... SGEDMD check point - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by SGEDMD with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, Z, LDZ, ZERO, Y1, M ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in SGEDMD,) - i = 1 - DO WHILE ( i <= K ) - IF ( IEIG(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL SAXPY( M, -REIG(i), Z(1,i), 1, Y1(1,i), 1 ) - RES1(i) = SNRM2( M, Y1(1,i), 1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIG(i) - AB(2,1) = -IEIG(i) - AB(1,2) = IEIG(i) - AB(2,2) = REIG(i) - CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) - RES1(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & - WORK ) - RES1(i+1) = RES1(i) - i = i + 2 - END IF - END DO - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_REZ = MAX( TMP_REZ, TMP ) - - IF ( TMP > TOL2 ) THEN - NFAIL_REZ = NFAIL_REZ + 1 - END IF - - IF ( LSAME(JOBREF,'E') ) THEN - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) - END DO - TMP_EX = MAX(TMP_EX,TMP) - END IF - - END IF - - ! ... store the results for inspection - DO i = 1, K - LAMBDA(i,1) = REIG(i) - LAMBDA(i,2) = IEIG(i) - END DO - - DEALLOCATE(IWORK) - DEALLOCATE(WORK) - - !====================================================================== - ! Now test the SGEDMDQ, if requested. - !====================================================================== - IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN - RJOBDATA(2) = 1 - F1 = F - - ! SGEDMDQ test: Workspace query and workspace allocation - CALL SGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & - JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & - LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & - RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, & - -1, IDUMMY, -1, INFO ) - LIWORK = IDUMMY(1) - ALLOCATE( IWORK(LIWORK) ) - LWORK = INT(WDUMMY(LWMINOPT)) - ALLOCATE(WORK(LWORK)) - - ! SGEDMDQ test: CALL SGEDMDQ - CALL SGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & - JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & - LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & - RES, AU, LDAU, W, LDW, S, LDS, & - WORK, LWORK, IWORK, LIWORK, INFO ) - - SINGVQX(1:KQ) = WORK(MIN(M,N+1)+1: MIN(M,N+1)+KQ) - - !..... SGEDMDQ check point - IF ( KQ /= K ) THEN - KDIFF = KDIFF+1 - END IF - - TMP = ZERO - DO i = 1, MIN(K, KQ) - TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & - SINGVX(1) ) - END DO - SVDIFF = MAX( SVDIFF, TMP ) - IF ( TMP > M*N*EPS ) THEN - NFAIL_SVDIFF = NFAIL_SVDIFF + 1 - END IF - - !..... SGEDMDQ check point - IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN - ! Check that the QR factors are computed and returned - ! as requested. The residual ||F-Q*R||_F / ||F||_F - ! is compared to M*N*EPS. - F2 = F - CALL SGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ONE, F1, & - LDF, Y, LDY, ONE, F2, LDF ) - TMP_FQR = SLANGE( 'F', M, N+1, F2, LDF, WORK ) / & - SLANGE( 'F', M, N+1, F, LDF, WORK ) - IF ( TMP_FQR > TOL2 ) THEN - NFAIL_F_QR = NFAIL_F_QR + 1 - END IF - END IF - - !..... SGEDMDQ checkpoint - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by SGEDMDQ with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL SGEMM( 'N', 'N', M, KQ, M, ONE, A, M, Z, M, ZERO, Y1, M ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in SGEDMDQ) - i = 1 - DO WHILE ( i <= KQ ) - IF ( IEIGQ(i) == ZERO ) THEN - ! have a real eigenvalue with real eigenvector - CALL SAXPY( M, -REIGQ(i), Z(1,i), 1, Y1(1,i), 1 ) - ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) - RES1(i) = SNRM2( M, Y1(1,i), 1) - i = i + 1 - ELSE - ! Have a complex conjugate pair - ! REIG(i) +- sqrt(-1)*IMEIG(i). - ! Since all computation is done in real - ! arithmetic, the formula for the residual - ! is recast for real representation of the - ! complex conjugate eigenpair. See the - ! description of RES. - AB(1,1) = REIGQ(i) - AB(2,1) = -IEIGQ(i) - AB(1,2) = IEIGQ(i) - AB(2,2) = REIGQ(i) - CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & - M, AB, 2, ONE, Y1(1,i), M ) ! BLAS CALL - ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC - RES1(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & - WORK ) ! LAPACK CALL - RES1(i+1) = RES1(i) - i = i + 2 - END IF - END DO - TMP = ZERO - DO i = 1, KQ - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVQX(K)/(ANORM*SINGVQX(1)) ) - END DO - TMP_REZQ = MAX( TMP_REZQ, TMP ) - IF ( TMP > TOL2 ) THEN - NFAIL_REZQ = NFAIL_REZQ + 1 - END IF - - END IF - - DO i = 1, KQ - LAMBDAQ(i,1) = REIGQ(i) - LAMBDAQ(i,2) = IEIGQ(i) - END DO - - DEALLOCATE(WORK) - DEALLOCATE(IWORK) - END IF ! TEST_QRDMD -!====================================================================== - - END DO ! LWMINOPT - !write(*,*) 'LWMINOPT loop completed' - END DO ! WHTSVD LOOP - !write(*,*) 'WHTSVD loop completed' - END DO ! NRNK LOOP - !write(*,*) 'NRNK loop completed' - END DO ! SCALE LOOP - !write(*,*) 'SCALE loop completed' - END DO ! JOBF LOOP - !write(*,*) 'JOBREF loop completed' - END DO ! JOBZ LOOP - !write(*,*) 'JOBZ loop completed' - - END DO ! MODE -6:6 - !write(*,*) 'MODE loop completed' - END DO ! 1 or 2 trajectories - !write(*,*) 'trajectories loop completed' - - DEALLOCATE(A) - DEALLOCATE(AC) - DEALLOCATE(DA) - DEALLOCATE(DL) - DEALLOCATE(F) - DEALLOCATE(F1) - DEALLOCATE(F2) - DEALLOCATE(X) - DEALLOCATE(X0) - DEALLOCATE(SINGVX) - DEALLOCATE(SINGVQX) - DEALLOCATE(Y) - DEALLOCATE(Y0) - DEALLOCATE(Y1) - DEALLOCATE(Z) - DEALLOCATE(Z1) - DEALLOCATE(RES) - DEALLOCATE(RES1) - DEALLOCATE(RESEX) - DEALLOCATE(REIG) - DEALLOCATE(IEIG) - DEALLOCATE(REIGQ) - DEALLOCATE(IEIGQ) - DEALLOCATE(REIGA) - DEALLOCATE(IEIGA) - DEALLOCATE(VA) - DEALLOCATE(LAMBDA) - DEALLOCATE(LAMBDAQ) - DEALLOCATE(EIGA) - DEALLOCATE(W) - DEALLOCATE(AU) - DEALLOCATE(S) - -!............................................................ - ! Generate random M-by-M matrix A. Use DLATMR from - END DO ! LLOOP - - - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for SGEDMD :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - IF ( NFAIL_Z_XV == 0 ) THEN - WRITE(*,*) '>>>> Z - U*V test PASSED.' - ELSE - WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' - WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV - END IF - IF ( NFAIL_AU == 0 ) THEN - WRITE(*,*) '>>>> A*U test PASSED. ' - ELSE - WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' - WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU - END IF - - IF ( NFAIL_REZ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ - END IF - - IF ( NFAIL_TOTAL == 0 ) THEN - WRITE(*,*) '>>>> SGEDMD :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>>>>>>>>> SGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - IF ( TEST_QRDMD ) THEN - WRITE(*,*) - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for SGEDMDQ :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - - IF ( NFAIL_SVDIFF == 0 ) THEN - WRITE(*,*) '>>>> SGEDMD and SGEDMDQ computed singular & - &values test PASSED.' - ELSE - WRITE(*,*) 'SGEDMD and SGEDMDQ discrepancies in & - &the singular values unacceptable ', & - NFAIL_SVDIFF, ' times. Test FAILED.' - WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF - END IF - - IF ( NFAIL_F_QR == 0 ) THEN - WRITE(*,*) '>>>> F - Q*R test PASSED.' - ELSE - WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' - WRITE(*,*) 'The largest relative residual was ', TMP_FQR - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR - END IF - - IF ( NFAIL_REZQ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ - END IF - - IF ( NFAILQ_TOTAL == 0 ) THEN - WRITE(*,*) '>>>>>>> SGEDMDQ :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>> SGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - END IF - - WRITE(*,*) - WRITE(*,*) 'Test completed.' - STOP - END +! This is a test program for checking the implementations of +! the implementations of the following subroutines +! +! SGEDMD for computation of the +! Dynamic Mode Decomposition (DMD) +! SGEDMDQ for computation of a +! QR factorization based compressed DMD +! +! Developed and supported by: +! =========================== +! Developed and coded by Zlatko Drmac, Faculty of Science, +! University of Zagreb; drmac@math.hr +! In cooperation with +! AIMdyn Inc., Santa Barbara, CA. +! ======================================================== +! How to run the code (compiler, link info) +! ======================================================== +! Compile as FORTRAN 90 (or later) and link with BLAS and +! LAPACK libraries. +! NOTE: The code is developed and tested on top of the +! Intel MKL library (versions 2022.0.3 and 2022.2.0), +! using the Intel Fortran compiler. +! +! For developers of the C++ implementation +! ======================================================== +! See the LAPACK++ and Template Numerical Toolkit (TNT) +! +! Note on a development of the GPU HP implementation +! ======================================================== +! Work in progress. See CUDA, MAGMA, SLATE. +! NOTE: The four SVD subroutines used in this code are +! included as a part of R&D and for the completeness. +! This was also an opportunity to test those SVD codes. +! If the scaling option is used all four are essentially +! equally good. For implementations on HP platforms, +! one can use whichever SVD is available. +!... ......................................................... +! NOTE: +! When using the Intel MKL 2022.0.3 the subroutine xGESVDQ +! (optionally used in xGEDMD) may cause access violation +! error for x = S, D, C, Z, but only if called with the +! work space query. (At least in our Windows 10 MSVS 2019.) +! The problem can be mitigated by downloading the source +! code of xGESVDQ from the LAPACK repository and use it +! localy instead of the one in the MKL. This seems to +! indicate that the problem is indeed in the MKL. +! This problem did not appear whith Intel MKL 2022.2.0. +! +! NOTE: +! xGESDD seems to have a problem with workspace. In some +! cases the length of the optimal workspace is returned +! smaller than the minimal workspace, as specified in the +! code. As a precaution, all optimal workspaces are +! set as MAX(minimal, optimal). +! Latest implementations of complex xGESDD have different +! length of the real worksapce. We use max value over +! two versions. +!............................................................ +!............................................................ +! + PROGRAM DMD_TEST + use iso_fortran_env, only: real32 + IMPLICIT NONE + integer, parameter :: WP = real32 + +!............................................................ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP +!............................................................ + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: & + A, AC, EIGA, LAMBDA, LAMBDAQ, F, F1, F2,& + Z, Z1, S, AU, W, VA, X, X0, Y, Y0, Y1 + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: & + DA, DL, DR, REIG, REIGA, REIGQ, IEIG, & + IEIGA, IEIGQ, RES, RES1, RESEX, SINGVX,& + SINGVQX, WORK + INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK + REAL(KIND=WP) :: AB(2,2), WDUMMY(2) + INTEGER :: IDUMMY(2), ISEED(4), RJOBDATA(8) + REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, DMAX, EPS, & + TOL, TOL2, SVDIFF, TMP, TMP_AU, & + TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & + TMP_EX, XNORM, YNORM +!............................................................ + INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & + LDZ, LIWORK, LWORK, M, N, L, LLOOP, NRNK + INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, KDIFF, & + NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & + NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & + NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD + INTEGER iNRNK, iWHTSVD, K_TRAJ, LWMINOPT + CHARACTER(LEN=1) GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & + SCALE, RESIDS, WANTQ, WANTR + + LOGICAL TEST_QRDMD +!..... external subroutines (BLAS and LAPACK) + EXTERNAL SAXPY, SGEEV, SGEMM, SGEMV, SLACPY, SLASCL + EXTERNAL SLARNV, SLATMR +!.....external subroutines DMD package, part 1 +! subroutines under test + EXTERNAL SGEDMD, SGEDMDQ + +!..... external functions (BLAS and LAPACK) + EXTERNAL SLAMCH, SLANGE, SNRM2 + REAL(KIND=WP) :: SLAMCH, SLANGE, SNRM2 + EXTERNAL LSAME + LOGICAL LSAME + + INTRINSIC ABS, INT, MIN, MAX +!............................................................ + + ! The test is always in pairs : ( SGEDMD and SGEDMDQ ) + ! because the test includes comparing the results (in pairs). +!..................................................................................... + TEST_QRDMD = .TRUE. ! This code by default performs tests on SGEDMDQ + ! Since the QR factorizations based algorithm is designed for + ! single trajectory data, only single trajectory tests will + ! be performed with xGEDMDQ. + WANTQ = 'Q' + WANTR = 'R' +!................................................................................. + + EPS = SLAMCH( 'P' ) ! machine precision SP + + ! Global counters of failures of some particular tests + NFAIL = 0 + NFAIL_REZ = 0 + NFAIL_REZQ = 0 + NFAIL_Z_XV = 0 + NFAIL_F_QR = 0 + NFAIL_AU = 0 + KDIFF = 0 + NFAIL_SVDIFF = 0 + NFAIL_TOTAL = 0 + NFAILQ_TOTAL = 0 + + + DO LLOOP = 1, 4 + + WRITE(*,*) 'L Loop Index = ', LLOOP + + ! Set the dimensions of the problem ... + WRITE(*,*) 'M = ' + READ(*,*) M + WRITE(*,*) M + ! ... and the number of snapshots. + WRITE(*,*) 'N = ' + READ(*,*) N + WRITE(*,*) N + + ! ... Test the dimensions + IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN + WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' + STOP + END IF +!............. + ! The seed inside the LLOOP so that each pass can be reproduced easily. + + ISEED(1) = 4 + ISEED(2) = 3 + ISEED(3) = 2 + ISEED(4) = 1 + + LDA = M + LDF = M + LDX = MAX(M,N+1) + LDY = MAX(M,N+1) + LDW = N + LDZ = M + LDAU = MAX(M,N+1) + LDS = N + + TMP_ZXW = ZERO + TMP_AU = ZERO + TMP_REZ = ZERO + TMP_REZQ = ZERO + SVDIFF = ZERO + TMP_EX = ZERO + + ! + ! Test the subroutines on real data snapshots. All + ! computation is done in real arithmetic, even when + ! Koopman eigenvalues and modes are real. + ! + ! Allocate memory space + ALLOCATE( A(LDA,M) ) + ALLOCATE( AC(LDA,M) ) + ALLOCATE( DA(M) ) + ALLOCATE( DL(M) ) + ALLOCATE( F(LDF,N+1) ) + ALLOCATE( F1(LDF,N+1) ) + ALLOCATE( F2(LDF,N+1) ) + ALLOCATE( X(LDX,N) ) + ALLOCATE( X0(LDX,N) ) + ALLOCATE( SINGVX(N) ) + ALLOCATE( SINGVQX(N) ) + ALLOCATE( Y(LDY,N+1) ) + ALLOCATE( Y0(LDY,N+1) ) + ALLOCATE( Y1(M,N+1) ) + ALLOCATE( Z(LDZ,N) ) + ALLOCATE( Z1(LDZ,N) ) + ALLOCATE( RES(N) ) + ALLOCATE( RES1(N) ) + ALLOCATE( RESEX(N) ) + ALLOCATE( REIG(N) ) + ALLOCATE( IEIG(N) ) + ALLOCATE( REIGQ(N) ) + ALLOCATE( IEIGQ(N) ) + ALLOCATE( REIGA(M) ) + ALLOCATE( IEIGA(M) ) + ALLOCATE( VA(LDA,M) ) + ALLOCATE( LAMBDA(N,2) ) + ALLOCATE( LAMBDAQ(N,2) ) + ALLOCATE( EIGA(M,2) ) + ALLOCATE( W(LDW,N) ) + ALLOCATE( AU(LDAU,N) ) + ALLOCATE( S(N,N) ) + + TOL = M*EPS + ! This mimics O(M*N)*EPS bound for accumulated roundoff error. + ! The factor 10 is somewhat arbitrary. + TOL2 = 10*M*N*EPS + +!............. + + DO K_TRAJ = 1, 2 + ! Number of intial conditions in the simulation/trajectories (1 or 2) + + COND = 1.0D8 + DMAX = 1.0D2 + RSIGN = 'F' + GRADE = 'N' + MODEL = 6 + CONDL = 1.0D2 + MODER = 6 + CONDR = 1.0D2 + PIVTNG = 'N' + + ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) + DO MODE = 1, 6 + + ALLOCATE( IWORK(2*M) ) + ALLOCATE(DR(N)) + CALL SLATMR( M, M, 'S', ISEED, 'N', DA, MODE, COND, & + DMAX, RSIGN, GRADE, DL, MODEL, CONDL, & + DR, MODER, CONDR, PIVTNG, IWORK, M, M, & + ZERO, -ONE, 'N', A, LDA, IWORK(M+1), INFO ) + DEALLOCATE(IWORK) + DEALLOCATE(DR) + + LWORK = 4*M+1 + ALLOCATE(WORK(LWORK)) + AC = A + CALL SGEEV( 'N','V', M, AC, M, REIGA, IEIGA, VA, M, & + VA, M, WORK, LWORK, INFO ) ! LAPACK CALL + DEALLOCATE(WORK) + TMP = ZERO + DO i = 1, M + EIGA(i,1) = REIGA(i) + EIGA(i,2) = IEIGA(i) + TMP = MAX( TMP, SQRT(REIGA(i)**2+IEIGA(i)**2)) + END DO + + ! Scale A to have the desirable spectral radius. + CALL SLASCL( 'G', 0, 0, TMP, ONE, M, M, A, M, INFO ) + CALL SLASCL( 'G', 0, 0, TMP, ONE, M, 2, EIGA, M, INFO ) + + ! Compute the norm of A + ANORM = SLANGE( 'F', N, N, A, M, WDUMMY ) + + IF ( K_TRAJ == 2 ) THEN + ! generate data with two inital conditions + CALL SLARNV(2, ISEED, M, F1(1,1) ) + F1(1:M,1) = 1.0E-10*F1(1:M,1) + DO i = 1, N/2 + CALL SGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & + F1(1,i+1), 1 ) + END DO + X0(1:M,1:N/2) = F1(1:M,1:N/2) + Y0(1:M,1:N/2) = F1(1:M,2:N/2+1) + + CALL SLARNV(2, ISEED, M, F1(1,1) ) + DO i = 1, N-N/2 + CALL SGEMV( 'N', M, M, ONE, A, M, F1(1,i), 1, ZERO, & + F1(1,i+1), 1 ) + END DO + X0(1:M,N/2+1:N) = F1(1:M,1:N-N/2) + Y0(1:M,N/2+1:N) = F1(1:M,2:N-N/2+1) + ELSE + ! single trajectory + CALL SLARNV(2, ISEED, M, F(1,1) ) + DO i = 1, N + CALL SGEMV( 'N', M, M, ONE, A, M, F(1,i), 1, ZERO, & + F(1,i+1), 1 ) + END DO + X0(1:M,1:N) = F(1:M,1:N) + Y0(1:M,1:N) = F(1:M,2:N+1) + END IF + + XNORM = SLANGE( 'F', M, N, X0, LDX, WDUMMY ) + YNORM = SLANGE( 'F', M, N, Y0, LDX, WDUMMY ) +!............................................................ + + DO iJOBZ = 1, 4 + + SELECT CASE ( iJOBZ ) + CASE(1) + JOBZ = 'V' ! Ritz vectors will be computed + RESIDS = 'R' ! Residuals will be computed + CASE(2) + JOBZ = 'V' + RESIDS = 'N' + CASE(3) + JOBZ = 'F' ! Ritz vectors in factored form + RESIDS = 'N' + CASE(4) + JOBZ = 'N' + RESIDS = 'N' + END SELECT + + DO iJOBREF = 1, 3 + + SELECT CASE ( iJOBREF ) + CASE(1) + JOBREF = 'R' ! Data for refined Ritz vectors + CASE(2) + JOBREF = 'E' ! Exact DMD vectors + CASE(3) + JOBREF = 'N' + END SELECT + + DO iSCALE = 1, 4 + + SELECT CASE ( iSCALE ) + CASE(1) + SCALE = 'S' ! X data normalized + CASE(2) + SCALE = 'C' ! X normalized, consist. check + CASE(3) + SCALE = 'Y' ! Y data normalized + CASE(4) + SCALE = 'N' + END SELECT + + DO iNRNK = -1, -2, -1 + ! Two truncation strategies. The "-2" case for R&D + ! purposes only - it uses possibly low accuracy small + ! singular values, in which case the formulas used in + ! the DMD are highly sensitive. + NRNK = iNRNK + + DO iWHTSVD = 1, 4 + ! Check all four options to compute the POD basis + ! via the SVD. + WHTSVD = iWHTSVD + + DO LWMINOPT = 1, 2 + ! Workspace query for the minimal (1) and for the optimal + ! (2) workspace lengths determined by workspace query. + + X(1:M,1:N) = X0(1:M,1:N) + Y(1:M,1:N) = Y0(1:M,1:N) + + ! SGEDMD: Workspace query and workspace allocation + CALL SGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & + N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & + LDZ, RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, -1, & + IDUMMY, -1, INFO ) + + LIWORK = IDUMMY(1) + ALLOCATE( IWORK(LIWORK) ) + LWORK = INT(WDUMMY(LWMINOPT)) + ALLOCATE( WORK(LWORK) ) + + ! SGEDMD test: CALL SGEDMD + CALL SGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, M, & + N, X, LDX, Y, LDY, NRNK, TOL, K, REIG, IEIG, Z, & + LDZ, RES, AU, LDAU, W, LDW, S, LDS, WORK, LWORK,& + IWORK, LIWORK, INFO ) + + SINGVX(1:N) = WORK(1:N) + + !...... SGEDMD check point + IF ( LSAME(JOBZ,'V') ) THEN + ! Check that Z = X*W, on return from SGEDMD + ! This checks that the returned aigenvectors in Z are + ! the product of the SVD'POD basis returned in X + ! and the eigenvectors of the rayleigh quotient + ! returned in W + CALL SGEMM( 'N', 'N', M, K, K, ONE, X, LDX, W, LDW, & + ZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL SAXPY( M, -ONE, Z(1,i), 1, Z1(1,i), 1) + TMP = MAX(TMP, SNRM2( M, Z1(1,i), 1 ) ) + END DO + TMP_ZXW = MAX(TMP_ZXW, TMP ) + + IF ( TMP_ZXW > 10*M*EPS ) THEN + NFAIL_Z_XV = NFAIL_Z_XV + 1 + END IF + + END IF + + !...... SGEDMD check point + IF ( LSAME(JOBREF,'R') ) THEN + ! The matrix A*U is returned for computing refined Ritz vectors. + ! Check that A*U is computed correctly using the formula + ! A*U = Y * V * inv(SIGMA). This depends on the + ! accuracy in the computed singular values and vectors of X. + ! See the paper for an error analysis. + ! Note that the left singular vectors of the input matrix X + ! are returned in the array X. + CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, X, LDX, & + ZERO, Z1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL SAXPY( M, -ONE, AU(1,i), 1, Z1(1,i), 1) + TMP = MAX( TMP, SNRM2( M, Z1(1,i),1 ) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_AU = MAX( TMP_AU, TMP ) + + IF ( TMP > TOL2 ) THEN + NFAIL_AU = NFAIL_AU + 1 + END IF + + ELSEIF ( LSAME(JOBREF,'E') ) THEN + ! The unscaled vectors of the Exact DMD are computed. + ! This option is included for the sake of completeness, + ! for users who prefer the Exact DMD vectors. The + ! returned vectors are in the real form, in the same way + ! as the Ritz vectors. Here we just save the vectors + ! and test them separately using a Matlab script. + + CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, AU, LDAU, ZERO, Y1, M ) + i=1 + DO WHILE ( i <= K ) + IF ( IEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL SAXPY( M, -REIG(i), AU(1,i), 1, Y1(1,i), 1 ) + RESEX(i) = SNRM2( M, Y1(1,i), 1) / SNRM2(M,AU(1,i),1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IEIG(i) + AB(1,2) = IEIG(i) + AB(2,2) = REIG(i) + CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, AU(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) + RESEX(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & + WORK )/ SLANGE( 'F', M, 2, AU(1,i), M, & + WORK ) + RESEX(i+1) = RESEX(i) + i = i + 2 + END IF + END DO + + END IF + + !...... SGEDMD check point + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by SGEDMD with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL SGEMM( 'N', 'N', M, K, M, ONE, A, LDA, Z, LDZ, ZERO, Y1, M ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in SGEDMD,) + i = 1 + DO WHILE ( i <= K ) + IF ( IEIG(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL SAXPY( M, -REIG(i), Z(1,i), 1, Y1(1,i), 1 ) + RES1(i) = SNRM2( M, Y1(1,i), 1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIG(i) + AB(2,1) = -IEIG(i) + AB(1,2) = IEIG(i) + AB(2,2) = REIG(i) + CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) + RES1(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & + WORK ) + RES1(i+1) = RES1(i) + i = i + 2 + END IF + END DO + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_REZ = MAX( TMP_REZ, TMP ) + + IF ( TMP > TOL2 ) THEN + NFAIL_REZ = NFAIL_REZ + 1 + END IF + + IF ( LSAME(JOBREF,'E') ) THEN + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) + END DO + TMP_EX = MAX(TMP_EX,TMP) + END IF + + END IF + + ! ... store the results for inspection + DO i = 1, K + LAMBDA(i,1) = REIG(i) + LAMBDA(i,2) = IEIG(i) + END DO + + DEALLOCATE(IWORK) + DEALLOCATE(WORK) + + !====================================================================== + ! Now test the SGEDMDQ, if requested. + !====================================================================== + IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN + RJOBDATA(2) = 1 + F1 = F + + ! SGEDMDQ test: Workspace query and workspace allocation + CALL SGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & + JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & + LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & + RES, AU, LDAU, W, LDW, S, LDS, WDUMMY, & + -1, IDUMMY, -1, INFO ) + LIWORK = IDUMMY(1) + ALLOCATE( IWORK(LIWORK) ) + LWORK = INT(WDUMMY(LWMINOPT)) + ALLOCATE(WORK(LWORK)) + + ! SGEDMDQ test: CALL SGEDMDQ + CALL SGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, & + JOBREF, WHTSVD, M, N+1, F1, LDF, X, LDX, Y, & + LDY, NRNK, TOL, KQ, REIGQ, IEIGQ, Z, LDZ, & + RES, AU, LDAU, W, LDW, S, LDS, & + WORK, LWORK, IWORK, LIWORK, INFO ) + + SINGVQX(1:KQ) = WORK(MIN(M,N+1)+1: MIN(M,N+1)+KQ) + + !..... SGEDMDQ check point + IF ( KQ /= K ) THEN + KDIFF = KDIFF+1 + END IF + + TMP = ZERO + DO i = 1, MIN(K, KQ) + TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & + SINGVX(1) ) + END DO + SVDIFF = MAX( SVDIFF, TMP ) + IF ( TMP > M*N*EPS ) THEN + NFAIL_SVDIFF = NFAIL_SVDIFF + 1 + END IF + + !..... SGEDMDQ check point + IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN + ! Check that the QR factors are computed and returned + ! as requested. The residual ||F-Q*R||_F / ||F||_F + ! is compared to M*N*EPS. + F2 = F + CALL SGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ONE, F1, & + LDF, Y, LDY, ONE, F2, LDF ) + TMP_FQR = SLANGE( 'F', M, N+1, F2, LDF, WORK ) / & + SLANGE( 'F', M, N+1, F, LDF, WORK ) + IF ( TMP_FQR > TOL2 ) THEN + NFAIL_F_QR = NFAIL_F_QR + 1 + END IF + END IF + + !..... SGEDMDQ checkpoint + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by SGEDMDQ with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL SGEMM( 'N', 'N', M, KQ, M, ONE, A, M, Z, M, ZERO, Y1, M ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in SGEDMDQ) + i = 1 + DO WHILE ( i <= KQ ) + IF ( IEIGQ(i) == ZERO ) THEN + ! have a real eigenvalue with real eigenvector + CALL SAXPY( M, -REIGQ(i), Z(1,i), 1, Y1(1,i), 1 ) + ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) + RES1(i) = SNRM2( M, Y1(1,i), 1) + i = i + 1 + ELSE + ! Have a complex conjugate pair + ! REIG(i) +- sqrt(-1)*IMEIG(i). + ! Since all computation is done in real + ! arithmetic, the formula for the residual + ! is recast for real representation of the + ! complex conjugate eigenpair. See the + ! description of RES. + AB(1,1) = REIGQ(i) + AB(2,1) = -IEIGQ(i) + AB(1,2) = IEIGQ(i) + AB(2,2) = REIGQ(i) + CALL SGEMM( 'N', 'N', M, 2, 2, -ONE, Z(1,i), & + M, AB, 2, ONE, Y1(1,i), M ) ! BLAS CALL + ! Y(1:M,i:i+1) = Y(1:M,i:i+1) - Z(1:M,i:i+1) * AB ! INTRINSIC + RES1(i) = SLANGE( 'F', M, 2, Y1(1,i), M, & + WORK ) ! LAPACK CALL + RES1(i+1) = RES1(i) + i = i + 2 + END IF + END DO + TMP = ZERO + DO i = 1, KQ + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVQX(K)/(ANORM*SINGVQX(1)) ) + END DO + TMP_REZQ = MAX( TMP_REZQ, TMP ) + IF ( TMP > TOL2 ) THEN + NFAIL_REZQ = NFAIL_REZQ + 1 + END IF + + END IF + + DO i = 1, KQ + LAMBDAQ(i,1) = REIGQ(i) + LAMBDAQ(i,2) = IEIGQ(i) + END DO + + DEALLOCATE(WORK) + DEALLOCATE(IWORK) + END IF ! TEST_QRDMD +!====================================================================== + + END DO ! LWMINOPT + !write(*,*) 'LWMINOPT loop completed' + END DO ! WHTSVD LOOP + !write(*,*) 'WHTSVD loop completed' + END DO ! NRNK LOOP + !write(*,*) 'NRNK loop completed' + END DO ! SCALE LOOP + !write(*,*) 'SCALE loop completed' + END DO ! JOBF LOOP + !write(*,*) 'JOBREF loop completed' + END DO ! JOBZ LOOP + !write(*,*) 'JOBZ loop completed' + + END DO ! MODE -6:6 + !write(*,*) 'MODE loop completed' + END DO ! 1 or 2 trajectories + !write(*,*) 'trajectories loop completed' + + DEALLOCATE(A) + DEALLOCATE(AC) + DEALLOCATE(DA) + DEALLOCATE(DL) + DEALLOCATE(F) + DEALLOCATE(F1) + DEALLOCATE(F2) + DEALLOCATE(X) + DEALLOCATE(X0) + DEALLOCATE(SINGVX) + DEALLOCATE(SINGVQX) + DEALLOCATE(Y) + DEALLOCATE(Y0) + DEALLOCATE(Y1) + DEALLOCATE(Z) + DEALLOCATE(Z1) + DEALLOCATE(RES) + DEALLOCATE(RES1) + DEALLOCATE(RESEX) + DEALLOCATE(REIG) + DEALLOCATE(IEIG) + DEALLOCATE(REIGQ) + DEALLOCATE(IEIGQ) + DEALLOCATE(REIGA) + DEALLOCATE(IEIGA) + DEALLOCATE(VA) + DEALLOCATE(LAMBDA) + DEALLOCATE(LAMBDAQ) + DEALLOCATE(EIGA) + DEALLOCATE(W) + DEALLOCATE(AU) + DEALLOCATE(S) + +!............................................................ + ! Generate random M-by-M matrix A. Use DLATMR from + END DO ! LLOOP + + + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for SGEDMD :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + IF ( NFAIL_Z_XV == 0 ) THEN + WRITE(*,*) '>>>> Z - U*V test PASSED.' + ELSE + WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' + WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV + END IF + IF ( NFAIL_AU == 0 ) THEN + WRITE(*,*) '>>>> A*U test PASSED. ' + ELSE + WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' + WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU + END IF + + IF ( NFAIL_REZ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ + END IF + + IF ( NFAIL_TOTAL == 0 ) THEN + WRITE(*,*) '>>>> SGEDMD :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>>>>>>>>> SGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + IF ( TEST_QRDMD ) THEN + WRITE(*,*) + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for SGEDMDQ :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + + IF ( NFAIL_SVDIFF == 0 ) THEN + WRITE(*,*) '>>>> SGEDMD and SGEDMDQ computed singular & + &values test PASSED.' + ELSE + WRITE(*,*) 'SGEDMD and SGEDMDQ discrepancies in & + &the singular values unacceptable ', & + NFAIL_SVDIFF, ' times. Test FAILED.' + WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF + END IF + + IF ( NFAIL_F_QR == 0 ) THEN + WRITE(*,*) '>>>> F - Q*R test PASSED.' + ELSE + WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' + WRITE(*,*) 'The largest relative residual was ', TMP_FQR + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR + END IF + + IF ( NFAIL_REZQ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ + END IF + + IF ( NFAILQ_TOTAL == 0 ) THEN + WRITE(*,*) '>>>>>>> SGEDMDQ :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>> SGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + END IF + + WRITE(*,*) + WRITE(*,*) 'Test completed.' + STOP + END diff --git a/TESTING/EIG/zchkdmd.f90 b/TESTING/EIG/zchkdmd.f90 index 873d956c40..d22c32efd7 100644 --- a/TESTING/EIG/zchkdmd.f90 +++ b/TESTING/EIG/zchkdmd.f90 @@ -1,745 +1,745 @@ -! This is a test program for checking the implementations of -! the implementations of the following subroutines -! -! ZGEDMD, for computation of the -! Dynamic Mode Decomposition (DMD) -! ZGEDMDQ, for computation of a -! QR factorization based compressed DMD -! -! Developed and supported by: -! =========================== -! Developed and coded by Zlatko Drmac, Faculty of Science, -! University of Zagreb; drmac@math.hr -! In cooperation with -! AIMdyn Inc., Santa Barbara, CA. -! ======================================================== -! How to run the code (compiler, link info) -! ======================================================== -! Compile as FORTRAN 90 (or later) and link with BLAS and -! LAPACK libraries. -! NOTE: The code is developed and tested on top of the -! Intel MKL library (versions 2022.0.3 and 2022.2.0), -! using the Intel Fortran compiler. -! -! For developers of the C++ implementation -! ======================================================== -! See the LAPACK++ and Template Numerical Toolkit (TNT) -! -! Note on a development of the GPU HP implementation -! ======================================================== -! Work in progress. See CUDA, MAGMA, SLATE. -! NOTE: The four SVD subroutines used in this code are -! included as a part of R&D and for the completeness. -! This was also an opportunity to test those SVD codes. -! If the scaling option is used all four are essentially -! equally good. For implementations on HP platforms, -! one can use whichever SVD is available. -!............................................................ - -!............................................................ -!............................................................ -! - PROGRAM DMD_TEST - use iso_fortran_env, only: real64 - IMPLICIT NONE - integer, parameter :: WP = real64 - -!............................................................ - REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP - REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP - - COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) - COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) -!............................................................ - REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: RES, & - RES1, RESEX, SINGVX, SINGVQX, WORK - INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK - REAL(KIND=WP) :: WDUMMY(2) - INTEGER :: IDUMMY(4), ISEED(4) - REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, EPS, & - TOL, TOL2, SVDIFF, TMP, TMP_AU, & - TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & - TMP_EX - -!............................................................ - COMPLEX(KIND=WP) :: ZMAX - INTEGER :: LZWORK - COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: ZA, ZAC, & - ZAU, ZF, ZF0, ZF1, ZS, ZW, & - ZX, ZX0, ZY, ZY0, ZY1, ZZ, ZZ1 - COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:) :: ZDA, ZDR, & - ZDL, ZEIGS, ZEIGSA, ZWORK - COMPLEX(KIND=WP) :: ZDUMMY(22), ZDUM2X2(2,2) -!............................................................ - INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & - LDZ, LIWORK, LWORK, M, N, LLOOP, NRNK, NRNKsp - INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, & - NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & - NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & - NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD, & - WHTSVDsp - INTEGER :: iNRNK, iWHTSVD, K_TRAJ, LWMINOPT - CHARACTER :: GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & - SCALE, RESIDS, WANTQ, WANTR - LOGICAL :: TEST_QRDMD - -!.....external subroutines (BLAS and LAPACK) - EXTERNAL DAXPY, DGEEV, DGEMM, DGEMV, DLACPY, DLASCL - EXTERNAL ZGEEV, ZGEMV, ZLASCL - EXTERNAL ZLARNV, ZLATMR - EXTERNAL ZAXPY, ZGEMM -!.....external subroutines DMD package, part 1 -! subroutines under test - EXTERNAL ZGEDMD, ZGEDMDQ -!.....external functions (BLAS and LAPACK) - EXTERNAL DLAMCH, DZNRM2 - REAL(KIND=WP) :: DLAMCH, DZNRM2 - REAL(KIND=WP) :: ZLANGE - EXTERNAL IZAMAX - INTEGER IZAMAX - EXTERNAL LSAME - LOGICAL LSAME - - INTRINSIC ABS, INT, MIN, MAX, SIGN -!............................................................ - - ! The test is always in pairs : ( ZGEDMD and ZGEDMDQ ) - ! because the test includes comparing the results (in pairs). -!..................................................................................... - TEST_QRDMD = .TRUE. ! This code by default performs tests on ZGEDMDQ - ! Since the QR factorizations based algorithm is designed for - ! single trajectory data, only single trajectory tests will - ! be performed with xGEDMDQ. - WANTQ = 'Q' - WANTR = 'R' -!................................................................................. - - EPS = DLAMCH( 'P' ) ! machine precision DP - - ! Global counters of failures of some particular tests - NFAIL = 0 - NFAIL_REZ = 0 - NFAIL_REZQ = 0 - NFAIL_Z_XV = 0 - NFAIL_F_QR = 0 - NFAIL_AU = 0 - NFAIL_SVDIFF = 0 - NFAIL_TOTAL = 0 - NFAILQ_TOTAL = 0 - - DO LLOOP = 1, 4 - - WRITE(*,*) 'L Loop Index = ', LLOOP - - ! Set the dimensions of the problem ... - WRITE(*,*) 'M = ' - READ(*,*) M - WRITE(*,*) M - ! ... and the number of snapshots. - WRITE(*,*) 'N = ' - READ(*,*) N - WRITE(*,*) N - - ! ... Test the dimensions - IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN - WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' - STOP - END IF -!............. - ! The seed inside the LLOOP so that each pass can be reproduced easily. - ISEED(1) = 4 - ISEED(2) = 3 - ISEED(3) = 2 - ISEED(4) = 1 - - LDA = M - LDF = M - LDX = M - LDY = M - LDW = N - LDZ = M - LDAU = M - LDS = N - - TMP_ZXW = ZERO - TMP_AU = ZERO - TMP_REZ = ZERO - TMP_REZQ = ZERO - SVDIFF = ZERO - TMP_EX = ZERO - - ALLOCATE( ZA(LDA,M) ) - ALLOCATE( ZAC(LDA,M) ) - ALLOCATE( ZF(LDF,N+1) ) - ALLOCATE( ZF0(LDF,N+1) ) - ALLOCATE( ZF1(LDF,N+1) ) - ALLOCATE( ZX(LDX,N) ) - ALLOCATE( ZX0(LDX,N) ) - ALLOCATE( ZY(LDY,N+1) ) - ALLOCATE( ZY0(LDY,N+1) ) - ALLOCATE( ZY1(LDY,N+1) ) - ALLOCATE( ZAU(LDAU,N) ) - ALLOCATE( ZW(LDW,N) ) - ALLOCATE( ZS(LDS,N) ) - ALLOCATE( ZZ(LDZ,N) ) - ALLOCATE( ZZ1(LDZ,N) ) - ALLOCATE( RES(N) ) - ALLOCATE( RES1(N) ) - ALLOCATE( RESEX(N) ) - ALLOCATE( ZEIGS(N) ) - ALLOCATE( SINGVX(N) ) - ALLOCATE( SINGVQX(N) ) - - TOL = M*EPS - ! This mimics O(M*N)*EPS bound for accumulated roundoff error. - ! The factor 10 is somewhat arbitrary. - TOL2 = 10*M*N*EPS - -!............. - - DO K_TRAJ = 1, 2 - ! Number of intial conditions in the simulation/trajectories (1 or 2) - - COND = 1.0D4 - ZMAX = (1.0D1,1.0D1) - RSIGN = 'F' - GRADE = 'N' - MODEL = 6 - CONDL = 1.0D1 - MODER = 6 - CONDR = 1.0D1 - PIVTNG = 'N' - - ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) - DO MODE = 1, 6 - - ALLOCATE( IWORK(2*M) ) - ALLOCATE( ZDA(M) ) - ALLOCATE( ZDL(M) ) - ALLOCATE( ZDR(M) ) - - CALL ZLATMR( M, M, 'N', ISEED, 'N', ZDA, MODE, COND, & - ZMAX, RSIGN, GRADE, ZDL, MODEL, CONDL, & - ZDR, MODER, CONDR, PIVTNG, IWORK, M, M, & - ZERO, -ONE, 'N', ZA, LDA, IWORK(M+1), INFO ) - DEALLOCATE( ZDR ) - DEALLOCATE( ZDL ) - DEALLOCATE( ZDA ) - DEALLOCATE( IWORK ) - - LZWORK = MAX(1,2*M) - ALLOCATE( ZEIGSA(M) ) - ALLOCATE( ZWORK(LZWORK) ) - ALLOCATE( WORK(2*M) ) - ZAC(1:M,1:M) = ZA(1:M,1:M) - CALL ZGEEV( 'N','N', M, ZAC, LDA, ZEIGSA, ZDUM2X2, 2, & - ZDUM2X2, 2, ZWORK, LZWORK, WORK, INFO ) ! LAPACK CALL - DEALLOCATE(WORK) - DEALLOCATE(ZWORK) - - TMP = ABS(ZEIGSA(IZAMAX(M, ZEIGSA, 1))) ! The spectral radius of ZA - ! Scale the matrix ZA to have unit spectral radius. - CALL ZLASCL( 'G',0, 0, TMP, ONE, M, M, & - ZA, LDA, INFO ) - CALL ZLASCL( 'G',0, 0, TMP, ONE, M, 1, & - ZEIGSA, M, INFO ) - ANORM = ZLANGE( 'F', M, M, ZA, LDA, WDUMMY ) - - IF ( K_TRAJ == 2 ) THEN - ! generate data as two trajectories - ! with two inital conditions - CALL ZLARNV(2, ISEED, M, ZF(1,1) ) - DO i = 1, N/2 - CALL ZGEMV( 'N', M, M, ZONE, ZA, LDA, ZF(1,i), 1, & - ZZERO, ZF(1,i+1), 1 ) - END DO - ZX0(1:M,1:N/2) = ZF(1:M,1:N/2) - ZY0(1:M,1:N/2) = ZF(1:M,2:N/2+1) - - CALL ZLARNV(2, ISEED, M, ZF(1,1) ) - DO i = 1, N-N/2 - CALL ZGEMV( 'N', M, M, ZONE, ZA, LDA, ZF(1,i), 1, & - ZZERO, ZF(1,i+1), 1 ) - END DO - ZX0(1:M,N/2+1:N) = ZF(1:M,1:N-N/2) - ZY0(1:M,N/2+1:N) = ZF(1:M,2:N-N/2+1) - ELSE - CALL ZLARNV(2, ISEED, M, ZF(1,1) ) - DO i = 1, N - CALL ZGEMV( 'N', M, M, ZONE, ZA, M, ZF(1,i), 1, & - ZZERO, ZF(1,i+1), 1 ) - END DO - ZF0(1:M,1:N+1) = ZF(1:M,1:N+1) - ZX0(1:M,1:N) = ZF0(1:M,1:N) - ZY0(1:M,1:N) = ZF0(1:M,2:N+1) - END IF - - DEALLOCATE( ZEIGSA ) -!........................................................................ - - DO iJOBZ = 1, 4 - - SELECT CASE ( iJOBZ ) - CASE(1) - JOBZ = 'V' - RESIDS = 'R' - CASE(2) - JOBZ = 'V' - RESIDS = 'N' - CASE(3) - JOBZ = 'F' - RESIDS = 'N' - CASE(4) - JOBZ = 'N' - RESIDS = 'N' - END SELECT - - DO iJOBREF = 1, 3 - - SELECT CASE ( iJOBREF ) - CASE(1) - JOBREF = 'R' - CASE(2) - JOBREF = 'E' - CASE(3) - JOBREF = 'N' - END SELECT - - DO iSCALE = 1, 4 - - SELECT CASE ( iSCALE ) - CASE(1) - SCALE = 'S' - CASE(2) - SCALE = 'C' - CASE(3) - SCALE = 'Y' - CASE(4) - SCALE = 'N' - END SELECT - - DO iNRNK = -1, -2, -1 - NRNK = iNRNK - NRNKsp = iNRNK - - DO iWHTSVD = 1, 3 - ! Check all four options to compute the POD basis - ! via the SVD. - WHTSVD = iWHTSVD - WHTSVDsp = iWHTSVD - - DO LWMINOPT = 1, 2 - ! Workspace query for the minimal (1) and for the optimal - ! (2) workspace lengths determined by workspace query. - - ! ZGEDMD is always tested and its results are also used for - ! comparisons with ZGEDMDQ. - - ZX(1:M,1:N) = ZX0(1:M,1:N) - ZY(1:M,1:N) = ZY0(1:M,1:N) - - CALL ZGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, ZX, LDX, ZY, LDY, NRNK, TOL, & - K, ZEIGS, ZZ, LDZ, RES, ZAU, LDAU, & - ZW, LDW, ZS, LDS, ZDUMMY, -1, & - WDUMMY, -1, IDUMMY, -1, INFO ) - IF ( (INFO .EQ. 2) .OR. ( INFO .EQ. 3 ) & - .OR. ( INFO < 0 ) ) THEN - WRITE(*,*) 'Call to ZGEDMD workspace query failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ', & - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL, LDZ, LDAU, LDW, LDS - STOP - END IF - - LZWORK = INT(ZDUMMY(LWMINOPT)) - LWORK = INT(WDUMMY(1)) - LIWORK = IDUMMY(1) - - ALLOCATE(ZWORK(LZWORK)) - ALLOCATE( WORK(LWORK)) - ALLOCATE(IWORK(LIWORK)) - - CALL ZGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, ZX, LDX, ZY, LDY, NRNK, TOL, & - K, ZEIGS, ZZ, LDZ, RES, ZAU, LDAU, & - ZW, LDW, ZS, LDS, ZWORK, LZWORK, & - WORK, LWORK, IWORK, LIWORK, INFO ) - - IF ( INFO /= 0 ) THEN - WRITE(*,*) 'Call to ZGEDMD failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - STOP - END IF - - SINGVX(1:N) = WORK(1:N) - - !...... ZGEDMD check point - IF ( LSAME(JOBZ,'V') ) THEN - ! Check that Z = X*W, on return from ZGEDMD - ! This checks that the returned eigenvectors in Z are - ! the product of the SVD'POD basis returned in X - ! and the eigenvectors of the rayleigh quotient - ! returned in W - CALL ZGEMM( 'N', 'N', M, K, K, ZONE, ZX, LDX, ZW, LDW, & - ZZERO, ZZ1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL ZAXPY( M, -ZONE, ZZ(1,i), 1, ZZ1(1,i), 1) - TMP = MAX(TMP, DZNRM2( M, ZZ1(1,i), 1 ) ) - END DO - TMP_ZXW = MAX(TMP_ZXW, TMP ) - IF ( TMP_ZXW <= 10*M*EPS ) THEN - !WRITE(*,*) ' :) .... OK .........ZGEDMD PASSED.' - ELSE - NFAIL_Z_XV = NFAIL_Z_XV + 1 - WRITE(*,*) ':( .................ZGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - END IF - - - !...... ZGEDMD check point - IF ( LSAME(JOBREF,'R') ) THEN - ! The matrix A*U is returned for computing refined Ritz vectors. - ! Check that A*U is computed correctly using the formula - ! A*U = Y * V * inv(SIGMA). This depends on the - ! accuracy in the computed singular values and vectors of X. - ! See the paper for an error analysis. - ! Note that the left singular vectors of the input matrix X - ! are returned in the array X. - CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZX, LDX, & - ZZERO, ZZ1, LDZ ) - TMP = ZERO - DO i = 1, K - CALL ZAXPY( M, -ZONE, ZAU(1,i), 1, ZZ1(1,i), 1) - TMP = MAX( TMP, DZNRM2( M, ZZ1(1,i),1 ) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_AU = MAX( TMP_AU, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) ':) .... OK .........ZGEDMD PASSED.' - ELSE - NFAIL_AU = NFAIL_AU + 1 - WRITE(*,*) ':( .................ZGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - ELSEIF ( LSAME(JOBREF,'E') ) THEN - ! The unscaled vectors of the Exact DMD are computed. - ! This option is included for the sake of completeness, - ! for users who prefer the Exact DMD vectors. The - ! returned vectors are in the real form, in the same way - ! as the Ritz vectors. Here we just save the vectors - ! and test them separately using a Matlab script. - - - CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZAU, LDAU, ZZERO, ZY1, LDY ) - - DO i=1, K - ! have a real eigenvalue with real eigenvector - CALL ZAXPY( M, -ZEIGS(i), ZAU(1,i), 1, ZY1(1,i), 1 ) - RESEX(i) = DZNRM2( M, ZY1(1,i), 1) / DZNRM2(M,ZAU(1,i),1) - END DO - END IF - !...... ZGEDMD check point - - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by ZGEDMD with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZZ, LDZ, ZZERO, ZY1, LDY ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in ZGEDMD,) - - DO i=1, K - ! have a real eigenvalue with real eigenvector - CALL ZAXPY( M, -ZEIGS(i), ZZ(1,i), 1, ZY1(1,i), 1 ) - RES1(i) = DZNRM2( M, ZY1(1,i), 1) - END DO - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVX(K)/(ANORM*SINGVX(1)) ) - END DO - TMP_REZ = MAX( TMP_REZ, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) ':) .... OK ..........ZGEDMD PASSED.' - ELSE - NFAIL_REZ = NFAIL_REZ + 1 - WRITE(*,*) ':( ..................ZGEDMD FAILED!', & - 'Check the code for implementation errors.' - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - END IF - - - IF ( LSAME(JOBREF,'E') ) THEN - TMP = ZERO - DO i = 1, K - TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) - END DO - TMP_EX = MAX(TMP_EX,TMP) - END IF - - END IF - - DEALLOCATE(ZWORK) - DEALLOCATE(WORK) - DEALLOCATE(IWORK) - - IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN - - ZF(1:M,1:N+1) = ZF0(1:M,1:N+1) - - CALL ZGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & - WHTSVD, M, N+1, ZF, LDF, ZX, LDX, ZY, LDY, & - NRNK, TOL, K, ZEIGS, ZZ, LDZ, RES, ZAU, & - LDAU, ZW, LDW, ZS, LDS, ZDUMMY, -1, & - WDUMMY, -1, IDUMMY, -1, INFO ) - - LZWORK = INT(ZDUMMY(LWMINOPT)) - ALLOCATE( ZWORK(LZWORK) ) - LIWORK = IDUMMY(1) - ALLOCATE(IWORK(LIWORK)) - LWORK = INT(WDUMMY(1)) - ALLOCATE(WORK(LWORK)) - - CALL ZGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & - WHTSVD, M, N+1, ZF, LDF, ZX, LDX, ZY, LDY, & - NRNK, TOL, KQ, ZEIGS, ZZ, LDZ, RES, ZAU, & - LDAU, ZW, LDW, ZS, LDS, ZWORK, LZWORK, & - WORK, LWORK, IWORK, LIWORK, INFO ) - - IF ( INFO /= 0 ) THEN - WRITE(*,*) 'Call to ZGEDMDQ failed. & - &Check the calling sequence and the code.' - WRITE(*,*) 'The error code is ', INFO - WRITE(*,*) 'The input parameters were ',& - SCALE, JOBZ, RESIDS, WANTQ, WANTR, WHTSVD, & - M, N, LDX, LDY, NRNK, TOL - STOP - END IF - SINGVQX(1:N) = WORK(1:N) - - !..... ZGEDMDQ check point - - IF ( 1 == 0 ) THEN - ! Comparison of ZGEDMD and ZGEDMDQ singular values disabled - TMP = ZERO - DO i = 1, MIN(K, KQ) - TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & - SINGVX(1) ) - END DO - SVDIFF = MAX( SVDIFF, TMP ) - IF ( TMP > M*N*EPS ) THEN - WRITE(*,*) 'FAILED! Something was wrong with the run.' - NFAIL_SVDIFF = NFAIL_SVDIFF + 1 - DO j =1, 3 - write(*,*) j, SINGVX(j), SINGVQX(j) - read(*,*) - END DO - - END IF - END IF - - !..... ZGEDMDQ check point - IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN - ! Check that the QR factors are computed and returned - ! as requested. The residual ||F-Q*R||_F / ||F||_F - ! is compared to M*N*EPS. - ZF1(1:M,1:N+1) = ZF0(1:M,1:N+1) - CALL ZGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ZONE, ZF, & - LDF, ZY, LDY, ZONE, ZF1, LDF ) - TMP_FQR = ZLANGE( 'F', M, N+1, ZF1, LDF, WORK ) / & - ZLANGE( 'F', M, N+1, ZF0, LDF, WORK ) - IF ( TMP_FQR > TOL2 ) THEN - WRITE(*,*) 'FAILED! Something was wrong with the run.' - NFAIL_F_QR = NFAIL_F_QR + 1 - ELSE - !WRITE(*,*) '........ PASSED.' - END IF - END IF - - !..... ZGEDMDQ check point - IF ( LSAME(RESIDS, 'R') ) THEN - ! Compare the residuals returned by ZGEDMDQ with the - ! explicitly computed residuals using the matrix A. - ! Compute explicitly Y1 = A*Z - CALL ZGEMM( 'N', 'N', M, KQ, M, ZONE, ZA, LDA, ZZ, LDZ, ZZERO, ZY1, LDY ) - ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms - ! of the invariant subspaces that correspond to complex conjugate - ! pairs of eigencalues. (See the description of Z in ZGEDMDQ) - - DO i=1, KQ - ! have a real eigenvalue with real eigenvector - CALL ZAXPY( M, -ZEIGS(i), ZZ(1,i), 1, ZY1(1,i), 1 ) - ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) - RES1(i) = DZNRM2( M, ZY1(1,i), 1) - END DO - TMP = ZERO - DO i = 1, KQ - TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & - SINGVQX(KQ)/(ANORM*SINGVQX(1)) ) - END DO - TMP_REZQ = MAX( TMP_REZQ, TMP ) - IF ( TMP <= TOL2 ) THEN - !WRITE(*,*) '.... OK ........ ZGEDMDQ PASSED.' - ELSE - NFAIL_REZQ = NFAIL_REZQ + 1 - WRITE(*,*) '................ ZGEDMDQ FAILED!', & - 'Check the code for implementation errors.' - STOP - END IF - - END IF - - DEALLOCATE( ZWORK ) - DEALLOCATE( WORK ) - DEALLOCATE( IWORK ) - - END IF ! ZGEDMDQ - -!....................................................................................................... - - END DO ! LWMINOPT - !write(*,*) 'LWMINOPT loop completed' - END DO ! iWHTSVD - !write(*,*) 'WHTSVD loop completed' - END DO ! iNRNK -2:-1 - !write(*,*) 'NRNK loop completed' - END DO ! iSCALE 1:4 - !write(*,*) 'SCALE loop completed' - END DO - !write(*,*) 'JOBREF loop completed' - END DO ! iJOBZ - !write(*,*) 'JOBZ loop completed' - - END DO ! MODE -6:6 - !write(*,*) 'MODE loop completed' - END DO ! 1 or 2 trajectories - !write(*,*) 'trajectories loop completed' - - DEALLOCATE( ZA ) - DEALLOCATE( ZAC ) - DEALLOCATE( ZZ ) - DEALLOCATE( ZF ) - DEALLOCATE( ZF0 ) - DEALLOCATE( ZF1 ) - DEALLOCATE( ZX ) - DEALLOCATE( ZX0 ) - DEALLOCATE( ZY ) - DEALLOCATE( ZY0 ) - DEALLOCATE( ZY1 ) - DEALLOCATE( ZAU ) - DEALLOCATE( ZW ) - DEALLOCATE( ZS ) - DEALLOCATE( ZZ1 ) - DEALLOCATE( RES ) - DEALLOCATE( RES1 ) - DEALLOCATE( RESEX ) - DEALLOCATE( ZEIGS ) - DEALLOCATE( SINGVX ) - DEALLOCATE( SINGVQX ) - - END DO ! LLOOP - - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for ZGEDMD :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - IF ( NFAIL_Z_XV == 0 ) THEN - WRITE(*,*) '>>>> Z - U*V test PASSED.' - ELSE - WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' - WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV - END IF - IF ( NFAIL_AU == 0 ) THEN - WRITE(*,*) '>>>> A*U test PASSED. ' - ELSE - WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' - WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU - END IF - - IF ( NFAIL_REZ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ - END IF - - IF ( NFAIL_TOTAL == 0 ) THEN - WRITE(*,*) '>>>> ZGEDMD :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>>>>>>>>> ZGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - IF ( TEST_QRDMD ) THEN - WRITE(*,*) - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) ' Test summary for ZGEDMDQ :' - WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' - WRITE(*,*) - - IF ( NFAIL_SVDIFF == 0 ) THEN - WRITE(*,*) '>>>> ZGEDMD and ZGEDMDQ computed singular & - &values test PASSED.' - ELSE - WRITE(*,*) 'ZGEDMD and ZGEDMDQ discrepancies in & - &the singular values unacceptable ', & - NFAIL_SVDIFF, ' times. Test FAILED.' - WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF - END IF - - IF ( NFAIL_F_QR == 0 ) THEN - WRITE(*,*) '>>>> F - Q*R test PASSED.' - ELSE - WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' - WRITE(*,*) 'The largest relative residual was ', TMP_FQR - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR - END IF - - IF ( NFAIL_REZQ == 0 ) THEN - WRITE(*,*) '>>>> Rezidual computation test PASSED.' - ELSE - WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' - WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ - WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS - NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ - END IF - - IF ( NFAILQ_TOTAL == 0 ) THEN - WRITE(*,*) '>>>>>>> ZGEDMDQ :: ALL TESTS PASSED.' - ELSE - WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' - WRITE(*,*) '>>>>>>> ZGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' - END IF - - END IF - - WRITE(*,*) - WRITE(*,*) 'Test completed.' - STOP - END +! This is a test program for checking the implementations of +! the implementations of the following subroutines +! +! ZGEDMD, for computation of the +! Dynamic Mode Decomposition (DMD) +! ZGEDMDQ, for computation of a +! QR factorization based compressed DMD +! +! Developed and supported by: +! =========================== +! Developed and coded by Zlatko Drmac, Faculty of Science, +! University of Zagreb; drmac@math.hr +! In cooperation with +! AIMdyn Inc., Santa Barbara, CA. +! ======================================================== +! How to run the code (compiler, link info) +! ======================================================== +! Compile as FORTRAN 90 (or later) and link with BLAS and +! LAPACK libraries. +! NOTE: The code is developed and tested on top of the +! Intel MKL library (versions 2022.0.3 and 2022.2.0), +! using the Intel Fortran compiler. +! +! For developers of the C++ implementation +! ======================================================== +! See the LAPACK++ and Template Numerical Toolkit (TNT) +! +! Note on a development of the GPU HP implementation +! ======================================================== +! Work in progress. See CUDA, MAGMA, SLATE. +! NOTE: The four SVD subroutines used in this code are +! included as a part of R&D and for the completeness. +! This was also an opportunity to test those SVD codes. +! If the scaling option is used all four are essentially +! equally good. For implementations on HP platforms, +! one can use whichever SVD is available. +!............................................................ + +!............................................................ +!............................................................ +! + PROGRAM DMD_TEST + use iso_fortran_env, only: real64 + IMPLICIT NONE + integer, parameter :: WP = real64 + +!............................................................ + REAL(KIND=WP), PARAMETER :: ONE = 1.0_WP + REAL(KIND=WP), PARAMETER :: ZERO = 0.0_WP + + COMPLEX(KIND=WP), PARAMETER :: ZONE = ( 1.0_WP, 0.0_WP ) + COMPLEX(KIND=WP), PARAMETER :: ZZERO = ( 0.0_WP, 0.0_WP ) +!............................................................ + REAL(KIND=WP), ALLOCATABLE, DIMENSION(:) :: RES, & + RES1, RESEX, SINGVX, SINGVQX, WORK + INTEGER , ALLOCATABLE, DIMENSION(:) :: IWORK + REAL(KIND=WP) :: WDUMMY(2) + INTEGER :: IDUMMY(4), ISEED(4) + REAL(KIND=WP) :: ANORM, COND, CONDL, CONDR, EPS, & + TOL, TOL2, SVDIFF, TMP, TMP_AU, & + TMP_FQR, TMP_REZ, TMP_REZQ, TMP_ZXW, & + TMP_EX + +!............................................................ + COMPLEX(KIND=WP) :: ZMAX + INTEGER :: LZWORK + COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:,:) :: ZA, ZAC, & + ZAU, ZF, ZF0, ZF1, ZS, ZW, & + ZX, ZX0, ZY, ZY0, ZY1, ZZ, ZZ1 + COMPLEX(KIND=WP), ALLOCATABLE, DIMENSION(:) :: ZDA, ZDR, & + ZDL, ZEIGS, ZEIGSA, ZWORK + COMPLEX(KIND=WP) :: ZDUMMY(22), ZDUM2X2(2,2) +!............................................................ + INTEGER :: K, KQ, LDF, LDS, LDA, LDAU, LDW, LDX, LDY, & + LDZ, LIWORK, LWORK, M, N, LLOOP, NRNK, NRNKsp + INTEGER :: i, iJOBREF, iJOBZ, iSCALE, INFO, j, & + NFAIL, NFAIL_AU, NFAIL_F_QR, NFAIL_REZ, & + NFAIL_REZQ, NFAIL_SVDIFF, NFAIL_TOTAL, NFAILQ_TOTAL, & + NFAIL_Z_XV, MODE, MODEL, MODER, WHTSVD, & + WHTSVDsp + INTEGER :: iNRNK, iWHTSVD, K_TRAJ, LWMINOPT + CHARACTER :: GRADE, JOBREF, JOBZ, PIVTNG, RSIGN, & + SCALE, RESIDS, WANTQ, WANTR + LOGICAL :: TEST_QRDMD + +!.....external subroutines (BLAS and LAPACK) + EXTERNAL DAXPY, DGEEV, DGEMM, DGEMV, DLACPY, DLASCL + EXTERNAL ZGEEV, ZGEMV, ZLASCL + EXTERNAL ZLARNV, ZLATMR + EXTERNAL ZAXPY, ZGEMM +!.....external subroutines DMD package, part 1 +! subroutines under test + EXTERNAL ZGEDMD, ZGEDMDQ +!.....external functions (BLAS and LAPACK) + EXTERNAL DLAMCH, DZNRM2 + REAL(KIND=WP) :: DLAMCH, DZNRM2 + REAL(KIND=WP) :: ZLANGE + EXTERNAL IZAMAX + INTEGER IZAMAX + EXTERNAL LSAME + LOGICAL LSAME + + INTRINSIC ABS, INT, MIN, MAX, SIGN +!............................................................ + + ! The test is always in pairs : ( ZGEDMD and ZGEDMDQ ) + ! because the test includes comparing the results (in pairs). +!..................................................................................... + TEST_QRDMD = .TRUE. ! This code by default performs tests on ZGEDMDQ + ! Since the QR factorizations based algorithm is designed for + ! single trajectory data, only single trajectory tests will + ! be performed with xGEDMDQ. + WANTQ = 'Q' + WANTR = 'R' +!................................................................................. + + EPS = DLAMCH( 'P' ) ! machine precision DP + + ! Global counters of failures of some particular tests + NFAIL = 0 + NFAIL_REZ = 0 + NFAIL_REZQ = 0 + NFAIL_Z_XV = 0 + NFAIL_F_QR = 0 + NFAIL_AU = 0 + NFAIL_SVDIFF = 0 + NFAIL_TOTAL = 0 + NFAILQ_TOTAL = 0 + + DO LLOOP = 1, 4 + + WRITE(*,*) 'L Loop Index = ', LLOOP + + ! Set the dimensions of the problem ... + WRITE(*,*) 'M = ' + READ(*,*) M + WRITE(*,*) M + ! ... and the number of snapshots. + WRITE(*,*) 'N = ' + READ(*,*) N + WRITE(*,*) N + + ! ... Test the dimensions + IF ( ( MIN(M,N) == 0 ) .OR. ( M < N ) ) THEN + WRITE(*,*) 'Bad dimensions. Required: M >= N > 0.' + STOP + END IF +!............. + ! The seed inside the LLOOP so that each pass can be reproduced easily. + ISEED(1) = 4 + ISEED(2) = 3 + ISEED(3) = 2 + ISEED(4) = 1 + + LDA = M + LDF = M + LDX = M + LDY = M + LDW = N + LDZ = M + LDAU = M + LDS = N + + TMP_ZXW = ZERO + TMP_AU = ZERO + TMP_REZ = ZERO + TMP_REZQ = ZERO + SVDIFF = ZERO + TMP_EX = ZERO + + ALLOCATE( ZA(LDA,M) ) + ALLOCATE( ZAC(LDA,M) ) + ALLOCATE( ZF(LDF,N+1) ) + ALLOCATE( ZF0(LDF,N+1) ) + ALLOCATE( ZF1(LDF,N+1) ) + ALLOCATE( ZX(LDX,N) ) + ALLOCATE( ZX0(LDX,N) ) + ALLOCATE( ZY(LDY,N+1) ) + ALLOCATE( ZY0(LDY,N+1) ) + ALLOCATE( ZY1(LDY,N+1) ) + ALLOCATE( ZAU(LDAU,N) ) + ALLOCATE( ZW(LDW,N) ) + ALLOCATE( ZS(LDS,N) ) + ALLOCATE( ZZ(LDZ,N) ) + ALLOCATE( ZZ1(LDZ,N) ) + ALLOCATE( RES(N) ) + ALLOCATE( RES1(N) ) + ALLOCATE( RESEX(N) ) + ALLOCATE( ZEIGS(N) ) + ALLOCATE( SINGVX(N) ) + ALLOCATE( SINGVQX(N) ) + + TOL = M*EPS + ! This mimics O(M*N)*EPS bound for accumulated roundoff error. + ! The factor 10 is somewhat arbitrary. + TOL2 = 10*M*N*EPS + +!............. + + DO K_TRAJ = 1, 2 + ! Number of intial conditions in the simulation/trajectories (1 or 2) + + COND = 1.0D4 + ZMAX = (1.0D1,1.0D1) + RSIGN = 'F' + GRADE = 'N' + MODEL = 6 + CONDL = 1.0D1 + MODER = 6 + CONDR = 1.0D1 + PIVTNG = 'N' + + ! Loop over all parameter MODE values for ZLATMR (+1,..,+6) + DO MODE = 1, 6 + + ALLOCATE( IWORK(2*M) ) + ALLOCATE( ZDA(M) ) + ALLOCATE( ZDL(M) ) + ALLOCATE( ZDR(M) ) + + CALL ZLATMR( M, M, 'N', ISEED, 'N', ZDA, MODE, COND, & + ZMAX, RSIGN, GRADE, ZDL, MODEL, CONDL, & + ZDR, MODER, CONDR, PIVTNG, IWORK, M, M, & + ZERO, -ONE, 'N', ZA, LDA, IWORK(M+1), INFO ) + DEALLOCATE( ZDR ) + DEALLOCATE( ZDL ) + DEALLOCATE( ZDA ) + DEALLOCATE( IWORK ) + + LZWORK = MAX(1,2*M) + ALLOCATE( ZEIGSA(M) ) + ALLOCATE( ZWORK(LZWORK) ) + ALLOCATE( WORK(2*M) ) + ZAC(1:M,1:M) = ZA(1:M,1:M) + CALL ZGEEV( 'N','N', M, ZAC, LDA, ZEIGSA, ZDUM2X2, 2, & + ZDUM2X2, 2, ZWORK, LZWORK, WORK, INFO ) ! LAPACK CALL + DEALLOCATE(WORK) + DEALLOCATE(ZWORK) + + TMP = ABS(ZEIGSA(IZAMAX(M, ZEIGSA, 1))) ! The spectral radius of ZA + ! Scale the matrix ZA to have unit spectral radius. + CALL ZLASCL( 'G',0, 0, TMP, ONE, M, M, & + ZA, LDA, INFO ) + CALL ZLASCL( 'G',0, 0, TMP, ONE, M, 1, & + ZEIGSA, M, INFO ) + ANORM = ZLANGE( 'F', M, M, ZA, LDA, WDUMMY ) + + IF ( K_TRAJ == 2 ) THEN + ! generate data as two trajectories + ! with two inital conditions + CALL ZLARNV(2, ISEED, M, ZF(1,1) ) + DO i = 1, N/2 + CALL ZGEMV( 'N', M, M, ZONE, ZA, LDA, ZF(1,i), 1, & + ZZERO, ZF(1,i+1), 1 ) + END DO + ZX0(1:M,1:N/2) = ZF(1:M,1:N/2) + ZY0(1:M,1:N/2) = ZF(1:M,2:N/2+1) + + CALL ZLARNV(2, ISEED, M, ZF(1,1) ) + DO i = 1, N-N/2 + CALL ZGEMV( 'N', M, M, ZONE, ZA, LDA, ZF(1,i), 1, & + ZZERO, ZF(1,i+1), 1 ) + END DO + ZX0(1:M,N/2+1:N) = ZF(1:M,1:N-N/2) + ZY0(1:M,N/2+1:N) = ZF(1:M,2:N-N/2+1) + ELSE + CALL ZLARNV(2, ISEED, M, ZF(1,1) ) + DO i = 1, N + CALL ZGEMV( 'N', M, M, ZONE, ZA, M, ZF(1,i), 1, & + ZZERO, ZF(1,i+1), 1 ) + END DO + ZF0(1:M,1:N+1) = ZF(1:M,1:N+1) + ZX0(1:M,1:N) = ZF0(1:M,1:N) + ZY0(1:M,1:N) = ZF0(1:M,2:N+1) + END IF + + DEALLOCATE( ZEIGSA ) +!........................................................................ + + DO iJOBZ = 1, 4 + + SELECT CASE ( iJOBZ ) + CASE(1) + JOBZ = 'V' + RESIDS = 'R' + CASE(2) + JOBZ = 'V' + RESIDS = 'N' + CASE(3) + JOBZ = 'F' + RESIDS = 'N' + CASE(4) + JOBZ = 'N' + RESIDS = 'N' + END SELECT + + DO iJOBREF = 1, 3 + + SELECT CASE ( iJOBREF ) + CASE(1) + JOBREF = 'R' + CASE(2) + JOBREF = 'E' + CASE(3) + JOBREF = 'N' + END SELECT + + DO iSCALE = 1, 4 + + SELECT CASE ( iSCALE ) + CASE(1) + SCALE = 'S' + CASE(2) + SCALE = 'C' + CASE(3) + SCALE = 'Y' + CASE(4) + SCALE = 'N' + END SELECT + + DO iNRNK = -1, -2, -1 + NRNK = iNRNK + NRNKsp = iNRNK + + DO iWHTSVD = 1, 3 + ! Check all four options to compute the POD basis + ! via the SVD. + WHTSVD = iWHTSVD + WHTSVDsp = iWHTSVD + + DO LWMINOPT = 1, 2 + ! Workspace query for the minimal (1) and for the optimal + ! (2) workspace lengths determined by workspace query. + + ! ZGEDMD is always tested and its results are also used for + ! comparisons with ZGEDMDQ. + + ZX(1:M,1:N) = ZX0(1:M,1:N) + ZY(1:M,1:N) = ZY0(1:M,1:N) + + CALL ZGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, ZX, LDX, ZY, LDY, NRNK, TOL, & + K, ZEIGS, ZZ, LDZ, RES, ZAU, LDAU, & + ZW, LDW, ZS, LDS, ZDUMMY, -1, & + WDUMMY, -1, IDUMMY, -1, INFO ) + IF ( (INFO .EQ. 2) .OR. ( INFO .EQ. 3 ) & + .OR. ( INFO < 0 ) ) THEN + WRITE(*,*) 'Call to ZGEDMD workspace query failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ', & + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL, LDZ, LDAU, LDW, LDS + STOP + END IF + + LZWORK = INT(ZDUMMY(LWMINOPT)) + LWORK = INT(WDUMMY(1)) + LIWORK = IDUMMY(1) + + ALLOCATE(ZWORK(LZWORK)) + ALLOCATE( WORK(LWORK)) + ALLOCATE(IWORK(LIWORK)) + + CALL ZGEDMD( SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, ZX, LDX, ZY, LDY, NRNK, TOL, & + K, ZEIGS, ZZ, LDZ, RES, ZAU, LDAU, & + ZW, LDW, ZS, LDS, ZWORK, LZWORK, & + WORK, LWORK, IWORK, LIWORK, INFO ) + + IF ( INFO /= 0 ) THEN + WRITE(*,*) 'Call to ZGEDMD failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + STOP + END IF + + SINGVX(1:N) = WORK(1:N) + + !...... ZGEDMD check point + IF ( LSAME(JOBZ,'V') ) THEN + ! Check that Z = X*W, on return from ZGEDMD + ! This checks that the returned eigenvectors in Z are + ! the product of the SVD'POD basis returned in X + ! and the eigenvectors of the rayleigh quotient + ! returned in W + CALL ZGEMM( 'N', 'N', M, K, K, ZONE, ZX, LDX, ZW, LDW, & + ZZERO, ZZ1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL ZAXPY( M, -ZONE, ZZ(1,i), 1, ZZ1(1,i), 1) + TMP = MAX(TMP, DZNRM2( M, ZZ1(1,i), 1 ) ) + END DO + TMP_ZXW = MAX(TMP_ZXW, TMP ) + IF ( TMP_ZXW <= 10*M*EPS ) THEN + !WRITE(*,*) ' :) .... OK .........ZGEDMD PASSED.' + ELSE + NFAIL_Z_XV = NFAIL_Z_XV + 1 + WRITE(*,*) ':( .................ZGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + END IF + + + !...... ZGEDMD check point + IF ( LSAME(JOBREF,'R') ) THEN + ! The matrix A*U is returned for computing refined Ritz vectors. + ! Check that A*U is computed correctly using the formula + ! A*U = Y * V * inv(SIGMA). This depends on the + ! accuracy in the computed singular values and vectors of X. + ! See the paper for an error analysis. + ! Note that the left singular vectors of the input matrix X + ! are returned in the array X. + CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZX, LDX, & + ZZERO, ZZ1, LDZ ) + TMP = ZERO + DO i = 1, K + CALL ZAXPY( M, -ZONE, ZAU(1,i), 1, ZZ1(1,i), 1) + TMP = MAX( TMP, DZNRM2( M, ZZ1(1,i),1 ) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_AU = MAX( TMP_AU, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) ':) .... OK .........ZGEDMD PASSED.' + ELSE + NFAIL_AU = NFAIL_AU + 1 + WRITE(*,*) ':( .................ZGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + ELSEIF ( LSAME(JOBREF,'E') ) THEN + ! The unscaled vectors of the Exact DMD are computed. + ! This option is included for the sake of completeness, + ! for users who prefer the Exact DMD vectors. The + ! returned vectors are in the real form, in the same way + ! as the Ritz vectors. Here we just save the vectors + ! and test them separately using a Matlab script. + + + CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZAU, LDAU, ZZERO, ZY1, LDY ) + + DO i=1, K + ! have a real eigenvalue with real eigenvector + CALL ZAXPY( M, -ZEIGS(i), ZAU(1,i), 1, ZY1(1,i), 1 ) + RESEX(i) = DZNRM2( M, ZY1(1,i), 1) / DZNRM2(M,ZAU(1,i),1) + END DO + END IF + !...... ZGEDMD check point + + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by ZGEDMD with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL ZGEMM( 'N', 'N', M, K, M, ZONE, ZA, LDA, ZZ, LDZ, ZZERO, ZY1, LDY ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in ZGEDMD,) + + DO i=1, K + ! have a real eigenvalue with real eigenvector + CALL ZAXPY( M, -ZEIGS(i), ZZ(1,i), 1, ZY1(1,i), 1 ) + RES1(i) = DZNRM2( M, ZY1(1,i), 1) + END DO + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVX(K)/(ANORM*SINGVX(1)) ) + END DO + TMP_REZ = MAX( TMP_REZ, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) ':) .... OK ..........ZGEDMD PASSED.' + ELSE + NFAIL_REZ = NFAIL_REZ + 1 + WRITE(*,*) ':( ..................ZGEDMD FAILED!', & + 'Check the code for implementation errors.' + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, JOBREF, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + END IF + + + IF ( LSAME(JOBREF,'E') ) THEN + TMP = ZERO + DO i = 1, K + TMP = MAX( TMP, ABS(RES1(i) - RESEX(i))/(RES1(i)+RESEX(i)) ) + END DO + TMP_EX = MAX(TMP_EX,TMP) + END IF + + END IF + + DEALLOCATE(ZWORK) + DEALLOCATE(WORK) + DEALLOCATE(IWORK) + + IF ( TEST_QRDMD .AND. (K_TRAJ == 1) ) THEN + + ZF(1:M,1:N+1) = ZF0(1:M,1:N+1) + + CALL ZGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & + WHTSVD, M, N+1, ZF, LDF, ZX, LDX, ZY, LDY, & + NRNK, TOL, K, ZEIGS, ZZ, LDZ, RES, ZAU, & + LDAU, ZW, LDW, ZS, LDS, ZDUMMY, -1, & + WDUMMY, -1, IDUMMY, -1, INFO ) + + LZWORK = INT(ZDUMMY(LWMINOPT)) + ALLOCATE( ZWORK(LZWORK) ) + LIWORK = IDUMMY(1) + ALLOCATE(IWORK(LIWORK)) + LWORK = INT(WDUMMY(1)) + ALLOCATE(WORK(LWORK)) + + CALL ZGEDMDQ( SCALE, JOBZ, RESIDS, WANTQ, WANTR, JOBREF, & + WHTSVD, M, N+1, ZF, LDF, ZX, LDX, ZY, LDY, & + NRNK, TOL, KQ, ZEIGS, ZZ, LDZ, RES, ZAU, & + LDAU, ZW, LDW, ZS, LDS, ZWORK, LZWORK, & + WORK, LWORK, IWORK, LIWORK, INFO ) + + IF ( INFO /= 0 ) THEN + WRITE(*,*) 'Call to ZGEDMDQ failed. & + &Check the calling sequence and the code.' + WRITE(*,*) 'The error code is ', INFO + WRITE(*,*) 'The input parameters were ',& + SCALE, JOBZ, RESIDS, WANTQ, WANTR, WHTSVD, & + M, N, LDX, LDY, NRNK, TOL + STOP + END IF + SINGVQX(1:N) = WORK(1:N) + + !..... ZGEDMDQ check point + + IF ( 1 == 0 ) THEN + ! Comparison of ZGEDMD and ZGEDMDQ singular values disabled + TMP = ZERO + DO i = 1, MIN(K, KQ) + TMP = MAX(TMP, ABS(SINGVX(i)-SINGVQX(i)) / & + SINGVX(1) ) + END DO + SVDIFF = MAX( SVDIFF, TMP ) + IF ( TMP > M*N*EPS ) THEN + WRITE(*,*) 'FAILED! Something was wrong with the run.' + NFAIL_SVDIFF = NFAIL_SVDIFF + 1 + DO j =1, 3 + write(*,*) j, SINGVX(j), SINGVQX(j) + read(*,*) + END DO + + END IF + END IF + + !..... ZGEDMDQ check point + IF ( LSAME(WANTQ,'Q') .AND. LSAME(WANTR,'R') ) THEN + ! Check that the QR factors are computed and returned + ! as requested. The residual ||F-Q*R||_F / ||F||_F + ! is compared to M*N*EPS. + ZF1(1:M,1:N+1) = ZF0(1:M,1:N+1) + CALL ZGEMM( 'N', 'N', M, N+1, MIN(M,N+1), -ZONE, ZF, & + LDF, ZY, LDY, ZONE, ZF1, LDF ) + TMP_FQR = ZLANGE( 'F', M, N+1, ZF1, LDF, WORK ) / & + ZLANGE( 'F', M, N+1, ZF0, LDF, WORK ) + IF ( TMP_FQR > TOL2 ) THEN + WRITE(*,*) 'FAILED! Something was wrong with the run.' + NFAIL_F_QR = NFAIL_F_QR + 1 + ELSE + !WRITE(*,*) '........ PASSED.' + END IF + END IF + + !..... ZGEDMDQ check point + IF ( LSAME(RESIDS, 'R') ) THEN + ! Compare the residuals returned by ZGEDMDQ with the + ! explicitly computed residuals using the matrix A. + ! Compute explicitly Y1 = A*Z + CALL ZGEMM( 'N', 'N', M, KQ, M, ZONE, ZA, LDA, ZZ, LDZ, ZZERO, ZY1, LDY ) + ! ... and then A*Z(:,i) - LAMBDA(i)*Z(:,i), using the real forms + ! of the invariant subspaces that correspond to complex conjugate + ! pairs of eigencalues. (See the description of Z in ZGEDMDQ) + + DO i=1, KQ + ! have a real eigenvalue with real eigenvector + CALL ZAXPY( M, -ZEIGS(i), ZZ(1,i), 1, ZY1(1,i), 1 ) + ! Y(1:M,i) = Y(1:M,i) - REIG(i)*Z(1:M,i) + RES1(i) = DZNRM2( M, ZY1(1,i), 1) + END DO + TMP = ZERO + DO i = 1, KQ + TMP = MAX( TMP, ABS(RES(i) - RES1(i)) * & + SINGVQX(KQ)/(ANORM*SINGVQX(1)) ) + END DO + TMP_REZQ = MAX( TMP_REZQ, TMP ) + IF ( TMP <= TOL2 ) THEN + !WRITE(*,*) '.... OK ........ ZGEDMDQ PASSED.' + ELSE + NFAIL_REZQ = NFAIL_REZQ + 1 + WRITE(*,*) '................ ZGEDMDQ FAILED!', & + 'Check the code for implementation errors.' + STOP + END IF + + END IF + + DEALLOCATE( ZWORK ) + DEALLOCATE( WORK ) + DEALLOCATE( IWORK ) + + END IF ! ZGEDMDQ + +!....................................................................................................... + + END DO ! LWMINOPT + !write(*,*) 'LWMINOPT loop completed' + END DO ! iWHTSVD + !write(*,*) 'WHTSVD loop completed' + END DO ! iNRNK -2:-1 + !write(*,*) 'NRNK loop completed' + END DO ! iSCALE 1:4 + !write(*,*) 'SCALE loop completed' + END DO + !write(*,*) 'JOBREF loop completed' + END DO ! iJOBZ + !write(*,*) 'JOBZ loop completed' + + END DO ! MODE -6:6 + !write(*,*) 'MODE loop completed' + END DO ! 1 or 2 trajectories + !write(*,*) 'trajectories loop completed' + + DEALLOCATE( ZA ) + DEALLOCATE( ZAC ) + DEALLOCATE( ZZ ) + DEALLOCATE( ZF ) + DEALLOCATE( ZF0 ) + DEALLOCATE( ZF1 ) + DEALLOCATE( ZX ) + DEALLOCATE( ZX0 ) + DEALLOCATE( ZY ) + DEALLOCATE( ZY0 ) + DEALLOCATE( ZY1 ) + DEALLOCATE( ZAU ) + DEALLOCATE( ZW ) + DEALLOCATE( ZS ) + DEALLOCATE( ZZ1 ) + DEALLOCATE( RES ) + DEALLOCATE( RES1 ) + DEALLOCATE( RESEX ) + DEALLOCATE( ZEIGS ) + DEALLOCATE( SINGVX ) + DEALLOCATE( SINGVQX ) + + END DO ! LLOOP + + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for ZGEDMD :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + IF ( NFAIL_Z_XV == 0 ) THEN + WRITE(*,*) '>>>> Z - U*V test PASSED.' + ELSE + WRITE(*,*) 'Z - U*V test FAILED ', NFAIL_Z_XV, ' time(s)' + WRITE(*,*) 'Max error ||Z-U*V||_F was ', TMP_ZXW + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_Z_XV + END IF + IF ( NFAIL_AU == 0 ) THEN + WRITE(*,*) '>>>> A*U test PASSED. ' + ELSE + WRITE(*,*) 'A*U test FAILED ', NFAIL_AU, ' time(s)' + WRITE(*,*) 'Max A*U test adjusted error measure was ', TMP_AU + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_AU + END IF + + IF ( NFAIL_REZ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAIL_TOTAL = NFAIL_TOTAL + NFAIL_REZ + END IF + + IF ( NFAIL_TOTAL == 0 ) THEN + WRITE(*,*) '>>>> ZGEDMD :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAIL_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>>>>>>>>> ZGEDMD :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + IF ( TEST_QRDMD ) THEN + WRITE(*,*) + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) ' Test summary for ZGEDMDQ :' + WRITE(*,*) '>>>>>>>>>>>>>>>>>>>>>>>>>>' + WRITE(*,*) + + IF ( NFAIL_SVDIFF == 0 ) THEN + WRITE(*,*) '>>>> ZGEDMD and ZGEDMDQ computed singular & + &values test PASSED.' + ELSE + WRITE(*,*) 'ZGEDMD and ZGEDMDQ discrepancies in & + &the singular values unacceptable ', & + NFAIL_SVDIFF, ' times. Test FAILED.' + WRITE(*,*) 'The maximal discrepancy in the singular values (relative to the norm) was ', SVDIFF + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_SVDIFF + END IF + + IF ( NFAIL_F_QR == 0 ) THEN + WRITE(*,*) '>>>> F - Q*R test PASSED.' + ELSE + WRITE(*,*) 'F - Q*R test FAILED ', NFAIL_F_QR, ' time(s)' + WRITE(*,*) 'The largest relative residual was ', TMP_FQR + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_F_QR + END IF + + IF ( NFAIL_REZQ == 0 ) THEN + WRITE(*,*) '>>>> Rezidual computation test PASSED.' + ELSE + WRITE(*,*) 'Rezidual computation test FAILED ', NFAIL_REZQ, 'time(s)' + WRITE(*,*) 'Max residual computing test adjusted error measure was ', TMP_REZQ + WRITE(*,*) 'It should be up to O(M*N) times EPS, EPS = ', EPS + NFAILQ_TOTAL = NFAILQ_TOTAL + NFAIL_REZQ + END IF + + IF ( NFAILQ_TOTAL == 0 ) THEN + WRITE(*,*) '>>>>>>> ZGEDMDQ :: ALL TESTS PASSED.' + ELSE + WRITE(*,*) NFAILQ_TOTAL, 'FAILURES!' + WRITE(*,*) '>>>>>>> ZGEDMDQ :: TESTS FAILED. CHECK THE IMPLEMENTATION.' + END IF + + END IF + + WRITE(*,*) + WRITE(*,*) 'Test completed.' + STOP + END From aa41ed6b5eddbc0f0003f92809a19edec8eda64c Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Tue, 16 Jan 2024 22:01:41 -0600 Subject: [PATCH 031/206] Fix ZWORK parameter name SRC/cgedmdq.f90:548: warning: argument 'lzwork' from the argument list of cgedmdq has multiple @param documentation sections SRC/zgedmdq.f90:546: warning: argument 'lzwork' from the argument list of zgedmdq has multiple @param documentation sections --- SRC/cgedmdq.f90 | 2 +- SRC/zgedmdq.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index b4eebee5dc..dd70a34a9e 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -433,7 +433,7 @@ !> The leading dimension of the array S. !> \endverbatim !..... -!> \param[out] LZWORK +!> \param[out] ZWORK !> \verbatim !> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array !> On exit, diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index 606c5666e7..ddea5c8375 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -432,7 +432,7 @@ !> The leading dimension of the array S. !> \endverbatim !..... -!> \param[out] LZWORK +!> \param[out] ZWORK !> \verbatim !> ZWORK (workspace/output) COMPLEX(KIND=WP) LWORK-by-1 array !> On exit, From 6597d4803b99be03cea40f38f376230efd7c029a Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Tue, 16 Jan 2024 22:16:55 -0600 Subject: [PATCH 032/206] Fix mismatched verbatim/endverbatim commands SRC/zgedmd.f90:213: warning: reached end of comment while inside a \verbatim block; check for missing \endverbatim tag! SRC/zgedmdq.f90:710: warning: unexpected command endverbatim --- SRC/zgedmd.f90 | 5 ++++- SRC/zgedmdq.f90 | 1 + 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index 385b82061f..a2af6e04b9 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -199,7 +199,7 @@ !> (the number of columns of X and Y). !> \endverbatim !..... -!> \param[in] LDX +!> \param[in,out] X !> \verbatim !> X (input/output) COMPLEX(KIND=WP) M-by-N array !> > On entry, X contains the data snapshot matrix X. It is @@ -210,7 +210,10 @@ !> data matrix X, U(:,1:K). All N columns of X contain all !> left singular vectors of the input matrix X. !> See the descriptions of K, Z and W. +!> \endverbatim !..... +!> \param[in] LDX +!> \verbatim !> LDX (input) INTEGER, LDX >= M !> The leading dimension of the array X. !> \endverbatim diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index ddea5c8375..c16288d0fa 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -196,6 +196,7 @@ !> \endverbatim !..... !> \param[in] WHTSVD +!> \verbatim !> WHTSVD (input) INTEGER, WHSTVD in { 1, 2, 3, 4 } !> Allows for a selection of the SVD algorithm from the !> LAPACK library. From dead4e4dfd63593c8720479c007fe01143e23478 Mon Sep 17 00:00:00 2001 From: Kyle Guinn Date: Tue, 16 Jan 2024 22:26:15 -0600 Subject: [PATCH 033/206] Fix missing DONE parameter name SRC/slaqp3rk.f:585: warning: unexpected command endverbatim SRC/dlaqp3rk.f:585: warning: unexpected command endverbatim SRC/claqp3rk.f:579: warning: unexpected command endverbatim SRC/zlaqp3rk.f:579: warning: unexpected command endverbatim --- SRC/claqp3rk.f | 2 +- SRC/dlaqp3rk.f | 2 +- SRC/slaqp3rk.f | 2 +- SRC/zlaqp3rk.f | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/SRC/claqp3rk.f b/SRC/claqp3rk.f index 8fe5a220ff..a381c53f88 100644 --- a/SRC/claqp3rk.f +++ b/SRC/claqp3rk.f @@ -217,7 +217,7 @@ *> The leading dimension of the array A. LDA >= max(1,M). *> \endverbatim *> -*> \param[out] +*> \param[out] DONE *> \verbatim *> DONE is LOGICAL *> TRUE: a) if the factorization completed before processing diff --git a/SRC/dlaqp3rk.f b/SRC/dlaqp3rk.f index 8139345ed7..73926ebd37 100644 --- a/SRC/dlaqp3rk.f +++ b/SRC/dlaqp3rk.f @@ -223,7 +223,7 @@ *> The leading dimension of the array A. LDA >= max(1,M). *> \endverbatim *> -*> \param[out] +*> \param[out] DONE *> \verbatim *> DONE is LOGICAL *> TRUE: a) if the factorization completed before processing diff --git a/SRC/slaqp3rk.f b/SRC/slaqp3rk.f index b2dc2b334c..08b8bfcbdd 100644 --- a/SRC/slaqp3rk.f +++ b/SRC/slaqp3rk.f @@ -223,7 +223,7 @@ *> The leading dimension of the array A. LDA >= max(1,M). *> \endverbatim *> -*> \param[out] +*> \param[out] DONE *> \verbatim *> DONE is LOGICAL *> TRUE: a) if the factorization completed before processing diff --git a/SRC/zlaqp3rk.f b/SRC/zlaqp3rk.f index 0dd8bf8e35..28bc517c3c 100644 --- a/SRC/zlaqp3rk.f +++ b/SRC/zlaqp3rk.f @@ -217,7 +217,7 @@ *> The leading dimension of the array A. LDA >= max(1,M). *> \endverbatim *> -*> \param[out] +*> \param[out] DONE *> \verbatim *> DONE is LOGICAL *> TRUE: a) if the factorization completed before processing From 827cb8e8eb827071fbf55d2867cbf669b15065b3 Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Wed, 17 Jan 2024 18:37:35 +0100 Subject: [PATCH 034/206] {C,Z}LARFGP: re-scale input vector more often Re-scale the input vector even if `X` is negligibly small in norm if the imaginary part of `ALPHA` is nonzero. For otherwise `XNORM` will not be computed with a small _relative_ error. fixes #980 --- SRC/clarfgp.f | 30 ++++++++++-------------------- SRC/zlarfgp.f | 30 ++++++++++-------------------- 2 files changed, 20 insertions(+), 40 deletions(-) diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f index 47b5e47b07..980e936122 100644 --- a/SRC/clarfgp.f +++ b/SRC/clarfgp.f @@ -148,33 +148,23 @@ SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU ) ALPHR = REAL( ALPHA ) ALPHI = AIMAG( ALPHA ) * - IF( XNORM.LE.EPS*ABS(ALPHA) ) THEN + IF( XNORM.LE.EPS*ABS(ALPHA) .AND. ALPHI.EQ.ZERO ) THEN * * H = [1-alpha/abs(alpha) 0; 0 I], sign chosen so ALPHA >= 0. * - IF( ALPHI.EQ.ZERO ) THEN - IF( ALPHR.GE.ZERO ) THEN -* When TAU.eq.ZERO, the vector is special-cased to be -* all zeros in the application routines. We do not need -* to clear it. - TAU = ZERO - ELSE -* However, the application routines rely on explicit -* zero checks when TAU.ne.ZERO, and we must clear X. - TAU = TWO - DO J = 1, N-1 - X( 1 + (J-1)*INCX ) = ZERO - END DO - ALPHA = -ALPHA - END IF + IF( ALPHR.GE.ZERO ) THEN +* When TAU.eq.ZERO, the vector is special-cased to be +* all zeros in the application routines. We do not need +* to clear it. + TAU = ZERO ELSE -* Only "reflecting" the diagonal entry to be real and non-negative. - XNORM = SLAPY2( ALPHR, ALPHI ) - TAU = CMPLX( ONE - ALPHR / XNORM, -ALPHI / XNORM ) +* However, the application routines rely on explicit +* zero checks when TAU.ne.ZERO, and we must clear X. + TAU = TWO DO J = 1, N-1 X( 1 + (J-1)*INCX ) = ZERO END DO - ALPHA = XNORM + ALPHA = -ALPHA END IF ELSE * diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f index 6c9efb04c6..d54f2ea5df 100644 --- a/SRC/zlarfgp.f +++ b/SRC/zlarfgp.f @@ -148,33 +148,23 @@ SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU ) ALPHR = DBLE( ALPHA ) ALPHI = DIMAG( ALPHA ) * - IF( XNORM.LE.EPS*ABS(ALPHA) ) THEN + IF( XNORM.LE.EPS*ABS(ALPHA) .AND. ALPHI.EQ.ZERO ) THEN * * H = [1-alpha/abs(alpha) 0; 0 I], sign chosen so ALPHA >= 0. * - IF( ALPHI.EQ.ZERO ) THEN - IF( ALPHR.GE.ZERO ) THEN -* When TAU.eq.ZERO, the vector is special-cased to be -* all zeros in the application routines. We do not need -* to clear it. - TAU = ZERO - ELSE -* However, the application routines rely on explicit -* zero checks when TAU.ne.ZERO, and we must clear X. - TAU = TWO - DO J = 1, N-1 - X( 1 + (J-1)*INCX ) = ZERO - END DO - ALPHA = -ALPHA - END IF + IF( ALPHR.GE.ZERO ) THEN +* When TAU.eq.ZERO, the vector is special-cased to be +* all zeros in the application routines. We do not need +* to clear it. + TAU = ZERO ELSE -* Only "reflecting" the diagonal entry to be real and non-negative. - XNORM = DLAPY2( ALPHR, ALPHI ) - TAU = DCMPLX( ONE - ALPHR / XNORM, -ALPHI / XNORM ) +* However, the application routines rely on explicit +* zero checks when TAU.ne.ZERO, and we must clear X. + TAU = TWO DO J = 1, N-1 X( 1 + (J-1)*INCX ) = ZERO END DO - ALPHA = XNORM + ALPHA = -ALPHA END IF ELSE * From cc90d869b03ed88ee76c559da34bb46ce570a594 Mon Sep 17 00:00:00 2001 From: FrK5E Date: Thu, 25 Jan 2024 22:09:22 +0100 Subject: [PATCH 035/206] Typo --- lapack_testing.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack_testing.py b/lapack_testing.py index 96fbeb2a68..dc3c471b56 100755 --- a/lapack_testing.py +++ b/lapack_testing.py @@ -38,7 +38,7 @@ 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(" SELECTION OF TESTS:") print(" - p [s/c/d/z/x] is to indicate the PRECISION to run:") print(" s=single") print(" d=double") From 741a2c2ee078638bb642d9283159586ee17f4ab6 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Thu, 29 Jun 2023 15:14:24 -0700 Subject: [PATCH 036/206] Add extended API with _64 suffix to LAPACKE --- LAPACKE/CMakeLists.txt | 25 +- LAPACKE/include/lapack.h | 2676 +++---- LAPACKE/include/lapacke.h | 15 + LAPACKE/include/lapacke_64.h | 12863 +++++++++++++++++++++++++++++++++ 4 files changed, 14247 insertions(+), 1332 deletions(-) create mode 100644 LAPACKE/include/lapacke_64.h diff --git a/LAPACKE/CMakeLists.txt b/LAPACKE/CMakeLists.txt index 1c56c0dcb5..7923f47dc2 100644 --- a/LAPACKE/CMakeLists.txt +++ b/LAPACKE/CMakeLists.txt @@ -67,12 +67,35 @@ if(LAPACKE_WITH_TMG) endif() list(APPEND SOURCES ${UTILS}) -add_library(${LAPACKELIB} ${SOURCES}) +add_library(${LAPACKELIB}_obj OBJECT ${SOURCES}) +set_target_properties(${LAPACKELIB}_obj PROPERTIES POSITION_INDEPENDENT_CODE ON) + +if(BUILD_INDEX64_EXT_API) + # 64bit Integer Extended Interface + set(SOURCES_64_C) + list(APPEND SOURCES_64_C ${SOURCES}) + list(REMOVE_ITEM SOURCES_64_C src/lapacke_nancheck.c) + list(REMOVE_ITEM SOURCES_64_C utils/lapacke_make_complex_float.c) + list(REMOVE_ITEM SOURCES_64_C utils/lapacke_make_complex_double.c) + add_library(${LAPACKELIB}_64_obj OBJECT ${SOURCES_64_C}) + set_target_properties(${LAPACKELIB}_64_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON) + target_compile_options(${LAPACKELIB}_64_obj PRIVATE + -DLAPACK_ILP64 + -DLAPACKE_API64 + -DWeirdNEC + -DCBLAS_API64) +endif() + +add_library(${LAPACKELIB} $ + $<$: $>) + set_target_properties( ${LAPACKELIB} PROPERTIES LINKER_LANGUAGE C VERSION ${LAPACK_VERSION} SOVERSION ${LAPACK_MAJOR_VERSION} + POSITION_INDEPENDENT_CODE ON ) target_include_directories(${LAPACKELIB} PUBLIC $ diff --git a/LAPACKE/include/lapack.h b/LAPACKE/include/lapack.h index a061a0b621..03e23d9e27 100644 --- a/LAPACKE/include/lapack.h +++ b/LAPACKE/include/lapack.h @@ -143,11 +143,25 @@ lapack_logical LAPACK_lsame_base( const char* ca, const char* cb, #define LAPACK_lsame(...) LAPACK_lsame_base(__VA_ARGS__) #endif +/* + * Integer specific API + */ +#ifdef LAPACKE_API64 +#ifndef API_SUFFIX +#define API_SUFFIX(a) a##_64 +#endif +#define LAPACK_GLOBAL_SUFFIX(a,b) LAPACK_GLOBAL_SUFFIX_(API_SUFFIX(a),API_SUFFIX(b)) +#define LAPACK_GLOBAL_SUFFIX_(a,b) LAPACK_GLOBAL(a,b) +#else +#define LAPACK_GLOBAL_SUFFIX(a,b) LAPACK_GLOBAL(a,b) +#endif + + /*----------------------------------------------------------------------------*/ /* This is in alphabetical order (ignoring leading precision). */ -#define LAPACK_cbbcsd_base LAPACK_GLOBAL(cbbcsd,CBBCSD) +#define LAPACK_cbbcsd_base LAPACK_GLOBAL_SUFFIX(cbbcsd,CBBCSD) void LAPACK_cbbcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -177,7 +191,7 @@ void LAPACK_cbbcsd_base( #define LAPACK_cbbcsd(...) LAPACK_cbbcsd_base(__VA_ARGS__) #endif -#define LAPACK_dbbcsd_base LAPACK_GLOBAL(dbbcsd,DBBCSD) +#define LAPACK_dbbcsd_base LAPACK_GLOBAL_SUFFIX(dbbcsd,DBBCSD) void LAPACK_dbbcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -207,7 +221,7 @@ void LAPACK_dbbcsd_base( #define LAPACK_dbbcsd(...) LAPACK_dbbcsd_base(__VA_ARGS__) #endif -#define LAPACK_sbbcsd_base LAPACK_GLOBAL(sbbcsd,SBBCSD) +#define LAPACK_sbbcsd_base LAPACK_GLOBAL_SUFFIX(sbbcsd,SBBCSD) void LAPACK_sbbcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -237,7 +251,7 @@ void LAPACK_sbbcsd_base( #define LAPACK_sbbcsd(...) LAPACK_sbbcsd_base(__VA_ARGS__) #endif -#define LAPACK_zbbcsd_base LAPACK_GLOBAL(zbbcsd,ZBBCSD) +#define LAPACK_zbbcsd_base LAPACK_GLOBAL_SUFFIX(zbbcsd,ZBBCSD) void LAPACK_zbbcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -267,7 +281,7 @@ void LAPACK_zbbcsd_base( #define LAPACK_zbbcsd(...) LAPACK_zbbcsd_base(__VA_ARGS__) #endif -#define LAPACK_dbdsdc_base LAPACK_GLOBAL(dbdsdc,DBDSDC) +#define LAPACK_dbdsdc_base LAPACK_GLOBAL_SUFFIX(dbdsdc,DBDSDC) void LAPACK_dbdsdc_base( char const* uplo, char const* compq, lapack_int const* n, @@ -289,7 +303,7 @@ void LAPACK_dbdsdc_base( #define LAPACK_dbdsdc(...) LAPACK_dbdsdc_base(__VA_ARGS__) #endif -#define LAPACK_sbdsdc_base LAPACK_GLOBAL(sbdsdc,SBDSDC) +#define LAPACK_sbdsdc_base LAPACK_GLOBAL_SUFFIX(sbdsdc,SBDSDC) void LAPACK_sbdsdc_base( char const* uplo, char const* compq, lapack_int const* n, @@ -311,7 +325,7 @@ void LAPACK_sbdsdc_base( #define LAPACK_sbdsdc(...) LAPACK_sbdsdc_base(__VA_ARGS__) #endif -#define LAPACK_cbdsqr_base LAPACK_GLOBAL(cbdsqr,CBDSQR) +#define LAPACK_cbdsqr_base LAPACK_GLOBAL_SUFFIX(cbdsqr,CBDSQR) void LAPACK_cbdsqr_base( char const* uplo, lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, @@ -332,7 +346,7 @@ void LAPACK_cbdsqr_base( #define LAPACK_cbdsqr(...) LAPACK_cbdsqr_base(__VA_ARGS__) #endif -#define LAPACK_dbdsqr_base LAPACK_GLOBAL(dbdsqr,DBDSQR) +#define LAPACK_dbdsqr_base LAPACK_GLOBAL_SUFFIX(dbdsqr,DBDSQR) void LAPACK_dbdsqr_base( char const* uplo, lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, @@ -353,7 +367,7 @@ void LAPACK_dbdsqr_base( #define LAPACK_dbdsqr(...) LAPACK_dbdsqr_base(__VA_ARGS__) #endif -#define LAPACK_sbdsqr_base LAPACK_GLOBAL(sbdsqr,SBDSQR) +#define LAPACK_sbdsqr_base LAPACK_GLOBAL_SUFFIX(sbdsqr,SBDSQR) void LAPACK_sbdsqr_base( char const* uplo, lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, @@ -374,7 +388,7 @@ void LAPACK_sbdsqr_base( #define LAPACK_sbdsqr(...) LAPACK_sbdsqr_base(__VA_ARGS__) #endif -#define LAPACK_zbdsqr_base LAPACK_GLOBAL(zbdsqr,ZBDSQR) +#define LAPACK_zbdsqr_base LAPACK_GLOBAL_SUFFIX(zbdsqr,ZBDSQR) void LAPACK_zbdsqr_base( char const* uplo, lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, @@ -395,7 +409,7 @@ void LAPACK_zbdsqr_base( #define LAPACK_zbdsqr(...) LAPACK_zbdsqr_base(__VA_ARGS__) #endif -#define LAPACK_dbdsvdx_base LAPACK_GLOBAL(dbdsvdx,DBDSVDX) +#define LAPACK_dbdsvdx_base LAPACK_GLOBAL_SUFFIX(dbdsvdx,DBDSVDX) void LAPACK_dbdsvdx_base( char const* uplo, char const* jobz, char const* range, lapack_int const* n, @@ -418,7 +432,7 @@ void LAPACK_dbdsvdx_base( #define LAPACK_dbdsvdx(...) LAPACK_dbdsvdx_base(__VA_ARGS__) #endif -#define LAPACK_sbdsvdx_base LAPACK_GLOBAL(sbdsvdx,SBDSVDX) +#define LAPACK_sbdsvdx_base LAPACK_GLOBAL_SUFFIX(sbdsvdx,SBDSVDX) void LAPACK_sbdsvdx_base( char const* uplo, char const* jobz, char const* range, lapack_int const* n, @@ -441,7 +455,7 @@ void LAPACK_sbdsvdx_base( #define LAPACK_sbdsvdx(...) LAPACK_sbdsvdx_base(__VA_ARGS__) #endif -#define LAPACK_ddisna_base LAPACK_GLOBAL(ddisna,DDISNA) +#define LAPACK_ddisna_base LAPACK_GLOBAL_SUFFIX(ddisna,DDISNA) void LAPACK_ddisna_base( char const* job, lapack_int const* m, lapack_int const* n, @@ -458,7 +472,7 @@ void LAPACK_ddisna_base( #define LAPACK_ddisna(...) LAPACK_ddisna_base(__VA_ARGS__) #endif -#define LAPACK_sdisna_base LAPACK_GLOBAL(sdisna,SDISNA) +#define LAPACK_sdisna_base LAPACK_GLOBAL_SUFFIX(sdisna,SDISNA) void LAPACK_sdisna_base( char const* job, lapack_int const* m, lapack_int const* n, @@ -475,7 +489,7 @@ void LAPACK_sdisna_base( #define LAPACK_sdisna(...) LAPACK_sdisna_base(__VA_ARGS__) #endif -#define LAPACK_cgbbrd_base LAPACK_GLOBAL(cgbbrd,CGBBRD) +#define LAPACK_cgbbrd_base LAPACK_GLOBAL_SUFFIX(cgbbrd,CGBBRD) void LAPACK_cgbbrd_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, @@ -498,7 +512,7 @@ void LAPACK_cgbbrd_base( #define LAPACK_cgbbrd(...) LAPACK_cgbbrd_base(__VA_ARGS__) #endif -#define LAPACK_dgbbrd_base LAPACK_GLOBAL(dgbbrd,DGBBRD) +#define LAPACK_dgbbrd_base LAPACK_GLOBAL_SUFFIX(dgbbrd,DGBBRD) void LAPACK_dgbbrd_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, @@ -520,7 +534,7 @@ void LAPACK_dgbbrd_base( #define LAPACK_dgbbrd(...) LAPACK_dgbbrd_base(__VA_ARGS__) #endif -#define LAPACK_sgbbrd_base LAPACK_GLOBAL(sgbbrd,SGBBRD) +#define LAPACK_sgbbrd_base LAPACK_GLOBAL_SUFFIX(sgbbrd,SGBBRD) void LAPACK_sgbbrd_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, @@ -542,7 +556,7 @@ void LAPACK_sgbbrd_base( #define LAPACK_sgbbrd(...) LAPACK_sgbbrd_base(__VA_ARGS__) #endif -#define LAPACK_zgbbrd_base LAPACK_GLOBAL(zgbbrd,ZGBBRD) +#define LAPACK_zgbbrd_base LAPACK_GLOBAL_SUFFIX(zgbbrd,ZGBBRD) void LAPACK_zgbbrd_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, @@ -565,7 +579,7 @@ void LAPACK_zgbbrd_base( #define LAPACK_zgbbrd(...) LAPACK_zgbbrd_base(__VA_ARGS__) #endif -#define LAPACK_cgbcon_base LAPACK_GLOBAL(cgbcon,CGBCON) +#define LAPACK_cgbcon_base LAPACK_GLOBAL_SUFFIX(cgbcon,CGBCON) void LAPACK_cgbcon_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -585,7 +599,7 @@ void LAPACK_cgbcon_base( #define LAPACK_cgbcon(...) LAPACK_cgbcon_base(__VA_ARGS__) #endif -#define LAPACK_dgbcon_base LAPACK_GLOBAL(dgbcon,DGBCON) +#define LAPACK_dgbcon_base LAPACK_GLOBAL_SUFFIX(dgbcon,DGBCON) void LAPACK_dgbcon_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -605,7 +619,7 @@ void LAPACK_dgbcon_base( #define LAPACK_dgbcon(...) LAPACK_dgbcon_base(__VA_ARGS__) #endif -#define LAPACK_sgbcon_base LAPACK_GLOBAL(sgbcon,SGBCON) +#define LAPACK_sgbcon_base LAPACK_GLOBAL_SUFFIX(sgbcon,SGBCON) void LAPACK_sgbcon_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -625,7 +639,7 @@ void LAPACK_sgbcon_base( #define LAPACK_sgbcon(...) LAPACK_sgbcon_base(__VA_ARGS__) #endif -#define LAPACK_zgbcon_base LAPACK_GLOBAL(zgbcon,ZGBCON) +#define LAPACK_zgbcon_base LAPACK_GLOBAL_SUFFIX(zgbcon,ZGBCON) void LAPACK_zgbcon_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -645,7 +659,7 @@ void LAPACK_zgbcon_base( #define LAPACK_zgbcon(...) LAPACK_zgbcon_base(__VA_ARGS__) #endif -#define LAPACK_cgbequ LAPACK_GLOBAL(cgbequ,CGBEQU) +#define LAPACK_cgbequ LAPACK_GLOBAL_SUFFIX(cgbequ,CGBEQU) void LAPACK_cgbequ( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_float const* AB, lapack_int const* ldab, @@ -656,7 +670,7 @@ void LAPACK_cgbequ( float* amax, lapack_int* info ); -#define LAPACK_dgbequ LAPACK_GLOBAL(dgbequ,DGBEQU) +#define LAPACK_dgbequ LAPACK_GLOBAL_SUFFIX(dgbequ,DGBEQU) void LAPACK_dgbequ( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, double const* AB, lapack_int const* ldab, @@ -667,7 +681,7 @@ void LAPACK_dgbequ( double* amax, lapack_int* info ); -#define LAPACK_sgbequ LAPACK_GLOBAL(sgbequ,SGBEQU) +#define LAPACK_sgbequ LAPACK_GLOBAL_SUFFIX(sgbequ,SGBEQU) void LAPACK_sgbequ( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, float const* AB, lapack_int const* ldab, @@ -678,7 +692,7 @@ void LAPACK_sgbequ( float* amax, lapack_int* info ); -#define LAPACK_zgbequ LAPACK_GLOBAL(zgbequ,ZGBEQU) +#define LAPACK_zgbequ LAPACK_GLOBAL_SUFFIX(zgbequ,ZGBEQU) void LAPACK_zgbequ( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_double const* AB, lapack_int const* ldab, @@ -689,7 +703,7 @@ void LAPACK_zgbequ( double* amax, lapack_int* info ); -#define LAPACK_cgbequb LAPACK_GLOBAL(cgbequb,CGBEQUB) +#define LAPACK_cgbequb LAPACK_GLOBAL_SUFFIX(cgbequb,CGBEQUB) void LAPACK_cgbequb( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_float const* AB, lapack_int const* ldab, @@ -700,7 +714,7 @@ void LAPACK_cgbequb( float* amax, lapack_int* info ); -#define LAPACK_dgbequb LAPACK_GLOBAL(dgbequb,DGBEQUB) +#define LAPACK_dgbequb LAPACK_GLOBAL_SUFFIX(dgbequb,DGBEQUB) void LAPACK_dgbequb( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, double const* AB, lapack_int const* ldab, @@ -711,7 +725,7 @@ void LAPACK_dgbequb( double* amax, lapack_int* info ); -#define LAPACK_sgbequb LAPACK_GLOBAL(sgbequb,SGBEQUB) +#define LAPACK_sgbequb LAPACK_GLOBAL_SUFFIX(sgbequb,SGBEQUB) void LAPACK_sgbequb( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, float const* AB, lapack_int const* ldab, @@ -722,7 +736,7 @@ void LAPACK_sgbequb( float* amax, lapack_int* info ); -#define LAPACK_zgbequb LAPACK_GLOBAL(zgbequb,ZGBEQUB) +#define LAPACK_zgbequb LAPACK_GLOBAL_SUFFIX(zgbequb,ZGBEQUB) void LAPACK_zgbequb( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_double const* AB, lapack_int const* ldab, @@ -733,7 +747,7 @@ void LAPACK_zgbequb( double* amax, lapack_int* info ); -#define LAPACK_cgbrfs_base LAPACK_GLOBAL(cgbrfs,CGBRFS) +#define LAPACK_cgbrfs_base LAPACK_GLOBAL_SUFFIX(cgbrfs,CGBRFS) void LAPACK_cgbrfs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -756,7 +770,7 @@ void LAPACK_cgbrfs_base( #define LAPACK_cgbrfs(...) LAPACK_cgbrfs_base(__VA_ARGS__) #endif -#define LAPACK_dgbrfs_base LAPACK_GLOBAL(dgbrfs,DGBRFS) +#define LAPACK_dgbrfs_base LAPACK_GLOBAL_SUFFIX(dgbrfs,DGBRFS) void LAPACK_dgbrfs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -779,7 +793,7 @@ void LAPACK_dgbrfs_base( #define LAPACK_dgbrfs(...) LAPACK_dgbrfs_base(__VA_ARGS__) #endif -#define LAPACK_sgbrfs_base LAPACK_GLOBAL(sgbrfs,SGBRFS) +#define LAPACK_sgbrfs_base LAPACK_GLOBAL_SUFFIX(sgbrfs,SGBRFS) void LAPACK_sgbrfs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -802,7 +816,7 @@ void LAPACK_sgbrfs_base( #define LAPACK_sgbrfs(...) LAPACK_sgbrfs_base(__VA_ARGS__) #endif -#define LAPACK_zgbrfs_base LAPACK_GLOBAL(zgbrfs,ZGBRFS) +#define LAPACK_zgbrfs_base LAPACK_GLOBAL_SUFFIX(zgbrfs,ZGBRFS) void LAPACK_zgbrfs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -825,7 +839,7 @@ void LAPACK_zgbrfs_base( #define LAPACK_zgbrfs(...) LAPACK_zgbrfs_base(__VA_ARGS__) #endif -#define LAPACK_cgbrfsx_base LAPACK_GLOBAL(cgbrfsx,CGBRFSX) +#define LAPACK_cgbrfsx_base LAPACK_GLOBAL_SUFFIX(cgbrfsx,CGBRFSX) void LAPACK_cgbrfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -853,7 +867,7 @@ void LAPACK_cgbrfsx_base( #define LAPACK_cgbrfsx(...) LAPACK_cgbrfsx_base(__VA_ARGS__) #endif -#define LAPACK_dgbrfsx_base LAPACK_GLOBAL(dgbrfsx,DGBRFSX) +#define LAPACK_dgbrfsx_base LAPACK_GLOBAL_SUFFIX(dgbrfsx,DGBRFSX) void LAPACK_dgbrfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -881,7 +895,7 @@ void LAPACK_dgbrfsx_base( #define LAPACK_dgbrfsx(...) LAPACK_dgbrfsx_base(__VA_ARGS__) #endif -#define LAPACK_sgbrfsx_base LAPACK_GLOBAL(sgbrfsx,SGBRFSX) +#define LAPACK_sgbrfsx_base LAPACK_GLOBAL_SUFFIX(sgbrfsx,SGBRFSX) void LAPACK_sgbrfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -909,7 +923,7 @@ void LAPACK_sgbrfsx_base( #define LAPACK_sgbrfsx(...) LAPACK_sgbrfsx_base(__VA_ARGS__) #endif -#define LAPACK_zgbrfsx_base LAPACK_GLOBAL(zgbrfsx,ZGBRFSX) +#define LAPACK_zgbrfsx_base LAPACK_GLOBAL_SUFFIX(zgbrfsx,ZGBRFSX) void LAPACK_zgbrfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -937,35 +951,35 @@ void LAPACK_zgbrfsx_base( #define LAPACK_zgbrfsx(...) LAPACK_zgbrfsx_base(__VA_ARGS__) #endif -#define LAPACK_cgbsv LAPACK_GLOBAL(cgbsv,CGBSV) +#define LAPACK_cgbsv LAPACK_GLOBAL_SUFFIX(cgbsv,CGBSV) void LAPACK_cgbsv( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, lapack_complex_float* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_complex_float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_dgbsv LAPACK_GLOBAL(dgbsv,DGBSV) +#define LAPACK_dgbsv LAPACK_GLOBAL_SUFFIX(dgbsv,DGBSV) void LAPACK_dgbsv( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, double* AB, lapack_int const* ldab, lapack_int* ipiv, double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_sgbsv LAPACK_GLOBAL(sgbsv,SGBSV) +#define LAPACK_sgbsv LAPACK_GLOBAL_SUFFIX(sgbsv,SGBSV) void LAPACK_sgbsv( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, float* AB, lapack_int const* ldab, lapack_int* ipiv, float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_zgbsv LAPACK_GLOBAL(zgbsv,ZGBSV) +#define LAPACK_zgbsv LAPACK_GLOBAL_SUFFIX(zgbsv,ZGBSV) void LAPACK_zgbsv( lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, lapack_complex_double* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_complex_double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_cgbsvx_base LAPACK_GLOBAL(cgbsvx,CGBSVX) +#define LAPACK_cgbsvx_base LAPACK_GLOBAL_SUFFIX(cgbsvx,CGBSVX) void LAPACK_cgbsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -992,7 +1006,7 @@ void LAPACK_cgbsvx_base( #define LAPACK_cgbsvx(...) LAPACK_cgbsvx_base(__VA_ARGS__) #endif -#define LAPACK_dgbsvx_base LAPACK_GLOBAL(dgbsvx,DGBSVX) +#define LAPACK_dgbsvx_base LAPACK_GLOBAL_SUFFIX(dgbsvx,DGBSVX) void LAPACK_dgbsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1019,7 +1033,7 @@ void LAPACK_dgbsvx_base( #define LAPACK_dgbsvx(...) LAPACK_dgbsvx_base(__VA_ARGS__) #endif -#define LAPACK_sgbsvx_base LAPACK_GLOBAL(sgbsvx,SGBSVX) +#define LAPACK_sgbsvx_base LAPACK_GLOBAL_SUFFIX(sgbsvx,SGBSVX) void LAPACK_sgbsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1046,7 +1060,7 @@ void LAPACK_sgbsvx_base( #define LAPACK_sgbsvx(...) LAPACK_sgbsvx_base(__VA_ARGS__) #endif -#define LAPACK_zgbsvx_base LAPACK_GLOBAL(zgbsvx,ZGBSVX) +#define LAPACK_zgbsvx_base LAPACK_GLOBAL_SUFFIX(zgbsvx,ZGBSVX) void LAPACK_zgbsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1073,7 +1087,7 @@ void LAPACK_zgbsvx_base( #define LAPACK_zgbsvx(...) LAPACK_zgbsvx_base(__VA_ARGS__) #endif -#define LAPACK_cgbsvxx_base LAPACK_GLOBAL(cgbsvxx,CGBSVXX) +#define LAPACK_cgbsvxx_base LAPACK_GLOBAL_SUFFIX(cgbsvxx,CGBSVXX) void LAPACK_cgbsvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1103,7 +1117,7 @@ void LAPACK_cgbsvxx_base( #define LAPACK_cgbsvxx(...) LAPACK_cgbsvxx_base(__VA_ARGS__) #endif -#define LAPACK_dgbsvxx_base LAPACK_GLOBAL(dgbsvxx,DGBSVXX) +#define LAPACK_dgbsvxx_base LAPACK_GLOBAL_SUFFIX(dgbsvxx,DGBSVXX) void LAPACK_dgbsvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1133,7 +1147,7 @@ void LAPACK_dgbsvxx_base( #define LAPACK_dgbsvxx(...) LAPACK_dgbsvxx_base(__VA_ARGS__) #endif -#define LAPACK_sgbsvxx_base LAPACK_GLOBAL(sgbsvxx,SGBSVXX) +#define LAPACK_sgbsvxx_base LAPACK_GLOBAL_SUFFIX(sgbsvxx,SGBSVXX) void LAPACK_sgbsvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1163,7 +1177,7 @@ void LAPACK_sgbsvxx_base( #define LAPACK_sgbsvxx(...) LAPACK_sgbsvxx_base(__VA_ARGS__) #endif -#define LAPACK_zgbsvxx_base LAPACK_GLOBAL(zgbsvxx,ZGBSVXX) +#define LAPACK_zgbsvxx_base LAPACK_GLOBAL_SUFFIX(zgbsvxx,ZGBSVXX) void LAPACK_zgbsvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1193,31 +1207,31 @@ void LAPACK_zgbsvxx_base( #define LAPACK_zgbsvxx(...) LAPACK_zgbsvxx_base(__VA_ARGS__) #endif -#define LAPACK_cgbtrf LAPACK_GLOBAL(cgbtrf,CGBTRF) +#define LAPACK_cgbtrf LAPACK_GLOBAL_SUFFIX(cgbtrf,CGBTRF) void LAPACK_cgbtrf( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_float* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_dgbtrf LAPACK_GLOBAL(dgbtrf,DGBTRF) +#define LAPACK_dgbtrf LAPACK_GLOBAL_SUFFIX(dgbtrf,DGBTRF) void LAPACK_dgbtrf( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, double* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_sgbtrf LAPACK_GLOBAL(sgbtrf,SGBTRF) +#define LAPACK_sgbtrf LAPACK_GLOBAL_SUFFIX(sgbtrf,SGBTRF) void LAPACK_sgbtrf( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, float* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_zgbtrf LAPACK_GLOBAL(zgbtrf,ZGBTRF) +#define LAPACK_zgbtrf LAPACK_GLOBAL_SUFFIX(zgbtrf,ZGBTRF) void LAPACK_zgbtrf( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_complex_double* AB, lapack_int const* ldab, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_cgbtrs_base LAPACK_GLOBAL(cgbtrs,CGBTRS) +#define LAPACK_cgbtrs_base LAPACK_GLOBAL_SUFFIX(cgbtrs,CGBTRS) void LAPACK_cgbtrs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1234,7 +1248,7 @@ void LAPACK_cgbtrs_base( #define LAPACK_cgbtrs(...) LAPACK_cgbtrs_base(__VA_ARGS__) #endif -#define LAPACK_dgbtrs_base LAPACK_GLOBAL(dgbtrs,DGBTRS) +#define LAPACK_dgbtrs_base LAPACK_GLOBAL_SUFFIX(dgbtrs,DGBTRS) void LAPACK_dgbtrs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1251,7 +1265,7 @@ void LAPACK_dgbtrs_base( #define LAPACK_dgbtrs(...) LAPACK_dgbtrs_base(__VA_ARGS__) #endif -#define LAPACK_sgbtrs_base LAPACK_GLOBAL(sgbtrs,SGBTRS) +#define LAPACK_sgbtrs_base LAPACK_GLOBAL_SUFFIX(sgbtrs,SGBTRS) void LAPACK_sgbtrs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1268,7 +1282,7 @@ void LAPACK_sgbtrs_base( #define LAPACK_sgbtrs(...) LAPACK_sgbtrs_base(__VA_ARGS__) #endif -#define LAPACK_zgbtrs_base LAPACK_GLOBAL(zgbtrs,ZGBTRS) +#define LAPACK_zgbtrs_base LAPACK_GLOBAL_SUFFIX(zgbtrs,ZGBTRS) void LAPACK_zgbtrs_base( char const* trans, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, @@ -1285,7 +1299,7 @@ void LAPACK_zgbtrs_base( #define LAPACK_zgbtrs(...) LAPACK_zgbtrs_base(__VA_ARGS__) #endif -#define LAPACK_cgebak_base LAPACK_GLOBAL(cgebak,CGEBAK) +#define LAPACK_cgebak_base LAPACK_GLOBAL_SUFFIX(cgebak,CGEBAK) void LAPACK_cgebak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -1302,7 +1316,7 @@ void LAPACK_cgebak_base( #define LAPACK_cgebak(...) LAPACK_cgebak_base(__VA_ARGS__) #endif -#define LAPACK_dgebak_base LAPACK_GLOBAL(dgebak,DGEBAK) +#define LAPACK_dgebak_base LAPACK_GLOBAL_SUFFIX(dgebak,DGEBAK) void LAPACK_dgebak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -1319,7 +1333,7 @@ void LAPACK_dgebak_base( #define LAPACK_dgebak(...) LAPACK_dgebak_base(__VA_ARGS__) #endif -#define LAPACK_sgebak_base LAPACK_GLOBAL(sgebak,SGEBAK) +#define LAPACK_sgebak_base LAPACK_GLOBAL_SUFFIX(sgebak,SGEBAK) void LAPACK_sgebak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -1336,7 +1350,7 @@ void LAPACK_sgebak_base( #define LAPACK_sgebak(...) LAPACK_sgebak_base(__VA_ARGS__) #endif -#define LAPACK_zgebak_base LAPACK_GLOBAL(zgebak,ZGEBAK) +#define LAPACK_zgebak_base LAPACK_GLOBAL_SUFFIX(zgebak,ZGEBAK) void LAPACK_zgebak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -1353,7 +1367,7 @@ void LAPACK_zgebak_base( #define LAPACK_zgebak(...) LAPACK_zgebak_base(__VA_ARGS__) #endif -#define LAPACK_cgebal_base LAPACK_GLOBAL(cgebal,CGEBAL) +#define LAPACK_cgebal_base LAPACK_GLOBAL_SUFFIX(cgebal,CGEBAL) void LAPACK_cgebal_base( char const* job, lapack_int const* n, @@ -1370,7 +1384,7 @@ void LAPACK_cgebal_base( #define LAPACK_cgebal(...) LAPACK_cgebal_base(__VA_ARGS__) #endif -#define LAPACK_dgebal_base LAPACK_GLOBAL(dgebal,DGEBAL) +#define LAPACK_dgebal_base LAPACK_GLOBAL_SUFFIX(dgebal,DGEBAL) void LAPACK_dgebal_base( char const* job, lapack_int const* n, @@ -1387,7 +1401,7 @@ void LAPACK_dgebal_base( #define LAPACK_dgebal(...) LAPACK_dgebal_base(__VA_ARGS__) #endif -#define LAPACK_sgebal_base LAPACK_GLOBAL(sgebal,SGEBAL) +#define LAPACK_sgebal_base LAPACK_GLOBAL_SUFFIX(sgebal,SGEBAL) void LAPACK_sgebal_base( char const* job, lapack_int const* n, @@ -1404,7 +1418,7 @@ void LAPACK_sgebal_base( #define LAPACK_sgebal(...) LAPACK_sgebal_base(__VA_ARGS__) #endif -#define LAPACK_zgebal_base LAPACK_GLOBAL(zgebal,ZGEBAL) +#define LAPACK_zgebal_base LAPACK_GLOBAL_SUFFIX(zgebal,ZGEBAL) void LAPACK_zgebal_base( char const* job, lapack_int const* n, @@ -1421,7 +1435,7 @@ void LAPACK_zgebal_base( #define LAPACK_zgebal(...) LAPACK_zgebal_base(__VA_ARGS__) #endif -#define LAPACK_cgebrd LAPACK_GLOBAL(cgebrd,CGEBRD) +#define LAPACK_cgebrd LAPACK_GLOBAL_SUFFIX(cgebrd,CGEBRD) void LAPACK_cgebrd( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -1432,7 +1446,7 @@ void LAPACK_cgebrd( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgebrd LAPACK_GLOBAL(dgebrd,DGEBRD) +#define LAPACK_dgebrd LAPACK_GLOBAL_SUFFIX(dgebrd,DGEBRD) void LAPACK_dgebrd( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -1443,7 +1457,7 @@ void LAPACK_dgebrd( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgebrd LAPACK_GLOBAL(sgebrd,SGEBRD) +#define LAPACK_sgebrd LAPACK_GLOBAL_SUFFIX(sgebrd,SGEBRD) void LAPACK_sgebrd( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -1454,7 +1468,7 @@ void LAPACK_sgebrd( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgebrd LAPACK_GLOBAL(zgebrd,ZGEBRD) +#define LAPACK_zgebrd LAPACK_GLOBAL_SUFFIX(zgebrd,ZGEBRD) void LAPACK_zgebrd( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -1465,7 +1479,7 @@ void LAPACK_zgebrd( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgecon_base LAPACK_GLOBAL(cgecon,CGECON) +#define LAPACK_cgecon_base LAPACK_GLOBAL_SUFFIX(cgecon,CGECON) void LAPACK_cgecon_base( char const* norm, lapack_int const* n, @@ -1485,7 +1499,7 @@ void LAPACK_cgecon_base( #define LAPACK_cgecon(...) LAPACK_cgecon_base(__VA_ARGS__) #endif -#define LAPACK_dgecon_base LAPACK_GLOBAL(dgecon,DGECON) +#define LAPACK_dgecon_base LAPACK_GLOBAL_SUFFIX(dgecon,DGECON) void LAPACK_dgecon_base( char const* norm, lapack_int const* n, @@ -1505,7 +1519,7 @@ void LAPACK_dgecon_base( #define LAPACK_dgecon(...) LAPACK_dgecon_base(__VA_ARGS__) #endif -#define LAPACK_sgecon_base LAPACK_GLOBAL(sgecon,SGECON) +#define LAPACK_sgecon_base LAPACK_GLOBAL_SUFFIX(sgecon,SGECON) void LAPACK_sgecon_base( char const* norm, lapack_int const* n, @@ -1525,7 +1539,7 @@ void LAPACK_sgecon_base( #define LAPACK_sgecon(...) LAPACK_sgecon_base(__VA_ARGS__) #endif -#define LAPACK_zgecon_base LAPACK_GLOBAL(zgecon,ZGECON) +#define LAPACK_zgecon_base LAPACK_GLOBAL_SUFFIX(zgecon,ZGECON) void LAPACK_zgecon_base( char const* norm, lapack_int const* n, @@ -1545,7 +1559,7 @@ void LAPACK_zgecon_base( #define LAPACK_zgecon(...) LAPACK_zgecon_base(__VA_ARGS__) #endif -#define LAPACK_cgeequ LAPACK_GLOBAL(cgeequ,CGEEQU) +#define LAPACK_cgeequ LAPACK_GLOBAL_SUFFIX(cgeequ,CGEEQU) void LAPACK_cgeequ( lapack_int const* m, lapack_int const* n, lapack_complex_float const* A, lapack_int const* lda, @@ -1556,7 +1570,7 @@ void LAPACK_cgeequ( float* amax, lapack_int* info ); -#define LAPACK_dgeequ LAPACK_GLOBAL(dgeequ,DGEEQU) +#define LAPACK_dgeequ LAPACK_GLOBAL_SUFFIX(dgeequ,DGEEQU) void LAPACK_dgeequ( lapack_int const* m, lapack_int const* n, double const* A, lapack_int const* lda, @@ -1567,7 +1581,7 @@ void LAPACK_dgeequ( double* amax, lapack_int* info ); -#define LAPACK_sgeequ LAPACK_GLOBAL(sgeequ,SGEEQU) +#define LAPACK_sgeequ LAPACK_GLOBAL_SUFFIX(sgeequ,SGEEQU) void LAPACK_sgeequ( lapack_int const* m, lapack_int const* n, float const* A, lapack_int const* lda, @@ -1578,7 +1592,7 @@ void LAPACK_sgeequ( float* amax, lapack_int* info ); -#define LAPACK_zgeequ LAPACK_GLOBAL(zgeequ,ZGEEQU) +#define LAPACK_zgeequ LAPACK_GLOBAL_SUFFIX(zgeequ,ZGEEQU) void LAPACK_zgeequ( lapack_int const* m, lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, @@ -1589,7 +1603,7 @@ void LAPACK_zgeequ( double* amax, lapack_int* info ); -#define LAPACK_cgeequb LAPACK_GLOBAL(cgeequb,CGEEQUB) +#define LAPACK_cgeequb LAPACK_GLOBAL_SUFFIX(cgeequb,CGEEQUB) void LAPACK_cgeequb( lapack_int const* m, lapack_int const* n, lapack_complex_float const* A, lapack_int const* lda, @@ -1600,7 +1614,7 @@ void LAPACK_cgeequb( float* amax, lapack_int* info ); -#define LAPACK_dgeequb LAPACK_GLOBAL(dgeequb,DGEEQUB) +#define LAPACK_dgeequb LAPACK_GLOBAL_SUFFIX(dgeequb,DGEEQUB) void LAPACK_dgeequb( lapack_int const* m, lapack_int const* n, double const* A, lapack_int const* lda, @@ -1611,7 +1625,7 @@ void LAPACK_dgeequb( double* amax, lapack_int* info ); -#define LAPACK_sgeequb LAPACK_GLOBAL(sgeequb,SGEEQUB) +#define LAPACK_sgeequb LAPACK_GLOBAL_SUFFIX(sgeequb,SGEEQUB) void LAPACK_sgeequb( lapack_int const* m, lapack_int const* n, float const* A, lapack_int const* lda, @@ -1622,7 +1636,7 @@ void LAPACK_sgeequb( float* amax, lapack_int* info ); -#define LAPACK_zgeequb LAPACK_GLOBAL(zgeequb,ZGEEQUB) +#define LAPACK_zgeequb LAPACK_GLOBAL_SUFFIX(zgeequb,ZGEEQUB) void LAPACK_zgeequb( lapack_int const* m, lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, @@ -1633,7 +1647,7 @@ void LAPACK_zgeequb( double* amax, lapack_int* info ); -#define LAPACK_cgees_base LAPACK_GLOBAL(cgees,CGEES) +#define LAPACK_cgees_base LAPACK_GLOBAL_SUFFIX(cgees,CGEES) void LAPACK_cgees_base( char const* jobvs, char const* sort, LAPACK_C_SELECT1 select, lapack_int const* n, @@ -1653,7 +1667,7 @@ void LAPACK_cgees_base( #define LAPACK_cgees(...) LAPACK_cgees_base(__VA_ARGS__) #endif -#define LAPACK_dgees_base LAPACK_GLOBAL(dgees,DGEES) +#define LAPACK_dgees_base LAPACK_GLOBAL_SUFFIX(dgees,DGEES) void LAPACK_dgees_base( char const* jobvs, char const* sort, LAPACK_D_SELECT2 select, lapack_int const* n, @@ -1673,7 +1687,7 @@ void LAPACK_dgees_base( #define LAPACK_dgees(...) LAPACK_dgees_base(__VA_ARGS__) #endif -#define LAPACK_sgees_base LAPACK_GLOBAL(sgees,SGEES) +#define LAPACK_sgees_base LAPACK_GLOBAL_SUFFIX(sgees,SGEES) void LAPACK_sgees_base( char const* jobvs, char const* sort, LAPACK_S_SELECT2 select, lapack_int const* n, @@ -1693,7 +1707,7 @@ void LAPACK_sgees_base( #define LAPACK_sgees(...) LAPACK_sgees_base(__VA_ARGS__) #endif -#define LAPACK_zgees_base LAPACK_GLOBAL(zgees,ZGEES) +#define LAPACK_zgees_base LAPACK_GLOBAL_SUFFIX(zgees,ZGEES) void LAPACK_zgees_base( char const* jobvs, char const* sort, LAPACK_Z_SELECT1 select, lapack_int const* n, @@ -1713,7 +1727,7 @@ void LAPACK_zgees_base( #define LAPACK_zgees(...) LAPACK_zgees_base(__VA_ARGS__) #endif -#define LAPACK_cgeesx_base LAPACK_GLOBAL(cgeesx,CGEESX) +#define LAPACK_cgeesx_base LAPACK_GLOBAL_SUFFIX(cgeesx,CGEESX) void LAPACK_cgeesx_base( char const* jobvs, char const* sort, LAPACK_C_SELECT1 select, char const* sense, lapack_int const* n, @@ -1735,7 +1749,7 @@ void LAPACK_cgeesx_base( #define LAPACK_cgeesx(...) LAPACK_cgeesx_base(__VA_ARGS__) #endif -#define LAPACK_dgeesx_base LAPACK_GLOBAL(dgeesx,DGEESX) +#define LAPACK_dgeesx_base LAPACK_GLOBAL_SUFFIX(dgeesx,DGEESX) void LAPACK_dgeesx_base( char const* jobvs, char const* sort, LAPACK_D_SELECT2 select, char const* sense, lapack_int const* n, @@ -1758,7 +1772,7 @@ void LAPACK_dgeesx_base( #define LAPACK_dgeesx(...) LAPACK_dgeesx_base(__VA_ARGS__) #endif -#define LAPACK_sgeesx_base LAPACK_GLOBAL(sgeesx,SGEESX) +#define LAPACK_sgeesx_base LAPACK_GLOBAL_SUFFIX(sgeesx,SGEESX) void LAPACK_sgeesx_base( char const* jobvs, char const* sort, LAPACK_S_SELECT2 select, char const* sense, lapack_int const* n, @@ -1781,7 +1795,7 @@ void LAPACK_sgeesx_base( #define LAPACK_sgeesx(...) LAPACK_sgeesx_base(__VA_ARGS__) #endif -#define LAPACK_zgeesx_base LAPACK_GLOBAL(zgeesx,ZGEESX) +#define LAPACK_zgeesx_base LAPACK_GLOBAL_SUFFIX(zgeesx,ZGEESX) void LAPACK_zgeesx_base( char const* jobvs, char const* sort, LAPACK_Z_SELECT1 select, char const* sense, lapack_int const* n, @@ -1803,7 +1817,7 @@ void LAPACK_zgeesx_base( #define LAPACK_zgeesx(...) LAPACK_zgeesx_base(__VA_ARGS__) #endif -#define LAPACK_cgeev_base LAPACK_GLOBAL(cgeev,CGEEV) +#define LAPACK_cgeev_base LAPACK_GLOBAL_SUFFIX(cgeev,CGEEV) void LAPACK_cgeev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -1824,7 +1838,7 @@ void LAPACK_cgeev_base( #define LAPACK_cgeev(...) LAPACK_cgeev_base(__VA_ARGS__) #endif -#define LAPACK_dgeev_base LAPACK_GLOBAL(dgeev,DGEEV) +#define LAPACK_dgeev_base LAPACK_GLOBAL_SUFFIX(dgeev,DGEEV) void LAPACK_dgeev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -1845,7 +1859,7 @@ void LAPACK_dgeev_base( #define LAPACK_dgeev(...) LAPACK_dgeev_base(__VA_ARGS__) #endif -#define LAPACK_sgeev_base LAPACK_GLOBAL(sgeev,SGEEV) +#define LAPACK_sgeev_base LAPACK_GLOBAL_SUFFIX(sgeev,SGEEV) void LAPACK_sgeev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -1866,7 +1880,7 @@ void LAPACK_sgeev_base( #define LAPACK_sgeev(...) LAPACK_sgeev_base(__VA_ARGS__) #endif -#define LAPACK_zgeev_base LAPACK_GLOBAL(zgeev,ZGEEV) +#define LAPACK_zgeev_base LAPACK_GLOBAL_SUFFIX(zgeev,ZGEEV) void LAPACK_zgeev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -1887,7 +1901,7 @@ void LAPACK_zgeev_base( #define LAPACK_zgeev(...) LAPACK_zgeev_base(__VA_ARGS__) #endif -#define LAPACK_cgeevx_base LAPACK_GLOBAL(cgeevx,CGEEVX) +#define LAPACK_cgeevx_base LAPACK_GLOBAL_SUFFIX(cgeevx,CGEEVX) void LAPACK_cgeevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -1912,7 +1926,7 @@ void LAPACK_cgeevx_base( #define LAPACK_cgeevx(...) LAPACK_cgeevx_base(__VA_ARGS__) #endif -#define LAPACK_dgeevx_base LAPACK_GLOBAL(dgeevx,DGEEVX) +#define LAPACK_dgeevx_base LAPACK_GLOBAL_SUFFIX(dgeevx,DGEEVX) void LAPACK_dgeevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -1938,7 +1952,7 @@ void LAPACK_dgeevx_base( #define LAPACK_dgeevx(...) LAPACK_dgeevx_base(__VA_ARGS__) #endif -#define LAPACK_sgeevx_base LAPACK_GLOBAL(sgeevx,SGEEVX) +#define LAPACK_sgeevx_base LAPACK_GLOBAL_SUFFIX(sgeevx,SGEEVX) void LAPACK_sgeevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -1964,7 +1978,7 @@ void LAPACK_sgeevx_base( #define LAPACK_sgeevx(...) LAPACK_sgeevx_base(__VA_ARGS__) #endif -#define LAPACK_zgeevx_base LAPACK_GLOBAL(zgeevx,ZGEEVX) +#define LAPACK_zgeevx_base LAPACK_GLOBAL_SUFFIX(zgeevx,ZGEEVX) void LAPACK_zgeevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -1989,7 +2003,7 @@ void LAPACK_zgeevx_base( #define LAPACK_zgeevx(...) LAPACK_zgeevx_base(__VA_ARGS__) #endif -#define LAPACK_cgehrd LAPACK_GLOBAL(cgehrd,CGEHRD) +#define LAPACK_cgehrd LAPACK_GLOBAL_SUFFIX(cgehrd,CGEHRD) void LAPACK_cgehrd( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, lapack_complex_float* A, lapack_int const* lda, @@ -1997,7 +2011,7 @@ void LAPACK_cgehrd( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgehrd LAPACK_GLOBAL(dgehrd,DGEHRD) +#define LAPACK_dgehrd LAPACK_GLOBAL_SUFFIX(dgehrd,DGEHRD) void LAPACK_dgehrd( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, double* A, lapack_int const* lda, @@ -2005,7 +2019,7 @@ void LAPACK_dgehrd( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgehrd LAPACK_GLOBAL(sgehrd,SGEHRD) +#define LAPACK_sgehrd LAPACK_GLOBAL_SUFFIX(sgehrd,SGEHRD) void LAPACK_sgehrd( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, float* A, lapack_int const* lda, @@ -2013,7 +2027,7 @@ void LAPACK_sgehrd( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgehrd LAPACK_GLOBAL(zgehrd,ZGEHRD) +#define LAPACK_zgehrd LAPACK_GLOBAL_SUFFIX(zgehrd,ZGEHRD) void LAPACK_zgehrd( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, lapack_complex_double* A, lapack_int const* lda, @@ -2021,7 +2035,7 @@ void LAPACK_zgehrd( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgejsv_base LAPACK_GLOBAL(cgejsv,CGEJSV) +#define LAPACK_cgejsv_base LAPACK_GLOBAL_SUFFIX(cgejsv,CGEJSV) void LAPACK_cgejsv_base( char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, lapack_int const* m, lapack_int const* n, @@ -2043,7 +2057,7 @@ void LAPACK_cgejsv_base( #define LAPACK_cgejsv(...) LAPACK_cgejsv_base(__VA_ARGS__) #endif -#define LAPACK_dgejsv_base LAPACK_GLOBAL(dgejsv,DGEJSV) +#define LAPACK_dgejsv_base LAPACK_GLOBAL_SUFFIX(dgejsv,DGEJSV) void LAPACK_dgejsv_base( char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, lapack_int const* m, lapack_int const* n, @@ -2064,7 +2078,7 @@ void LAPACK_dgejsv_base( #define LAPACK_dgejsv(...) LAPACK_dgejsv_base(__VA_ARGS__) #endif -#define LAPACK_sgejsv_base LAPACK_GLOBAL(sgejsv,SGEJSV) +#define LAPACK_sgejsv_base LAPACK_GLOBAL_SUFFIX(sgejsv,SGEJSV) void LAPACK_sgejsv_base( char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, lapack_int const* m, lapack_int const* n, @@ -2085,7 +2099,7 @@ void LAPACK_sgejsv_base( #define LAPACK_sgejsv(...) LAPACK_sgejsv_base(__VA_ARGS__) #endif -#define LAPACK_zgejsv_base LAPACK_GLOBAL(zgejsv,ZGEJSV) +#define LAPACK_zgejsv_base LAPACK_GLOBAL_SUFFIX(zgejsv,ZGEJSV) void LAPACK_zgejsv_base( char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, lapack_int const* m, lapack_int const* n, @@ -2107,7 +2121,7 @@ void LAPACK_zgejsv_base( #define LAPACK_zgejsv(...) LAPACK_zgejsv_base(__VA_ARGS__) #endif -#define LAPACK_cgelq LAPACK_GLOBAL(cgelq,CGELQ) +#define LAPACK_cgelq LAPACK_GLOBAL_SUFFIX(cgelq,CGELQ) void LAPACK_cgelq( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2115,7 +2129,7 @@ void LAPACK_cgelq( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgelq LAPACK_GLOBAL(dgelq,DGELQ) +#define LAPACK_dgelq LAPACK_GLOBAL_SUFFIX(dgelq,DGELQ) void LAPACK_dgelq( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2123,7 +2137,7 @@ void LAPACK_dgelq( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgelq LAPACK_GLOBAL(sgelq,SGELQ) +#define LAPACK_sgelq LAPACK_GLOBAL_SUFFIX(sgelq,SGELQ) void LAPACK_sgelq( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2131,7 +2145,7 @@ void LAPACK_sgelq( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgelq LAPACK_GLOBAL(zgelq,ZGELQ) +#define LAPACK_zgelq LAPACK_GLOBAL_SUFFIX(zgelq,ZGELQ) void LAPACK_zgelq( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2139,7 +2153,7 @@ void LAPACK_zgelq( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgelq2 LAPACK_GLOBAL(cgelq2,CGELQ2) +#define LAPACK_cgelq2 LAPACK_GLOBAL_SUFFIX(cgelq2,CGELQ2) void LAPACK_cgelq2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2147,7 +2161,7 @@ void LAPACK_cgelq2( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dgelq2 LAPACK_GLOBAL(dgelq2,DGELQ2) +#define LAPACK_dgelq2 LAPACK_GLOBAL_SUFFIX(dgelq2,DGELQ2) void LAPACK_dgelq2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2155,7 +2169,7 @@ void LAPACK_dgelq2( double* work, lapack_int* info ); -#define LAPACK_sgelq2 LAPACK_GLOBAL(sgelq2,SGELQ2) +#define LAPACK_sgelq2 LAPACK_GLOBAL_SUFFIX(sgelq2,SGELQ2) void LAPACK_sgelq2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2163,7 +2177,7 @@ void LAPACK_sgelq2( float* work, lapack_int* info ); -#define LAPACK_zgelq2 LAPACK_GLOBAL(zgelq2,ZGELQ2) +#define LAPACK_zgelq2 LAPACK_GLOBAL_SUFFIX(zgelq2,ZGELQ2) void LAPACK_zgelq2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2171,7 +2185,7 @@ void LAPACK_zgelq2( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_cgelqf LAPACK_GLOBAL(cgelqf,CGELQF) +#define LAPACK_cgelqf LAPACK_GLOBAL_SUFFIX(cgelqf,CGELQF) void LAPACK_cgelqf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2179,7 +2193,7 @@ void LAPACK_cgelqf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgelqf LAPACK_GLOBAL(dgelqf,DGELQF) +#define LAPACK_dgelqf LAPACK_GLOBAL_SUFFIX(dgelqf,DGELQF) void LAPACK_dgelqf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2187,7 +2201,7 @@ void LAPACK_dgelqf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgelqf LAPACK_GLOBAL(sgelqf,SGELQF) +#define LAPACK_sgelqf LAPACK_GLOBAL_SUFFIX(sgelqf,SGELQF) void LAPACK_sgelqf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2195,7 +2209,7 @@ void LAPACK_sgelqf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgelqf LAPACK_GLOBAL(zgelqf,ZGELQF) +#define LAPACK_zgelqf LAPACK_GLOBAL_SUFFIX(zgelqf,ZGELQF) void LAPACK_zgelqf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2203,7 +2217,7 @@ void LAPACK_zgelqf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgels_base LAPACK_GLOBAL(cgels,CGELS) +#define LAPACK_cgels_base LAPACK_GLOBAL_SUFFIX(cgels,CGELS) void LAPACK_cgels_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -2221,7 +2235,7 @@ void LAPACK_cgels_base( #define LAPACK_cgels(...) LAPACK_cgels_base(__VA_ARGS__) #endif -#define LAPACK_dgels_base LAPACK_GLOBAL(dgels,DGELS) +#define LAPACK_dgels_base LAPACK_GLOBAL_SUFFIX(dgels,DGELS) void LAPACK_dgels_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -2239,7 +2253,7 @@ void LAPACK_dgels_base( #define LAPACK_dgels(...) LAPACK_dgels_base(__VA_ARGS__) #endif -#define LAPACK_sgels_base LAPACK_GLOBAL(sgels,SGELS) +#define LAPACK_sgels_base LAPACK_GLOBAL_SUFFIX(sgels,SGELS) void LAPACK_sgels_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -2257,7 +2271,7 @@ void LAPACK_sgels_base( #define LAPACK_sgels(...) LAPACK_sgels_base(__VA_ARGS__) #endif -#define LAPACK_zgels_base LAPACK_GLOBAL(zgels,ZGELS) +#define LAPACK_zgels_base LAPACK_GLOBAL_SUFFIX(zgels,ZGELS) void LAPACK_zgels_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -2275,7 +2289,7 @@ void LAPACK_zgels_base( #define LAPACK_zgels(...) LAPACK_zgels_base(__VA_ARGS__) #endif -#define LAPACK_cgelsd LAPACK_GLOBAL(cgelsd,CGELSD) +#define LAPACK_cgelsd LAPACK_GLOBAL_SUFFIX(cgelsd,CGELSD) void LAPACK_cgelsd( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_float* A, lapack_int const* lda, @@ -2287,7 +2301,7 @@ void LAPACK_cgelsd( lapack_int* iwork, lapack_int* info ); -#define LAPACK_dgelsd LAPACK_GLOBAL(dgelsd,DGELSD) +#define LAPACK_dgelsd LAPACK_GLOBAL_SUFFIX(dgelsd,DGELSD) void LAPACK_dgelsd( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, double* A, lapack_int const* lda, @@ -2298,7 +2312,7 @@ void LAPACK_dgelsd( lapack_int* iwork, lapack_int* info ); -#define LAPACK_sgelsd LAPACK_GLOBAL(sgelsd,SGELSD) +#define LAPACK_sgelsd LAPACK_GLOBAL_SUFFIX(sgelsd,SGELSD) void LAPACK_sgelsd( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, float* A, lapack_int const* lda, @@ -2309,7 +2323,7 @@ void LAPACK_sgelsd( lapack_int* iwork, lapack_int* info ); -#define LAPACK_zgelsd LAPACK_GLOBAL(zgelsd,ZGELSD) +#define LAPACK_zgelsd LAPACK_GLOBAL_SUFFIX(zgelsd,ZGELSD) void LAPACK_zgelsd( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* A, lapack_int const* lda, @@ -2321,7 +2335,7 @@ void LAPACK_zgelsd( lapack_int* iwork, lapack_int* info ); -#define LAPACK_cgelss LAPACK_GLOBAL(cgelss,CGELSS) +#define LAPACK_cgelss LAPACK_GLOBAL_SUFFIX(cgelss,CGELSS) void LAPACK_cgelss( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_float* A, lapack_int const* lda, @@ -2332,7 +2346,7 @@ void LAPACK_cgelss( float* rwork, lapack_int* info ); -#define LAPACK_dgelss LAPACK_GLOBAL(dgelss,DGELSS) +#define LAPACK_dgelss LAPACK_GLOBAL_SUFFIX(dgelss,DGELSS) void LAPACK_dgelss( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, double* A, lapack_int const* lda, @@ -2342,7 +2356,7 @@ void LAPACK_dgelss( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgelss LAPACK_GLOBAL(sgelss,SGELSS) +#define LAPACK_sgelss LAPACK_GLOBAL_SUFFIX(sgelss,SGELSS) void LAPACK_sgelss( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, float* A, lapack_int const* lda, @@ -2352,7 +2366,7 @@ void LAPACK_sgelss( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgelss LAPACK_GLOBAL(zgelss,ZGELSS) +#define LAPACK_zgelss LAPACK_GLOBAL_SUFFIX(zgelss,ZGELSS) void LAPACK_zgelss( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* A, lapack_int const* lda, @@ -2363,7 +2377,7 @@ void LAPACK_zgelss( double* rwork, lapack_int* info ); -#define LAPACK_cgelsy LAPACK_GLOBAL(cgelsy,CGELSY) +#define LAPACK_cgelsy LAPACK_GLOBAL_SUFFIX(cgelsy,CGELSY) void LAPACK_cgelsy( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_float* A, lapack_int const* lda, @@ -2373,7 +2387,7 @@ void LAPACK_cgelsy( float* rwork, lapack_int* info ); -#define LAPACK_dgelsy LAPACK_GLOBAL(dgelsy,DGELSY) +#define LAPACK_dgelsy LAPACK_GLOBAL_SUFFIX(dgelsy,DGELSY) void LAPACK_dgelsy( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, double* A, lapack_int const* lda, @@ -2382,7 +2396,7 @@ void LAPACK_dgelsy( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgelsy LAPACK_GLOBAL(sgelsy,SGELSY) +#define LAPACK_sgelsy LAPACK_GLOBAL_SUFFIX(sgelsy,SGELSY) void LAPACK_sgelsy( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, float* A, lapack_int const* lda, @@ -2391,7 +2405,7 @@ void LAPACK_sgelsy( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgelsy LAPACK_GLOBAL(zgelsy,ZGELSY) +#define LAPACK_zgelsy LAPACK_GLOBAL_SUFFIX(zgelsy,ZGELSY) void LAPACK_zgelsy( lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* A, lapack_int const* lda, @@ -2401,7 +2415,7 @@ void LAPACK_zgelsy( double* rwork, lapack_int* info ); -#define LAPACK_cgemlq_base LAPACK_GLOBAL(cgemlq,CGEMLQ) +#define LAPACK_cgemlq_base LAPACK_GLOBAL_SUFFIX(cgemlq,CGEMLQ) void LAPACK_cgemlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2420,7 +2434,7 @@ void LAPACK_cgemlq_base( #define LAPACK_cgemlq(...) LAPACK_cgemlq_base(__VA_ARGS__) #endif -#define LAPACK_dgemlq_base LAPACK_GLOBAL(dgemlq,DGEMLQ) +#define LAPACK_dgemlq_base LAPACK_GLOBAL_SUFFIX(dgemlq,DGEMLQ) void LAPACK_dgemlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2439,7 +2453,7 @@ void LAPACK_dgemlq_base( #define LAPACK_dgemlq(...) LAPACK_dgemlq_base(__VA_ARGS__) #endif -#define LAPACK_sgemlq_base LAPACK_GLOBAL(sgemlq,SGEMLQ) +#define LAPACK_sgemlq_base LAPACK_GLOBAL_SUFFIX(sgemlq,SGEMLQ) void LAPACK_sgemlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2458,7 +2472,7 @@ void LAPACK_sgemlq_base( #define LAPACK_sgemlq(...) LAPACK_sgemlq_base(__VA_ARGS__) #endif -#define LAPACK_zgemlq_base LAPACK_GLOBAL(zgemlq,ZGEMLQ) +#define LAPACK_zgemlq_base LAPACK_GLOBAL_SUFFIX(zgemlq,ZGEMLQ) void LAPACK_zgemlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2477,7 +2491,7 @@ void LAPACK_zgemlq_base( #define LAPACK_zgemlq(...) LAPACK_zgemlq_base(__VA_ARGS__) #endif -#define LAPACK_cgemqr_base LAPACK_GLOBAL(cgemqr,CGEMQR) +#define LAPACK_cgemqr_base LAPACK_GLOBAL_SUFFIX(cgemqr,CGEMQR) void LAPACK_cgemqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2496,7 +2510,7 @@ void LAPACK_cgemqr_base( #define LAPACK_cgemqr(...) LAPACK_cgemqr_base(__VA_ARGS__) #endif -#define LAPACK_dgemqr_base LAPACK_GLOBAL(dgemqr,DGEMQR) +#define LAPACK_dgemqr_base LAPACK_GLOBAL_SUFFIX(dgemqr,DGEMQR) void LAPACK_dgemqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2515,7 +2529,7 @@ void LAPACK_dgemqr_base( #define LAPACK_dgemqr(...) LAPACK_dgemqr_base(__VA_ARGS__) #endif -#define LAPACK_sgemqr_base LAPACK_GLOBAL(sgemqr,SGEMQR) +#define LAPACK_sgemqr_base LAPACK_GLOBAL_SUFFIX(sgemqr,SGEMQR) void LAPACK_sgemqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2534,7 +2548,7 @@ void LAPACK_sgemqr_base( #define LAPACK_sgemqr(...) LAPACK_sgemqr_base(__VA_ARGS__) #endif -#define LAPACK_zgemqr_base LAPACK_GLOBAL(zgemqr,ZGEMQR) +#define LAPACK_zgemqr_base LAPACK_GLOBAL_SUFFIX(zgemqr,ZGEMQR) void LAPACK_zgemqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -2553,7 +2567,7 @@ void LAPACK_zgemqr_base( #define LAPACK_zgemqr(...) LAPACK_zgemqr_base(__VA_ARGS__) #endif -#define LAPACK_cgemqrt_base LAPACK_GLOBAL(cgemqrt,CGEMQRT) +#define LAPACK_cgemqrt_base LAPACK_GLOBAL_SUFFIX(cgemqrt,CGEMQRT) void LAPACK_cgemqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, @@ -2572,7 +2586,7 @@ void LAPACK_cgemqrt_base( #define LAPACK_cgemqrt(...) LAPACK_cgemqrt_base(__VA_ARGS__) #endif -#define LAPACK_dgemqrt_base LAPACK_GLOBAL(dgemqrt,DGEMQRT) +#define LAPACK_dgemqrt_base LAPACK_GLOBAL_SUFFIX(dgemqrt,DGEMQRT) void LAPACK_dgemqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, @@ -2591,7 +2605,7 @@ void LAPACK_dgemqrt_base( #define LAPACK_dgemqrt(...) LAPACK_dgemqrt_base(__VA_ARGS__) #endif -#define LAPACK_sgemqrt_base LAPACK_GLOBAL(sgemqrt,SGEMQRT) +#define LAPACK_sgemqrt_base LAPACK_GLOBAL_SUFFIX(sgemqrt,SGEMQRT) void LAPACK_sgemqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, @@ -2610,7 +2624,7 @@ void LAPACK_sgemqrt_base( #define LAPACK_sgemqrt(...) LAPACK_sgemqrt_base(__VA_ARGS__) #endif -#define LAPACK_zgemqrt_base LAPACK_GLOBAL(zgemqrt,ZGEMQRT) +#define LAPACK_zgemqrt_base LAPACK_GLOBAL_SUFFIX(zgemqrt,ZGEMQRT) void LAPACK_zgemqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, @@ -2629,7 +2643,7 @@ void LAPACK_zgemqrt_base( #define LAPACK_zgemqrt(...) LAPACK_zgemqrt_base(__VA_ARGS__) #endif -#define LAPACK_cgeql2 LAPACK_GLOBAL(cgeql2,CGEQL2) +#define LAPACK_cgeql2 LAPACK_GLOBAL_SUFFIX(cgeql2,CGEQL2) void LAPACK_cgeql2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2637,7 +2651,7 @@ void LAPACK_cgeql2( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dgeql2 LAPACK_GLOBAL(dgeql2,DGEQL2) +#define LAPACK_dgeql2 LAPACK_GLOBAL_SUFFIX(dgeql2,DGEQL2) void LAPACK_dgeql2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2645,7 +2659,7 @@ void LAPACK_dgeql2( double* work, lapack_int* info ); -#define LAPACK_sgeql2 LAPACK_GLOBAL(sgeql2,SGEQL2) +#define LAPACK_sgeql2 LAPACK_GLOBAL_SUFFIX(sgeql2,SGEQL2) void LAPACK_sgeql2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2653,7 +2667,7 @@ void LAPACK_sgeql2( float* work, lapack_int* info ); -#define LAPACK_zgeql2 LAPACK_GLOBAL(zgeql2,ZGEQL2) +#define LAPACK_zgeql2 LAPACK_GLOBAL_SUFFIX(zgeql2,ZGEQL2) void LAPACK_zgeql2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2661,7 +2675,7 @@ void LAPACK_zgeql2( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_cgeqlf LAPACK_GLOBAL(cgeqlf,CGEQLF) +#define LAPACK_cgeqlf LAPACK_GLOBAL_SUFFIX(cgeqlf,CGEQLF) void LAPACK_cgeqlf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2669,7 +2683,7 @@ void LAPACK_cgeqlf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgeqlf LAPACK_GLOBAL(dgeqlf,DGEQLF) +#define LAPACK_dgeqlf LAPACK_GLOBAL_SUFFIX(dgeqlf,DGEQLF) void LAPACK_dgeqlf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2677,7 +2691,7 @@ void LAPACK_dgeqlf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqlf LAPACK_GLOBAL(sgeqlf,SGEQLF) +#define LAPACK_sgeqlf LAPACK_GLOBAL_SUFFIX(sgeqlf,SGEQLF) void LAPACK_sgeqlf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2685,7 +2699,7 @@ void LAPACK_sgeqlf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgeqlf LAPACK_GLOBAL(zgeqlf,ZGEQLF) +#define LAPACK_zgeqlf LAPACK_GLOBAL_SUFFIX(zgeqlf,ZGEQLF) void LAPACK_zgeqlf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2693,29 +2707,29 @@ void LAPACK_zgeqlf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqpf LAPACK_GLOBAL(sgeqpf,SGEQPF) +#define LAPACK_sgeqpf LAPACK_GLOBAL_SUFFIX(sgeqpf,SGEQPF) void LAPACK_sgeqpf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, lapack_int* jpvt, float* tau, float* work, lapack_int *info ); -#define LAPACK_dgeqpf LAPACK_GLOBAL(dgeqpf,DGEQPF) +#define LAPACK_dgeqpf LAPACK_GLOBAL_SUFFIX(dgeqpf,DGEQPF) void LAPACK_dgeqpf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, lapack_int* jpvt, double* tau, double* work, lapack_int *info ); -#define LAPACK_cgeqpf LAPACK_GLOBAL(cgeqpf,CGEQPF) +#define LAPACK_cgeqpf LAPACK_GLOBAL_SUFFIX(cgeqpf,CGEQPF) void LAPACK_cgeqpf( lapack_int* m, lapack_int* n, lapack_complex_float* a, lapack_int* lda, lapack_int* jpvt, lapack_complex_float* tau, lapack_complex_float* work, float* rwork, lapack_int *info ); -#define LAPACK_zgeqpf LAPACK_GLOBAL(zgeqpf,ZGEQPF) +#define LAPACK_zgeqpf LAPACK_GLOBAL_SUFFIX(zgeqpf,ZGEQPF) void LAPACK_zgeqpf( lapack_int* m, lapack_int* n, lapack_complex_double* a, lapack_int* lda, lapack_int* jpvt, lapack_complex_double* tau, lapack_complex_double* work, double* rwork, lapack_int *info ); -#define LAPACK_cgeqp3 LAPACK_GLOBAL(cgeqp3,CGEQP3) +#define LAPACK_cgeqp3 LAPACK_GLOBAL_SUFFIX(cgeqp3,CGEQP3) void LAPACK_cgeqp3( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int* JPVT, @@ -2724,7 +2738,7 @@ void LAPACK_cgeqp3( float* rwork, lapack_int* info ); -#define LAPACK_dgeqp3 LAPACK_GLOBAL(dgeqp3,DGEQP3) +#define LAPACK_dgeqp3 LAPACK_GLOBAL_SUFFIX(dgeqp3,DGEQP3) void LAPACK_dgeqp3( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, lapack_int* JPVT, @@ -2732,7 +2746,7 @@ void LAPACK_dgeqp3( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqp3 LAPACK_GLOBAL(sgeqp3,SGEQP3) +#define LAPACK_sgeqp3 LAPACK_GLOBAL_SUFFIX(sgeqp3,SGEQP3) void LAPACK_sgeqp3( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, lapack_int* JPVT, @@ -2740,7 +2754,7 @@ void LAPACK_sgeqp3( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgeqp3 LAPACK_GLOBAL(zgeqp3,ZGEQP3) +#define LAPACK_zgeqp3 LAPACK_GLOBAL_SUFFIX(zgeqp3,ZGEQP3) void LAPACK_zgeqp3( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int* JPVT, @@ -2749,7 +2763,7 @@ void LAPACK_zgeqp3( double* rwork, lapack_int* info ); -#define LAPACK_cgeqr LAPACK_GLOBAL(cgeqr,CGEQR) +#define LAPACK_cgeqr LAPACK_GLOBAL_SUFFIX(cgeqr,CGEQR) void LAPACK_cgeqr( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2757,7 +2771,7 @@ void LAPACK_cgeqr( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgeqr LAPACK_GLOBAL(dgeqr,DGEQR) +#define LAPACK_dgeqr LAPACK_GLOBAL_SUFFIX(dgeqr,DGEQR) void LAPACK_dgeqr( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2765,7 +2779,7 @@ void LAPACK_dgeqr( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqr LAPACK_GLOBAL(sgeqr,SGEQR) +#define LAPACK_sgeqr LAPACK_GLOBAL_SUFFIX(sgeqr,SGEQR) void LAPACK_sgeqr( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2773,7 +2787,7 @@ void LAPACK_sgeqr( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgeqr LAPACK_GLOBAL(zgeqr,ZGEQR) +#define LAPACK_zgeqr LAPACK_GLOBAL_SUFFIX(zgeqr,ZGEQR) void LAPACK_zgeqr( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2781,7 +2795,7 @@ void LAPACK_zgeqr( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgeqr2 LAPACK_GLOBAL(cgeqr2,CGEQR2) +#define LAPACK_cgeqr2 LAPACK_GLOBAL_SUFFIX(cgeqr2,CGEQR2) void LAPACK_cgeqr2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2789,7 +2803,7 @@ void LAPACK_cgeqr2( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dgeqr2 LAPACK_GLOBAL(dgeqr2,DGEQR2) +#define LAPACK_dgeqr2 LAPACK_GLOBAL_SUFFIX(dgeqr2,DGEQR2) void LAPACK_dgeqr2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2797,7 +2811,7 @@ void LAPACK_dgeqr2( double* work, lapack_int* info ); -#define LAPACK_sgeqr2 LAPACK_GLOBAL(sgeqr2,SGEQR2) +#define LAPACK_sgeqr2 LAPACK_GLOBAL_SUFFIX(sgeqr2,SGEQR2) void LAPACK_sgeqr2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2805,7 +2819,7 @@ void LAPACK_sgeqr2( float* work, lapack_int* info ); -#define LAPACK_zgeqr2 LAPACK_GLOBAL(zgeqr2,ZGEQR2) +#define LAPACK_zgeqr2 LAPACK_GLOBAL_SUFFIX(zgeqr2,ZGEQR2) void LAPACK_zgeqr2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2813,7 +2827,7 @@ void LAPACK_zgeqr2( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_cgeqrf LAPACK_GLOBAL(cgeqrf,CGEQRF) +#define LAPACK_cgeqrf LAPACK_GLOBAL_SUFFIX(cgeqrf,CGEQRF) void LAPACK_cgeqrf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2821,7 +2835,7 @@ void LAPACK_cgeqrf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgeqrf LAPACK_GLOBAL(dgeqrf,DGEQRF) +#define LAPACK_dgeqrf LAPACK_GLOBAL_SUFFIX(dgeqrf,DGEQRF) void LAPACK_dgeqrf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2829,7 +2843,7 @@ void LAPACK_dgeqrf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqrf LAPACK_GLOBAL(sgeqrf,SGEQRF) +#define LAPACK_sgeqrf LAPACK_GLOBAL_SUFFIX(sgeqrf,SGEQRF) void LAPACK_sgeqrf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2837,7 +2851,7 @@ void LAPACK_sgeqrf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgeqrf LAPACK_GLOBAL(zgeqrf,ZGEQRF) +#define LAPACK_zgeqrf LAPACK_GLOBAL_SUFFIX(zgeqrf,ZGEQRF) void LAPACK_zgeqrf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2845,7 +2859,7 @@ void LAPACK_zgeqrf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgeqrfp LAPACK_GLOBAL(cgeqrfp,CGEQRFP) +#define LAPACK_cgeqrfp LAPACK_GLOBAL_SUFFIX(cgeqrfp,CGEQRFP) void LAPACK_cgeqrfp( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -2853,7 +2867,7 @@ void LAPACK_cgeqrfp( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgeqrfp LAPACK_GLOBAL(dgeqrfp,DGEQRFP) +#define LAPACK_dgeqrfp LAPACK_GLOBAL_SUFFIX(dgeqrfp,DGEQRFP) void LAPACK_dgeqrfp( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -2861,7 +2875,7 @@ void LAPACK_dgeqrfp( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgeqrfp LAPACK_GLOBAL(sgeqrfp,SGEQRFP) +#define LAPACK_sgeqrfp LAPACK_GLOBAL_SUFFIX(sgeqrfp,SGEQRFP) void LAPACK_sgeqrfp( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -2869,7 +2883,7 @@ void LAPACK_sgeqrfp( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgeqrfp LAPACK_GLOBAL(zgeqrfp,ZGEQRFP) +#define LAPACK_zgeqrfp LAPACK_GLOBAL_SUFFIX(zgeqrfp,ZGEQRFP) void LAPACK_zgeqrfp( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -2877,7 +2891,7 @@ void LAPACK_zgeqrfp( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgeqrt LAPACK_GLOBAL(cgeqrt,CGEQRT) +#define LAPACK_cgeqrt LAPACK_GLOBAL_SUFFIX(cgeqrt,CGEQRT) void LAPACK_cgeqrt( lapack_int const* m, lapack_int const* n, lapack_int const* nb, lapack_complex_float* A, lapack_int const* lda, @@ -2885,7 +2899,7 @@ void LAPACK_cgeqrt( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dgeqrt LAPACK_GLOBAL(dgeqrt,DGEQRT) +#define LAPACK_dgeqrt LAPACK_GLOBAL_SUFFIX(dgeqrt,DGEQRT) void LAPACK_dgeqrt( lapack_int const* m, lapack_int const* n, lapack_int const* nb, double* A, lapack_int const* lda, @@ -2893,7 +2907,7 @@ void LAPACK_dgeqrt( double* work, lapack_int* info ); -#define LAPACK_sgeqrt LAPACK_GLOBAL(sgeqrt,SGEQRT) +#define LAPACK_sgeqrt LAPACK_GLOBAL_SUFFIX(sgeqrt,SGEQRT) void LAPACK_sgeqrt( lapack_int const* m, lapack_int const* n, lapack_int const* nb, float* A, lapack_int const* lda, @@ -2901,7 +2915,7 @@ void LAPACK_sgeqrt( float* work, lapack_int* info ); -#define LAPACK_zgeqrt LAPACK_GLOBAL(zgeqrt,ZGEQRT) +#define LAPACK_zgeqrt LAPACK_GLOBAL_SUFFIX(zgeqrt,ZGEQRT) void LAPACK_zgeqrt( lapack_int const* m, lapack_int const* n, lapack_int const* nb, lapack_complex_double* A, lapack_int const* lda, @@ -2909,63 +2923,63 @@ void LAPACK_zgeqrt( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_cgeqrt2 LAPACK_GLOBAL(cgeqrt2,CGEQRT2) +#define LAPACK_cgeqrt2 LAPACK_GLOBAL_SUFFIX(cgeqrt2,CGEQRT2) void LAPACK_cgeqrt2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_complex_float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_dgeqrt2 LAPACK_GLOBAL(dgeqrt2,DGEQRT2) +#define LAPACK_dgeqrt2 LAPACK_GLOBAL_SUFFIX(dgeqrt2,DGEQRT2) void LAPACK_dgeqrt2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_sgeqrt2 LAPACK_GLOBAL(sgeqrt2,SGEQRT2) +#define LAPACK_sgeqrt2 LAPACK_GLOBAL_SUFFIX(sgeqrt2,SGEQRT2) void LAPACK_sgeqrt2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_zgeqrt2 LAPACK_GLOBAL(zgeqrt2,ZGEQRT2) +#define LAPACK_zgeqrt2 LAPACK_GLOBAL_SUFFIX(zgeqrt2,ZGEQRT2) void LAPACK_zgeqrt2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_complex_double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_cgeqrt3 LAPACK_GLOBAL(cgeqrt3,CGEQRT3) +#define LAPACK_cgeqrt3 LAPACK_GLOBAL_SUFFIX(cgeqrt3,CGEQRT3) void LAPACK_cgeqrt3( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_complex_float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_dgeqrt3 LAPACK_GLOBAL(dgeqrt3,DGEQRT3) +#define LAPACK_dgeqrt3 LAPACK_GLOBAL_SUFFIX(dgeqrt3,DGEQRT3) void LAPACK_dgeqrt3( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_sgeqrt3 LAPACK_GLOBAL(sgeqrt3,SGEQRT3) +#define LAPACK_sgeqrt3 LAPACK_GLOBAL_SUFFIX(sgeqrt3,SGEQRT3) void LAPACK_sgeqrt3( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_zgeqrt3 LAPACK_GLOBAL(zgeqrt3,ZGEQRT3) +#define LAPACK_zgeqrt3 LAPACK_GLOBAL_SUFFIX(zgeqrt3,ZGEQRT3) void LAPACK_zgeqrt3( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_complex_double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_cgerfs_base LAPACK_GLOBAL(cgerfs,CGERFS) +#define LAPACK_cgerfs_base LAPACK_GLOBAL_SUFFIX(cgerfs,CGERFS) void LAPACK_cgerfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -2988,7 +3002,7 @@ void LAPACK_cgerfs_base( #define LAPACK_cgerfs(...) LAPACK_cgerfs_base(__VA_ARGS__) #endif -#define LAPACK_dgerfs_base LAPACK_GLOBAL(dgerfs,DGERFS) +#define LAPACK_dgerfs_base LAPACK_GLOBAL_SUFFIX(dgerfs,DGERFS) void LAPACK_dgerfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -3011,7 +3025,7 @@ void LAPACK_dgerfs_base( #define LAPACK_dgerfs(...) LAPACK_dgerfs_base(__VA_ARGS__) #endif -#define LAPACK_sgerfs_base LAPACK_GLOBAL(sgerfs,SGERFS) +#define LAPACK_sgerfs_base LAPACK_GLOBAL_SUFFIX(sgerfs,SGERFS) void LAPACK_sgerfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -3034,7 +3048,7 @@ void LAPACK_sgerfs_base( #define LAPACK_sgerfs(...) LAPACK_sgerfs_base(__VA_ARGS__) #endif -#define LAPACK_zgerfs_base LAPACK_GLOBAL(zgerfs,ZGERFS) +#define LAPACK_zgerfs_base LAPACK_GLOBAL_SUFFIX(zgerfs,ZGERFS) void LAPACK_zgerfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -3057,7 +3071,7 @@ void LAPACK_zgerfs_base( #define LAPACK_zgerfs(...) LAPACK_zgerfs_base(__VA_ARGS__) #endif -#define LAPACK_cgerfsx_base LAPACK_GLOBAL(cgerfsx,CGERFSX) +#define LAPACK_cgerfsx_base LAPACK_GLOBAL_SUFFIX(cgerfsx,CGERFSX) void LAPACK_cgerfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -3085,7 +3099,7 @@ void LAPACK_cgerfsx_base( #define LAPACK_cgerfsx(...) LAPACK_cgerfsx_base(__VA_ARGS__) #endif -#define LAPACK_dgerfsx_base LAPACK_GLOBAL(dgerfsx,DGERFSX) +#define LAPACK_dgerfsx_base LAPACK_GLOBAL_SUFFIX(dgerfsx,DGERFSX) void LAPACK_dgerfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -3113,7 +3127,7 @@ void LAPACK_dgerfsx_base( #define LAPACK_dgerfsx(...) LAPACK_dgerfsx_base(__VA_ARGS__) #endif -#define LAPACK_sgerfsx_base LAPACK_GLOBAL(sgerfsx,SGERFSX) +#define LAPACK_sgerfsx_base LAPACK_GLOBAL_SUFFIX(sgerfsx,SGERFSX) void LAPACK_sgerfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -3141,7 +3155,7 @@ void LAPACK_sgerfsx_base( #define LAPACK_sgerfsx(...) LAPACK_sgerfsx_base(__VA_ARGS__) #endif -#define LAPACK_zgerfsx_base LAPACK_GLOBAL(zgerfsx,ZGERFSX) +#define LAPACK_zgerfsx_base LAPACK_GLOBAL_SUFFIX(zgerfsx,ZGERFSX) void LAPACK_zgerfsx_base( char const* trans, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -3169,7 +3183,7 @@ void LAPACK_zgerfsx_base( #define LAPACK_zgerfsx(...) LAPACK_zgerfsx_base(__VA_ARGS__) #endif -#define LAPACK_cgerq2 LAPACK_GLOBAL(cgerq2,CGERQ2) +#define LAPACK_cgerq2 LAPACK_GLOBAL_SUFFIX(cgerq2,CGERQ2) void LAPACK_cgerq2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -3177,7 +3191,7 @@ void LAPACK_cgerq2( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dgerq2 LAPACK_GLOBAL(dgerq2,DGERQ2) +#define LAPACK_dgerq2 LAPACK_GLOBAL_SUFFIX(dgerq2,DGERQ2) void LAPACK_dgerq2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -3185,7 +3199,7 @@ void LAPACK_dgerq2( double* work, lapack_int* info ); -#define LAPACK_sgerq2 LAPACK_GLOBAL(sgerq2,SGERQ2) +#define LAPACK_sgerq2 LAPACK_GLOBAL_SUFFIX(sgerq2,SGERQ2) void LAPACK_sgerq2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -3193,7 +3207,7 @@ void LAPACK_sgerq2( float* work, lapack_int* info ); -#define LAPACK_zgerq2 LAPACK_GLOBAL(zgerq2,ZGERQ2) +#define LAPACK_zgerq2 LAPACK_GLOBAL_SUFFIX(zgerq2,ZGERQ2) void LAPACK_zgerq2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -3201,7 +3215,7 @@ void LAPACK_zgerq2( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_cgerqf LAPACK_GLOBAL(cgerqf,CGERQF) +#define LAPACK_cgerqf LAPACK_GLOBAL_SUFFIX(cgerqf,CGERQF) void LAPACK_cgerqf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -3209,7 +3223,7 @@ void LAPACK_cgerqf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgerqf LAPACK_GLOBAL(dgerqf,DGERQF) +#define LAPACK_dgerqf LAPACK_GLOBAL_SUFFIX(dgerqf,DGERQF) void LAPACK_dgerqf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -3217,7 +3231,7 @@ void LAPACK_dgerqf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgerqf LAPACK_GLOBAL(sgerqf,SGERQF) +#define LAPACK_sgerqf LAPACK_GLOBAL_SUFFIX(sgerqf,SGERQF) void LAPACK_sgerqf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -3225,7 +3239,7 @@ void LAPACK_sgerqf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgerqf LAPACK_GLOBAL(zgerqf,ZGERQF) +#define LAPACK_zgerqf LAPACK_GLOBAL_SUFFIX(zgerqf,ZGERQF) void LAPACK_zgerqf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -3233,7 +3247,7 @@ void LAPACK_zgerqf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgesdd_base LAPACK_GLOBAL(cgesdd,CGESDD) +#define LAPACK_cgesdd_base LAPACK_GLOBAL_SUFFIX(cgesdd,CGESDD) void LAPACK_cgesdd_base( char const* jobz, lapack_int const* m, lapack_int const* n, @@ -3255,7 +3269,7 @@ void LAPACK_cgesdd_base( #define LAPACK_cgesdd(...) LAPACK_cgesdd_base(__VA_ARGS__) #endif -#define LAPACK_dgesdd_base LAPACK_GLOBAL(dgesdd,DGESDD) +#define LAPACK_dgesdd_base LAPACK_GLOBAL_SUFFIX(dgesdd,DGESDD) void LAPACK_dgesdd_base( char const* jobz, lapack_int const* m, lapack_int const* n, @@ -3276,7 +3290,7 @@ void LAPACK_dgesdd_base( #define LAPACK_dgesdd(...) LAPACK_dgesdd_base(__VA_ARGS__) #endif -#define LAPACK_sgesdd_base LAPACK_GLOBAL(sgesdd,SGESDD) +#define LAPACK_sgesdd_base LAPACK_GLOBAL_SUFFIX(sgesdd,SGESDD) void LAPACK_sgesdd_base( char const* jobz, lapack_int const* m, lapack_int const* n, @@ -3297,7 +3311,7 @@ void LAPACK_sgesdd_base( #define LAPACK_sgesdd(...) LAPACK_sgesdd_base(__VA_ARGS__) #endif -#define LAPACK_zgesdd_base LAPACK_GLOBAL(zgesdd,ZGESDD) +#define LAPACK_zgesdd_base LAPACK_GLOBAL_SUFFIX(zgesdd,ZGESDD) void LAPACK_zgesdd_base( char const* jobz, lapack_int const* m, lapack_int const* n, @@ -3319,7 +3333,7 @@ void LAPACK_zgesdd_base( #define LAPACK_zgesdd(...) LAPACK_zgesdd_base(__VA_ARGS__) #endif -#define LAPACK_cgedmd_base LAPACK_GLOBAL(cgedmd,CGEDMD) +#define LAPACK_cgedmd_base LAPACK_GLOBAL_SUFFIX(cgedmd,CGEDMD) void LAPACK_cgedmd_base( char const* jobs, char const* jobz, char const* jobr, char const* jobf, lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, @@ -3345,7 +3359,7 @@ void LAPACK_cgedmd_base( #endif -#define LAPACK_dgedmd_base LAPACK_GLOBAL(dgedmd,DGEDMD) +#define LAPACK_dgedmd_base LAPACK_GLOBAL_SUFFIX(dgedmd,DGEDMD) void LAPACK_dgedmd_base( char const* jobs, char const* jobz, char const* jobr, char const* jobf, lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, @@ -3369,7 +3383,7 @@ void LAPACK_dgedmd_base( #define LAPACK_dgedmd(...) LAPACK_dgedmd_base(__VA_ARGS__) #endif -#define LAPACK_sgedmd_base LAPACK_GLOBAL(sgedmd,SGEDMD) +#define LAPACK_sgedmd_base LAPACK_GLOBAL_SUFFIX(sgedmd,SGEDMD) void LAPACK_sgedmd_base( char const* jobs, char const* jobz, char const* jobr, char const* jobf, lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, @@ -3393,7 +3407,7 @@ void LAPACK_sgedmd_base( #define LAPACK_sgedmd(...) LAPACK_sgedmd_base(__VA_ARGS__) #endif -#define LAPACK_zgedmd_base LAPACK_GLOBAL(zgedmd,ZGEDMD) +#define LAPACK_zgedmd_base LAPACK_GLOBAL_SUFFIX(zgedmd,ZGEDMD) void LAPACK_zgedmd_base( char const* jobs, char const* jobz, char const* jobr, char const* jobf, lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, @@ -3418,7 +3432,7 @@ void LAPACK_zgedmd_base( #define LAPACK_zgedmd(...) LAPACK_zgedmd_base(__VA_ARGS__) #endif -#define LAPACK_cgedmdq_base LAPACK_GLOBAL(cgedmdq,CGEDMDQ) +#define LAPACK_cgedmdq_base LAPACK_GLOBAL_SUFFIX(cgedmdq,CGEDMDQ) void LAPACK_cgedmdq_base( char const* jobs, char const* jobz, char const* jobr, char const* jobq, char const* jobt, char const* jobf, lapack_int const* whtsvd, @@ -3446,7 +3460,7 @@ void LAPACK_cgedmdq_base( #define LAPACK_cgedmdq(...) LAPACK_cgedmdq_base(__VA_ARGS__) #endif -#define LAPACK_dgedmdq_base LAPACK_GLOBAL(dgedmdq,DGEDMDQ) +#define LAPACK_dgedmdq_base LAPACK_GLOBAL_SUFFIX(dgedmdq,DGEDMDQ) void LAPACK_dgedmdq_base( char const* jobs, char const* jobz, char const* jobr, char const* jobq, char const* jobt, char const* jobf, lapack_int const* whtsvd, @@ -3473,7 +3487,7 @@ void LAPACK_dgedmdq_base( #define LAPACK_dgedmdq(...) LAPACK_dgedmdq_base(__VA_ARGS__) #endif -#define LAPACK_sgedmdq_base LAPACK_GLOBAL(sgedmdq,SGEDMDQ) +#define LAPACK_sgedmdq_base LAPACK_GLOBAL_SUFFIX(sgedmdq,SGEDMDQ) void LAPACK_sgedmdq_base( char const* jobs, char const* jobz, char const* jobr, char const* jobq, char const* jobt, char const* jobf, lapack_int const* whtsvd, @@ -3500,7 +3514,7 @@ void LAPACK_sgedmdq_base( #define LAPACK_sgedmdq(...) LAPACK_sgedmdq_base(__VA_ARGS__) #endif -#define LAPACK_zgedmdq_base LAPACK_GLOBAL(zgedmdq,ZGEDMDQ) +#define LAPACK_zgedmdq_base LAPACK_GLOBAL_SUFFIX(zgedmdq,ZGEDMDQ) void LAPACK_zgedmdq_base( char const* jobs, char const* jobz, char const* jobr, char const* jobq, char const* jobt, char const* jobf, lapack_int const* whtsvd, @@ -3529,35 +3543,35 @@ void LAPACK_zgedmdq_base( #define LAPACK_zgedmdq(...) LAPACK_zgedmdq_base(__VA_ARGS__) #endif -#define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV) +#define LAPACK_cgesv LAPACK_GLOBAL_SUFFIX(cgesv,CGESV) void LAPACK_cgesv( lapack_int const* n, lapack_int const* nrhs, lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, lapack_complex_float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_dgesv LAPACK_GLOBAL(dgesv,DGESV) +#define LAPACK_dgesv LAPACK_GLOBAL_SUFFIX(dgesv,DGESV) void LAPACK_dgesv( lapack_int const* n, lapack_int const* nrhs, double* A, lapack_int const* lda, lapack_int* ipiv, double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_sgesv LAPACK_GLOBAL(sgesv,SGESV) +#define LAPACK_sgesv LAPACK_GLOBAL_SUFFIX(sgesv,SGESV) void LAPACK_sgesv( lapack_int const* n, lapack_int const* nrhs, float* A, lapack_int const* lda, lapack_int* ipiv, float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_zgesv LAPACK_GLOBAL(zgesv,ZGESV) +#define LAPACK_zgesv LAPACK_GLOBAL_SUFFIX(zgesv,ZGESV) void LAPACK_zgesv( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, lapack_complex_double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_dsgesv LAPACK_GLOBAL(dsgesv,DSGESV) +#define LAPACK_dsgesv LAPACK_GLOBAL_SUFFIX(dsgesv,DSGESV) void LAPACK_dsgesv( lapack_int const* n, lapack_int const* nrhs, double* A, lapack_int const* lda, lapack_int* ipiv, @@ -3567,7 +3581,7 @@ void LAPACK_dsgesv( float* swork, lapack_int* iter, lapack_int* info ); -#define LAPACK_zcgesv LAPACK_GLOBAL(zcgesv,ZCGESV) +#define LAPACK_zcgesv LAPACK_GLOBAL_SUFFIX(zcgesv,ZCGESV) void LAPACK_zcgesv( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, @@ -3578,7 +3592,7 @@ void LAPACK_zcgesv( double* rwork, lapack_int* iter, lapack_int* info ); -#define LAPACK_cgesvd_base LAPACK_GLOBAL(cgesvd,CGESVD) +#define LAPACK_cgesvd_base LAPACK_GLOBAL_SUFFIX(cgesvd,CGESVD) void LAPACK_cgesvd_base( char const* jobu, char const* jobvt, lapack_int const* m, lapack_int const* n, @@ -3599,7 +3613,7 @@ void LAPACK_cgesvd_base( #define LAPACK_cgesvd(...) LAPACK_cgesvd_base(__VA_ARGS__) #endif -#define LAPACK_dgesvd_base LAPACK_GLOBAL(dgesvd,DGESVD) +#define LAPACK_dgesvd_base LAPACK_GLOBAL_SUFFIX(dgesvd,DGESVD) void LAPACK_dgesvd_base( char const* jobu, char const* jobvt, lapack_int const* m, lapack_int const* n, @@ -3619,7 +3633,7 @@ void LAPACK_dgesvd_base( #define LAPACK_dgesvd(...) LAPACK_dgesvd_base(__VA_ARGS__) #endif -#define LAPACK_sgesvd_base LAPACK_GLOBAL(sgesvd,SGESVD) +#define LAPACK_sgesvd_base LAPACK_GLOBAL_SUFFIX(sgesvd,SGESVD) void LAPACK_sgesvd_base( char const* jobu, char const* jobvt, lapack_int const* m, lapack_int const* n, @@ -3639,7 +3653,7 @@ void LAPACK_sgesvd_base( #define LAPACK_sgesvd(...) LAPACK_sgesvd_base(__VA_ARGS__) #endif -#define LAPACK_zgesvd_base LAPACK_GLOBAL(zgesvd,ZGESVD) +#define LAPACK_zgesvd_base LAPACK_GLOBAL_SUFFIX(zgesvd,ZGESVD) void LAPACK_zgesvd_base( char const* jobu, char const* jobvt, lapack_int const* m, lapack_int const* n, @@ -3660,7 +3674,7 @@ void LAPACK_zgesvd_base( #define LAPACK_zgesvd(...) LAPACK_zgesvd_base(__VA_ARGS__) #endif -#define LAPACK_cgesvdq_base LAPACK_GLOBAL(cgesvdq,CGESVDQ) +#define LAPACK_cgesvdq_base LAPACK_GLOBAL_SUFFIX(cgesvdq,CGESVDQ) void LAPACK_cgesvdq_base( char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3682,7 +3696,7 @@ void LAPACK_cgesvdq_base( #define LAPACK_cgesvdq(...) LAPACK_cgesvdq_base(__VA_ARGS__) #endif -#define LAPACK_dgesvdq_base LAPACK_GLOBAL(dgesvdq,DGESVDQ) +#define LAPACK_dgesvdq_base LAPACK_GLOBAL_SUFFIX(dgesvdq,DGESVDQ) void LAPACK_dgesvdq_base( char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3704,7 +3718,7 @@ void LAPACK_dgesvdq_base( #define LAPACK_dgesvdq(...) LAPACK_dgesvdq_base(__VA_ARGS__) #endif -#define LAPACK_sgesvdq_base LAPACK_GLOBAL(sgesvdq,SGESVDQ) +#define LAPACK_sgesvdq_base LAPACK_GLOBAL_SUFFIX(sgesvdq,SGESVDQ) void LAPACK_sgesvdq_base( char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3726,7 +3740,7 @@ void LAPACK_sgesvdq_base( #define LAPACK_sgesvdq(...) LAPACK_sgesvdq_base(__VA_ARGS__) #endif -#define LAPACK_zgesvdq_base LAPACK_GLOBAL(zgesvdq,ZGESVDQ) +#define LAPACK_zgesvdq_base LAPACK_GLOBAL_SUFFIX(zgesvdq,ZGESVDQ) void LAPACK_zgesvdq_base( char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3748,7 +3762,7 @@ void LAPACK_zgesvdq_base( #define LAPACK_zgesvdq(...) LAPACK_zgesvdq_base(__VA_ARGS__) #endif -#define LAPACK_cgesvdx_base LAPACK_GLOBAL(cgesvdx,CGESVDX) +#define LAPACK_cgesvdx_base LAPACK_GLOBAL_SUFFIX(cgesvdx,CGESVDX) void LAPACK_cgesvdx_base( char const* jobu, char const* jobvt, char const* range, lapack_int const* m, lapack_int const* n, @@ -3773,7 +3787,7 @@ void LAPACK_cgesvdx_base( #endif -#define LAPACK_dgesvdx_base LAPACK_GLOBAL(dgesvdx,DGESVDX) +#define LAPACK_dgesvdx_base LAPACK_GLOBAL_SUFFIX(dgesvdx,DGESVDX) void LAPACK_dgesvdx_base( char const* jobu, char const* jobvt, char const* range, lapack_int const* m, lapack_int const* n, @@ -3796,7 +3810,7 @@ void LAPACK_dgesvdx_base( #define LAPACK_dgesvdx(...) LAPACK_dgesvdx_base(__VA_ARGS__) #endif -#define LAPACK_sgesvdx_base LAPACK_GLOBAL(sgesvdx,SGESVDX) +#define LAPACK_sgesvdx_base LAPACK_GLOBAL_SUFFIX(sgesvdx,SGESVDX) void LAPACK_sgesvdx_base( char const* jobu, char const* jobvt, char const* range, lapack_int const* m, lapack_int const* n, @@ -3819,7 +3833,7 @@ void LAPACK_sgesvdx_base( #define LAPACK_sgesvdx(...) LAPACK_sgesvdx_base(__VA_ARGS__) #endif -#define LAPACK_zgesvdx_base LAPACK_GLOBAL(zgesvdx,ZGESVDX) +#define LAPACK_zgesvdx_base LAPACK_GLOBAL_SUFFIX(zgesvdx,ZGESVDX) void LAPACK_zgesvdx_base( char const* jobu, char const* jobvt, char const* range, lapack_int const* m, lapack_int const* n, @@ -3843,7 +3857,7 @@ void LAPACK_zgesvdx_base( #define LAPACK_zgesvdx(...) LAPACK_zgesvdx_base(__VA_ARGS__) #endif -#define LAPACK_cgesvj_base LAPACK_GLOBAL(cgesvj,CGESVJ) +#define LAPACK_cgesvj_base LAPACK_GLOBAL_SUFFIX(cgesvj,CGESVJ) void LAPACK_cgesvj_base( char const* joba, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3863,7 +3877,7 @@ void LAPACK_cgesvj_base( #define LAPACK_cgesvj(...) LAPACK_cgesvj_base(__VA_ARGS__) #endif -#define LAPACK_dgesvj_base LAPACK_GLOBAL(dgesvj,DGESVJ) +#define LAPACK_dgesvj_base LAPACK_GLOBAL_SUFFIX(dgesvj,DGESVJ) void LAPACK_dgesvj_base( char const* joba, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3882,7 +3896,7 @@ void LAPACK_dgesvj_base( #define LAPACK_dgesvj(...) LAPACK_dgesvj_base(__VA_ARGS__) #endif -#define LAPACK_sgesvj_base LAPACK_GLOBAL(sgesvj,SGESVJ) +#define LAPACK_sgesvj_base LAPACK_GLOBAL_SUFFIX(sgesvj,SGESVJ) void LAPACK_sgesvj_base( char const* joba, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3901,7 +3915,7 @@ void LAPACK_sgesvj_base( #define LAPACK_sgesvj(...) LAPACK_sgesvj_base(__VA_ARGS__) #endif -#define LAPACK_zgesvj_base LAPACK_GLOBAL(zgesvj,ZGESVJ) +#define LAPACK_zgesvj_base LAPACK_GLOBAL_SUFFIX(zgesvj,ZGESVJ) void LAPACK_zgesvj_base( char const* joba, char const* jobu, char const* jobv, lapack_int const* m, lapack_int const* n, @@ -3921,7 +3935,7 @@ void LAPACK_zgesvj_base( #define LAPACK_zgesvj(...) LAPACK_zgesvj_base(__VA_ARGS__) #endif -#define LAPACK_cgesvx_base LAPACK_GLOBAL(cgesvx,CGESVX) +#define LAPACK_cgesvx_base LAPACK_GLOBAL_SUFFIX(cgesvx,CGESVX) void LAPACK_cgesvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -3948,7 +3962,7 @@ void LAPACK_cgesvx_base( #define LAPACK_cgesvx(...) LAPACK_cgesvx_base(__VA_ARGS__) #endif -#define LAPACK_dgesvx_base LAPACK_GLOBAL(dgesvx,DGESVX) +#define LAPACK_dgesvx_base LAPACK_GLOBAL_SUFFIX(dgesvx,DGESVX) void LAPACK_dgesvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -3975,7 +3989,7 @@ void LAPACK_dgesvx_base( #define LAPACK_dgesvx(...) LAPACK_dgesvx_base(__VA_ARGS__) #endif -#define LAPACK_sgesvx_base LAPACK_GLOBAL(sgesvx,SGESVX) +#define LAPACK_sgesvx_base LAPACK_GLOBAL_SUFFIX(sgesvx,SGESVX) void LAPACK_sgesvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4002,7 +4016,7 @@ void LAPACK_sgesvx_base( #define LAPACK_sgesvx(...) LAPACK_sgesvx_base(__VA_ARGS__) #endif -#define LAPACK_zgesvx_base LAPACK_GLOBAL(zgesvx,ZGESVX) +#define LAPACK_zgesvx_base LAPACK_GLOBAL_SUFFIX(zgesvx,ZGESVX) void LAPACK_zgesvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4029,7 +4043,7 @@ void LAPACK_zgesvx_base( #define LAPACK_zgesvx(...) LAPACK_zgesvx_base(__VA_ARGS__) #endif -#define LAPACK_cgesvxx_base LAPACK_GLOBAL(cgesvxx,CGESVXX) +#define LAPACK_cgesvxx_base LAPACK_GLOBAL_SUFFIX(cgesvxx,CGESVXX) void LAPACK_cgesvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4059,7 +4073,7 @@ void LAPACK_cgesvxx_base( #define LAPACK_cgesvxx(...) LAPACK_cgesvxx_base(__VA_ARGS__) #endif -#define LAPACK_dgesvxx_base LAPACK_GLOBAL(dgesvxx,DGESVXX) +#define LAPACK_dgesvxx_base LAPACK_GLOBAL_SUFFIX(dgesvxx,DGESVXX) void LAPACK_dgesvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4089,7 +4103,7 @@ void LAPACK_dgesvxx_base( #define LAPACK_dgesvxx(...) LAPACK_dgesvxx_base(__VA_ARGS__) #endif -#define LAPACK_sgesvxx_base LAPACK_GLOBAL(sgesvxx,SGESVXX) +#define LAPACK_sgesvxx_base LAPACK_GLOBAL_SUFFIX(sgesvxx,SGESVXX) void LAPACK_sgesvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4119,7 +4133,7 @@ void LAPACK_sgesvxx_base( #define LAPACK_sgesvxx(...) LAPACK_sgesvxx_base(__VA_ARGS__) #endif -#define LAPACK_zgesvxx_base LAPACK_GLOBAL(zgesvxx,ZGESVXX) +#define LAPACK_zgesvxx_base LAPACK_GLOBAL_SUFFIX(zgesvxx,ZGESVXX) void LAPACK_zgesvxx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4149,107 +4163,107 @@ void LAPACK_zgesvxx_base( #define LAPACK_zgesvxx(...) LAPACK_zgesvxx_base(__VA_ARGS__) #endif -#define LAPACK_cgetf2 LAPACK_GLOBAL(cgetf2,CGETF2) +#define LAPACK_cgetf2 LAPACK_GLOBAL_SUFFIX(cgetf2,CGETF2) void LAPACK_cgetf2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_dgetf2 LAPACK_GLOBAL(dgetf2,DGETF2) +#define LAPACK_dgetf2 LAPACK_GLOBAL_SUFFIX(dgetf2,DGETF2) void LAPACK_dgetf2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_sgetf2 LAPACK_GLOBAL(sgetf2,SGETF2) +#define LAPACK_sgetf2 LAPACK_GLOBAL_SUFFIX(sgetf2,SGETF2) void LAPACK_sgetf2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_zgetf2 LAPACK_GLOBAL(zgetf2,ZGETF2) +#define LAPACK_zgetf2 LAPACK_GLOBAL_SUFFIX(zgetf2,ZGETF2) void LAPACK_zgetf2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF) +#define LAPACK_cgetrf LAPACK_GLOBAL_SUFFIX(cgetrf,CGETRF) void LAPACK_cgetrf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF) +#define LAPACK_dgetrf LAPACK_GLOBAL_SUFFIX(dgetrf,DGETRF) void LAPACK_dgetrf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) +#define LAPACK_sgetrf LAPACK_GLOBAL_SUFFIX(sgetrf,SGETRF) void LAPACK_sgetrf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_zgetrf LAPACK_GLOBAL(zgetrf,ZGETRF) +#define LAPACK_zgetrf LAPACK_GLOBAL_SUFFIX(zgetrf,ZGETRF) void LAPACK_zgetrf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_cgetrf2 LAPACK_GLOBAL(cgetrf2,CGETRF2) +#define LAPACK_cgetrf2 LAPACK_GLOBAL_SUFFIX(cgetrf2,CGETRF2) void LAPACK_cgetrf2( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_dgetrf2 LAPACK_GLOBAL(dgetrf2,DGETRF2) +#define LAPACK_dgetrf2 LAPACK_GLOBAL_SUFFIX(dgetrf2,DGETRF2) void LAPACK_dgetrf2( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_sgetrf2 LAPACK_GLOBAL(sgetrf2,SGETRF2) +#define LAPACK_sgetrf2 LAPACK_GLOBAL_SUFFIX(sgetrf2,SGETRF2) void LAPACK_sgetrf2( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_zgetrf2 LAPACK_GLOBAL(zgetrf2,ZGETRF2) +#define LAPACK_zgetrf2 LAPACK_GLOBAL_SUFFIX(zgetrf2,ZGETRF2) void LAPACK_zgetrf2( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_cgetri LAPACK_GLOBAL(cgetri,CGETRI) +#define LAPACK_cgetri LAPACK_GLOBAL_SUFFIX(cgetri,CGETRI) void LAPACK_cgetri( lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgetri LAPACK_GLOBAL(dgetri,DGETRI) +#define LAPACK_dgetri LAPACK_GLOBAL_SUFFIX(dgetri,DGETRI) void LAPACK_dgetri( lapack_int const* n, double* A, lapack_int const* lda, lapack_int const* ipiv, double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgetri LAPACK_GLOBAL(sgetri,SGETRI) +#define LAPACK_sgetri LAPACK_GLOBAL_SUFFIX(sgetri,SGETRI) void LAPACK_sgetri( lapack_int const* n, float* A, lapack_int const* lda, lapack_int const* ipiv, float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgetri LAPACK_GLOBAL(zgetri,ZGETRI) +#define LAPACK_zgetri LAPACK_GLOBAL_SUFFIX(zgetri,ZGETRI) void LAPACK_zgetri( lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgetrs_base LAPACK_GLOBAL(cgetrs,CGETRS) +#define LAPACK_cgetrs_base LAPACK_GLOBAL_SUFFIX(cgetrs,CGETRS) void LAPACK_cgetrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4266,7 +4280,7 @@ void LAPACK_cgetrs_base( #define LAPACK_cgetrs(...) LAPACK_cgetrs_base(__VA_ARGS__) #endif -#define LAPACK_dgetrs_base LAPACK_GLOBAL(dgetrs,DGETRS) +#define LAPACK_dgetrs_base LAPACK_GLOBAL_SUFFIX(dgetrs,DGETRS) void LAPACK_dgetrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4283,7 +4297,7 @@ void LAPACK_dgetrs_base( #define LAPACK_dgetrs(...) LAPACK_dgetrs_base(__VA_ARGS__) #endif -#define LAPACK_sgetrs_base LAPACK_GLOBAL(sgetrs,SGETRS) +#define LAPACK_sgetrs_base LAPACK_GLOBAL_SUFFIX(sgetrs,SGETRS) void LAPACK_sgetrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4300,7 +4314,7 @@ void LAPACK_sgetrs_base( #define LAPACK_sgetrs(...) LAPACK_sgetrs_base(__VA_ARGS__) #endif -#define LAPACK_zgetrs_base LAPACK_GLOBAL(zgetrs,ZGETRS) +#define LAPACK_zgetrs_base LAPACK_GLOBAL_SUFFIX(zgetrs,ZGETRS) void LAPACK_zgetrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -4317,7 +4331,7 @@ void LAPACK_zgetrs_base( #define LAPACK_zgetrs(...) LAPACK_zgetrs_base(__VA_ARGS__) #endif -#define LAPACK_cgetsls_base LAPACK_GLOBAL(cgetsls,CGETSLS) +#define LAPACK_cgetsls_base LAPACK_GLOBAL_SUFFIX(cgetsls,CGETSLS) void LAPACK_cgetsls_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -4335,7 +4349,7 @@ void LAPACK_cgetsls_base( #define LAPACK_cgetsls(...) LAPACK_cgetsls_base(__VA_ARGS__) #endif -#define LAPACK_dgetsls_base LAPACK_GLOBAL(dgetsls,DGETSLS) +#define LAPACK_dgetsls_base LAPACK_GLOBAL_SUFFIX(dgetsls,DGETSLS) void LAPACK_dgetsls_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -4353,7 +4367,7 @@ void LAPACK_dgetsls_base( #define LAPACK_dgetsls(...) LAPACK_dgetsls_base(__VA_ARGS__) #endif -#define LAPACK_sgetsls_base LAPACK_GLOBAL(sgetsls,SGETSLS) +#define LAPACK_sgetsls_base LAPACK_GLOBAL_SUFFIX(sgetsls,SGETSLS) void LAPACK_sgetsls_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -4371,7 +4385,7 @@ void LAPACK_sgetsls_base( #define LAPACK_sgetsls(...) LAPACK_sgetsls_base(__VA_ARGS__) #endif -#define LAPACK_zgetsls_base LAPACK_GLOBAL(zgetsls,ZGETSLS) +#define LAPACK_zgetsls_base LAPACK_GLOBAL_SUFFIX(zgetsls,ZGETSLS) void LAPACK_zgetsls_base( char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, @@ -4389,7 +4403,7 @@ void LAPACK_zgetsls_base( #define LAPACK_zgetsls(...) LAPACK_zgetsls_base(__VA_ARGS__) #endif -#define LAPACK_cgetsqrhrt LAPACK_GLOBAL(cgetsqrhrt,CGETSQRHRT) +#define LAPACK_cgetsqrhrt LAPACK_GLOBAL_SUFFIX(cgetsqrhrt,CGETSQRHRT) void LAPACK_cgetsqrhrt( lapack_int const* m, lapack_int const* n, lapack_int const* mb1, lapack_int const* nb1, lapack_int const* nb2, @@ -4398,7 +4412,7 @@ void LAPACK_cgetsqrhrt( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgetsqrhrt LAPACK_GLOBAL(dgetsqrhrt,DGETSQRHRT) +#define LAPACK_dgetsqrhrt LAPACK_GLOBAL_SUFFIX(dgetsqrhrt,DGETSQRHRT) void LAPACK_dgetsqrhrt( lapack_int const* m, lapack_int const* n, lapack_int const* mb1, lapack_int const* nb1, lapack_int const* nb2, @@ -4407,7 +4421,7 @@ void LAPACK_dgetsqrhrt( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgetsqrhrt LAPACK_GLOBAL(sgetsqrhrt,SGETSQRHRT) +#define LAPACK_sgetsqrhrt LAPACK_GLOBAL_SUFFIX(sgetsqrhrt,SGETSQRHRT) void LAPACK_sgetsqrhrt( lapack_int const* m, lapack_int const* n, lapack_int const* mb1, lapack_int const* nb1, lapack_int const* nb2, @@ -4416,7 +4430,7 @@ void LAPACK_sgetsqrhrt( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgetsqrhrt LAPACK_GLOBAL(zgetsqrhrt,ZGETSQRHRT) +#define LAPACK_zgetsqrhrt LAPACK_GLOBAL_SUFFIX(zgetsqrhrt,ZGETSQRHRT) void LAPACK_zgetsqrhrt( lapack_int const* m, lapack_int const* n, lapack_int const* mb1, lapack_int const* nb1, lapack_int const* nb2, @@ -4425,7 +4439,7 @@ void LAPACK_zgetsqrhrt( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cggbak_base LAPACK_GLOBAL(cggbak,CGGBAK) +#define LAPACK_cggbak_base LAPACK_GLOBAL_SUFFIX(cggbak,CGGBAK) void LAPACK_cggbak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -4443,7 +4457,7 @@ void LAPACK_cggbak_base( #define LAPACK_cggbak(...) LAPACK_cggbak_base(__VA_ARGS__) #endif -#define LAPACK_dggbak_base LAPACK_GLOBAL(dggbak,DGGBAK) +#define LAPACK_dggbak_base LAPACK_GLOBAL_SUFFIX(dggbak,DGGBAK) void LAPACK_dggbak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -4461,7 +4475,7 @@ void LAPACK_dggbak_base( #define LAPACK_dggbak(...) LAPACK_dggbak_base(__VA_ARGS__) #endif -#define LAPACK_sggbak_base LAPACK_GLOBAL(sggbak,SGGBAK) +#define LAPACK_sggbak_base LAPACK_GLOBAL_SUFFIX(sggbak,SGGBAK) void LAPACK_sggbak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -4479,7 +4493,7 @@ void LAPACK_sggbak_base( #define LAPACK_sggbak(...) LAPACK_sggbak_base(__VA_ARGS__) #endif -#define LAPACK_zggbak_base LAPACK_GLOBAL(zggbak,ZGGBAK) +#define LAPACK_zggbak_base LAPACK_GLOBAL_SUFFIX(zggbak,ZGGBAK) void LAPACK_zggbak_base( char const* job, char const* side, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -4497,7 +4511,7 @@ void LAPACK_zggbak_base( #define LAPACK_zggbak(...) LAPACK_zggbak_base(__VA_ARGS__) #endif -#define LAPACK_cggbal_base LAPACK_GLOBAL(cggbal,CGGBAL) +#define LAPACK_cggbal_base LAPACK_GLOBAL_SUFFIX(cggbal,CGGBAL) void LAPACK_cggbal_base( char const* job, lapack_int const* n, @@ -4517,7 +4531,7 @@ void LAPACK_cggbal_base( #define LAPACK_cggbal(...) LAPACK_cggbal_base(__VA_ARGS__) #endif -#define LAPACK_dggbal_base LAPACK_GLOBAL(dggbal,DGGBAL) +#define LAPACK_dggbal_base LAPACK_GLOBAL_SUFFIX(dggbal,DGGBAL) void LAPACK_dggbal_base( char const* job, lapack_int const* n, @@ -4537,7 +4551,7 @@ void LAPACK_dggbal_base( #define LAPACK_dggbal(...) LAPACK_dggbal_base(__VA_ARGS__) #endif -#define LAPACK_sggbal_base LAPACK_GLOBAL(sggbal,SGGBAL) +#define LAPACK_sggbal_base LAPACK_GLOBAL_SUFFIX(sggbal,SGGBAL) void LAPACK_sggbal_base( char const* job, lapack_int const* n, @@ -4557,7 +4571,7 @@ void LAPACK_sggbal_base( #define LAPACK_sggbal(...) LAPACK_sggbal_base(__VA_ARGS__) #endif -#define LAPACK_zggbal_base LAPACK_GLOBAL(zggbal,ZGGBAL) +#define LAPACK_zggbal_base LAPACK_GLOBAL_SUFFIX(zggbal,ZGGBAL) void LAPACK_zggbal_base( char const* job, lapack_int const* n, @@ -4577,7 +4591,7 @@ void LAPACK_zggbal_base( #define LAPACK_zggbal(...) LAPACK_zggbal_base(__VA_ARGS__) #endif -#define LAPACK_cgges_base LAPACK_GLOBAL(cgges,CGGES) +#define LAPACK_cgges_base LAPACK_GLOBAL_SUFFIX(cgges,CGGES) void LAPACK_cgges_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, lapack_int const* n, @@ -4600,7 +4614,7 @@ void LAPACK_cgges_base( #define LAPACK_cgges(...) LAPACK_cgges_base(__VA_ARGS__) #endif -#define LAPACK_dgges_base LAPACK_GLOBAL(dgges,DGGES) +#define LAPACK_dgges_base LAPACK_GLOBAL_SUFFIX(dgges,DGGES) void LAPACK_dgges_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, lapack_int const* n, @@ -4623,7 +4637,7 @@ void LAPACK_dgges_base( #define LAPACK_dgges(...) LAPACK_dgges_base(__VA_ARGS__) #endif -#define LAPACK_sgges_base LAPACK_GLOBAL(sgges,SGGES) +#define LAPACK_sgges_base LAPACK_GLOBAL_SUFFIX(sgges,SGGES) void LAPACK_sgges_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, lapack_int const* n, @@ -4646,7 +4660,7 @@ void LAPACK_sgges_base( #define LAPACK_sgges(...) LAPACK_sgges_base(__VA_ARGS__) #endif -#define LAPACK_zgges_base LAPACK_GLOBAL(zgges,ZGGES) +#define LAPACK_zgges_base LAPACK_GLOBAL_SUFFIX(zgges,ZGGES) void LAPACK_zgges_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, lapack_int const* n, @@ -4669,7 +4683,7 @@ void LAPACK_zgges_base( #define LAPACK_zgges(...) LAPACK_zgges_base(__VA_ARGS__) #endif -#define LAPACK_cgges3_base LAPACK_GLOBAL(cgges3,CGGES3) +#define LAPACK_cgges3_base LAPACK_GLOBAL_SUFFIX(cgges3,CGGES3) void LAPACK_cgges3_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, lapack_int const* n, @@ -4692,7 +4706,7 @@ void LAPACK_cgges3_base( #define LAPACK_cgges3(...) LAPACK_cgges3_base(__VA_ARGS__) #endif -#define LAPACK_dgges3_base LAPACK_GLOBAL(dgges3,DGGES3) +#define LAPACK_dgges3_base LAPACK_GLOBAL_SUFFIX(dgges3,DGGES3) void LAPACK_dgges3_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, lapack_int const* n, @@ -4715,7 +4729,7 @@ void LAPACK_dgges3_base( #define LAPACK_dgges3(...) LAPACK_dgges3_base(__VA_ARGS__) #endif -#define LAPACK_sgges3_base LAPACK_GLOBAL(sgges3,SGGES3) +#define LAPACK_sgges3_base LAPACK_GLOBAL_SUFFIX(sgges3,SGGES3) void LAPACK_sgges3_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, lapack_int const* n, @@ -4738,7 +4752,7 @@ void LAPACK_sgges3_base( #define LAPACK_sgges3(...) LAPACK_sgges3_base(__VA_ARGS__) #endif -#define LAPACK_zgges3_base LAPACK_GLOBAL(zgges3,ZGGES3) +#define LAPACK_zgges3_base LAPACK_GLOBAL_SUFFIX(zgges3,ZGGES3) void LAPACK_zgges3_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, lapack_int const* n, @@ -4761,7 +4775,7 @@ void LAPACK_zgges3_base( #define LAPACK_zgges3(...) LAPACK_zgges3_base(__VA_ARGS__) #endif -#define LAPACK_cggesx_base LAPACK_GLOBAL(cggesx,CGGESX) +#define LAPACK_cggesx_base LAPACK_GLOBAL_SUFFIX(cggesx,CGGESX) void LAPACK_cggesx_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, char const* sense, lapack_int const* n, @@ -4787,7 +4801,7 @@ void LAPACK_cggesx_base( #define LAPACK_cggesx(...) LAPACK_cggesx_base(__VA_ARGS__) #endif -#define LAPACK_dggesx_base LAPACK_GLOBAL(dggesx,DGGESX) +#define LAPACK_dggesx_base LAPACK_GLOBAL_SUFFIX(dggesx,DGGESX) void LAPACK_dggesx_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, char const* sense, lapack_int const* n, @@ -4813,7 +4827,7 @@ void LAPACK_dggesx_base( #define LAPACK_dggesx(...) LAPACK_dggesx_base(__VA_ARGS__) #endif -#define LAPACK_sggesx_base LAPACK_GLOBAL(sggesx,SGGESX) +#define LAPACK_sggesx_base LAPACK_GLOBAL_SUFFIX(sggesx,SGGESX) void LAPACK_sggesx_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, char const* sense, lapack_int const* n, @@ -4839,7 +4853,7 @@ void LAPACK_sggesx_base( #define LAPACK_sggesx(...) LAPACK_sggesx_base(__VA_ARGS__) #endif -#define LAPACK_zggesx_base LAPACK_GLOBAL(zggesx,ZGGESX) +#define LAPACK_zggesx_base LAPACK_GLOBAL_SUFFIX(zggesx,ZGGESX) void LAPACK_zggesx_base( char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, char const* sense, lapack_int const* n, @@ -4865,7 +4879,7 @@ void LAPACK_zggesx_base( #define LAPACK_zggesx(...) LAPACK_zggesx_base(__VA_ARGS__) #endif -#define LAPACK_cggev_base LAPACK_GLOBAL(cggev,CGGEV) +#define LAPACK_cggev_base LAPACK_GLOBAL_SUFFIX(cggev,CGGEV) void LAPACK_cggev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -4888,7 +4902,7 @@ void LAPACK_cggev_base( #define LAPACK_cggev(...) LAPACK_cggev_base(__VA_ARGS__) #endif -#define LAPACK_dggev_base LAPACK_GLOBAL(dggev,DGGEV) +#define LAPACK_dggev_base LAPACK_GLOBAL_SUFFIX(dggev,DGGEV) void LAPACK_dggev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -4911,7 +4925,7 @@ void LAPACK_dggev_base( #define LAPACK_dggev(...) LAPACK_dggev_base(__VA_ARGS__) #endif -#define LAPACK_sggev_base LAPACK_GLOBAL(sggev,SGGEV) +#define LAPACK_sggev_base LAPACK_GLOBAL_SUFFIX(sggev,SGGEV) void LAPACK_sggev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -4934,7 +4948,7 @@ void LAPACK_sggev_base( #define LAPACK_sggev(...) LAPACK_sggev_base(__VA_ARGS__) #endif -#define LAPACK_zggev_base LAPACK_GLOBAL(zggev,ZGGEV) +#define LAPACK_zggev_base LAPACK_GLOBAL_SUFFIX(zggev,ZGGEV) void LAPACK_zggev_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -4957,7 +4971,7 @@ void LAPACK_zggev_base( #define LAPACK_zggev(...) LAPACK_zggev_base(__VA_ARGS__) #endif -#define LAPACK_cggev3_base LAPACK_GLOBAL(cggev3,CGGEV3) +#define LAPACK_cggev3_base LAPACK_GLOBAL_SUFFIX(cggev3,CGGEV3) void LAPACK_cggev3_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -4980,7 +4994,7 @@ void LAPACK_cggev3_base( #define LAPACK_cggev3(...) LAPACK_cggev3_base(__VA_ARGS__) #endif -#define LAPACK_dggev3_base LAPACK_GLOBAL(dggev3,DGGEV3) +#define LAPACK_dggev3_base LAPACK_GLOBAL_SUFFIX(dggev3,DGGEV3) void LAPACK_dggev3_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -5003,7 +5017,7 @@ void LAPACK_dggev3_base( #define LAPACK_dggev3(...) LAPACK_dggev3_base(__VA_ARGS__) #endif -#define LAPACK_sggev3_base LAPACK_GLOBAL(sggev3,SGGEV3) +#define LAPACK_sggev3_base LAPACK_GLOBAL_SUFFIX(sggev3,SGGEV3) void LAPACK_sggev3_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -5026,7 +5040,7 @@ void LAPACK_sggev3_base( #define LAPACK_sggev3(...) LAPACK_sggev3_base(__VA_ARGS__) #endif -#define LAPACK_zggev3_base LAPACK_GLOBAL(zggev3,ZGGEV3) +#define LAPACK_zggev3_base LAPACK_GLOBAL_SUFFIX(zggev3,ZGGEV3) void LAPACK_zggev3_base( char const* jobvl, char const* jobvr, lapack_int const* n, @@ -5049,7 +5063,7 @@ void LAPACK_zggev3_base( #define LAPACK_zggev3(...) LAPACK_zggev3_base(__VA_ARGS__) #endif -#define LAPACK_cggevx_base LAPACK_GLOBAL(cggevx,CGGEVX) +#define LAPACK_cggevx_base LAPACK_GLOBAL_SUFFIX(cggevx,CGGEVX) void LAPACK_cggevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -5079,7 +5093,7 @@ void LAPACK_cggevx_base( #define LAPACK_cggevx(...) LAPACK_cggevx_base(__VA_ARGS__) #endif -#define LAPACK_dggevx_base LAPACK_GLOBAL(dggevx,DGGEVX) +#define LAPACK_dggevx_base LAPACK_GLOBAL_SUFFIX(dggevx,DGGEVX) void LAPACK_dggevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -5109,7 +5123,7 @@ void LAPACK_dggevx_base( #define LAPACK_dggevx(...) LAPACK_dggevx_base(__VA_ARGS__) #endif -#define LAPACK_sggevx_base LAPACK_GLOBAL(sggevx,SGGEVX) +#define LAPACK_sggevx_base LAPACK_GLOBAL_SUFFIX(sggevx,SGGEVX) void LAPACK_sggevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -5139,7 +5153,7 @@ void LAPACK_sggevx_base( #define LAPACK_sggevx(...) LAPACK_sggevx_base(__VA_ARGS__) #endif -#define LAPACK_zggevx_base LAPACK_GLOBAL(zggevx,ZGGEVX) +#define LAPACK_zggevx_base LAPACK_GLOBAL_SUFFIX(zggevx,ZGGEVX) void LAPACK_zggevx_base( char const* balanc, char const* jobvl, char const* jobvr, char const* sense, lapack_int const* n, @@ -5169,7 +5183,7 @@ void LAPACK_zggevx_base( #define LAPACK_zggevx(...) LAPACK_zggevx_base(__VA_ARGS__) #endif -#define LAPACK_cggglm LAPACK_GLOBAL(cggglm,CGGGLM) +#define LAPACK_cggglm LAPACK_GLOBAL_SUFFIX(cggglm,CGGGLM) void LAPACK_cggglm( lapack_int const* n, lapack_int const* m, lapack_int const* p, lapack_complex_float* A, lapack_int const* lda, @@ -5180,7 +5194,7 @@ void LAPACK_cggglm( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dggglm LAPACK_GLOBAL(dggglm,DGGGLM) +#define LAPACK_dggglm LAPACK_GLOBAL_SUFFIX(dggglm,DGGGLM) void LAPACK_dggglm( lapack_int const* n, lapack_int const* m, lapack_int const* p, double* A, lapack_int const* lda, @@ -5191,7 +5205,7 @@ void LAPACK_dggglm( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sggglm LAPACK_GLOBAL(sggglm,SGGGLM) +#define LAPACK_sggglm LAPACK_GLOBAL_SUFFIX(sggglm,SGGGLM) void LAPACK_sggglm( lapack_int const* n, lapack_int const* m, lapack_int const* p, float* A, lapack_int const* lda, @@ -5202,7 +5216,7 @@ void LAPACK_sggglm( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zggglm LAPACK_GLOBAL(zggglm,ZGGGLM) +#define LAPACK_zggglm LAPACK_GLOBAL_SUFFIX(zggglm,ZGGGLM) void LAPACK_zggglm( lapack_int const* n, lapack_int const* m, lapack_int const* p, lapack_complex_double* A, lapack_int const* lda, @@ -5213,7 +5227,7 @@ void LAPACK_zggglm( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cgghd3_base LAPACK_GLOBAL(cgghd3,CGGHD3) +#define LAPACK_cgghd3_base LAPACK_GLOBAL_SUFFIX(cgghd3,CGGHD3) void LAPACK_cgghd3_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5233,7 +5247,7 @@ void LAPACK_cgghd3_base( #define LAPACK_cgghd3(...) LAPACK_cgghd3_base(__VA_ARGS__) #endif -#define LAPACK_dgghd3_base LAPACK_GLOBAL(dgghd3,DGGHD3) +#define LAPACK_dgghd3_base LAPACK_GLOBAL_SUFFIX(dgghd3,DGGHD3) void LAPACK_dgghd3_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5253,7 +5267,7 @@ void LAPACK_dgghd3_base( #define LAPACK_dgghd3(...) LAPACK_dgghd3_base(__VA_ARGS__) #endif -#define LAPACK_sgghd3_base LAPACK_GLOBAL(sgghd3,SGGHD3) +#define LAPACK_sgghd3_base LAPACK_GLOBAL_SUFFIX(sgghd3,SGGHD3) void LAPACK_sgghd3_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5273,7 +5287,7 @@ void LAPACK_sgghd3_base( #define LAPACK_sgghd3(...) LAPACK_sgghd3_base(__VA_ARGS__) #endif -#define LAPACK_zgghd3_base LAPACK_GLOBAL(zgghd3,ZGGHD3) +#define LAPACK_zgghd3_base LAPACK_GLOBAL_SUFFIX(zgghd3,ZGGHD3) void LAPACK_zgghd3_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5293,7 +5307,7 @@ void LAPACK_zgghd3_base( #define LAPACK_zgghd3(...) LAPACK_zgghd3_base(__VA_ARGS__) #endif -#define LAPACK_cgghrd_base LAPACK_GLOBAL(cgghrd,CGGHRD) +#define LAPACK_cgghrd_base LAPACK_GLOBAL_SUFFIX(cgghrd,CGGHRD) void LAPACK_cgghrd_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5312,7 +5326,7 @@ void LAPACK_cgghrd_base( #define LAPACK_cgghrd(...) LAPACK_cgghrd_base(__VA_ARGS__) #endif -#define LAPACK_dgghrd_base LAPACK_GLOBAL(dgghrd,DGGHRD) +#define LAPACK_dgghrd_base LAPACK_GLOBAL_SUFFIX(dgghrd,DGGHRD) void LAPACK_dgghrd_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5331,7 +5345,7 @@ void LAPACK_dgghrd_base( #define LAPACK_dgghrd(...) LAPACK_dgghrd_base(__VA_ARGS__) #endif -#define LAPACK_sgghrd_base LAPACK_GLOBAL(sgghrd,SGGHRD) +#define LAPACK_sgghrd_base LAPACK_GLOBAL_SUFFIX(sgghrd,SGGHRD) void LAPACK_sgghrd_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5350,7 +5364,7 @@ void LAPACK_sgghrd_base( #define LAPACK_sgghrd(...) LAPACK_sgghrd_base(__VA_ARGS__) #endif -#define LAPACK_zgghrd_base LAPACK_GLOBAL(zgghrd,ZGGHRD) +#define LAPACK_zgghrd_base LAPACK_GLOBAL_SUFFIX(zgghrd,ZGGHRD) void LAPACK_zgghrd_base( char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -5369,7 +5383,7 @@ void LAPACK_zgghrd_base( #define LAPACK_zgghrd(...) LAPACK_zgghrd_base(__VA_ARGS__) #endif -#define LAPACK_cgglse LAPACK_GLOBAL(cgglse,CGGLSE) +#define LAPACK_cgglse LAPACK_GLOBAL_SUFFIX(cgglse,CGGLSE) void LAPACK_cgglse( lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_complex_float* A, lapack_int const* lda, @@ -5380,7 +5394,7 @@ void LAPACK_cgglse( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dgglse LAPACK_GLOBAL(dgglse,DGGLSE) +#define LAPACK_dgglse LAPACK_GLOBAL_SUFFIX(dgglse,DGGLSE) void LAPACK_dgglse( lapack_int const* m, lapack_int const* n, lapack_int const* p, double* A, lapack_int const* lda, @@ -5391,7 +5405,7 @@ void LAPACK_dgglse( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sgglse LAPACK_GLOBAL(sgglse,SGGLSE) +#define LAPACK_sgglse LAPACK_GLOBAL_SUFFIX(sgglse,SGGLSE) void LAPACK_sgglse( lapack_int const* m, lapack_int const* n, lapack_int const* p, float* A, lapack_int const* lda, @@ -5402,7 +5416,7 @@ void LAPACK_sgglse( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zgglse LAPACK_GLOBAL(zgglse,ZGGLSE) +#define LAPACK_zgglse LAPACK_GLOBAL_SUFFIX(zgglse,ZGGLSE) void LAPACK_zgglse( lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_complex_double* A, lapack_int const* lda, @@ -5413,7 +5427,7 @@ void LAPACK_zgglse( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cggqrf LAPACK_GLOBAL(cggqrf,CGGQRF) +#define LAPACK_cggqrf LAPACK_GLOBAL_SUFFIX(cggqrf,CGGQRF) void LAPACK_cggqrf( lapack_int const* n, lapack_int const* m, lapack_int const* p, lapack_complex_float* A, lapack_int const* lda, @@ -5423,7 +5437,7 @@ void LAPACK_cggqrf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dggqrf LAPACK_GLOBAL(dggqrf,DGGQRF) +#define LAPACK_dggqrf LAPACK_GLOBAL_SUFFIX(dggqrf,DGGQRF) void LAPACK_dggqrf( lapack_int const* n, lapack_int const* m, lapack_int const* p, double* A, lapack_int const* lda, @@ -5433,7 +5447,7 @@ void LAPACK_dggqrf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sggqrf LAPACK_GLOBAL(sggqrf,SGGQRF) +#define LAPACK_sggqrf LAPACK_GLOBAL_SUFFIX(sggqrf,SGGQRF) void LAPACK_sggqrf( lapack_int const* n, lapack_int const* m, lapack_int const* p, float* A, lapack_int const* lda, @@ -5443,7 +5457,7 @@ void LAPACK_sggqrf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zggqrf LAPACK_GLOBAL(zggqrf,ZGGQRF) +#define LAPACK_zggqrf LAPACK_GLOBAL_SUFFIX(zggqrf,ZGGQRF) void LAPACK_zggqrf( lapack_int const* n, lapack_int const* m, lapack_int const* p, lapack_complex_double* A, lapack_int const* lda, @@ -5453,7 +5467,7 @@ void LAPACK_zggqrf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cggrqf LAPACK_GLOBAL(cggrqf,CGGRQF) +#define LAPACK_cggrqf LAPACK_GLOBAL_SUFFIX(cggrqf,CGGRQF) void LAPACK_cggrqf( lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -5463,7 +5477,7 @@ void LAPACK_cggrqf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dggrqf LAPACK_GLOBAL(dggrqf,DGGRQF) +#define LAPACK_dggrqf LAPACK_GLOBAL_SUFFIX(dggrqf,DGGRQF) void LAPACK_dggrqf( lapack_int const* m, lapack_int const* p, lapack_int const* n, double* A, lapack_int const* lda, @@ -5473,7 +5487,7 @@ void LAPACK_dggrqf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sggrqf LAPACK_GLOBAL(sggrqf,SGGRQF) +#define LAPACK_sggrqf LAPACK_GLOBAL_SUFFIX(sggrqf,SGGRQF) void LAPACK_sggrqf( lapack_int const* m, lapack_int const* p, lapack_int const* n, float* A, lapack_int const* lda, @@ -5483,7 +5497,7 @@ void LAPACK_sggrqf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zggrqf LAPACK_GLOBAL(zggrqf,ZGGRQF) +#define LAPACK_zggrqf LAPACK_GLOBAL_SUFFIX(zggrqf,ZGGRQF) void LAPACK_zggrqf( lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -5493,7 +5507,7 @@ void LAPACK_zggrqf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cggsvd_base LAPACK_GLOBAL(cggsvd,CGGSVD) +#define LAPACK_cggsvd_base LAPACK_GLOBAL_SUFFIX(cggsvd,CGGSVD) lapack_int LAPACK_cggsvd_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, @@ -5516,7 +5530,7 @@ lapack_int LAPACK_cggsvd_base( #define LAPACK_cggsvd(...) LAPACK_cggsvd_base(__VA_ARGS__) #endif -#define LAPACK_sggsvd_base LAPACK_GLOBAL(sggsvd,SGGSVD) +#define LAPACK_sggsvd_base LAPACK_GLOBAL_SUFFIX(sggsvd,SGGSVD) lapack_int LAPACK_sggsvd_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, @@ -5538,7 +5552,7 @@ lapack_int LAPACK_sggsvd_base( #define LAPACK_sggsvd(...) LAPACK_sggsvd_base(__VA_ARGS__) #endif -#define LAPACK_dggsvd_base LAPACK_GLOBAL(dggsvd,DGGSVD) +#define LAPACK_dggsvd_base LAPACK_GLOBAL_SUFFIX(dggsvd,DGGSVD) lapack_int LAPACK_dggsvd_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, @@ -5560,7 +5574,7 @@ lapack_int LAPACK_dggsvd_base( #define LAPACK_dggsvd(...) LAPACK_dggsvd_base(__VA_ARGS__) #endif -#define LAPACK_zggsvd_base LAPACK_GLOBAL(zggsvd,ZGGSVD) +#define LAPACK_zggsvd_base LAPACK_GLOBAL_SUFFIX(zggsvd,ZGGSVD) lapack_int LAPACK_zggsvd_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, @@ -5583,7 +5597,7 @@ lapack_int LAPACK_zggsvd_base( #define LAPACK_zggsvd(...) LAPACK_zggsvd_base(__VA_ARGS__) #endif -#define LAPACK_cggsvd3_base LAPACK_GLOBAL(cggsvd3,CGGSVD3) +#define LAPACK_cggsvd3_base LAPACK_GLOBAL_SUFFIX(cggsvd3,CGGSVD3) void LAPACK_cggsvd3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, @@ -5608,7 +5622,7 @@ void LAPACK_cggsvd3_base( #define LAPACK_cggsvd3(...) LAPACK_cggsvd3_base(__VA_ARGS__) #endif -#define LAPACK_dggsvd3_base LAPACK_GLOBAL(dggsvd3,DGGSVD3) +#define LAPACK_dggsvd3_base LAPACK_GLOBAL_SUFFIX(dggsvd3,DGGSVD3) void LAPACK_dggsvd3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, @@ -5632,7 +5646,7 @@ void LAPACK_dggsvd3_base( #define LAPACK_dggsvd3(...) LAPACK_dggsvd3_base(__VA_ARGS__) #endif -#define LAPACK_sggsvd3_base LAPACK_GLOBAL(sggsvd3,SGGSVD3) +#define LAPACK_sggsvd3_base LAPACK_GLOBAL_SUFFIX(sggsvd3,SGGSVD3) void LAPACK_sggsvd3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, @@ -5656,7 +5670,7 @@ void LAPACK_sggsvd3_base( #define LAPACK_sggsvd3(...) LAPACK_sggsvd3_base(__VA_ARGS__) #endif -#define LAPACK_zggsvd3_base LAPACK_GLOBAL(zggsvd3,ZGGSVD3) +#define LAPACK_zggsvd3_base LAPACK_GLOBAL_SUFFIX(zggsvd3,ZGGSVD3) void LAPACK_zggsvd3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, @@ -5681,7 +5695,7 @@ void LAPACK_zggsvd3_base( #define LAPACK_zggsvd3(...) LAPACK_zggsvd3_base(__VA_ARGS__) #endif -#define LAPACK_sggsvp_base LAPACK_GLOBAL(sggsvp,SGGSVP) +#define LAPACK_sggsvp_base LAPACK_GLOBAL_SUFFIX(sggsvp,SGGSVP) lapack_int LAPACK_sggsvp_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5704,7 +5718,7 @@ lapack_int LAPACK_sggsvp_base( #define LAPACK_sggsvp(...) LAPACK_sggsvp_base(__VA_ARGS__) #endif -#define LAPACK_dggsvp_base LAPACK_GLOBAL(dggsvp,DGGSVP) +#define LAPACK_dggsvp_base LAPACK_GLOBAL_SUFFIX(dggsvp,DGGSVP) lapack_int LAPACK_dggsvp_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5727,7 +5741,7 @@ lapack_int LAPACK_dggsvp_base( #define LAPACK_dggsvp(...) LAPACK_dggsvp_base(__VA_ARGS__) #endif -#define LAPACK_cggsvp_base LAPACK_GLOBAL(cggsvp,CGGSVP) +#define LAPACK_cggsvp_base LAPACK_GLOBAL_SUFFIX(cggsvp,CGGSVP) lapack_int LAPACK_cggsvp_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5749,7 +5763,7 @@ lapack_int LAPACK_cggsvp_base( #define LAPACK_cggsvp(...) LAPACK_cggsvp_base(__VA_ARGS__) #endif -#define LAPACK_zggsvp_base LAPACK_GLOBAL(zggsvp,ZGGSVP) +#define LAPACK_zggsvp_base LAPACK_GLOBAL_SUFFIX(zggsvp,ZGGSVP) lapack_int LAPACK_zggsvp_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5771,7 +5785,7 @@ lapack_int LAPACK_zggsvp_base( #define LAPACK_zggsvp(...) LAPACK_zggsvp_base(__VA_ARGS__) #endif -#define LAPACK_cggsvp3_base LAPACK_GLOBAL(cggsvp3,CGGSVP3) +#define LAPACK_cggsvp3_base LAPACK_GLOBAL_SUFFIX(cggsvp3,CGGSVP3) void LAPACK_cggsvp3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5797,7 +5811,7 @@ void LAPACK_cggsvp3_base( #define LAPACK_cggsvp3(...) LAPACK_cggsvp3_base(__VA_ARGS__) #endif -#define LAPACK_dggsvp3_base LAPACK_GLOBAL(dggsvp3,DGGSVP3) +#define LAPACK_dggsvp3_base LAPACK_GLOBAL_SUFFIX(dggsvp3,DGGSVP3) void LAPACK_dggsvp3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5822,7 +5836,7 @@ void LAPACK_dggsvp3_base( #define LAPACK_dggsvp3(...) LAPACK_dggsvp3_base(__VA_ARGS__) #endif -#define LAPACK_sggsvp3_base LAPACK_GLOBAL(sggsvp3,SGGSVP3) +#define LAPACK_sggsvp3_base LAPACK_GLOBAL_SUFFIX(sggsvp3,SGGSVP3) void LAPACK_sggsvp3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5847,7 +5861,7 @@ void LAPACK_sggsvp3_base( #define LAPACK_sggsvp3(...) LAPACK_sggsvp3_base(__VA_ARGS__) #endif -#define LAPACK_zggsvp3_base LAPACK_GLOBAL(zggsvp3,ZGGSVP3) +#define LAPACK_zggsvp3_base LAPACK_GLOBAL_SUFFIX(zggsvp3,ZGGSVP3) void LAPACK_zggsvp3_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, @@ -5873,7 +5887,7 @@ void LAPACK_zggsvp3_base( #define LAPACK_zggsvp3(...) LAPACK_zggsvp3_base(__VA_ARGS__) #endif -#define LAPACK_cgtcon_base LAPACK_GLOBAL(cgtcon,CGTCON) +#define LAPACK_cgtcon_base LAPACK_GLOBAL_SUFFIX(cgtcon,CGTCON) void LAPACK_cgtcon_base( char const* norm, lapack_int const* n, @@ -5895,7 +5909,7 @@ void LAPACK_cgtcon_base( #define LAPACK_cgtcon(...) LAPACK_cgtcon_base(__VA_ARGS__) #endif -#define LAPACK_dgtcon_base LAPACK_GLOBAL(dgtcon,DGTCON) +#define LAPACK_dgtcon_base LAPACK_GLOBAL_SUFFIX(dgtcon,DGTCON) void LAPACK_dgtcon_base( char const* norm, lapack_int const* n, @@ -5918,7 +5932,7 @@ void LAPACK_dgtcon_base( #define LAPACK_dgtcon(...) LAPACK_dgtcon_base(__VA_ARGS__) #endif -#define LAPACK_sgtcon_base LAPACK_GLOBAL(sgtcon,SGTCON) +#define LAPACK_sgtcon_base LAPACK_GLOBAL_SUFFIX(sgtcon,SGTCON) void LAPACK_sgtcon_base( char const* norm, lapack_int const* n, @@ -5941,7 +5955,7 @@ void LAPACK_sgtcon_base( #define LAPACK_sgtcon(...) LAPACK_sgtcon_base(__VA_ARGS__) #endif -#define LAPACK_zgtcon_base LAPACK_GLOBAL(zgtcon,ZGTCON) +#define LAPACK_zgtcon_base LAPACK_GLOBAL_SUFFIX(zgtcon,ZGTCON) void LAPACK_zgtcon_base( char const* norm, lapack_int const* n, @@ -5963,7 +5977,7 @@ void LAPACK_zgtcon_base( #define LAPACK_zgtcon(...) LAPACK_zgtcon_base(__VA_ARGS__) #endif -#define LAPACK_cgtrfs_base LAPACK_GLOBAL(cgtrfs,CGTRFS) +#define LAPACK_cgtrfs_base LAPACK_GLOBAL_SUFFIX(cgtrfs,CGTRFS) void LAPACK_cgtrfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -5991,7 +6005,7 @@ void LAPACK_cgtrfs_base( #define LAPACK_cgtrfs(...) LAPACK_cgtrfs_base(__VA_ARGS__) #endif -#define LAPACK_dgtrfs_base LAPACK_GLOBAL(dgtrfs,DGTRFS) +#define LAPACK_dgtrfs_base LAPACK_GLOBAL_SUFFIX(dgtrfs,DGTRFS) void LAPACK_dgtrfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6019,7 +6033,7 @@ void LAPACK_dgtrfs_base( #define LAPACK_dgtrfs(...) LAPACK_dgtrfs_base(__VA_ARGS__) #endif -#define LAPACK_sgtrfs_base LAPACK_GLOBAL(sgtrfs,SGTRFS) +#define LAPACK_sgtrfs_base LAPACK_GLOBAL_SUFFIX(sgtrfs,SGTRFS) void LAPACK_sgtrfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6047,7 +6061,7 @@ void LAPACK_sgtrfs_base( #define LAPACK_sgtrfs(...) LAPACK_sgtrfs_base(__VA_ARGS__) #endif -#define LAPACK_zgtrfs_base LAPACK_GLOBAL(zgtrfs,ZGTRFS) +#define LAPACK_zgtrfs_base LAPACK_GLOBAL_SUFFIX(zgtrfs,ZGTRFS) void LAPACK_zgtrfs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6075,7 +6089,7 @@ void LAPACK_zgtrfs_base( #define LAPACK_zgtrfs(...) LAPACK_zgtrfs_base(__VA_ARGS__) #endif -#define LAPACK_cgtsv LAPACK_GLOBAL(cgtsv,CGTSV) +#define LAPACK_cgtsv LAPACK_GLOBAL_SUFFIX(cgtsv,CGTSV) void LAPACK_cgtsv( lapack_int const* n, lapack_int const* nrhs, lapack_complex_float* DL, @@ -6084,7 +6098,7 @@ void LAPACK_cgtsv( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_dgtsv LAPACK_GLOBAL(dgtsv,DGTSV) +#define LAPACK_dgtsv LAPACK_GLOBAL_SUFFIX(dgtsv,DGTSV) void LAPACK_dgtsv( lapack_int const* n, lapack_int const* nrhs, double* DL, @@ -6093,7 +6107,7 @@ void LAPACK_dgtsv( double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_sgtsv LAPACK_GLOBAL(sgtsv,SGTSV) +#define LAPACK_sgtsv LAPACK_GLOBAL_SUFFIX(sgtsv,SGTSV) void LAPACK_sgtsv( lapack_int const* n, lapack_int const* nrhs, float* DL, @@ -6102,7 +6116,7 @@ void LAPACK_sgtsv( float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_zgtsv LAPACK_GLOBAL(zgtsv,ZGTSV) +#define LAPACK_zgtsv LAPACK_GLOBAL_SUFFIX(zgtsv,ZGTSV) void LAPACK_zgtsv( lapack_int const* n, lapack_int const* nrhs, lapack_complex_double* DL, @@ -6111,7 +6125,7 @@ void LAPACK_zgtsv( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_cgtsvx_base LAPACK_GLOBAL(cgtsvx,CGTSVX) +#define LAPACK_cgtsvx_base LAPACK_GLOBAL_SUFFIX(cgtsvx,CGTSVX) void LAPACK_cgtsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6140,7 +6154,7 @@ void LAPACK_cgtsvx_base( #define LAPACK_cgtsvx(...) LAPACK_cgtsvx_base(__VA_ARGS__) #endif -#define LAPACK_dgtsvx_base LAPACK_GLOBAL(dgtsvx,DGTSVX) +#define LAPACK_dgtsvx_base LAPACK_GLOBAL_SUFFIX(dgtsvx,DGTSVX) void LAPACK_dgtsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6169,7 +6183,7 @@ void LAPACK_dgtsvx_base( #define LAPACK_dgtsvx(...) LAPACK_dgtsvx_base(__VA_ARGS__) #endif -#define LAPACK_sgtsvx_base LAPACK_GLOBAL(sgtsvx,SGTSVX) +#define LAPACK_sgtsvx_base LAPACK_GLOBAL_SUFFIX(sgtsvx,SGTSVX) void LAPACK_sgtsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6198,7 +6212,7 @@ void LAPACK_sgtsvx_base( #define LAPACK_sgtsvx(...) LAPACK_sgtsvx_base(__VA_ARGS__) #endif -#define LAPACK_zgtsvx_base LAPACK_GLOBAL(zgtsvx,ZGTSVX) +#define LAPACK_zgtsvx_base LAPACK_GLOBAL_SUFFIX(zgtsvx,ZGTSVX) void LAPACK_zgtsvx_base( char const* fact, char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6227,7 +6241,7 @@ void LAPACK_zgtsvx_base( #define LAPACK_zgtsvx(...) LAPACK_zgtsvx_base(__VA_ARGS__) #endif -#define LAPACK_cgttrf LAPACK_GLOBAL(cgttrf,CGTTRF) +#define LAPACK_cgttrf LAPACK_GLOBAL_SUFFIX(cgttrf,CGTTRF) void LAPACK_cgttrf( lapack_int const* n, lapack_complex_float* DL, @@ -6236,7 +6250,7 @@ void LAPACK_cgttrf( lapack_complex_float* DU2, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_dgttrf LAPACK_GLOBAL(dgttrf,DGTTRF) +#define LAPACK_dgttrf LAPACK_GLOBAL_SUFFIX(dgttrf,DGTTRF) void LAPACK_dgttrf( lapack_int const* n, double* DL, @@ -6245,7 +6259,7 @@ void LAPACK_dgttrf( double* DU2, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_sgttrf LAPACK_GLOBAL(sgttrf,SGTTRF) +#define LAPACK_sgttrf LAPACK_GLOBAL_SUFFIX(sgttrf,SGTTRF) void LAPACK_sgttrf( lapack_int const* n, float* DL, @@ -6254,7 +6268,7 @@ void LAPACK_sgttrf( float* DU2, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_zgttrf LAPACK_GLOBAL(zgttrf,ZGTTRF) +#define LAPACK_zgttrf LAPACK_GLOBAL_SUFFIX(zgttrf,ZGTTRF) void LAPACK_zgttrf( lapack_int const* n, lapack_complex_double* DL, @@ -6263,7 +6277,7 @@ void LAPACK_zgttrf( lapack_complex_double* DU2, lapack_int* ipiv, lapack_int* info ); -#define LAPACK_cgttrs_base LAPACK_GLOBAL(cgttrs,CGTTRS) +#define LAPACK_cgttrs_base LAPACK_GLOBAL_SUFFIX(cgttrs,CGTTRS) void LAPACK_cgttrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6283,7 +6297,7 @@ void LAPACK_cgttrs_base( #define LAPACK_cgttrs(...) LAPACK_cgttrs_base(__VA_ARGS__) #endif -#define LAPACK_dgttrs_base LAPACK_GLOBAL(dgttrs,DGTTRS) +#define LAPACK_dgttrs_base LAPACK_GLOBAL_SUFFIX(dgttrs,DGTTRS) void LAPACK_dgttrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6303,7 +6317,7 @@ void LAPACK_dgttrs_base( #define LAPACK_dgttrs(...) LAPACK_dgttrs_base(__VA_ARGS__) #endif -#define LAPACK_sgttrs_base LAPACK_GLOBAL(sgttrs,SGTTRS) +#define LAPACK_sgttrs_base LAPACK_GLOBAL_SUFFIX(sgttrs,SGTTRS) void LAPACK_sgttrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6323,7 +6337,7 @@ void LAPACK_sgttrs_base( #define LAPACK_sgttrs(...) LAPACK_sgttrs_base(__VA_ARGS__) #endif -#define LAPACK_zgttrs_base LAPACK_GLOBAL(zgttrs,ZGTTRS) +#define LAPACK_zgttrs_base LAPACK_GLOBAL_SUFFIX(zgttrs,ZGTTRS) void LAPACK_zgttrs_base( char const* trans, lapack_int const* n, lapack_int const* nrhs, @@ -6343,7 +6357,7 @@ void LAPACK_zgttrs_base( #define LAPACK_zgttrs(...) LAPACK_zgttrs_base(__VA_ARGS__) #endif -#define LAPACK_chbev_base LAPACK_GLOBAL(chbev,CHBEV) +#define LAPACK_chbev_base LAPACK_GLOBAL_SUFFIX(chbev,CHBEV) void LAPACK_chbev_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6363,7 +6377,7 @@ void LAPACK_chbev_base( #define LAPACK_chbev(...) LAPACK_chbev_base(__VA_ARGS__) #endif -#define LAPACK_zhbev_base LAPACK_GLOBAL(zhbev,ZHBEV) +#define LAPACK_zhbev_base LAPACK_GLOBAL_SUFFIX(zhbev,ZHBEV) void LAPACK_zhbev_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6383,7 +6397,7 @@ void LAPACK_zhbev_base( #define LAPACK_zhbev(...) LAPACK_zhbev_base(__VA_ARGS__) #endif -#define LAPACK_chbev_2stage_base LAPACK_GLOBAL(chbev_2stage,CHBEV_2STAGE) +#define LAPACK_chbev_2stage_base LAPACK_GLOBAL_SUFFIX(chbev_2stage,CHBEV_2STAGE) void LAPACK_chbev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6403,7 +6417,7 @@ void LAPACK_chbev_2stage_base( #define LAPACK_chbev_2stage(...) LAPACK_chbev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhbev_2stage_base LAPACK_GLOBAL(zhbev_2stage,ZHBEV_2STAGE) +#define LAPACK_zhbev_2stage_base LAPACK_GLOBAL_SUFFIX(zhbev_2stage,ZHBEV_2STAGE) void LAPACK_zhbev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6423,7 +6437,7 @@ void LAPACK_zhbev_2stage_base( #define LAPACK_zhbev_2stage(...) LAPACK_zhbev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chbevd_base LAPACK_GLOBAL(chbevd,CHBEVD) +#define LAPACK_chbevd_base LAPACK_GLOBAL_SUFFIX(chbevd,CHBEVD) void LAPACK_chbevd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6444,7 +6458,7 @@ void LAPACK_chbevd_base( #define LAPACK_chbevd(...) LAPACK_chbevd_base(__VA_ARGS__) #endif -#define LAPACK_zhbevd_base LAPACK_GLOBAL(zhbevd,ZHBEVD) +#define LAPACK_zhbevd_base LAPACK_GLOBAL_SUFFIX(zhbevd,ZHBEVD) void LAPACK_zhbevd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6465,7 +6479,7 @@ void LAPACK_zhbevd_base( #define LAPACK_zhbevd(...) LAPACK_zhbevd_base(__VA_ARGS__) #endif -#define LAPACK_chbevd_2stage_base LAPACK_GLOBAL(chbevd_2stage,CHBEVD_2STAGE) +#define LAPACK_chbevd_2stage_base LAPACK_GLOBAL_SUFFIX(chbevd_2stage,CHBEVD_2STAGE) void LAPACK_chbevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6486,7 +6500,7 @@ void LAPACK_chbevd_2stage_base( #define LAPACK_chbevd_2stage(...) LAPACK_chbevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhbevd_2stage_base LAPACK_GLOBAL(zhbevd_2stage,ZHBEVD_2STAGE) +#define LAPACK_zhbevd_2stage_base LAPACK_GLOBAL_SUFFIX(zhbevd_2stage,ZHBEVD_2STAGE) void LAPACK_zhbevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6507,7 +6521,7 @@ void LAPACK_zhbevd_2stage_base( #define LAPACK_zhbevd_2stage(...) LAPACK_zhbevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chbevx_base LAPACK_GLOBAL(chbevx,CHBEVX) +#define LAPACK_chbevx_base LAPACK_GLOBAL_SUFFIX(chbevx,CHBEVX) void LAPACK_chbevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6532,7 +6546,7 @@ void LAPACK_chbevx_base( #define LAPACK_chbevx(...) LAPACK_chbevx_base(__VA_ARGS__) #endif -#define LAPACK_zhbevx_base LAPACK_GLOBAL(zhbevx,ZHBEVX) +#define LAPACK_zhbevx_base LAPACK_GLOBAL_SUFFIX(zhbevx,ZHBEVX) void LAPACK_zhbevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6557,7 +6571,7 @@ void LAPACK_zhbevx_base( #define LAPACK_zhbevx(...) LAPACK_zhbevx_base(__VA_ARGS__) #endif -#define LAPACK_chbevx_2stage_base LAPACK_GLOBAL(chbevx_2stage,CHBEVX_2STAGE) +#define LAPACK_chbevx_2stage_base LAPACK_GLOBAL_SUFFIX(chbevx_2stage,CHBEVX_2STAGE) void LAPACK_chbevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6582,7 +6596,7 @@ void LAPACK_chbevx_2stage_base( #define LAPACK_chbevx_2stage(...) LAPACK_chbevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhbevx_2stage_base LAPACK_GLOBAL(zhbevx_2stage,ZHBEVX_2STAGE) +#define LAPACK_zhbevx_2stage_base LAPACK_GLOBAL_SUFFIX(zhbevx_2stage,ZHBEVX_2STAGE) void LAPACK_zhbevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6607,7 +6621,7 @@ void LAPACK_zhbevx_2stage_base( #define LAPACK_zhbevx_2stage(...) LAPACK_zhbevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chbgst_base LAPACK_GLOBAL(chbgst,CHBGST) +#define LAPACK_chbgst_base LAPACK_GLOBAL_SUFFIX(chbgst,CHBGST) void LAPACK_chbgst_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6627,7 +6641,7 @@ void LAPACK_chbgst_base( #define LAPACK_chbgst(...) LAPACK_chbgst_base(__VA_ARGS__) #endif -#define LAPACK_zhbgst_base LAPACK_GLOBAL(zhbgst,ZHBGST) +#define LAPACK_zhbgst_base LAPACK_GLOBAL_SUFFIX(zhbgst,ZHBGST) void LAPACK_zhbgst_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6647,7 +6661,7 @@ void LAPACK_zhbgst_base( #define LAPACK_zhbgst(...) LAPACK_zhbgst_base(__VA_ARGS__) #endif -#define LAPACK_chbgv_base LAPACK_GLOBAL(chbgv,CHBGV) +#define LAPACK_chbgv_base LAPACK_GLOBAL_SUFFIX(chbgv,CHBGV) void LAPACK_chbgv_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6668,7 +6682,7 @@ void LAPACK_chbgv_base( #define LAPACK_chbgv(...) LAPACK_chbgv_base(__VA_ARGS__) #endif -#define LAPACK_zhbgv_base LAPACK_GLOBAL(zhbgv,ZHBGV) +#define LAPACK_zhbgv_base LAPACK_GLOBAL_SUFFIX(zhbgv,ZHBGV) void LAPACK_zhbgv_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6689,7 +6703,7 @@ void LAPACK_zhbgv_base( #define LAPACK_zhbgv(...) LAPACK_zhbgv_base(__VA_ARGS__) #endif -#define LAPACK_chbgvd_base LAPACK_GLOBAL(chbgvd,CHBGVD) +#define LAPACK_chbgvd_base LAPACK_GLOBAL_SUFFIX(chbgvd,CHBGVD) void LAPACK_chbgvd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6711,7 +6725,7 @@ void LAPACK_chbgvd_base( #define LAPACK_chbgvd(...) LAPACK_chbgvd_base(__VA_ARGS__) #endif -#define LAPACK_zhbgvd_base LAPACK_GLOBAL(zhbgvd,ZHBGVD) +#define LAPACK_zhbgvd_base LAPACK_GLOBAL_SUFFIX(zhbgvd,ZHBGVD) void LAPACK_zhbgvd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6733,7 +6747,7 @@ void LAPACK_zhbgvd_base( #define LAPACK_zhbgvd(...) LAPACK_zhbgvd_base(__VA_ARGS__) #endif -#define LAPACK_chbgvx_base LAPACK_GLOBAL(chbgvx,CHBGVX) +#define LAPACK_chbgvx_base LAPACK_GLOBAL_SUFFIX(chbgvx,CHBGVX) void LAPACK_chbgvx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6759,7 +6773,7 @@ void LAPACK_chbgvx_base( #define LAPACK_chbgvx(...) LAPACK_chbgvx_base(__VA_ARGS__) #endif -#define LAPACK_zhbgvx_base LAPACK_GLOBAL(zhbgvx,ZHBGVX) +#define LAPACK_zhbgvx_base LAPACK_GLOBAL_SUFFIX(zhbgvx,ZHBGVX) void LAPACK_zhbgvx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -6785,7 +6799,7 @@ void LAPACK_zhbgvx_base( #define LAPACK_zhbgvx(...) LAPACK_zhbgvx_base(__VA_ARGS__) #endif -#define LAPACK_chbtrd_base LAPACK_GLOBAL(chbtrd,CHBTRD) +#define LAPACK_chbtrd_base LAPACK_GLOBAL_SUFFIX(chbtrd,CHBTRD) void LAPACK_chbtrd_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6805,7 +6819,7 @@ void LAPACK_chbtrd_base( #define LAPACK_chbtrd(...) LAPACK_chbtrd_base(__VA_ARGS__) #endif -#define LAPACK_zhbtrd_base LAPACK_GLOBAL(zhbtrd,ZHBTRD) +#define LAPACK_zhbtrd_base LAPACK_GLOBAL_SUFFIX(zhbtrd,ZHBTRD) void LAPACK_zhbtrd_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -6825,7 +6839,7 @@ void LAPACK_zhbtrd_base( #define LAPACK_zhbtrd(...) LAPACK_zhbtrd_base(__VA_ARGS__) #endif -#define LAPACK_checon_base LAPACK_GLOBAL(checon,CHECON) +#define LAPACK_checon_base LAPACK_GLOBAL_SUFFIX(checon,CHECON) void LAPACK_checon_base( char const* uplo, lapack_int const* n, @@ -6844,7 +6858,7 @@ void LAPACK_checon_base( #define LAPACK_checon(...) LAPACK_checon_base(__VA_ARGS__) #endif -#define LAPACK_zhecon_base LAPACK_GLOBAL(zhecon,ZHECON) +#define LAPACK_zhecon_base LAPACK_GLOBAL_SUFFIX(zhecon,ZHECON) void LAPACK_zhecon_base( char const* uplo, lapack_int const* n, @@ -6863,7 +6877,7 @@ void LAPACK_zhecon_base( #define LAPACK_zhecon(...) LAPACK_zhecon_base(__VA_ARGS__) #endif -#define LAPACK_checon_3_base LAPACK_GLOBAL(checon_3,CHECON_3) +#define LAPACK_checon_3_base LAPACK_GLOBAL_SUFFIX(checon_3,CHECON_3) void LAPACK_checon_3_base( char const* uplo, lapack_int const* n, @@ -6883,7 +6897,7 @@ void LAPACK_checon_3_base( #define LAPACK_checon_3(...) LAPACK_checon_3_base(__VA_ARGS__) #endif -#define LAPACK_zhecon_3_base LAPACK_GLOBAL(zhecon_3,ZHECON_3) +#define LAPACK_zhecon_3_base LAPACK_GLOBAL_SUFFIX(zhecon_3,ZHECON_3) void LAPACK_zhecon_3_base( char const* uplo, lapack_int const* n, @@ -6903,7 +6917,7 @@ void LAPACK_zhecon_3_base( #define LAPACK_zhecon_3(...) LAPACK_zhecon_3_base(__VA_ARGS__) #endif -#define LAPACK_cheequb_base LAPACK_GLOBAL(cheequb,CHEEQUB) +#define LAPACK_cheequb_base LAPACK_GLOBAL_SUFFIX(cheequb,CHEEQUB) void LAPACK_cheequb_base( char const* uplo, lapack_int const* n, @@ -6923,7 +6937,7 @@ void LAPACK_cheequb_base( #define LAPACK_cheequb(...) LAPACK_cheequb_base(__VA_ARGS__) #endif -#define LAPACK_zheequb_base LAPACK_GLOBAL(zheequb,ZHEEQUB) +#define LAPACK_zheequb_base LAPACK_GLOBAL_SUFFIX(zheequb,ZHEEQUB) void LAPACK_zheequb_base( char const* uplo, lapack_int const* n, @@ -6943,7 +6957,7 @@ void LAPACK_zheequb_base( #define LAPACK_zheequb(...) LAPACK_zheequb_base(__VA_ARGS__) #endif -#define LAPACK_cheev_base LAPACK_GLOBAL(cheev,CHEEV) +#define LAPACK_cheev_base LAPACK_GLOBAL_SUFFIX(cheev,CHEEV) void LAPACK_cheev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -6962,7 +6976,7 @@ void LAPACK_cheev_base( #define LAPACK_cheev(...) LAPACK_cheev_base(__VA_ARGS__) #endif -#define LAPACK_zheev_base LAPACK_GLOBAL(zheev,ZHEEV) +#define LAPACK_zheev_base LAPACK_GLOBAL_SUFFIX(zheev,ZHEEV) void LAPACK_zheev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -6981,7 +6995,7 @@ void LAPACK_zheev_base( #define LAPACK_zheev(...) LAPACK_zheev_base(__VA_ARGS__) #endif -#define LAPACK_cheev_2stage_base LAPACK_GLOBAL(cheev_2stage,CHEEV_2STAGE) +#define LAPACK_cheev_2stage_base LAPACK_GLOBAL_SUFFIX(cheev_2stage,CHEEV_2STAGE) void LAPACK_cheev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7000,7 +7014,7 @@ void LAPACK_cheev_2stage_base( #define LAPACK_cheev_2stage(...) LAPACK_cheev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zheev_2stage_base LAPACK_GLOBAL(zheev_2stage,ZHEEV_2STAGE) +#define LAPACK_zheev_2stage_base LAPACK_GLOBAL_SUFFIX(zheev_2stage,ZHEEV_2STAGE) void LAPACK_zheev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7019,7 +7033,7 @@ void LAPACK_zheev_2stage_base( #define LAPACK_zheev_2stage(...) LAPACK_zheev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_cheevd_base LAPACK_GLOBAL(cheevd,CHEEVD) +#define LAPACK_cheevd_base LAPACK_GLOBAL_SUFFIX(cheevd,CHEEVD) void LAPACK_cheevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7039,7 +7053,7 @@ void LAPACK_cheevd_base( #define LAPACK_cheevd(...) LAPACK_cheevd_base(__VA_ARGS__) #endif -#define LAPACK_zheevd_base LAPACK_GLOBAL(zheevd,ZHEEVD) +#define LAPACK_zheevd_base LAPACK_GLOBAL_SUFFIX(zheevd,ZHEEVD) void LAPACK_zheevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7059,7 +7073,7 @@ void LAPACK_zheevd_base( #define LAPACK_zheevd(...) LAPACK_zheevd_base(__VA_ARGS__) #endif -#define LAPACK_cheevd_2stage_base LAPACK_GLOBAL(cheevd_2stage,CHEEVD_2STAGE) +#define LAPACK_cheevd_2stage_base LAPACK_GLOBAL_SUFFIX(cheevd_2stage,CHEEVD_2STAGE) void LAPACK_cheevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7079,7 +7093,7 @@ void LAPACK_cheevd_2stage_base( #define LAPACK_cheevd_2stage(...) LAPACK_cheevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zheevd_2stage_base LAPACK_GLOBAL(zheevd_2stage,ZHEEVD_2STAGE) +#define LAPACK_zheevd_2stage_base LAPACK_GLOBAL_SUFFIX(zheevd_2stage,ZHEEVD_2STAGE) void LAPACK_zheevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -7099,7 +7113,7 @@ void LAPACK_zheevd_2stage_base( #define LAPACK_zheevd_2stage(...) LAPACK_zheevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_cheevr_base LAPACK_GLOBAL(cheevr,CHEEVR) +#define LAPACK_cheevr_base LAPACK_GLOBAL_SUFFIX(cheevr,CHEEVR) void LAPACK_cheevr_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7123,7 +7137,7 @@ void LAPACK_cheevr_base( #define LAPACK_cheevr(...) LAPACK_cheevr_base(__VA_ARGS__) #endif -#define LAPACK_zheevr_base LAPACK_GLOBAL(zheevr,ZHEEVR) +#define LAPACK_zheevr_base LAPACK_GLOBAL_SUFFIX(zheevr,ZHEEVR) void LAPACK_zheevr_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7147,7 +7161,7 @@ void LAPACK_zheevr_base( #define LAPACK_zheevr(...) LAPACK_zheevr_base(__VA_ARGS__) #endif -#define LAPACK_cheevr_2stage_base LAPACK_GLOBAL(cheevr_2stage,CHEEVR_2STAGE) +#define LAPACK_cheevr_2stage_base LAPACK_GLOBAL_SUFFIX(cheevr_2stage,CHEEVR_2STAGE) void LAPACK_cheevr_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7171,7 +7185,7 @@ void LAPACK_cheevr_2stage_base( #define LAPACK_cheevr_2stage(...) LAPACK_cheevr_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zheevr_2stage_base LAPACK_GLOBAL(zheevr_2stage,ZHEEVR_2STAGE) +#define LAPACK_zheevr_2stage_base LAPACK_GLOBAL_SUFFIX(zheevr_2stage,ZHEEVR_2STAGE) void LAPACK_zheevr_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7195,7 +7209,7 @@ void LAPACK_zheevr_2stage_base( #define LAPACK_zheevr_2stage(...) LAPACK_zheevr_2stage_base(__VA_ARGS__) #endif -#define LAPACK_cheevx_base LAPACK_GLOBAL(cheevx,CHEEVX) +#define LAPACK_cheevx_base LAPACK_GLOBAL_SUFFIX(cheevx,CHEEVX) void LAPACK_cheevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7219,7 +7233,7 @@ void LAPACK_cheevx_base( #define LAPACK_cheevx(...) LAPACK_cheevx_base(__VA_ARGS__) #endif -#define LAPACK_zheevx_base LAPACK_GLOBAL(zheevx,ZHEEVX) +#define LAPACK_zheevx_base LAPACK_GLOBAL_SUFFIX(zheevx,ZHEEVX) void LAPACK_zheevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7243,7 +7257,7 @@ void LAPACK_zheevx_base( #define LAPACK_zheevx(...) LAPACK_zheevx_base(__VA_ARGS__) #endif -#define LAPACK_cheevx_2stage_base LAPACK_GLOBAL(cheevx_2stage,CHEEVX_2STAGE) +#define LAPACK_cheevx_2stage_base LAPACK_GLOBAL_SUFFIX(cheevx_2stage,CHEEVX_2STAGE) void LAPACK_cheevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7267,7 +7281,7 @@ void LAPACK_cheevx_2stage_base( #define LAPACK_cheevx_2stage(...) LAPACK_cheevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zheevx_2stage_base LAPACK_GLOBAL(zheevx_2stage,ZHEEVX_2STAGE) +#define LAPACK_zheevx_2stage_base LAPACK_GLOBAL_SUFFIX(zheevx_2stage,ZHEEVX_2STAGE) void LAPACK_zheevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7291,7 +7305,7 @@ void LAPACK_zheevx_2stage_base( #define LAPACK_zheevx_2stage(...) LAPACK_zheevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chegst_base LAPACK_GLOBAL(chegst,CHEGST) +#define LAPACK_chegst_base LAPACK_GLOBAL_SUFFIX(chegst,CHEGST) void LAPACK_chegst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -7308,7 +7322,7 @@ void LAPACK_chegst_base( #define LAPACK_chegst(...) LAPACK_chegst_base(__VA_ARGS__) #endif -#define LAPACK_zhegst_base LAPACK_GLOBAL(zhegst,ZHEGST) +#define LAPACK_zhegst_base LAPACK_GLOBAL_SUFFIX(zhegst,ZHEGST) void LAPACK_zhegst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -7325,7 +7339,7 @@ void LAPACK_zhegst_base( #define LAPACK_zhegst(...) LAPACK_zhegst_base(__VA_ARGS__) #endif -#define LAPACK_chegv_base LAPACK_GLOBAL(chegv,CHEGV) +#define LAPACK_chegv_base LAPACK_GLOBAL_SUFFIX(chegv,CHEGV) void LAPACK_chegv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7345,7 +7359,7 @@ void LAPACK_chegv_base( #define LAPACK_chegv(...) LAPACK_chegv_base(__VA_ARGS__) #endif -#define LAPACK_zhegv_base LAPACK_GLOBAL(zhegv,ZHEGV) +#define LAPACK_zhegv_base LAPACK_GLOBAL_SUFFIX(zhegv,ZHEGV) void LAPACK_zhegv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7365,7 +7379,7 @@ void LAPACK_zhegv_base( #define LAPACK_zhegv(...) LAPACK_zhegv_base(__VA_ARGS__) #endif -#define LAPACK_chegv_2stage_base LAPACK_GLOBAL(chegv_2stage,CHEGV_2STAGE) +#define LAPACK_chegv_2stage_base LAPACK_GLOBAL_SUFFIX(chegv_2stage,CHEGV_2STAGE) void LAPACK_chegv_2stage_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7385,7 +7399,7 @@ void LAPACK_chegv_2stage_base( #define LAPACK_chegv_2stage(...) LAPACK_chegv_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhegv_2stage_base LAPACK_GLOBAL(zhegv_2stage,ZHEGV_2STAGE) +#define LAPACK_zhegv_2stage_base LAPACK_GLOBAL_SUFFIX(zhegv_2stage,ZHEGV_2STAGE) void LAPACK_zhegv_2stage_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7405,7 +7419,7 @@ void LAPACK_zhegv_2stage_base( #define LAPACK_zhegv_2stage(...) LAPACK_zhegv_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chegvd_base LAPACK_GLOBAL(chegvd,CHEGVD) +#define LAPACK_chegvd_base LAPACK_GLOBAL_SUFFIX(chegvd,CHEGVD) void LAPACK_chegvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7426,7 +7440,7 @@ void LAPACK_chegvd_base( #define LAPACK_chegvd(...) LAPACK_chegvd_base(__VA_ARGS__) #endif -#define LAPACK_zhegvd_base LAPACK_GLOBAL(zhegvd,ZHEGVD) +#define LAPACK_zhegvd_base LAPACK_GLOBAL_SUFFIX(zhegvd,ZHEGVD) void LAPACK_zhegvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -7447,7 +7461,7 @@ void LAPACK_zhegvd_base( #define LAPACK_zhegvd(...) LAPACK_zhegvd_base(__VA_ARGS__) #endif -#define LAPACK_chegvx_base LAPACK_GLOBAL(chegvx,CHEGVX) +#define LAPACK_chegvx_base LAPACK_GLOBAL_SUFFIX(chegvx,CHEGVX) void LAPACK_chegvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7472,7 +7486,7 @@ void LAPACK_chegvx_base( #define LAPACK_chegvx(...) LAPACK_chegvx_base(__VA_ARGS__) #endif -#define LAPACK_zhegvx_base LAPACK_GLOBAL(zhegvx,ZHEGVX) +#define LAPACK_zhegvx_base LAPACK_GLOBAL_SUFFIX(zhegvx,ZHEGVX) void LAPACK_zhegvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -7497,7 +7511,7 @@ void LAPACK_zhegvx_base( #define LAPACK_zhegvx(...) LAPACK_zhegvx_base(__VA_ARGS__) #endif -#define LAPACK_cherfs_base LAPACK_GLOBAL(cherfs,CHERFS) +#define LAPACK_cherfs_base LAPACK_GLOBAL_SUFFIX(cherfs,CHERFS) void LAPACK_cherfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7520,7 +7534,7 @@ void LAPACK_cherfs_base( #define LAPACK_cherfs(...) LAPACK_cherfs_base(__VA_ARGS__) #endif -#define LAPACK_zherfs_base LAPACK_GLOBAL(zherfs,ZHERFS) +#define LAPACK_zherfs_base LAPACK_GLOBAL_SUFFIX(zherfs,ZHERFS) void LAPACK_zherfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7543,7 +7557,7 @@ void LAPACK_zherfs_base( #define LAPACK_zherfs(...) LAPACK_zherfs_base(__VA_ARGS__) #endif -#define LAPACK_cherfsx_base LAPACK_GLOBAL(cherfsx,CHERFSX) +#define LAPACK_cherfsx_base LAPACK_GLOBAL_SUFFIX(cherfsx,CHERFSX) void LAPACK_cherfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -7570,7 +7584,7 @@ void LAPACK_cherfsx_base( #define LAPACK_cherfsx(...) LAPACK_cherfsx_base(__VA_ARGS__) #endif -#define LAPACK_zherfsx_base LAPACK_GLOBAL(zherfsx,ZHERFSX) +#define LAPACK_zherfsx_base LAPACK_GLOBAL_SUFFIX(zherfsx,ZHERFSX) void LAPACK_zherfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -7597,7 +7611,7 @@ void LAPACK_zherfsx_base( #define LAPACK_zherfsx(...) LAPACK_zherfsx_base(__VA_ARGS__) #endif -#define LAPACK_chesv_base LAPACK_GLOBAL(chesv,CHESV) +#define LAPACK_chesv_base LAPACK_GLOBAL_SUFFIX(chesv,CHESV) void LAPACK_chesv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7615,7 +7629,7 @@ void LAPACK_chesv_base( #define LAPACK_chesv(...) LAPACK_chesv_base(__VA_ARGS__) #endif -#define LAPACK_zhesv_base LAPACK_GLOBAL(zhesv,ZHESV) +#define LAPACK_zhesv_base LAPACK_GLOBAL_SUFFIX(zhesv,ZHESV) void LAPACK_zhesv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7633,7 +7647,7 @@ void LAPACK_zhesv_base( #define LAPACK_zhesv(...) LAPACK_zhesv_base(__VA_ARGS__) #endif -#define LAPACK_chesv_aa_base LAPACK_GLOBAL(chesv_aa,CHESV_AA) +#define LAPACK_chesv_aa_base LAPACK_GLOBAL_SUFFIX(chesv_aa,CHESV_AA) void LAPACK_chesv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7651,7 +7665,7 @@ void LAPACK_chesv_aa_base( #define LAPACK_chesv_aa(...) LAPACK_chesv_aa_base(__VA_ARGS__) #endif -#define LAPACK_zhesv_aa_base LAPACK_GLOBAL(zhesv_aa,ZHESV_AA) +#define LAPACK_zhesv_aa_base LAPACK_GLOBAL_SUFFIX(zhesv_aa,ZHESV_AA) void LAPACK_zhesv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7669,7 +7683,7 @@ void LAPACK_zhesv_aa_base( #define LAPACK_zhesv_aa(...) LAPACK_zhesv_aa_base(__VA_ARGS__) #endif -#define LAPACK_chesv_aa_2stage_base LAPACK_GLOBAL(chesv_aa_2stage,CHESV_AA_2STAGE) +#define LAPACK_chesv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(chesv_aa_2stage,CHESV_AA_2STAGE) void LAPACK_chesv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7688,7 +7702,7 @@ void LAPACK_chesv_aa_2stage_base( #define LAPACK_chesv_aa_2stage(...) LAPACK_chesv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhesv_aa_2stage_base LAPACK_GLOBAL(zhesv_aa_2stage,ZHESV_AA_2STAGE) +#define LAPACK_zhesv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zhesv_aa_2stage,ZHESV_AA_2STAGE) void LAPACK_zhesv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7707,7 +7721,7 @@ void LAPACK_zhesv_aa_2stage_base( #define LAPACK_zhesv_aa_2stage(...) LAPACK_zhesv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chesv_rk_base LAPACK_GLOBAL(chesv_rk,CHESV_RK) +#define LAPACK_chesv_rk_base LAPACK_GLOBAL_SUFFIX(chesv_rk,CHESV_RK) void LAPACK_chesv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7726,7 +7740,7 @@ void LAPACK_chesv_rk_base( #define LAPACK_chesv_rk(...) LAPACK_chesv_rk_base(__VA_ARGS__) #endif -#define LAPACK_zhesv_rk_base LAPACK_GLOBAL(zhesv_rk,ZHESV_RK) +#define LAPACK_zhesv_rk_base LAPACK_GLOBAL_SUFFIX(zhesv_rk,ZHESV_RK) void LAPACK_zhesv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7745,7 +7759,7 @@ void LAPACK_zhesv_rk_base( #define LAPACK_zhesv_rk(...) LAPACK_zhesv_rk_base(__VA_ARGS__) #endif -#define LAPACK_chesv_rook_base LAPACK_GLOBAL(chesv_rook,CHESV_ROOK) +#define LAPACK_chesv_rook_base LAPACK_GLOBAL_SUFFIX(chesv_rook,CHESV_ROOK) void LAPACK_chesv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7763,7 +7777,7 @@ void LAPACK_chesv_rook_base( #define LAPACK_chesv_rook(...) LAPACK_chesv_rook_base(__VA_ARGS__) #endif -#define LAPACK_zhesv_rook_base LAPACK_GLOBAL(zhesv_rook,ZHESV_ROOK) +#define LAPACK_zhesv_rook_base LAPACK_GLOBAL_SUFFIX(zhesv_rook,ZHESV_ROOK) void LAPACK_zhesv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7781,7 +7795,7 @@ void LAPACK_zhesv_rook_base( #define LAPACK_zhesv_rook(...) LAPACK_zhesv_rook_base(__VA_ARGS__) #endif -#define LAPACK_chesvx_base LAPACK_GLOBAL(chesvx,CHESVX) +#define LAPACK_chesvx_base LAPACK_GLOBAL_SUFFIX(chesvx,CHESVX) void LAPACK_chesvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7805,7 +7819,7 @@ void LAPACK_chesvx_base( #define LAPACK_chesvx(...) LAPACK_chesvx_base(__VA_ARGS__) #endif -#define LAPACK_zhesvx_base LAPACK_GLOBAL(zhesvx,ZHESVX) +#define LAPACK_zhesvx_base LAPACK_GLOBAL_SUFFIX(zhesvx,ZHESVX) void LAPACK_zhesvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7829,7 +7843,7 @@ void LAPACK_zhesvx_base( #define LAPACK_zhesvx(...) LAPACK_zhesvx_base(__VA_ARGS__) #endif -#define LAPACK_chesvxx_base LAPACK_GLOBAL(chesvxx,CHESVXX) +#define LAPACK_chesvxx_base LAPACK_GLOBAL_SUFFIX(chesvxx,CHESVXX) void LAPACK_chesvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7858,7 +7872,7 @@ void LAPACK_chesvxx_base( #define LAPACK_chesvxx(...) LAPACK_chesvxx_base(__VA_ARGS__) #endif -#define LAPACK_zhesvxx_base LAPACK_GLOBAL(zhesvxx,ZHESVXX) +#define LAPACK_zhesvxx_base LAPACK_GLOBAL_SUFFIX(zhesvxx,ZHESVXX) void LAPACK_zhesvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -7887,7 +7901,7 @@ void LAPACK_zhesvxx_base( #define LAPACK_zhesvxx(...) LAPACK_zhesvxx_base(__VA_ARGS__) #endif -#define LAPACK_cheswapr_base LAPACK_GLOBAL(cheswapr,CHESWAPR) +#define LAPACK_cheswapr_base LAPACK_GLOBAL_SUFFIX(cheswapr,CHESWAPR) void LAPACK_cheswapr_base( char const* uplo, lapack_int const* n, @@ -7902,7 +7916,7 @@ void LAPACK_cheswapr_base( #define LAPACK_cheswapr(...) LAPACK_cheswapr_base(__VA_ARGS__) #endif -#define LAPACK_zheswapr_base LAPACK_GLOBAL(zheswapr,ZHESWAPR) +#define LAPACK_zheswapr_base LAPACK_GLOBAL_SUFFIX(zheswapr,ZHESWAPR) void LAPACK_zheswapr_base( char const* uplo, lapack_int const* n, @@ -7917,7 +7931,7 @@ void LAPACK_zheswapr_base( #define LAPACK_zheswapr(...) LAPACK_zheswapr_base(__VA_ARGS__) #endif -#define LAPACK_chetrd_base LAPACK_GLOBAL(chetrd,CHETRD) +#define LAPACK_chetrd_base LAPACK_GLOBAL_SUFFIX(chetrd,CHETRD) void LAPACK_chetrd_base( char const* uplo, lapack_int const* n, @@ -7937,7 +7951,7 @@ void LAPACK_chetrd_base( #define LAPACK_chetrd(...) LAPACK_chetrd_base(__VA_ARGS__) #endif -#define LAPACK_zhetrd_base LAPACK_GLOBAL(zhetrd,ZHETRD) +#define LAPACK_zhetrd_base LAPACK_GLOBAL_SUFFIX(zhetrd,ZHETRD) void LAPACK_zhetrd_base( char const* uplo, lapack_int const* n, @@ -7957,7 +7971,7 @@ void LAPACK_zhetrd_base( #define LAPACK_zhetrd(...) LAPACK_zhetrd_base(__VA_ARGS__) #endif -#define LAPACK_chetrd_2stage_base LAPACK_GLOBAL(chetrd_2stage,CHETRD_2STAGE) +#define LAPACK_chetrd_2stage_base LAPACK_GLOBAL_SUFFIX(chetrd_2stage,CHETRD_2STAGE) void LAPACK_chetrd_2stage_base( char const* vect, char const* uplo, lapack_int const* n, @@ -7978,7 +7992,7 @@ void LAPACK_chetrd_2stage_base( #define LAPACK_chetrd_2stage(...) LAPACK_chetrd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhetrd_2stage_base LAPACK_GLOBAL(zhetrd_2stage,ZHETRD_2STAGE) +#define LAPACK_zhetrd_2stage_base LAPACK_GLOBAL_SUFFIX(zhetrd_2stage,ZHETRD_2STAGE) void LAPACK_zhetrd_2stage_base( char const* vect, char const* uplo, lapack_int const* n, @@ -7999,7 +8013,7 @@ void LAPACK_zhetrd_2stage_base( #define LAPACK_zhetrd_2stage(...) LAPACK_zhetrd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chetrf_base LAPACK_GLOBAL(chetrf,CHETRF) +#define LAPACK_chetrf_base LAPACK_GLOBAL_SUFFIX(chetrf,CHETRF) void LAPACK_chetrf_base( char const* uplo, lapack_int const* n, @@ -8016,7 +8030,7 @@ void LAPACK_chetrf_base( #define LAPACK_chetrf(...) LAPACK_chetrf_base(__VA_ARGS__) #endif -#define LAPACK_zhetrf_base LAPACK_GLOBAL(zhetrf,ZHETRF) +#define LAPACK_zhetrf_base LAPACK_GLOBAL_SUFFIX(zhetrf,ZHETRF) void LAPACK_zhetrf_base( char const* uplo, lapack_int const* n, @@ -8033,7 +8047,7 @@ void LAPACK_zhetrf_base( #define LAPACK_zhetrf(...) LAPACK_zhetrf_base(__VA_ARGS__) #endif -#define LAPACK_chetrf_aa_base LAPACK_GLOBAL(chetrf_aa,CHETRF_AA) +#define LAPACK_chetrf_aa_base LAPACK_GLOBAL_SUFFIX(chetrf_aa,CHETRF_AA) void LAPACK_chetrf_aa_base( char const* uplo, lapack_int const* n, @@ -8050,7 +8064,7 @@ void LAPACK_chetrf_aa_base( #define LAPACK_chetrf_aa(...) LAPACK_chetrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_zhetrf_aa_base LAPACK_GLOBAL(zhetrf_aa,ZHETRF_AA) +#define LAPACK_zhetrf_aa_base LAPACK_GLOBAL_SUFFIX(zhetrf_aa,ZHETRF_AA) void LAPACK_zhetrf_aa_base( char const* uplo, lapack_int const* n, @@ -8067,7 +8081,7 @@ void LAPACK_zhetrf_aa_base( #define LAPACK_zhetrf_aa(...) LAPACK_zhetrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_chetrf_aa_2stage_base LAPACK_GLOBAL(chetrf_aa_2stage,CHETRF_AA_2STAGE) +#define LAPACK_chetrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(chetrf_aa_2stage,CHETRF_AA_2STAGE) void LAPACK_chetrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -8085,7 +8099,7 @@ void LAPACK_chetrf_aa_2stage_base( #define LAPACK_chetrf_aa_2stage(...) LAPACK_chetrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhetrf_aa_2stage_base LAPACK_GLOBAL(zhetrf_aa_2stage,ZHETRF_AA_2STAGE) +#define LAPACK_zhetrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zhetrf_aa_2stage,ZHETRF_AA_2STAGE) void LAPACK_zhetrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -8103,7 +8117,7 @@ void LAPACK_zhetrf_aa_2stage_base( #define LAPACK_zhetrf_aa_2stage(...) LAPACK_zhetrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chetrf_rk_base LAPACK_GLOBAL(chetrf_rk,CHETRF_RK) +#define LAPACK_chetrf_rk_base LAPACK_GLOBAL_SUFFIX(chetrf_rk,CHETRF_RK) void LAPACK_chetrf_rk_base( char const* uplo, lapack_int const* n, @@ -8121,7 +8135,7 @@ void LAPACK_chetrf_rk_base( #define LAPACK_chetrf_rk(...) LAPACK_chetrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_zhetrf_rk_base LAPACK_GLOBAL(zhetrf_rk,ZHETRF_RK) +#define LAPACK_zhetrf_rk_base LAPACK_GLOBAL_SUFFIX(zhetrf_rk,ZHETRF_RK) void LAPACK_zhetrf_rk_base( char const* uplo, lapack_int const* n, @@ -8139,7 +8153,7 @@ void LAPACK_zhetrf_rk_base( #define LAPACK_zhetrf_rk(...) LAPACK_zhetrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_chetrf_rook_base LAPACK_GLOBAL(chetrf_rook,CHETRF_ROOK) +#define LAPACK_chetrf_rook_base LAPACK_GLOBAL_SUFFIX(chetrf_rook,CHETRF_ROOK) void LAPACK_chetrf_rook_base( char const* uplo, lapack_int const* n, @@ -8156,7 +8170,7 @@ void LAPACK_chetrf_rook_base( #define LAPACK_chetrf_rook(...) LAPACK_chetrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_zhetrf_rook_base LAPACK_GLOBAL(zhetrf_rook,ZHETRF_ROOK) +#define LAPACK_zhetrf_rook_base LAPACK_GLOBAL_SUFFIX(zhetrf_rook,ZHETRF_ROOK) void LAPACK_zhetrf_rook_base( char const* uplo, lapack_int const* n, @@ -8173,7 +8187,7 @@ void LAPACK_zhetrf_rook_base( #define LAPACK_zhetrf_rook(...) LAPACK_zhetrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_chetri_base LAPACK_GLOBAL(chetri,CHETRI) +#define LAPACK_chetri_base LAPACK_GLOBAL_SUFFIX(chetri,CHETRI) void LAPACK_chetri_base( char const* uplo, lapack_int const* n, @@ -8190,7 +8204,7 @@ void LAPACK_chetri_base( #define LAPACK_chetri(...) LAPACK_chetri_base(__VA_ARGS__) #endif -#define LAPACK_zhetri_base LAPACK_GLOBAL(zhetri,ZHETRI) +#define LAPACK_zhetri_base LAPACK_GLOBAL_SUFFIX(zhetri,ZHETRI) void LAPACK_zhetri_base( char const* uplo, lapack_int const* n, @@ -8207,7 +8221,7 @@ void LAPACK_zhetri_base( #define LAPACK_zhetri(...) LAPACK_zhetri_base(__VA_ARGS__) #endif -#define LAPACK_chetri2_base LAPACK_GLOBAL(chetri2,CHETRI2) +#define LAPACK_chetri2_base LAPACK_GLOBAL_SUFFIX(chetri2,CHETRI2) void LAPACK_chetri2_base( char const* uplo, lapack_int const* n, @@ -8224,7 +8238,7 @@ void LAPACK_chetri2_base( #define LAPACK_chetri2(...) LAPACK_chetri2_base(__VA_ARGS__) #endif -#define LAPACK_zhetri2_base LAPACK_GLOBAL(zhetri2,ZHETRI2) +#define LAPACK_zhetri2_base LAPACK_GLOBAL_SUFFIX(zhetri2,ZHETRI2) void LAPACK_zhetri2_base( char const* uplo, lapack_int const* n, @@ -8241,7 +8255,7 @@ void LAPACK_zhetri2_base( #define LAPACK_zhetri2(...) LAPACK_zhetri2_base(__VA_ARGS__) #endif -#define LAPACK_chetri2x_base LAPACK_GLOBAL(chetri2x,CHETRI2X) +#define LAPACK_chetri2x_base LAPACK_GLOBAL_SUFFIX(chetri2x,CHETRI2X) void LAPACK_chetri2x_base( char const* uplo, lapack_int const* n, @@ -8258,7 +8272,7 @@ void LAPACK_chetri2x_base( #define LAPACK_chetri2x(...) LAPACK_chetri2x_base(__VA_ARGS__) #endif -#define LAPACK_zhetri2x_base LAPACK_GLOBAL(zhetri2x,ZHETRI2X) +#define LAPACK_zhetri2x_base LAPACK_GLOBAL_SUFFIX(zhetri2x,ZHETRI2X) void LAPACK_zhetri2x_base( char const* uplo, lapack_int const* n, @@ -8275,7 +8289,7 @@ void LAPACK_zhetri2x_base( #define LAPACK_zhetri2x(...) LAPACK_zhetri2x_base(__VA_ARGS__) #endif -#define LAPACK_chetri_3_base LAPACK_GLOBAL(chetri_3,CHETRI_3) +#define LAPACK_chetri_3_base LAPACK_GLOBAL_SUFFIX(chetri_3,CHETRI_3) void LAPACK_chetri_3_base( char const* uplo, lapack_int const* n, @@ -8293,7 +8307,7 @@ void LAPACK_chetri_3_base( #define LAPACK_chetri_3(...) LAPACK_chetri_3_base(__VA_ARGS__) #endif -#define LAPACK_zhetri_3_base LAPACK_GLOBAL(zhetri_3,ZHETRI_3) +#define LAPACK_zhetri_3_base LAPACK_GLOBAL_SUFFIX(zhetri_3,ZHETRI_3) void LAPACK_zhetri_3_base( char const* uplo, lapack_int const* n, @@ -8311,7 +8325,7 @@ void LAPACK_zhetri_3_base( #define LAPACK_zhetri_3(...) LAPACK_zhetri_3_base(__VA_ARGS__) #endif -#define LAPACK_chetrs_base LAPACK_GLOBAL(chetrs,CHETRS) +#define LAPACK_chetrs_base LAPACK_GLOBAL_SUFFIX(chetrs,CHETRS) void LAPACK_chetrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8328,7 +8342,7 @@ void LAPACK_chetrs_base( #define LAPACK_chetrs(...) LAPACK_chetrs_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs_base LAPACK_GLOBAL(zhetrs,ZHETRS) +#define LAPACK_zhetrs_base LAPACK_GLOBAL_SUFFIX(zhetrs,ZHETRS) void LAPACK_zhetrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8345,7 +8359,7 @@ void LAPACK_zhetrs_base( #define LAPACK_zhetrs(...) LAPACK_zhetrs_base(__VA_ARGS__) #endif -#define LAPACK_chetrs2_base LAPACK_GLOBAL(chetrs2,CHETRS2) +#define LAPACK_chetrs2_base LAPACK_GLOBAL_SUFFIX(chetrs2,CHETRS2) void LAPACK_chetrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8363,7 +8377,7 @@ void LAPACK_chetrs2_base( #define LAPACK_chetrs2(...) LAPACK_chetrs2_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs2_base LAPACK_GLOBAL(zhetrs2,ZHETRS2) +#define LAPACK_zhetrs2_base LAPACK_GLOBAL_SUFFIX(zhetrs2,ZHETRS2) void LAPACK_zhetrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8381,7 +8395,7 @@ void LAPACK_zhetrs2_base( #define LAPACK_zhetrs2(...) LAPACK_zhetrs2_base(__VA_ARGS__) #endif -#define LAPACK_chetrs_3_base LAPACK_GLOBAL(chetrs_3,CHETRS_3) +#define LAPACK_chetrs_3_base LAPACK_GLOBAL_SUFFIX(chetrs_3,CHETRS_3) void LAPACK_chetrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8399,7 +8413,7 @@ void LAPACK_chetrs_3_base( #define LAPACK_chetrs_3(...) LAPACK_chetrs_3_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs_3_base LAPACK_GLOBAL(zhetrs_3,ZHETRS_3) +#define LAPACK_zhetrs_3_base LAPACK_GLOBAL_SUFFIX(zhetrs_3,ZHETRS_3) void LAPACK_zhetrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8417,7 +8431,7 @@ void LAPACK_zhetrs_3_base( #define LAPACK_zhetrs_3(...) LAPACK_zhetrs_3_base(__VA_ARGS__) #endif -#define LAPACK_chetrs_aa_base LAPACK_GLOBAL(chetrs_aa,CHETRS_AA) +#define LAPACK_chetrs_aa_base LAPACK_GLOBAL_SUFFIX(chetrs_aa,CHETRS_AA) void LAPACK_chetrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8435,7 +8449,7 @@ void LAPACK_chetrs_aa_base( #define LAPACK_chetrs_aa(...) LAPACK_chetrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs_aa_base LAPACK_GLOBAL(zhetrs_aa,ZHETRS_AA) +#define LAPACK_zhetrs_aa_base LAPACK_GLOBAL_SUFFIX(zhetrs_aa,ZHETRS_AA) void LAPACK_zhetrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8453,7 +8467,7 @@ void LAPACK_zhetrs_aa_base( #define LAPACK_zhetrs_aa(...) LAPACK_zhetrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_chetrs_aa_2stage_base LAPACK_GLOBAL(chetrs_aa_2stage,CHETRS_AA_2STAGE) +#define LAPACK_chetrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(chetrs_aa_2stage,CHETRS_AA_2STAGE) void LAPACK_chetrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8471,7 +8485,7 @@ void LAPACK_chetrs_aa_2stage_base( #define LAPACK_chetrs_aa_2stage(...) LAPACK_chetrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs_aa_2stage_base LAPACK_GLOBAL(zhetrs_aa_2stage,ZHETRS_AA_2STAGE) +#define LAPACK_zhetrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zhetrs_aa_2stage,ZHETRS_AA_2STAGE) void LAPACK_zhetrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8489,7 +8503,7 @@ void LAPACK_zhetrs_aa_2stage_base( #define LAPACK_zhetrs_aa_2stage(...) LAPACK_zhetrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_chetrs_rook_base LAPACK_GLOBAL(chetrs_rook,CHETRS_ROOK) +#define LAPACK_chetrs_rook_base LAPACK_GLOBAL_SUFFIX(chetrs_rook,CHETRS_ROOK) void LAPACK_chetrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8506,7 +8520,7 @@ void LAPACK_chetrs_rook_base( #define LAPACK_chetrs_rook(...) LAPACK_chetrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_zhetrs_rook_base LAPACK_GLOBAL(zhetrs_rook,ZHETRS_ROOK) +#define LAPACK_zhetrs_rook_base LAPACK_GLOBAL_SUFFIX(zhetrs_rook,ZHETRS_ROOK) void LAPACK_zhetrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -8523,7 +8537,7 @@ void LAPACK_zhetrs_rook_base( #define LAPACK_zhetrs_rook(...) LAPACK_zhetrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_chfrk_base LAPACK_GLOBAL(chfrk,CHFRK) +#define LAPACK_chfrk_base LAPACK_GLOBAL_SUFFIX(chfrk,CHFRK) void LAPACK_chfrk_base( char const* transr, char const* uplo, char const* trans, lapack_int const* n, lapack_int const* k, @@ -8541,7 +8555,7 @@ void LAPACK_chfrk_base( #define LAPACK_chfrk(...) LAPACK_chfrk_base(__VA_ARGS__) #endif -#define LAPACK_zhfrk_base LAPACK_GLOBAL(zhfrk,ZHFRK) +#define LAPACK_zhfrk_base LAPACK_GLOBAL_SUFFIX(zhfrk,ZHFRK) void LAPACK_zhfrk_base( char const* transr, char const* uplo, char const* trans, lapack_int const* n, lapack_int const* k, @@ -8559,7 +8573,7 @@ void LAPACK_zhfrk_base( #define LAPACK_zhfrk(...) LAPACK_zhfrk_base(__VA_ARGS__) #endif -#define LAPACK_chgeqz_base LAPACK_GLOBAL(chgeqz,CHGEQZ) +#define LAPACK_chgeqz_base LAPACK_GLOBAL_SUFFIX(chgeqz,CHGEQZ) void LAPACK_chgeqz_base( char const* job, char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -8582,7 +8596,7 @@ void LAPACK_chgeqz_base( #define LAPACK_chgeqz(...) LAPACK_chgeqz_base(__VA_ARGS__) #endif -#define LAPACK_dhgeqz_base LAPACK_GLOBAL(dhgeqz,DHGEQZ) +#define LAPACK_dhgeqz_base LAPACK_GLOBAL_SUFFIX(dhgeqz,DHGEQZ) void LAPACK_dhgeqz_base( char const* job, char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -8605,7 +8619,7 @@ void LAPACK_dhgeqz_base( #define LAPACK_dhgeqz(...) LAPACK_dhgeqz_base(__VA_ARGS__) #endif -#define LAPACK_shgeqz_base LAPACK_GLOBAL(shgeqz,SHGEQZ) +#define LAPACK_shgeqz_base LAPACK_GLOBAL_SUFFIX(shgeqz,SHGEQZ) void LAPACK_shgeqz_base( char const* job, char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -8628,7 +8642,7 @@ void LAPACK_shgeqz_base( #define LAPACK_shgeqz(...) LAPACK_shgeqz_base(__VA_ARGS__) #endif -#define LAPACK_zhgeqz_base LAPACK_GLOBAL(zhgeqz,ZHGEQZ) +#define LAPACK_zhgeqz_base LAPACK_GLOBAL_SUFFIX(zhgeqz,ZHGEQZ) void LAPACK_zhgeqz_base( char const* job, char const* compq, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -8651,7 +8665,7 @@ void LAPACK_zhgeqz_base( #define LAPACK_zhgeqz(...) LAPACK_zhgeqz_base(__VA_ARGS__) #endif -#define LAPACK_chpcon_base LAPACK_GLOBAL(chpcon,CHPCON) +#define LAPACK_chpcon_base LAPACK_GLOBAL_SUFFIX(chpcon,CHPCON) void LAPACK_chpcon_base( char const* uplo, lapack_int const* n, @@ -8670,7 +8684,7 @@ void LAPACK_chpcon_base( #define LAPACK_chpcon(...) LAPACK_chpcon_base(__VA_ARGS__) #endif -#define LAPACK_zhpcon_base LAPACK_GLOBAL(zhpcon,ZHPCON) +#define LAPACK_zhpcon_base LAPACK_GLOBAL_SUFFIX(zhpcon,ZHPCON) void LAPACK_zhpcon_base( char const* uplo, lapack_int const* n, @@ -8689,7 +8703,7 @@ void LAPACK_zhpcon_base( #define LAPACK_zhpcon(...) LAPACK_zhpcon_base(__VA_ARGS__) #endif -#define LAPACK_chpev_base LAPACK_GLOBAL(chpev,CHPEV) +#define LAPACK_chpev_base LAPACK_GLOBAL_SUFFIX(chpev,CHPEV) void LAPACK_chpev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -8709,7 +8723,7 @@ void LAPACK_chpev_base( #define LAPACK_chpev(...) LAPACK_chpev_base(__VA_ARGS__) #endif -#define LAPACK_zhpev_base LAPACK_GLOBAL(zhpev,ZHPEV) +#define LAPACK_zhpev_base LAPACK_GLOBAL_SUFFIX(zhpev,ZHPEV) void LAPACK_zhpev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -8729,7 +8743,7 @@ void LAPACK_zhpev_base( #define LAPACK_zhpev(...) LAPACK_zhpev_base(__VA_ARGS__) #endif -#define LAPACK_chpevd_base LAPACK_GLOBAL(chpevd,CHPEVD) +#define LAPACK_chpevd_base LAPACK_GLOBAL_SUFFIX(chpevd,CHPEVD) void LAPACK_chpevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -8750,7 +8764,7 @@ void LAPACK_chpevd_base( #define LAPACK_chpevd(...) LAPACK_chpevd_base(__VA_ARGS__) #endif -#define LAPACK_zhpevd_base LAPACK_GLOBAL(zhpevd,ZHPEVD) +#define LAPACK_zhpevd_base LAPACK_GLOBAL_SUFFIX(zhpevd,ZHPEVD) void LAPACK_zhpevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -8771,7 +8785,7 @@ void LAPACK_zhpevd_base( #define LAPACK_zhpevd(...) LAPACK_zhpevd_base(__VA_ARGS__) #endif -#define LAPACK_chpevx_base LAPACK_GLOBAL(chpevx,CHPEVX) +#define LAPACK_chpevx_base LAPACK_GLOBAL_SUFFIX(chpevx,CHPEVX) void LAPACK_chpevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -8795,7 +8809,7 @@ void LAPACK_chpevx_base( #define LAPACK_chpevx(...) LAPACK_chpevx_base(__VA_ARGS__) #endif -#define LAPACK_zhpevx_base LAPACK_GLOBAL(zhpevx,ZHPEVX) +#define LAPACK_zhpevx_base LAPACK_GLOBAL_SUFFIX(zhpevx,ZHPEVX) void LAPACK_zhpevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -8819,7 +8833,7 @@ void LAPACK_zhpevx_base( #define LAPACK_zhpevx(...) LAPACK_zhpevx_base(__VA_ARGS__) #endif -#define LAPACK_chpgst_base LAPACK_GLOBAL(chpgst,CHPGST) +#define LAPACK_chpgst_base LAPACK_GLOBAL_SUFFIX(chpgst,CHPGST) void LAPACK_chpgst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -8836,7 +8850,7 @@ void LAPACK_chpgst_base( #define LAPACK_chpgst(...) LAPACK_chpgst_base(__VA_ARGS__) #endif -#define LAPACK_zhpgst_base LAPACK_GLOBAL(zhpgst,ZHPGST) +#define LAPACK_zhpgst_base LAPACK_GLOBAL_SUFFIX(zhpgst,ZHPGST) void LAPACK_zhpgst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -8853,7 +8867,7 @@ void LAPACK_zhpgst_base( #define LAPACK_zhpgst(...) LAPACK_zhpgst_base(__VA_ARGS__) #endif -#define LAPACK_chpgv_base LAPACK_GLOBAL(chpgv,CHPGV) +#define LAPACK_chpgv_base LAPACK_GLOBAL_SUFFIX(chpgv,CHPGV) void LAPACK_chpgv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -8874,7 +8888,7 @@ void LAPACK_chpgv_base( #define LAPACK_chpgv(...) LAPACK_chpgv_base(__VA_ARGS__) #endif -#define LAPACK_zhpgv_base LAPACK_GLOBAL(zhpgv,ZHPGV) +#define LAPACK_zhpgv_base LAPACK_GLOBAL_SUFFIX(zhpgv,ZHPGV) void LAPACK_zhpgv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -8895,7 +8909,7 @@ void LAPACK_zhpgv_base( #define LAPACK_zhpgv(...) LAPACK_zhpgv_base(__VA_ARGS__) #endif -#define LAPACK_chpgvd_base LAPACK_GLOBAL(chpgvd,CHPGVD) +#define LAPACK_chpgvd_base LAPACK_GLOBAL_SUFFIX(chpgvd,CHPGVD) void LAPACK_chpgvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -8917,7 +8931,7 @@ void LAPACK_chpgvd_base( #define LAPACK_chpgvd(...) LAPACK_chpgvd_base(__VA_ARGS__) #endif -#define LAPACK_zhpgvd_base LAPACK_GLOBAL(zhpgvd,ZHPGVD) +#define LAPACK_zhpgvd_base LAPACK_GLOBAL_SUFFIX(zhpgvd,ZHPGVD) void LAPACK_zhpgvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -8939,7 +8953,7 @@ void LAPACK_zhpgvd_base( #define LAPACK_zhpgvd(...) LAPACK_zhpgvd_base(__VA_ARGS__) #endif -#define LAPACK_chpgvx_base LAPACK_GLOBAL(chpgvx,CHPGVX) +#define LAPACK_chpgvx_base LAPACK_GLOBAL_SUFFIX(chpgvx,CHPGVX) void LAPACK_chpgvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -8964,7 +8978,7 @@ void LAPACK_chpgvx_base( #define LAPACK_chpgvx(...) LAPACK_chpgvx_base(__VA_ARGS__) #endif -#define LAPACK_zhpgvx_base LAPACK_GLOBAL(zhpgvx,ZHPGVX) +#define LAPACK_zhpgvx_base LAPACK_GLOBAL_SUFFIX(zhpgvx,ZHPGVX) void LAPACK_zhpgvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -8989,7 +9003,7 @@ void LAPACK_zhpgvx_base( #define LAPACK_zhpgvx(...) LAPACK_zhpgvx_base(__VA_ARGS__) #endif -#define LAPACK_chprfs_base LAPACK_GLOBAL(chprfs,CHPRFS) +#define LAPACK_chprfs_base LAPACK_GLOBAL_SUFFIX(chprfs,CHPRFS) void LAPACK_chprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9012,7 +9026,7 @@ void LAPACK_chprfs_base( #define LAPACK_chprfs(...) LAPACK_chprfs_base(__VA_ARGS__) #endif -#define LAPACK_zhprfs_base LAPACK_GLOBAL(zhprfs,ZHPRFS) +#define LAPACK_zhprfs_base LAPACK_GLOBAL_SUFFIX(zhprfs,ZHPRFS) void LAPACK_zhprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9035,7 +9049,7 @@ void LAPACK_zhprfs_base( #define LAPACK_zhprfs(...) LAPACK_zhprfs_base(__VA_ARGS__) #endif -#define LAPACK_chpsv_base LAPACK_GLOBAL(chpsv,CHPSV) +#define LAPACK_chpsv_base LAPACK_GLOBAL_SUFFIX(chpsv,CHPSV) void LAPACK_chpsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9052,7 +9066,7 @@ void LAPACK_chpsv_base( #define LAPACK_chpsv(...) LAPACK_chpsv_base(__VA_ARGS__) #endif -#define LAPACK_zhpsv_base LAPACK_GLOBAL(zhpsv,ZHPSV) +#define LAPACK_zhpsv_base LAPACK_GLOBAL_SUFFIX(zhpsv,ZHPSV) void LAPACK_zhpsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9069,7 +9083,7 @@ void LAPACK_zhpsv_base( #define LAPACK_zhpsv(...) LAPACK_zhpsv_base(__VA_ARGS__) #endif -#define LAPACK_chpsvx_base LAPACK_GLOBAL(chpsvx,CHPSVX) +#define LAPACK_chpsvx_base LAPACK_GLOBAL_SUFFIX(chpsvx,CHPSVX) void LAPACK_chpsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9093,7 +9107,7 @@ void LAPACK_chpsvx_base( #define LAPACK_chpsvx(...) LAPACK_chpsvx_base(__VA_ARGS__) #endif -#define LAPACK_zhpsvx_base LAPACK_GLOBAL(zhpsvx,ZHPSVX) +#define LAPACK_zhpsvx_base LAPACK_GLOBAL_SUFFIX(zhpsvx,ZHPSVX) void LAPACK_zhpsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9117,7 +9131,7 @@ void LAPACK_zhpsvx_base( #define LAPACK_zhpsvx(...) LAPACK_zhpsvx_base(__VA_ARGS__) #endif -#define LAPACK_chptrd_base LAPACK_GLOBAL(chptrd,CHPTRD) +#define LAPACK_chptrd_base LAPACK_GLOBAL_SUFFIX(chptrd,CHPTRD) void LAPACK_chptrd_base( char const* uplo, lapack_int const* n, @@ -9136,7 +9150,7 @@ void LAPACK_chptrd_base( #define LAPACK_chptrd(...) LAPACK_chptrd_base(__VA_ARGS__) #endif -#define LAPACK_zhptrd_base LAPACK_GLOBAL(zhptrd,ZHPTRD) +#define LAPACK_zhptrd_base LAPACK_GLOBAL_SUFFIX(zhptrd,ZHPTRD) void LAPACK_zhptrd_base( char const* uplo, lapack_int const* n, @@ -9155,7 +9169,7 @@ void LAPACK_zhptrd_base( #define LAPACK_zhptrd(...) LAPACK_zhptrd_base(__VA_ARGS__) #endif -#define LAPACK_chptrf_base LAPACK_GLOBAL(chptrf,CHPTRF) +#define LAPACK_chptrf_base LAPACK_GLOBAL_SUFFIX(chptrf,CHPTRF) void LAPACK_chptrf_base( char const* uplo, lapack_int const* n, @@ -9171,7 +9185,7 @@ void LAPACK_chptrf_base( #define LAPACK_chptrf(...) LAPACK_chptrf_base(__VA_ARGS__) #endif -#define LAPACK_zhptrf_base LAPACK_GLOBAL(zhptrf,ZHPTRF) +#define LAPACK_zhptrf_base LAPACK_GLOBAL_SUFFIX(zhptrf,ZHPTRF) void LAPACK_zhptrf_base( char const* uplo, lapack_int const* n, @@ -9187,7 +9201,7 @@ void LAPACK_zhptrf_base( #define LAPACK_zhptrf(...) LAPACK_zhptrf_base(__VA_ARGS__) #endif -#define LAPACK_chptri_base LAPACK_GLOBAL(chptri,CHPTRI) +#define LAPACK_chptri_base LAPACK_GLOBAL_SUFFIX(chptri,CHPTRI) void LAPACK_chptri_base( char const* uplo, lapack_int const* n, @@ -9204,7 +9218,7 @@ void LAPACK_chptri_base( #define LAPACK_chptri(...) LAPACK_chptri_base(__VA_ARGS__) #endif -#define LAPACK_zhptri_base LAPACK_GLOBAL(zhptri,ZHPTRI) +#define LAPACK_zhptri_base LAPACK_GLOBAL_SUFFIX(zhptri,ZHPTRI) void LAPACK_zhptri_base( char const* uplo, lapack_int const* n, @@ -9221,7 +9235,7 @@ void LAPACK_zhptri_base( #define LAPACK_zhptri(...) LAPACK_zhptri_base(__VA_ARGS__) #endif -#define LAPACK_chptrs_base LAPACK_GLOBAL(chptrs,CHPTRS) +#define LAPACK_chptrs_base LAPACK_GLOBAL_SUFFIX(chptrs,CHPTRS) void LAPACK_chptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9238,7 +9252,7 @@ void LAPACK_chptrs_base( #define LAPACK_chptrs(...) LAPACK_chptrs_base(__VA_ARGS__) #endif -#define LAPACK_zhptrs_base LAPACK_GLOBAL(zhptrs,ZHPTRS) +#define LAPACK_zhptrs_base LAPACK_GLOBAL_SUFFIX(zhptrs,ZHPTRS) void LAPACK_zhptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -9255,7 +9269,7 @@ void LAPACK_zhptrs_base( #define LAPACK_zhptrs(...) LAPACK_zhptrs_base(__VA_ARGS__) #endif -#define LAPACK_chsein_base LAPACK_GLOBAL(chsein,CHSEIN) +#define LAPACK_chsein_base LAPACK_GLOBAL_SUFFIX(chsein,CHSEIN) void LAPACK_chsein_base( char const* side, char const* eigsrc, char const* initv, lapack_logical const* select, @@ -9277,7 +9291,7 @@ void LAPACK_chsein_base( #define LAPACK_chsein(...) LAPACK_chsein_base(__VA_ARGS__) #endif -#define LAPACK_dhsein_base LAPACK_GLOBAL(dhsein,DHSEIN) +#define LAPACK_dhsein_base LAPACK_GLOBAL_SUFFIX(dhsein,DHSEIN) void LAPACK_dhsein_base( char const* side, char const* eigsrc, char const* initv, lapack_logical* select, @@ -9299,7 +9313,7 @@ void LAPACK_dhsein_base( #define LAPACK_dhsein(...) LAPACK_dhsein_base(__VA_ARGS__) #endif -#define LAPACK_shsein_base LAPACK_GLOBAL(shsein,SHSEIN) +#define LAPACK_shsein_base LAPACK_GLOBAL_SUFFIX(shsein,SHSEIN) void LAPACK_shsein_base( char const* side, char const* eigsrc, char const* initv, lapack_logical* select, @@ -9321,7 +9335,7 @@ void LAPACK_shsein_base( #define LAPACK_shsein(...) LAPACK_shsein_base(__VA_ARGS__) #endif -#define LAPACK_zhsein_base LAPACK_GLOBAL(zhsein,ZHSEIN) +#define LAPACK_zhsein_base LAPACK_GLOBAL_SUFFIX(zhsein,ZHSEIN) void LAPACK_zhsein_base( char const* side, char const* eigsrc, char const* initv, lapack_logical const* select, @@ -9343,7 +9357,7 @@ void LAPACK_zhsein_base( #define LAPACK_zhsein(...) LAPACK_zhsein_base(__VA_ARGS__) #endif -#define LAPACK_chseqr_base LAPACK_GLOBAL(chseqr,CHSEQR) +#define LAPACK_chseqr_base LAPACK_GLOBAL_SUFFIX(chseqr,CHSEQR) void LAPACK_chseqr_base( char const* job, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -9362,7 +9376,7 @@ void LAPACK_chseqr_base( #define LAPACK_chseqr(...) LAPACK_chseqr_base(__VA_ARGS__) #endif -#define LAPACK_dhseqr_base LAPACK_GLOBAL(dhseqr,DHSEQR) +#define LAPACK_dhseqr_base LAPACK_GLOBAL_SUFFIX(dhseqr,DHSEQR) void LAPACK_dhseqr_base( char const* job, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -9382,7 +9396,7 @@ void LAPACK_dhseqr_base( #define LAPACK_dhseqr(...) LAPACK_dhseqr_base(__VA_ARGS__) #endif -#define LAPACK_shseqr_base LAPACK_GLOBAL(shseqr,SHSEQR) +#define LAPACK_shseqr_base LAPACK_GLOBAL_SUFFIX(shseqr,SHSEQR) void LAPACK_shseqr_base( char const* job, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -9402,7 +9416,7 @@ void LAPACK_shseqr_base( #define LAPACK_shseqr(...) LAPACK_shseqr_base(__VA_ARGS__) #endif -#define LAPACK_zhseqr_base LAPACK_GLOBAL(zhseqr,ZHSEQR) +#define LAPACK_zhseqr_base LAPACK_GLOBAL_SUFFIX(zhseqr,ZHSEQR) void LAPACK_zhseqr_base( char const* job, char const* compz, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -9421,45 +9435,45 @@ void LAPACK_zhseqr_base( #define LAPACK_zhseqr(...) LAPACK_zhseqr_base(__VA_ARGS__) #endif -#define LAPACK_clacgv LAPACK_GLOBAL(clacgv,CLACGV) +#define LAPACK_clacgv LAPACK_GLOBAL_SUFFIX(clacgv,CLACGV) void LAPACK_clacgv( lapack_int const* n, lapack_complex_float* X, lapack_int const* incx ); -#define LAPACK_zlacgv LAPACK_GLOBAL(zlacgv,ZLACGV) +#define LAPACK_zlacgv LAPACK_GLOBAL_SUFFIX(zlacgv,ZLACGV) void LAPACK_zlacgv( lapack_int const* n, lapack_complex_double* X, lapack_int const* incx ); -#define LAPACK_clacn2 LAPACK_GLOBAL(clacn2,CLACN2) +#define LAPACK_clacn2 LAPACK_GLOBAL_SUFFIX(clacn2,CLACN2) void LAPACK_clacn2( lapack_int const* n, lapack_complex_float* V, lapack_complex_float* X, float* est, lapack_int* kase, lapack_int* ISAVE ); -#define LAPACK_dlacn2 LAPACK_GLOBAL(dlacn2,DLACN2) +#define LAPACK_dlacn2 LAPACK_GLOBAL_SUFFIX(dlacn2,DLACN2) void LAPACK_dlacn2( lapack_int const* n, double* V, double* X, lapack_int* ISGN, double* est, lapack_int* kase, lapack_int* ISAVE ); -#define LAPACK_slacn2 LAPACK_GLOBAL(slacn2,SLACN2) +#define LAPACK_slacn2 LAPACK_GLOBAL_SUFFIX(slacn2,SLACN2) void LAPACK_slacn2( lapack_int const* n, float* V, float* X, lapack_int* ISGN, float* est, lapack_int* kase, lapack_int* ISAVE ); -#define LAPACK_zlacn2 LAPACK_GLOBAL(zlacn2,ZLACN2) +#define LAPACK_zlacn2 LAPACK_GLOBAL_SUFFIX(zlacn2,ZLACN2) void LAPACK_zlacn2( lapack_int const* n, lapack_complex_double* V, lapack_complex_double* X, double* est, lapack_int* kase, lapack_int* ISAVE ); -#define LAPACK_clacp2_base LAPACK_GLOBAL(clacp2,CLACP2) +#define LAPACK_clacp2_base LAPACK_GLOBAL_SUFFIX(clacp2,CLACP2) void LAPACK_clacp2_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9475,7 +9489,7 @@ void LAPACK_clacp2_base( #define LAPACK_clacp2(...) LAPACK_clacp2_base(__VA_ARGS__) #endif -#define LAPACK_zlacp2_base LAPACK_GLOBAL(zlacp2,ZLACP2) +#define LAPACK_zlacp2_base LAPACK_GLOBAL_SUFFIX(zlacp2,ZLACP2) void LAPACK_zlacp2_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9491,7 +9505,7 @@ void LAPACK_zlacp2_base( #define LAPACK_zlacp2(...) LAPACK_zlacp2_base(__VA_ARGS__) #endif -#define LAPACK_clacpy_base LAPACK_GLOBAL(clacpy,CLACPY) +#define LAPACK_clacpy_base LAPACK_GLOBAL_SUFFIX(clacpy,CLACPY) void LAPACK_clacpy_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9507,7 +9521,7 @@ void LAPACK_clacpy_base( #define LAPACK_clacpy(...) LAPACK_clacpy_base(__VA_ARGS__) #endif -#define LAPACK_dlacpy_base LAPACK_GLOBAL(dlacpy,DLACPY) +#define LAPACK_dlacpy_base LAPACK_GLOBAL_SUFFIX(dlacpy,DLACPY) void LAPACK_dlacpy_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9523,7 +9537,7 @@ void LAPACK_dlacpy_base( #define LAPACK_dlacpy(...) LAPACK_dlacpy_base(__VA_ARGS__) #endif -#define LAPACK_slacpy_base LAPACK_GLOBAL(slacpy,SLACPY) +#define LAPACK_slacpy_base LAPACK_GLOBAL_SUFFIX(slacpy,SLACPY) void LAPACK_slacpy_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9539,7 +9553,7 @@ void LAPACK_slacpy_base( #define LAPACK_slacpy(...) LAPACK_slacpy_base(__VA_ARGS__) #endif -#define LAPACK_zlacpy_base LAPACK_GLOBAL(zlacpy,ZLACPY) +#define LAPACK_zlacpy_base LAPACK_GLOBAL_SUFFIX(zlacpy,ZLACPY) void LAPACK_zlacpy_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -9555,7 +9569,7 @@ void LAPACK_zlacpy_base( #define LAPACK_zlacpy(...) LAPACK_zlacpy_base(__VA_ARGS__) #endif -#define LAPACK_clacrm LAPACK_GLOBAL(clacrm,CLACRM) +#define LAPACK_clacrm LAPACK_GLOBAL_SUFFIX(clacrm,CLACRM) void LAPACK_clacrm( lapack_int const* m, lapack_int const* n, lapack_complex_float const* A, lapack_int const* lda, @@ -9563,7 +9577,7 @@ void LAPACK_clacrm( lapack_complex_float* C, lapack_int const* ldc, float* rwork ); -#define LAPACK_zlacrm LAPACK_GLOBAL(zlacrm,ZLACRM) +#define LAPACK_zlacrm LAPACK_GLOBAL_SUFFIX(zlacrm,ZLACRM) void LAPACK_zlacrm( lapack_int const* m, lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, @@ -9571,35 +9585,35 @@ void LAPACK_zlacrm( lapack_complex_double* C, lapack_int const* ldc, double* rwork ); -#define LAPACK_zlag2c LAPACK_GLOBAL(zlag2c,ZLAG2C) +#define LAPACK_zlag2c LAPACK_GLOBAL_SUFFIX(zlag2c,ZLAG2C) void LAPACK_zlag2c( lapack_int const* m, lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, lapack_complex_float* SA, lapack_int const* ldsa, lapack_int* info ); -#define LAPACK_slag2d LAPACK_GLOBAL(slag2d,SLAG2D) +#define LAPACK_slag2d LAPACK_GLOBAL_SUFFIX(slag2d,SLAG2D) void LAPACK_slag2d( lapack_int const* m, lapack_int const* n, float const* SA, lapack_int const* ldsa, double* A, lapack_int const* lda, lapack_int* info ); -#define LAPACK_dlag2s LAPACK_GLOBAL(dlag2s,DLAG2S) +#define LAPACK_dlag2s LAPACK_GLOBAL_SUFFIX(dlag2s,DLAG2S) void LAPACK_dlag2s( lapack_int const* m, lapack_int const* n, double const* A, lapack_int const* lda, float* SA, lapack_int const* ldsa, lapack_int* info ); -#define LAPACK_clag2z LAPACK_GLOBAL(clag2z,CLAG2Z) +#define LAPACK_clag2z LAPACK_GLOBAL_SUFFIX(clag2z,CLAG2Z) void LAPACK_clag2z( lapack_int const* m, lapack_int const* n, lapack_complex_float const* SA, lapack_int const* ldsa, lapack_complex_double* A, lapack_int const* lda, lapack_int* info ); -#define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE) +#define LAPACK_clagge LAPACK_GLOBAL_SUFFIX(clagge,CLAGGE) void LAPACK_clagge( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, float const* D, @@ -9607,7 +9621,7 @@ void LAPACK_clagge( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE) +#define LAPACK_dlagge LAPACK_GLOBAL_SUFFIX(dlagge,DLAGGE) void LAPACK_dlagge( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, double const* D, @@ -9615,7 +9629,7 @@ void LAPACK_dlagge( double* work, lapack_int* info ); -#define LAPACK_slagge LAPACK_GLOBAL(slagge,SLAGGE) +#define LAPACK_slagge LAPACK_GLOBAL_SUFFIX(slagge,SLAGGE) void LAPACK_slagge( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, float const* D, @@ -9623,7 +9637,7 @@ void LAPACK_slagge( float* work, lapack_int* info ); -#define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE) +#define LAPACK_zlagge LAPACK_GLOBAL_SUFFIX(zlagge,ZLAGGE) void LAPACK_zlagge( lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, double const* D, @@ -9631,7 +9645,7 @@ void LAPACK_zlagge( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_claghe LAPACK_GLOBAL(claghe,CLAGHE) +#define LAPACK_claghe LAPACK_GLOBAL_SUFFIX(claghe,CLAGHE) void LAPACK_claghe( lapack_int const* n, lapack_int const* k, float const* D, @@ -9639,7 +9653,7 @@ void LAPACK_claghe( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_zlaghe LAPACK_GLOBAL(zlaghe,ZLAGHE) +#define LAPACK_zlaghe LAPACK_GLOBAL_SUFFIX(zlaghe,ZLAGHE) void LAPACK_zlaghe( lapack_int const* n, lapack_int const* k, double const* D, @@ -9647,7 +9661,7 @@ void LAPACK_zlaghe( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_clagsy LAPACK_GLOBAL(clagsy,CLAGSY) +#define LAPACK_clagsy LAPACK_GLOBAL_SUFFIX(clagsy,CLAGSY) void LAPACK_clagsy( lapack_int const* n, lapack_int const* k, float const* D, @@ -9655,7 +9669,7 @@ void LAPACK_clagsy( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dlagsy LAPACK_GLOBAL(dlagsy,DLAGSY) +#define LAPACK_dlagsy LAPACK_GLOBAL_SUFFIX(dlagsy,DLAGSY) void LAPACK_dlagsy( lapack_int const* n, lapack_int const* k, double const* D, @@ -9663,7 +9677,7 @@ void LAPACK_dlagsy( double* work, lapack_int* info ); -#define LAPACK_slagsy LAPACK_GLOBAL(slagsy,SLAGSY) +#define LAPACK_slagsy LAPACK_GLOBAL_SUFFIX(slagsy,SLAGSY) void LAPACK_slagsy( lapack_int const* n, lapack_int const* k, float const* D, @@ -9671,7 +9685,7 @@ void LAPACK_slagsy( float* work, lapack_int* info ); -#define LAPACK_zlagsy LAPACK_GLOBAL(zlagsy,ZLAGSY) +#define LAPACK_zlagsy LAPACK_GLOBAL_SUFFIX(zlagsy,ZLAGSY) void LAPACK_zlagsy( lapack_int const* n, lapack_int const* k, double const* D, @@ -9679,7 +9693,7 @@ void LAPACK_zlagsy( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_dlamch_base LAPACK_GLOBAL(dlamch,DLAMCH) +#define LAPACK_dlamch_base LAPACK_GLOBAL_SUFFIX(dlamch,DLAMCH) double LAPACK_dlamch_base( char const* cmach #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9692,7 +9706,7 @@ double LAPACK_dlamch_base( #define LAPACK_dlamch(...) LAPACK_dlamch_base(__VA_ARGS__) #endif -#define LAPACK_slamch_base LAPACK_GLOBAL(slamch,SLAMCH) +#define LAPACK_slamch_base LAPACK_GLOBAL_SUFFIX(slamch,SLAMCH) lapack_float_return LAPACK_slamch_base( char const* cmach #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9705,7 +9719,7 @@ lapack_float_return LAPACK_slamch_base( #define LAPACK_slamch(...) LAPACK_slamch_base(__VA_ARGS__) #endif -#define LAPACK_clangb_base LAPACK_GLOBAL(clangb,CLANGB) +#define LAPACK_clangb_base LAPACK_GLOBAL_SUFFIX(clangb,CLANGB) lapack_float_return LAPACK_clangb_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -9721,7 +9735,7 @@ lapack_float_return LAPACK_clangb_base( #define LAPACK_clangb(...) LAPACK_clangb_base(__VA_ARGS__) #endif -#define LAPACK_dlangb_base LAPACK_GLOBAL(dlangb,DLANGB) +#define LAPACK_dlangb_base LAPACK_GLOBAL_SUFFIX(dlangb,DLANGB) double LAPACK_dlangb_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -9737,7 +9751,7 @@ double LAPACK_dlangb_base( #define LAPACK_dlangb(...) LAPACK_dlangb_base(__VA_ARGS__) #endif -#define LAPACK_slangb_base LAPACK_GLOBAL(slangb,SLANGB) +#define LAPACK_slangb_base LAPACK_GLOBAL_SUFFIX(slangb,SLANGB) lapack_float_return LAPACK_slangb_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -9753,7 +9767,7 @@ lapack_float_return LAPACK_slangb_base( #define LAPACK_slangb(...) LAPACK_slangb_base(__VA_ARGS__) #endif -#define LAPACK_zlangb_base LAPACK_GLOBAL(zlangb,ZLANGB) +#define LAPACK_zlangb_base LAPACK_GLOBAL_SUFFIX(zlangb,ZLANGB) double LAPACK_zlangb_base( char const* norm, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, @@ -9769,7 +9783,7 @@ double LAPACK_zlangb_base( #define LAPACK_zlangb(...) LAPACK_zlangb_base(__VA_ARGS__) #endif -#define LAPACK_clange_base LAPACK_GLOBAL(clange,CLANGE) +#define LAPACK_clange_base LAPACK_GLOBAL_SUFFIX(clange,CLANGE) lapack_float_return LAPACK_clange_base( char const* norm, lapack_int const* m, lapack_int const* n, @@ -9785,7 +9799,7 @@ lapack_float_return LAPACK_clange_base( #define LAPACK_clange(...) LAPACK_clange_base(__VA_ARGS__) #endif -#define LAPACK_dlange_base LAPACK_GLOBAL(dlange,DLANGE) +#define LAPACK_dlange_base LAPACK_GLOBAL_SUFFIX(dlange,DLANGE) double LAPACK_dlange_base( char const* norm, lapack_int const* m, lapack_int const* n, @@ -9801,7 +9815,7 @@ double LAPACK_dlange_base( #define LAPACK_dlange(...) LAPACK_dlange_base(__VA_ARGS__) #endif -#define LAPACK_slange_base LAPACK_GLOBAL(slange,SLANGE) +#define LAPACK_slange_base LAPACK_GLOBAL_SUFFIX(slange,SLANGE) lapack_float_return LAPACK_slange_base( char const* norm, lapack_int const* m, lapack_int const* n, @@ -9817,7 +9831,7 @@ lapack_float_return LAPACK_slange_base( #define LAPACK_slange(...) LAPACK_slange_base(__VA_ARGS__) #endif -#define LAPACK_zlange_base LAPACK_GLOBAL(zlange,ZLANGE) +#define LAPACK_zlange_base LAPACK_GLOBAL_SUFFIX(zlange,ZLANGE) double LAPACK_zlange_base( char const* norm, lapack_int const* m, lapack_int const* n, @@ -9833,7 +9847,7 @@ double LAPACK_zlange_base( #define LAPACK_zlange(...) LAPACK_zlange_base(__VA_ARGS__) #endif -#define LAPACK_clangt_base LAPACK_GLOBAL(clangt,CLANGT) +#define LAPACK_clangt_base LAPACK_GLOBAL_SUFFIX(clangt,CLANGT) lapack_float_return LAPACK_clangt_base( char const* norm, lapack_int const* n, @@ -9850,7 +9864,7 @@ lapack_float_return LAPACK_clangt_base( #define LAPACK_clangt(...) LAPACK_clangt_base(__VA_ARGS__) #endif -#define LAPACK_dlangt_base LAPACK_GLOBAL(dlangt,DLANGT) +#define LAPACK_dlangt_base LAPACK_GLOBAL_SUFFIX(dlangt,DLANGT) double LAPACK_dlangt_base( char const* norm, lapack_int const* n, @@ -9867,7 +9881,7 @@ double LAPACK_dlangt_base( #define LAPACK_dlangt(...) LAPACK_dlangt_base(__VA_ARGS__) #endif -#define LAPACK_slangt_base LAPACK_GLOBAL(slangt,SLANGT) +#define LAPACK_slangt_base LAPACK_GLOBAL_SUFFIX(slangt,SLANGT) lapack_float_return LAPACK_slangt_base( char const* norm, lapack_int const* n, @@ -9884,7 +9898,7 @@ lapack_float_return LAPACK_slangt_base( #define LAPACK_slangt(...) LAPACK_slangt_base(__VA_ARGS__) #endif -#define LAPACK_zlangt_base LAPACK_GLOBAL(zlangt,ZLANGT) +#define LAPACK_zlangt_base LAPACK_GLOBAL_SUFFIX(zlangt,ZLANGT) double LAPACK_zlangt_base( char const* norm, lapack_int const* n, @@ -9901,7 +9915,7 @@ double LAPACK_zlangt_base( #define LAPACK_zlangt(...) LAPACK_zlangt_base(__VA_ARGS__) #endif -#define LAPACK_clanhb_base LAPACK_GLOBAL(clanhb,CLANHB) +#define LAPACK_clanhb_base LAPACK_GLOBAL_SUFFIX(clanhb,CLANHB) lapack_float_return LAPACK_clanhb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -9917,7 +9931,7 @@ lapack_float_return LAPACK_clanhb_base( #define LAPACK_clanhb(...) LAPACK_clanhb_base(__VA_ARGS__) #endif -#define LAPACK_zlanhb_base LAPACK_GLOBAL(zlanhb,ZLANHB) +#define LAPACK_zlanhb_base LAPACK_GLOBAL_SUFFIX(zlanhb,ZLANHB) double LAPACK_zlanhb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -9933,7 +9947,7 @@ double LAPACK_zlanhb_base( #define LAPACK_zlanhb(...) LAPACK_zlanhb_base(__VA_ARGS__) #endif -#define LAPACK_clanhe_base LAPACK_GLOBAL(clanhe,CLANHE) +#define LAPACK_clanhe_base LAPACK_GLOBAL_SUFFIX(clanhe,CLANHE) lapack_float_return LAPACK_clanhe_base( char const* norm, char const* uplo, lapack_int const* n, @@ -9949,7 +9963,7 @@ lapack_float_return LAPACK_clanhe_base( #define LAPACK_clanhe(...) LAPACK_clanhe_base(__VA_ARGS__) #endif -#define LAPACK_zlanhe_base LAPACK_GLOBAL(zlanhe,ZLANHE) +#define LAPACK_zlanhe_base LAPACK_GLOBAL_SUFFIX(zlanhe,ZLANHE) double LAPACK_zlanhe_base( char const* norm, char const* uplo, lapack_int const* n, @@ -9965,7 +9979,7 @@ double LAPACK_zlanhe_base( #define LAPACK_zlanhe(...) LAPACK_zlanhe_base(__VA_ARGS__) #endif -#define LAPACK_clanhp_base LAPACK_GLOBAL(clanhp,CLANHP) +#define LAPACK_clanhp_base LAPACK_GLOBAL_SUFFIX(clanhp,CLANHP) lapack_float_return LAPACK_clanhp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -9981,7 +9995,7 @@ lapack_float_return LAPACK_clanhp_base( #define LAPACK_clanhp(...) LAPACK_clanhp_base(__VA_ARGS__) #endif -#define LAPACK_zlanhp_base LAPACK_GLOBAL(zlanhp,ZLANHP) +#define LAPACK_zlanhp_base LAPACK_GLOBAL_SUFFIX(zlanhp,ZLANHP) double LAPACK_zlanhp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -9997,7 +10011,7 @@ double LAPACK_zlanhp_base( #define LAPACK_zlanhp(...) LAPACK_zlanhp_base(__VA_ARGS__) #endif -#define LAPACK_clanhs_base LAPACK_GLOBAL(clanhs,CLANHS) +#define LAPACK_clanhs_base LAPACK_GLOBAL_SUFFIX(clanhs,CLANHS) lapack_float_return LAPACK_clanhs_base( char const* norm, lapack_int const* n, @@ -10013,7 +10027,7 @@ lapack_float_return LAPACK_clanhs_base( #define LAPACK_clanhs(...) LAPACK_clanhs_base(__VA_ARGS__) #endif -#define LAPACK_dlanhs_base LAPACK_GLOBAL(dlanhs,DLANHS) +#define LAPACK_dlanhs_base LAPACK_GLOBAL_SUFFIX(dlanhs,DLANHS) double LAPACK_dlanhs_base( char const* norm, lapack_int const* n, @@ -10029,7 +10043,7 @@ double LAPACK_dlanhs_base( #define LAPACK_dlanhs(...) LAPACK_dlanhs_base(__VA_ARGS__) #endif -#define LAPACK_slanhs_base LAPACK_GLOBAL(slanhs,SLANHS) +#define LAPACK_slanhs_base LAPACK_GLOBAL_SUFFIX(slanhs,SLANHS) lapack_float_return LAPACK_slanhs_base( char const* norm, lapack_int const* n, @@ -10045,7 +10059,7 @@ lapack_float_return LAPACK_slanhs_base( #define LAPACK_slanhs(...) LAPACK_slanhs_base(__VA_ARGS__) #endif -#define LAPACK_zlanhs_base LAPACK_GLOBAL(zlanhs,ZLANHS) +#define LAPACK_zlanhs_base LAPACK_GLOBAL_SUFFIX(zlanhs,ZLANHS) double LAPACK_zlanhs_base( char const* norm, lapack_int const* n, @@ -10061,7 +10075,7 @@ double LAPACK_zlanhs_base( #define LAPACK_zlanhs(...) LAPACK_zlanhs_base(__VA_ARGS__) #endif -#define LAPACK_clanht_base LAPACK_GLOBAL(clanht,CLANHT) +#define LAPACK_clanht_base LAPACK_GLOBAL_SUFFIX(clanht,CLANHT) lapack_float_return LAPACK_clanht_base( char const* norm, lapack_int const* n, @@ -10077,7 +10091,7 @@ lapack_float_return LAPACK_clanht_base( #define LAPACK_clanht(...) LAPACK_clanht_base(__VA_ARGS__) #endif -#define LAPACK_zlanht_base LAPACK_GLOBAL(zlanht,ZLANHT) +#define LAPACK_zlanht_base LAPACK_GLOBAL_SUFFIX(zlanht,ZLANHT) double LAPACK_zlanht_base( char const* norm, lapack_int const* n, @@ -10093,7 +10107,7 @@ double LAPACK_zlanht_base( #define LAPACK_zlanht(...) LAPACK_zlanht_base(__VA_ARGS__) #endif -#define LAPACK_clansb_base LAPACK_GLOBAL(clansb,CLANSB) +#define LAPACK_clansb_base LAPACK_GLOBAL_SUFFIX(clansb,CLANSB) lapack_float_return LAPACK_clansb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -10109,7 +10123,7 @@ lapack_float_return LAPACK_clansb_base( #define LAPACK_clansb(...) LAPACK_clansb_base(__VA_ARGS__) #endif -#define LAPACK_dlansb_base LAPACK_GLOBAL(dlansb,DLANSB) +#define LAPACK_dlansb_base LAPACK_GLOBAL_SUFFIX(dlansb,DLANSB) double LAPACK_dlansb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -10125,7 +10139,7 @@ double LAPACK_dlansb_base( #define LAPACK_dlansb(...) LAPACK_dlansb_base(__VA_ARGS__) #endif -#define LAPACK_slansb_base LAPACK_GLOBAL(slansb,SLANSB) +#define LAPACK_slansb_base LAPACK_GLOBAL_SUFFIX(slansb,SLANSB) lapack_float_return LAPACK_slansb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -10141,7 +10155,7 @@ lapack_float_return LAPACK_slansb_base( #define LAPACK_slansb(...) LAPACK_slansb_base(__VA_ARGS__) #endif -#define LAPACK_zlansb_base LAPACK_GLOBAL(zlansb,ZLANSB) +#define LAPACK_zlansb_base LAPACK_GLOBAL_SUFFIX(zlansb,ZLANSB) double LAPACK_zlansb_base( char const* norm, char const* uplo, lapack_int const* n, lapack_int const* k, @@ -10157,7 +10171,7 @@ double LAPACK_zlansb_base( #define LAPACK_zlansb(...) LAPACK_zlansb_base(__VA_ARGS__) #endif -#define LAPACK_clansp_base LAPACK_GLOBAL(clansp,CLANSP) +#define LAPACK_clansp_base LAPACK_GLOBAL_SUFFIX(clansp,CLANSP) lapack_float_return LAPACK_clansp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10173,7 +10187,7 @@ lapack_float_return LAPACK_clansp_base( #define LAPACK_clansp(...) LAPACK_clansp_base(__VA_ARGS__) #endif -#define LAPACK_dlansp_base LAPACK_GLOBAL(dlansp,DLANSP) +#define LAPACK_dlansp_base LAPACK_GLOBAL_SUFFIX(dlansp,DLANSP) double LAPACK_dlansp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10189,7 +10203,7 @@ double LAPACK_dlansp_base( #define LAPACK_dlansp(...) LAPACK_dlansp_base(__VA_ARGS__) #endif -#define LAPACK_slansp_base LAPACK_GLOBAL(slansp,SLANSP) +#define LAPACK_slansp_base LAPACK_GLOBAL_SUFFIX(slansp,SLANSP) lapack_float_return LAPACK_slansp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10205,7 +10219,7 @@ lapack_float_return LAPACK_slansp_base( #define LAPACK_slansp(...) LAPACK_slansp_base(__VA_ARGS__) #endif -#define LAPACK_zlansp_base LAPACK_GLOBAL(zlansp,ZLANSP) +#define LAPACK_zlansp_base LAPACK_GLOBAL_SUFFIX(zlansp,ZLANSP) double LAPACK_zlansp_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10221,7 +10235,7 @@ double LAPACK_zlansp_base( #define LAPACK_zlansp(...) LAPACK_zlansp_base(__VA_ARGS__) #endif -#define LAPACK_dlanst_base LAPACK_GLOBAL(dlanst,DLANST) +#define LAPACK_dlanst_base LAPACK_GLOBAL_SUFFIX(dlanst,DLANST) double LAPACK_dlanst_base( char const* norm, lapack_int const* n, @@ -10237,7 +10251,7 @@ double LAPACK_dlanst_base( #define LAPACK_dlanst(...) LAPACK_dlanst_base(__VA_ARGS__) #endif -#define LAPACK_slanst_base LAPACK_GLOBAL(slanst,SLANST) +#define LAPACK_slanst_base LAPACK_GLOBAL_SUFFIX(slanst,SLANST) lapack_float_return LAPACK_slanst_base( char const* norm, lapack_int const* n, @@ -10253,7 +10267,7 @@ lapack_float_return LAPACK_slanst_base( #define LAPACK_slanst(...) LAPACK_slanst_base(__VA_ARGS__) #endif -#define LAPACK_clansy_base LAPACK_GLOBAL(clansy,CLANSY) +#define LAPACK_clansy_base LAPACK_GLOBAL_SUFFIX(clansy,CLANSY) lapack_float_return LAPACK_clansy_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10269,7 +10283,7 @@ lapack_float_return LAPACK_clansy_base( #define LAPACK_clansy(...) LAPACK_clansy_base(__VA_ARGS__) #endif -#define LAPACK_dlansy_base LAPACK_GLOBAL(dlansy,DLANSY) +#define LAPACK_dlansy_base LAPACK_GLOBAL_SUFFIX(dlansy,DLANSY) double LAPACK_dlansy_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10285,7 +10299,7 @@ double LAPACK_dlansy_base( #define LAPACK_dlansy(...) LAPACK_dlansy_base(__VA_ARGS__) #endif -#define LAPACK_slansy_base LAPACK_GLOBAL(slansy,SLANSY) +#define LAPACK_slansy_base LAPACK_GLOBAL_SUFFIX(slansy,SLANSY) lapack_float_return LAPACK_slansy_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10301,7 +10315,7 @@ lapack_float_return LAPACK_slansy_base( #define LAPACK_slansy(...) LAPACK_slansy_base(__VA_ARGS__) #endif -#define LAPACK_zlansy_base LAPACK_GLOBAL(zlansy,ZLANSY) +#define LAPACK_zlansy_base LAPACK_GLOBAL_SUFFIX(zlansy,ZLANSY) double LAPACK_zlansy_base( char const* norm, char const* uplo, lapack_int const* n, @@ -10317,7 +10331,7 @@ double LAPACK_zlansy_base( #define LAPACK_zlansy(...) LAPACK_zlansy_base(__VA_ARGS__) #endif -#define LAPACK_clantb_base LAPACK_GLOBAL(clantb,CLANTB) +#define LAPACK_clantb_base LAPACK_GLOBAL_SUFFIX(clantb,CLANTB) lapack_float_return LAPACK_clantb_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* k, @@ -10333,7 +10347,7 @@ lapack_float_return LAPACK_clantb_base( #define LAPACK_clantb(...) LAPACK_clantb_base(__VA_ARGS__) #endif -#define LAPACK_dlantb_base LAPACK_GLOBAL(dlantb,DLANTB) +#define LAPACK_dlantb_base LAPACK_GLOBAL_SUFFIX(dlantb,DLANTB) double LAPACK_dlantb_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* k, @@ -10349,7 +10363,7 @@ double LAPACK_dlantb_base( #define LAPACK_dlantb(...) LAPACK_dlantb_base(__VA_ARGS__) #endif -#define LAPACK_slantb_base LAPACK_GLOBAL(slantb,SLANTB) +#define LAPACK_slantb_base LAPACK_GLOBAL_SUFFIX(slantb,SLANTB) lapack_float_return LAPACK_slantb_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* k, @@ -10365,7 +10379,7 @@ lapack_float_return LAPACK_slantb_base( #define LAPACK_slantb(...) LAPACK_slantb_base(__VA_ARGS__) #endif -#define LAPACK_zlantb_base LAPACK_GLOBAL(zlantb,ZLANTB) +#define LAPACK_zlantb_base LAPACK_GLOBAL_SUFFIX(zlantb,ZLANTB) double LAPACK_zlantb_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* k, @@ -10381,7 +10395,7 @@ double LAPACK_zlantb_base( #define LAPACK_zlantb(...) LAPACK_zlantb_base(__VA_ARGS__) #endif -#define LAPACK_clantp_base LAPACK_GLOBAL(clantp,CLANTP) +#define LAPACK_clantp_base LAPACK_GLOBAL_SUFFIX(clantp,CLANTP) lapack_float_return LAPACK_clantp_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -10397,7 +10411,7 @@ lapack_float_return LAPACK_clantp_base( #define LAPACK_clantp(...) LAPACK_clantp_base(__VA_ARGS__) #endif -#define LAPACK_dlantp_base LAPACK_GLOBAL(dlantp,DLANTP) +#define LAPACK_dlantp_base LAPACK_GLOBAL_SUFFIX(dlantp,DLANTP) double LAPACK_dlantp_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -10413,7 +10427,7 @@ double LAPACK_dlantp_base( #define LAPACK_dlantp(...) LAPACK_dlantp_base(__VA_ARGS__) #endif -#define LAPACK_slantp_base LAPACK_GLOBAL(slantp,SLANTP) +#define LAPACK_slantp_base LAPACK_GLOBAL_SUFFIX(slantp,SLANTP) lapack_float_return LAPACK_slantp_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -10429,7 +10443,7 @@ lapack_float_return LAPACK_slantp_base( #define LAPACK_slantp(...) LAPACK_slantp_base(__VA_ARGS__) #endif -#define LAPACK_zlantp_base LAPACK_GLOBAL(zlantp,ZLANTP) +#define LAPACK_zlantp_base LAPACK_GLOBAL_SUFFIX(zlantp,ZLANTP) double LAPACK_zlantp_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -10445,7 +10459,7 @@ double LAPACK_zlantp_base( #define LAPACK_zlantp(...) LAPACK_zlantp_base(__VA_ARGS__) #endif -#define LAPACK_clantr_base LAPACK_GLOBAL(clantr,CLANTR) +#define LAPACK_clantr_base LAPACK_GLOBAL_SUFFIX(clantr,CLANTR) lapack_float_return LAPACK_clantr_base( char const* norm, char const* uplo, char const* diag, lapack_int const* m, lapack_int const* n, @@ -10461,7 +10475,7 @@ lapack_float_return LAPACK_clantr_base( #define LAPACK_clantr(...) LAPACK_clantr_base(__VA_ARGS__) #endif -#define LAPACK_dlantr_base LAPACK_GLOBAL(dlantr,DLANTR) +#define LAPACK_dlantr_base LAPACK_GLOBAL_SUFFIX(dlantr,DLANTR) double LAPACK_dlantr_base( char const* norm, char const* uplo, char const* diag, lapack_int const* m, lapack_int const* n, @@ -10477,7 +10491,7 @@ double LAPACK_dlantr_base( #define LAPACK_dlantr(...) LAPACK_dlantr_base(__VA_ARGS__) #endif -#define LAPACK_slantr_base LAPACK_GLOBAL(slantr,SLANTR) +#define LAPACK_slantr_base LAPACK_GLOBAL_SUFFIX(slantr,SLANTR) lapack_float_return LAPACK_slantr_base( char const* norm, char const* uplo, char const* diag, lapack_int const* m, lapack_int const* n, @@ -10493,7 +10507,7 @@ lapack_float_return LAPACK_slantr_base( #define LAPACK_slantr(...) LAPACK_slantr_base(__VA_ARGS__) #endif -#define LAPACK_zlantr_base LAPACK_GLOBAL(zlantr,ZLANTR) +#define LAPACK_zlantr_base LAPACK_GLOBAL_SUFFIX(zlantr,ZLANTR) double LAPACK_zlantr_base( char const* norm, char const* uplo, char const* diag, lapack_int const* m, lapack_int const* n, @@ -10509,69 +10523,69 @@ double LAPACK_zlantr_base( #define LAPACK_zlantr(...) LAPACK_zlantr_base(__VA_ARGS__) #endif -#define LAPACK_clapmr LAPACK_GLOBAL(clapmr,CLAPMR) +#define LAPACK_clapmr LAPACK_GLOBAL_SUFFIX(clapmr,CLAPMR) void LAPACK_clapmr( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, lapack_complex_float* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_dlapmr LAPACK_GLOBAL(dlapmr,DLAPMR) +#define LAPACK_dlapmr LAPACK_GLOBAL_SUFFIX(dlapmr,DLAPMR) void LAPACK_dlapmr( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, double* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_slapmr LAPACK_GLOBAL(slapmr,SLAPMR) +#define LAPACK_slapmr LAPACK_GLOBAL_SUFFIX(slapmr,SLAPMR) void LAPACK_slapmr( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, float* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_zlapmr LAPACK_GLOBAL(zlapmr,ZLAPMR) +#define LAPACK_zlapmr LAPACK_GLOBAL_SUFFIX(zlapmr,ZLAPMR) void LAPACK_zlapmr( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, lapack_complex_double* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_clapmt LAPACK_GLOBAL(clapmt,CLAPMT) +#define LAPACK_clapmt LAPACK_GLOBAL_SUFFIX(clapmt,CLAPMT) void LAPACK_clapmt( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, lapack_complex_float* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_dlapmt LAPACK_GLOBAL(dlapmt,DLAPMT) +#define LAPACK_dlapmt LAPACK_GLOBAL_SUFFIX(dlapmt,DLAPMT) void LAPACK_dlapmt( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, double* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_slapmt LAPACK_GLOBAL(slapmt,SLAPMT) +#define LAPACK_slapmt LAPACK_GLOBAL_SUFFIX(slapmt,SLAPMT) void LAPACK_slapmt( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, float* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_zlapmt LAPACK_GLOBAL(zlapmt,ZLAPMT) +#define LAPACK_zlapmt LAPACK_GLOBAL_SUFFIX(zlapmt,ZLAPMT) void LAPACK_zlapmt( lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, lapack_complex_double* X, lapack_int const* ldx, lapack_int* K ); -#define LAPACK_dlapy2 LAPACK_GLOBAL(dlapy2,DLAPY2) +#define LAPACK_dlapy2 LAPACK_GLOBAL_SUFFIX(dlapy2,DLAPY2) double LAPACK_dlapy2( double const* x, double const* y ); -#define LAPACK_slapy2 LAPACK_GLOBAL(slapy2,SLAPY2) +#define LAPACK_slapy2 LAPACK_GLOBAL_SUFFIX(slapy2,SLAPY2) lapack_float_return LAPACK_slapy2( float const* x, float const* y ); -#define LAPACK_dlapy3 LAPACK_GLOBAL(dlapy3,DLAPY3) +#define LAPACK_dlapy3 LAPACK_GLOBAL_SUFFIX(dlapy3,DLAPY3) double LAPACK_dlapy3( double const* x, double const* y, double const* z ); -#define LAPACK_slapy3 LAPACK_GLOBAL(slapy3,SLAPY3) +#define LAPACK_slapy3 LAPACK_GLOBAL_SUFFIX(slapy3,SLAPY3) lapack_float_return LAPACK_slapy3( float const* x, float const* y, float const* z ); -#define LAPACK_clarcm LAPACK_GLOBAL(clarcm,CLARCM) +#define LAPACK_clarcm LAPACK_GLOBAL_SUFFIX(clarcm,CLARCM) void LAPACK_clarcm( lapack_int const* m, lapack_int const* n, float const* A, lapack_int const* lda, @@ -10579,7 +10593,7 @@ void LAPACK_clarcm( lapack_complex_float* C, lapack_int const* ldc, float* rwork ); -#define LAPACK_zlarcm LAPACK_GLOBAL(zlarcm,ZLARCM) +#define LAPACK_zlarcm LAPACK_GLOBAL_SUFFIX(zlarcm,ZLARCM) void LAPACK_zlarcm( lapack_int const* m, lapack_int const* n, double const* A, lapack_int const* lda, @@ -10587,7 +10601,7 @@ void LAPACK_zlarcm( lapack_complex_double* C, lapack_int const* ldc, double* rwork ); -#define LAPACK_clarf_base LAPACK_GLOBAL(clarf,CLARF) +#define LAPACK_clarf_base LAPACK_GLOBAL_SUFFIX(clarf,CLARF) void LAPACK_clarf_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10605,7 +10619,7 @@ void LAPACK_clarf_base( #define LAPACK_clarf(...) LAPACK_clarf_base(__VA_ARGS__) #endif -#define LAPACK_dlarf_base LAPACK_GLOBAL(dlarf,DLARF) +#define LAPACK_dlarf_base LAPACK_GLOBAL_SUFFIX(dlarf,DLARF) void LAPACK_dlarf_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10623,7 +10637,7 @@ void LAPACK_dlarf_base( #define LAPACK_dlarf(...) LAPACK_dlarf_base(__VA_ARGS__) #endif -#define LAPACK_slarf_base LAPACK_GLOBAL(slarf,SLARF) +#define LAPACK_slarf_base LAPACK_GLOBAL_SUFFIX(slarf,SLARF) void LAPACK_slarf_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10641,7 +10655,7 @@ void LAPACK_slarf_base( #define LAPACK_slarf(...) LAPACK_slarf_base(__VA_ARGS__) #endif -#define LAPACK_zlarf_base LAPACK_GLOBAL(zlarf,ZLARF) +#define LAPACK_zlarf_base LAPACK_GLOBAL_SUFFIX(zlarf,ZLARF) void LAPACK_zlarf_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10659,7 +10673,7 @@ void LAPACK_zlarf_base( #define LAPACK_zlarf(...) LAPACK_zlarf_base(__VA_ARGS__) #endif -#define LAPACK_clarfb_base LAPACK_GLOBAL(clarfb,CLARFB) +#define LAPACK_clarfb_base LAPACK_GLOBAL_SUFFIX(clarfb,CLARFB) void LAPACK_clarfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -10677,7 +10691,7 @@ void LAPACK_clarfb_base( #define LAPACK_clarfb(...) LAPACK_clarfb_base(__VA_ARGS__) #endif -#define LAPACK_dlarfb_base LAPACK_GLOBAL(dlarfb,DLARFB) +#define LAPACK_dlarfb_base LAPACK_GLOBAL_SUFFIX(dlarfb,DLARFB) void LAPACK_dlarfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -10695,7 +10709,7 @@ void LAPACK_dlarfb_base( #define LAPACK_dlarfb(...) LAPACK_dlarfb_base(__VA_ARGS__) #endif -#define LAPACK_slarfb_base LAPACK_GLOBAL(slarfb,SLARFB) +#define LAPACK_slarfb_base LAPACK_GLOBAL_SUFFIX(slarfb,SLARFB) void LAPACK_slarfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -10713,7 +10727,7 @@ void LAPACK_slarfb_base( #define LAPACK_slarfb(...) LAPACK_slarfb_base(__VA_ARGS__) #endif -#define LAPACK_zlarfb_base LAPACK_GLOBAL(zlarfb,ZLARFB) +#define LAPACK_zlarfb_base LAPACK_GLOBAL_SUFFIX(zlarfb,ZLARFB) void LAPACK_zlarfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -10731,35 +10745,35 @@ void LAPACK_zlarfb_base( #define LAPACK_zlarfb(...) LAPACK_zlarfb_base(__VA_ARGS__) #endif -#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG) +#define LAPACK_clarfg LAPACK_GLOBAL_SUFFIX(clarfg,CLARFG) void LAPACK_clarfg( lapack_int const* n, lapack_complex_float* alpha, lapack_complex_float* X, lapack_int const* incx, lapack_complex_float* tau ); -#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG) +#define LAPACK_dlarfg LAPACK_GLOBAL_SUFFIX(dlarfg,DLARFG) void LAPACK_dlarfg( lapack_int const* n, double* alpha, double* X, lapack_int const* incx, double* tau ); -#define LAPACK_slarfg LAPACK_GLOBAL(slarfg,SLARFG) +#define LAPACK_slarfg LAPACK_GLOBAL_SUFFIX(slarfg,SLARFG) void LAPACK_slarfg( lapack_int const* n, float* alpha, float* X, lapack_int const* incx, float* tau ); -#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG) +#define LAPACK_zlarfg LAPACK_GLOBAL_SUFFIX(zlarfg,ZLARFG) void LAPACK_zlarfg( lapack_int const* n, lapack_complex_double* alpha, lapack_complex_double* X, lapack_int const* incx, lapack_complex_double* tau ); -#define LAPACK_clarft_base LAPACK_GLOBAL(clarft,CLARFT) +#define LAPACK_clarft_base LAPACK_GLOBAL_SUFFIX(clarft,CLARFT) void LAPACK_clarft_base( char const* direct, char const* storev, lapack_int const* n, lapack_int const* k, @@ -10776,7 +10790,7 @@ void LAPACK_clarft_base( #define LAPACK_clarft(...) LAPACK_clarft_base(__VA_ARGS__) #endif -#define LAPACK_dlarft_base LAPACK_GLOBAL(dlarft,DLARFT) +#define LAPACK_dlarft_base LAPACK_GLOBAL_SUFFIX(dlarft,DLARFT) void LAPACK_dlarft_base( char const* direct, char const* storev, lapack_int const* n, lapack_int const* k, @@ -10793,7 +10807,7 @@ void LAPACK_dlarft_base( #define LAPACK_dlarft(...) LAPACK_dlarft_base(__VA_ARGS__) #endif -#define LAPACK_slarft_base LAPACK_GLOBAL(slarft,SLARFT) +#define LAPACK_slarft_base LAPACK_GLOBAL_SUFFIX(slarft,SLARFT) void LAPACK_slarft_base( char const* direct, char const* storev, lapack_int const* n, lapack_int const* k, @@ -10810,7 +10824,7 @@ void LAPACK_slarft_base( #define LAPACK_slarft(...) LAPACK_slarft_base(__VA_ARGS__) #endif -#define LAPACK_zlarft_base LAPACK_GLOBAL(zlarft,ZLARFT) +#define LAPACK_zlarft_base LAPACK_GLOBAL_SUFFIX(zlarft,ZLARFT) void LAPACK_zlarft_base( char const* direct, char const* storev, lapack_int const* n, lapack_int const* k, @@ -10827,7 +10841,7 @@ void LAPACK_zlarft_base( #define LAPACK_zlarft(...) LAPACK_zlarft_base(__VA_ARGS__) #endif -#define LAPACK_clarfx_base LAPACK_GLOBAL(clarfx,CLARFX) +#define LAPACK_clarfx_base LAPACK_GLOBAL_SUFFIX(clarfx,CLARFX) void LAPACK_clarfx_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10845,7 +10859,7 @@ void LAPACK_clarfx_base( #define LAPACK_clarfx(...) LAPACK_clarfx_base(__VA_ARGS__) #endif -#define LAPACK_dlarfx_base LAPACK_GLOBAL(dlarfx,DLARFX) +#define LAPACK_dlarfx_base LAPACK_GLOBAL_SUFFIX(dlarfx,DLARFX) void LAPACK_dlarfx_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10863,7 +10877,7 @@ void LAPACK_dlarfx_base( #define LAPACK_dlarfx(...) LAPACK_dlarfx_base(__VA_ARGS__) #endif -#define LAPACK_slarfx_base LAPACK_GLOBAL(slarfx,SLARFX) +#define LAPACK_slarfx_base LAPACK_GLOBAL_SUFFIX(slarfx,SLARFX) void LAPACK_slarfx_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10881,7 +10895,7 @@ void LAPACK_slarfx_base( #define LAPACK_slarfx(...) LAPACK_slarfx_base(__VA_ARGS__) #endif -#define LAPACK_zlarfx_base LAPACK_GLOBAL(zlarfx,ZLARFX) +#define LAPACK_zlarfx_base LAPACK_GLOBAL_SUFFIX(zlarfx,ZLARFX) void LAPACK_zlarfx_base( char const* side, lapack_int const* m, lapack_int const* n, @@ -10899,27 +10913,27 @@ void LAPACK_zlarfx_base( #define LAPACK_zlarfx(...) LAPACK_zlarfx_base(__VA_ARGS__) #endif -#define LAPACK_clarnv LAPACK_GLOBAL(clarnv,CLARNV) +#define LAPACK_clarnv LAPACK_GLOBAL_SUFFIX(clarnv,CLARNV) void LAPACK_clarnv( lapack_int const* idist, lapack_int* iseed, lapack_int const* n, lapack_complex_float* X ); -#define LAPACK_dlarnv LAPACK_GLOBAL(dlarnv,DLARNV) +#define LAPACK_dlarnv LAPACK_GLOBAL_SUFFIX(dlarnv,DLARNV) void LAPACK_dlarnv( lapack_int const* idist, lapack_int* iseed, lapack_int const* n, double* X ); -#define LAPACK_slarnv LAPACK_GLOBAL(slarnv,SLARNV) +#define LAPACK_slarnv LAPACK_GLOBAL_SUFFIX(slarnv,SLARNV) void LAPACK_slarnv( lapack_int const* idist, lapack_int* iseed, lapack_int const* n, float* X ); -#define LAPACK_zlarnv LAPACK_GLOBAL(zlarnv,ZLARNV) +#define LAPACK_zlarnv LAPACK_GLOBAL_SUFFIX(zlarnv,ZLARNV) void LAPACK_zlarnv( lapack_int const* idist, lapack_int* iseed, lapack_int const* n, lapack_complex_double* X ); -#define LAPACK_dlartgp LAPACK_GLOBAL(dlartgp,DLARTGP) +#define LAPACK_dlartgp LAPACK_GLOBAL_SUFFIX(dlartgp,DLARTGP) void LAPACK_dlartgp( double const* f, double const* g, @@ -10927,7 +10941,7 @@ void LAPACK_dlartgp( double* sn, double* r ); -#define LAPACK_slartgp LAPACK_GLOBAL(slartgp,SLARTGP) +#define LAPACK_slartgp LAPACK_GLOBAL_SUFFIX(slartgp,SLARTGP) void LAPACK_slartgp( float const* f, float const* g, @@ -10935,7 +10949,7 @@ void LAPACK_slartgp( float* sn, float* r ); -#define LAPACK_dlartgs LAPACK_GLOBAL(dlartgs,DLARTGS) +#define LAPACK_dlartgs LAPACK_GLOBAL_SUFFIX(dlartgs,DLARTGS) void LAPACK_dlartgs( double const* x, double const* y, @@ -10943,7 +10957,7 @@ void LAPACK_dlartgs( double* cs, double* sn ); -#define LAPACK_slartgs LAPACK_GLOBAL(slartgs,SLARTGS) +#define LAPACK_slartgs LAPACK_GLOBAL_SUFFIX(slartgs,SLARTGS) void LAPACK_slartgs( float const* x, float const* y, @@ -10951,7 +10965,7 @@ void LAPACK_slartgs( float* cs, float* sn ); -#define LAPACK_clascl_base LAPACK_GLOBAL(clascl,CLASCL) +#define LAPACK_clascl_base LAPACK_GLOBAL_SUFFIX(clascl,CLASCL) void LAPACK_clascl_base( char const* type, lapack_int const* kl, lapack_int const* ku, @@ -10969,7 +10983,7 @@ void LAPACK_clascl_base( #define LAPACK_clascl(...) LAPACK_clascl_base(__VA_ARGS__) #endif -#define LAPACK_dlascl_base LAPACK_GLOBAL(dlascl,DLASCL) +#define LAPACK_dlascl_base LAPACK_GLOBAL_SUFFIX(dlascl,DLASCL) void LAPACK_dlascl_base( char const* type, lapack_int const* kl, lapack_int const* ku, @@ -10987,7 +11001,7 @@ void LAPACK_dlascl_base( #define LAPACK_dlascl(...) LAPACK_dlascl_base(__VA_ARGS__) #endif -#define LAPACK_slascl_base LAPACK_GLOBAL(slascl,SLASCL) +#define LAPACK_slascl_base LAPACK_GLOBAL_SUFFIX(slascl,SLASCL) void LAPACK_slascl_base( char const* type, lapack_int const* kl, lapack_int const* ku, @@ -11005,7 +11019,7 @@ void LAPACK_slascl_base( #define LAPACK_slascl(...) LAPACK_slascl_base(__VA_ARGS__) #endif -#define LAPACK_zlascl_base LAPACK_GLOBAL(zlascl,ZLASCL) +#define LAPACK_zlascl_base LAPACK_GLOBAL_SUFFIX(zlascl,ZLASCL) void LAPACK_zlascl_base( char const* type, lapack_int const* kl, lapack_int const* ku, @@ -11023,7 +11037,7 @@ void LAPACK_zlascl_base( #define LAPACK_zlascl(...) LAPACK_zlascl_base(__VA_ARGS__) #endif -#define LAPACK_claset_base LAPACK_GLOBAL(claset,CLASET) +#define LAPACK_claset_base LAPACK_GLOBAL_SUFFIX(claset,CLASET) void LAPACK_claset_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -11040,7 +11054,7 @@ void LAPACK_claset_base( #define LAPACK_claset(...) LAPACK_claset_base(__VA_ARGS__) #endif -#define LAPACK_dlaset_base LAPACK_GLOBAL(dlaset,DLASET) +#define LAPACK_dlaset_base LAPACK_GLOBAL_SUFFIX(dlaset,DLASET) void LAPACK_dlaset_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -11057,7 +11071,7 @@ void LAPACK_dlaset_base( #define LAPACK_dlaset(...) LAPACK_dlaset_base(__VA_ARGS__) #endif -#define LAPACK_slaset_base LAPACK_GLOBAL(slaset,SLASET) +#define LAPACK_slaset_base LAPACK_GLOBAL_SUFFIX(slaset,SLASET) void LAPACK_slaset_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -11074,7 +11088,7 @@ void LAPACK_slaset_base( #define LAPACK_slaset(...) LAPACK_slaset_base(__VA_ARGS__) #endif -#define LAPACK_zlaset_base LAPACK_GLOBAL(zlaset,ZLASET) +#define LAPACK_zlaset_base LAPACK_GLOBAL_SUFFIX(zlaset,ZLASET) void LAPACK_zlaset_base( char const* uplo, lapack_int const* m, lapack_int const* n, @@ -11091,7 +11105,7 @@ void LAPACK_zlaset_base( #define LAPACK_zlaset(...) LAPACK_zlaset_base(__VA_ARGS__) #endif -#define LAPACK_dlasrt_base LAPACK_GLOBAL(dlasrt,DLASRT) +#define LAPACK_dlasrt_base LAPACK_GLOBAL_SUFFIX(dlasrt,DLASRT) void LAPACK_dlasrt_base( char const* id, lapack_int const* n, @@ -11107,7 +11121,7 @@ void LAPACK_dlasrt_base( #define LAPACK_dlasrt(...) LAPACK_dlasrt_base(__VA_ARGS__) #endif -#define LAPACK_slasrt_base LAPACK_GLOBAL(slasrt,SLASRT) +#define LAPACK_slasrt_base LAPACK_GLOBAL_SUFFIX(slasrt,SLASRT) void LAPACK_slasrt_base( char const* id, lapack_int const* n, @@ -11123,55 +11137,55 @@ void LAPACK_slasrt_base( #define LAPACK_slasrt(...) LAPACK_slasrt_base(__VA_ARGS__) #endif -#define LAPACK_classq LAPACK_GLOBAL(classq,CLASSQ) +#define LAPACK_classq LAPACK_GLOBAL_SUFFIX(classq,CLASSQ) void LAPACK_classq( lapack_int const* n, lapack_complex_float const* X, lapack_int const* incx, float* scale, float* sumsq ); -#define LAPACK_dlassq LAPACK_GLOBAL(dlassq,DLASSQ) +#define LAPACK_dlassq LAPACK_GLOBAL_SUFFIX(dlassq,DLASSQ) void LAPACK_dlassq( lapack_int const* n, double const* X, lapack_int const* incx, double* scale, double* sumsq ); -#define LAPACK_slassq LAPACK_GLOBAL(slassq,SLASSQ) +#define LAPACK_slassq LAPACK_GLOBAL_SUFFIX(slassq,SLASSQ) void LAPACK_slassq( lapack_int const* n, float const* X, lapack_int const* incx, float* scale, float* sumsq ); -#define LAPACK_zlassq LAPACK_GLOBAL(zlassq,ZLASSQ) +#define LAPACK_zlassq LAPACK_GLOBAL_SUFFIX(zlassq,ZLASSQ) void LAPACK_zlassq( lapack_int const* n, lapack_complex_double const* X, lapack_int const* incx, double* scale, double* sumsq ); -#define LAPACK_claswp LAPACK_GLOBAL(claswp,CLASWP) +#define LAPACK_claswp LAPACK_GLOBAL_SUFFIX(claswp,CLASWP) void LAPACK_claswp( lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); -#define LAPACK_dlaswp LAPACK_GLOBAL(dlaswp,DLASWP) +#define LAPACK_dlaswp LAPACK_GLOBAL_SUFFIX(dlaswp,DLASWP) void LAPACK_dlaswp( lapack_int const* n, double* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); -#define LAPACK_slaswp LAPACK_GLOBAL(slaswp,SLASWP) +#define LAPACK_slaswp LAPACK_GLOBAL_SUFFIX(slaswp,SLASWP) void LAPACK_slaswp( lapack_int const* n, float* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); -#define LAPACK_zlaswp LAPACK_GLOBAL(zlaswp,ZLASWP) +#define LAPACK_zlaswp LAPACK_GLOBAL_SUFFIX(zlaswp,ZLASWP) void LAPACK_zlaswp( lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); -#define LAPACK_clatms_base LAPACK_GLOBAL(clatms,CLATMS) +#define LAPACK_clatms_base LAPACK_GLOBAL_SUFFIX(clatms,CLATMS) void LAPACK_clatms_base( lapack_int const* m, lapack_int const* n, char const* dist, lapack_int* iseed, char const* sym, @@ -11193,7 +11207,7 @@ void LAPACK_clatms_base( #define LAPACK_clatms(...) LAPACK_clatms_base(__VA_ARGS__) #endif -#define LAPACK_dlatms_base LAPACK_GLOBAL(dlatms,DLATMS) +#define LAPACK_dlatms_base LAPACK_GLOBAL_SUFFIX(dlatms,DLATMS) void LAPACK_dlatms_base( lapack_int const* m, lapack_int const* n, char const* dist, lapack_int* iseed, char const* sym, @@ -11215,7 +11229,7 @@ void LAPACK_dlatms_base( #define LAPACK_dlatms(...) LAPACK_dlatms_base(__VA_ARGS__) #endif -#define LAPACK_slatms_base LAPACK_GLOBAL(slatms,SLATMS) +#define LAPACK_slatms_base LAPACK_GLOBAL_SUFFIX(slatms,SLATMS) void LAPACK_slatms_base( lapack_int const* m, lapack_int const* n, char const* dist, lapack_int* iseed, char const* sym, @@ -11237,7 +11251,7 @@ void LAPACK_slatms_base( #define LAPACK_slatms(...) LAPACK_slatms_base(__VA_ARGS__) #endif -#define LAPACK_zlatms_base LAPACK_GLOBAL(zlatms,ZLATMS) +#define LAPACK_zlatms_base LAPACK_GLOBAL_SUFFIX(zlatms,ZLATMS) void LAPACK_zlatms_base( lapack_int const* m, lapack_int const* n, char const* dist, lapack_int* iseed, char const* sym, @@ -11259,7 +11273,7 @@ void LAPACK_zlatms_base( #define LAPACK_zlatms(...) LAPACK_zlatms_base(__VA_ARGS__) #endif -#define LAPACK_clauum_base LAPACK_GLOBAL(clauum,CLAUUM) +#define LAPACK_clauum_base LAPACK_GLOBAL_SUFFIX(clauum,CLAUUM) void LAPACK_clauum_base( char const* uplo, lapack_int const* n, @@ -11275,7 +11289,7 @@ void LAPACK_clauum_base( #define LAPACK_clauum(...) LAPACK_clauum_base(__VA_ARGS__) #endif -#define LAPACK_dlauum_base LAPACK_GLOBAL(dlauum,DLAUUM) +#define LAPACK_dlauum_base LAPACK_GLOBAL_SUFFIX(dlauum,DLAUUM) void LAPACK_dlauum_base( char const* uplo, lapack_int const* n, @@ -11291,7 +11305,7 @@ void LAPACK_dlauum_base( #define LAPACK_dlauum(...) LAPACK_dlauum_base(__VA_ARGS__) #endif -#define LAPACK_slauum_base LAPACK_GLOBAL(slauum,SLAUUM) +#define LAPACK_slauum_base LAPACK_GLOBAL_SUFFIX(slauum,SLAUUM) void LAPACK_slauum_base( char const* uplo, lapack_int const* n, @@ -11307,7 +11321,7 @@ void LAPACK_slauum_base( #define LAPACK_slauum(...) LAPACK_slauum_base(__VA_ARGS__) #endif -#define LAPACK_zlauum_base LAPACK_GLOBAL(zlauum,ZLAUUM) +#define LAPACK_zlauum_base LAPACK_GLOBAL_SUFFIX(zlauum,ZLAUUM) void LAPACK_zlauum_base( char const* uplo, lapack_int const* n, @@ -11323,11 +11337,11 @@ void LAPACK_zlauum_base( #define LAPACK_zlauum(...) LAPACK_zlauum_base(__VA_ARGS__) #endif -#define LAPACK_ilaver LAPACK_GLOBAL(ilaver,ILAVER) +#define LAPACK_ilaver LAPACK_GLOBAL_SUFFIX(ilaver,ILAVER) void LAPACK_ilaver( lapack_int* vers_major, lapack_int* vers_minor, lapack_int* vers_patch ); -#define LAPACK_dopgtr_base LAPACK_GLOBAL(dopgtr,DOPGTR) +#define LAPACK_dopgtr_base LAPACK_GLOBAL_SUFFIX(dopgtr,DOPGTR) void LAPACK_dopgtr_base( char const* uplo, lapack_int const* n, @@ -11346,7 +11360,7 @@ void LAPACK_dopgtr_base( #define LAPACK_dopgtr(...) LAPACK_dopgtr_base(__VA_ARGS__) #endif -#define LAPACK_sopgtr_base LAPACK_GLOBAL(sopgtr,SOPGTR) +#define LAPACK_sopgtr_base LAPACK_GLOBAL_SUFFIX(sopgtr,SOPGTR) void LAPACK_sopgtr_base( char const* uplo, lapack_int const* n, @@ -11365,7 +11379,7 @@ void LAPACK_sopgtr_base( #define LAPACK_sopgtr(...) LAPACK_sopgtr_base(__VA_ARGS__) #endif -#define LAPACK_dopmtr_base LAPACK_GLOBAL(dopmtr,DOPMTR) +#define LAPACK_dopmtr_base LAPACK_GLOBAL_SUFFIX(dopmtr,DOPMTR) void LAPACK_dopmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -11384,7 +11398,7 @@ void LAPACK_dopmtr_base( #define LAPACK_dopmtr(...) LAPACK_dopmtr_base(__VA_ARGS__) #endif -#define LAPACK_sopmtr_base LAPACK_GLOBAL(sopmtr,SOPMTR) +#define LAPACK_sopmtr_base LAPACK_GLOBAL_SUFFIX(sopmtr,SOPMTR) void LAPACK_sopmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -11403,7 +11417,7 @@ void LAPACK_sopmtr_base( #define LAPACK_sopmtr(...) LAPACK_sopmtr_base(__VA_ARGS__) #endif -#define LAPACK_dorbdb_base LAPACK_GLOBAL(dorbdb,DORBDB) +#define LAPACK_dorbdb_base LAPACK_GLOBAL_SUFFIX(dorbdb,DORBDB) void LAPACK_dorbdb_base( char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11429,7 +11443,7 @@ void LAPACK_dorbdb_base( #define LAPACK_dorbdb(...) LAPACK_dorbdb_base(__VA_ARGS__) #endif -#define LAPACK_sorbdb_base LAPACK_GLOBAL(sorbdb,SORBDB) +#define LAPACK_sorbdb_base LAPACK_GLOBAL_SUFFIX(sorbdb,SORBDB) void LAPACK_sorbdb_base( char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11455,7 +11469,7 @@ void LAPACK_sorbdb_base( #define LAPACK_sorbdb(...) LAPACK_sorbdb_base(__VA_ARGS__) #endif -#define LAPACK_dorcsd_base LAPACK_GLOBAL(dorcsd,DORCSD) +#define LAPACK_dorcsd_base LAPACK_GLOBAL_SUFFIX(dorcsd,DORCSD) void LAPACK_dorcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11481,7 +11495,7 @@ void LAPACK_dorcsd_base( #define LAPACK_dorcsd(...) LAPACK_dorcsd_base(__VA_ARGS__) #endif -#define LAPACK_sorcsd_base LAPACK_GLOBAL(sorcsd,SORCSD) +#define LAPACK_sorcsd_base LAPACK_GLOBAL_SUFFIX(sorcsd,SORCSD) void LAPACK_sorcsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11507,7 +11521,7 @@ void LAPACK_sorcsd_base( #define LAPACK_sorcsd(...) LAPACK_sorcsd_base(__VA_ARGS__) #endif -#define LAPACK_dorcsd2by1_base LAPACK_GLOBAL(dorcsd2by1,DORCSD2BY1) +#define LAPACK_dorcsd2by1_base LAPACK_GLOBAL_SUFFIX(dorcsd2by1,DORCSD2BY1) void LAPACK_dorcsd2by1_base( char const* jobu1, char const* jobu2, char const* jobv1t, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11530,7 +11544,7 @@ void LAPACK_dorcsd2by1_base( #define LAPACK_dorcsd2by1(...) LAPACK_dorcsd2by1_base(__VA_ARGS__) #endif -#define LAPACK_sorcsd2by1_base LAPACK_GLOBAL(sorcsd2by1,SORCSD2BY1) +#define LAPACK_sorcsd2by1_base LAPACK_GLOBAL_SUFFIX(sorcsd2by1,SORCSD2BY1) void LAPACK_sorcsd2by1_base( char const* jobu1, char const* jobu2, char const* jobv1t, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -11553,7 +11567,7 @@ void LAPACK_sorcsd2by1_base( #define LAPACK_sorcsd2by1(...) LAPACK_sorcsd2by1_base(__VA_ARGS__) #endif -#define LAPACK_dorgbr_base LAPACK_GLOBAL(dorgbr,DORGBR) +#define LAPACK_dorgbr_base LAPACK_GLOBAL_SUFFIX(dorgbr,DORGBR) void LAPACK_dorgbr_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11571,7 +11585,7 @@ void LAPACK_dorgbr_base( #define LAPACK_dorgbr(...) LAPACK_dorgbr_base(__VA_ARGS__) #endif -#define LAPACK_sorgbr_base LAPACK_GLOBAL(sorgbr,SORGBR) +#define LAPACK_sorgbr_base LAPACK_GLOBAL_SUFFIX(sorgbr,SORGBR) void LAPACK_sorgbr_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11589,7 +11603,7 @@ void LAPACK_sorgbr_base( #define LAPACK_sorgbr(...) LAPACK_sorgbr_base(__VA_ARGS__) #endif -#define LAPACK_dorghr LAPACK_GLOBAL(dorghr,DORGHR) +#define LAPACK_dorghr LAPACK_GLOBAL_SUFFIX(dorghr,DORGHR) void LAPACK_dorghr( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, double* A, lapack_int const* lda, @@ -11597,7 +11611,7 @@ void LAPACK_dorghr( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorghr LAPACK_GLOBAL(sorghr,SORGHR) +#define LAPACK_sorghr LAPACK_GLOBAL_SUFFIX(sorghr,SORGHR) void LAPACK_sorghr( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, float* A, lapack_int const* lda, @@ -11605,7 +11619,7 @@ void LAPACK_sorghr( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorglq LAPACK_GLOBAL(dorglq,DORGLQ) +#define LAPACK_dorglq LAPACK_GLOBAL_SUFFIX(dorglq,DORGLQ) void LAPACK_dorglq( lapack_int const* m, lapack_int const* n, lapack_int const* k, double* A, lapack_int const* lda, @@ -11613,7 +11627,7 @@ void LAPACK_dorglq( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorglq LAPACK_GLOBAL(sorglq,SORGLQ) +#define LAPACK_sorglq LAPACK_GLOBAL_SUFFIX(sorglq,SORGLQ) void LAPACK_sorglq( lapack_int const* m, lapack_int const* n, lapack_int const* k, float* A, lapack_int const* lda, @@ -11621,7 +11635,7 @@ void LAPACK_sorglq( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorgql LAPACK_GLOBAL(dorgql,DORGQL) +#define LAPACK_dorgql LAPACK_GLOBAL_SUFFIX(dorgql,DORGQL) void LAPACK_dorgql( lapack_int const* m, lapack_int const* n, lapack_int const* k, double* A, lapack_int const* lda, @@ -11629,7 +11643,7 @@ void LAPACK_dorgql( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorgql LAPACK_GLOBAL(sorgql,SORGQL) +#define LAPACK_sorgql LAPACK_GLOBAL_SUFFIX(sorgql,SORGQL) void LAPACK_sorgql( lapack_int const* m, lapack_int const* n, lapack_int const* k, float* A, lapack_int const* lda, @@ -11637,7 +11651,7 @@ void LAPACK_sorgql( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorgqr LAPACK_GLOBAL(dorgqr,DORGQR) +#define LAPACK_dorgqr LAPACK_GLOBAL_SUFFIX(dorgqr,DORGQR) void LAPACK_dorgqr( lapack_int const* m, lapack_int const* n, lapack_int const* k, double* A, lapack_int const* lda, @@ -11645,7 +11659,7 @@ void LAPACK_dorgqr( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorgqr LAPACK_GLOBAL(sorgqr,SORGQR) +#define LAPACK_sorgqr LAPACK_GLOBAL_SUFFIX(sorgqr,SORGQR) void LAPACK_sorgqr( lapack_int const* m, lapack_int const* n, lapack_int const* k, float* A, lapack_int const* lda, @@ -11653,7 +11667,7 @@ void LAPACK_sorgqr( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorgrq LAPACK_GLOBAL(dorgrq,DORGRQ) +#define LAPACK_dorgrq LAPACK_GLOBAL_SUFFIX(dorgrq,DORGRQ) void LAPACK_dorgrq( lapack_int const* m, lapack_int const* n, lapack_int const* k, double* A, lapack_int const* lda, @@ -11661,7 +11675,7 @@ void LAPACK_dorgrq( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorgrq LAPACK_GLOBAL(sorgrq,SORGRQ) +#define LAPACK_sorgrq LAPACK_GLOBAL_SUFFIX(sorgrq,SORGRQ) void LAPACK_sorgrq( lapack_int const* m, lapack_int const* n, lapack_int const* k, float* A, lapack_int const* lda, @@ -11669,7 +11683,7 @@ void LAPACK_sorgrq( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorgtr_base LAPACK_GLOBAL(dorgtr,DORGTR) +#define LAPACK_dorgtr_base LAPACK_GLOBAL_SUFFIX(dorgtr,DORGTR) void LAPACK_dorgtr_base( char const* uplo, lapack_int const* n, @@ -11687,7 +11701,7 @@ void LAPACK_dorgtr_base( #define LAPACK_dorgtr(...) LAPACK_dorgtr_base(__VA_ARGS__) #endif -#define LAPACK_sorgtr_base LAPACK_GLOBAL(sorgtr,SORGTR) +#define LAPACK_sorgtr_base LAPACK_GLOBAL_SUFFIX(sorgtr,SORGTR) void LAPACK_sorgtr_base( char const* uplo, lapack_int const* n, @@ -11705,7 +11719,7 @@ void LAPACK_sorgtr_base( #define LAPACK_sorgtr(...) LAPACK_sorgtr_base(__VA_ARGS__) #endif -#define LAPACK_dorgtsqr_row LAPACK_GLOBAL(dorgtsqr_row,DORGTSQR_ROW) +#define LAPACK_dorgtsqr_row LAPACK_GLOBAL_SUFFIX(dorgtsqr_row,DORGTSQR_ROW) void LAPACK_dorgtsqr_row( lapack_int const* m, lapack_int const* n, lapack_int const* mb, lapack_int const* nb, @@ -11714,7 +11728,7 @@ void LAPACK_dorgtsqr_row( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_sorgtsqr_row LAPACK_GLOBAL(sorgtsqr_row,SORGTSQR_ROW) +#define LAPACK_sorgtsqr_row LAPACK_GLOBAL_SUFFIX(sorgtsqr_row,SORGTSQR_ROW) void LAPACK_sorgtsqr_row( lapack_int const* m, lapack_int const* n, lapack_int const* mb, lapack_int const* nb, @@ -11723,7 +11737,7 @@ void LAPACK_sorgtsqr_row( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dorhr_col LAPACK_GLOBAL(dorhr_col,DORHR_COL) +#define LAPACK_dorhr_col LAPACK_GLOBAL_SUFFIX(dorhr_col,DORHR_COL) void LAPACK_dorhr_col( lapack_int const* m, lapack_int const* n, lapack_int const* nb, double* A, @@ -11731,7 +11745,7 @@ void LAPACK_dorhr_col( lapack_int const* ldt, double* D, lapack_int* info ); -#define LAPACK_sorhr_col LAPACK_GLOBAL(sorhr_col,SORHR_COL) +#define LAPACK_sorhr_col LAPACK_GLOBAL_SUFFIX(sorhr_col,SORHR_COL) void LAPACK_sorhr_col( lapack_int const* m, lapack_int const* n, lapack_int const* nb, float* A, @@ -11739,7 +11753,7 @@ void LAPACK_sorhr_col( lapack_int const* ldt, float* D, lapack_int* info ); -#define LAPACK_dormbr_base LAPACK_GLOBAL(dormbr,DORMBR) +#define LAPACK_dormbr_base LAPACK_GLOBAL_SUFFIX(dormbr,DORMBR) void LAPACK_dormbr_base( char const* vect, char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11758,7 +11772,7 @@ void LAPACK_dormbr_base( #define LAPACK_dormbr(...) LAPACK_dormbr_base(__VA_ARGS__) #endif -#define LAPACK_sormbr_base LAPACK_GLOBAL(sormbr,SORMBR) +#define LAPACK_sormbr_base LAPACK_GLOBAL_SUFFIX(sormbr,SORMBR) void LAPACK_sormbr_base( char const* vect, char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11777,7 +11791,7 @@ void LAPACK_sormbr_base( #define LAPACK_sormbr(...) LAPACK_sormbr_base(__VA_ARGS__) #endif -#define LAPACK_dormhr_base LAPACK_GLOBAL(dormhr,DORMHR) +#define LAPACK_dormhr_base LAPACK_GLOBAL_SUFFIX(dormhr,DORMHR) void LAPACK_dormhr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -11796,7 +11810,7 @@ void LAPACK_dormhr_base( #define LAPACK_dormhr(...) LAPACK_dormhr_base(__VA_ARGS__) #endif -#define LAPACK_sormhr_base LAPACK_GLOBAL(sormhr,SORMHR) +#define LAPACK_sormhr_base LAPACK_GLOBAL_SUFFIX(sormhr,SORMHR) void LAPACK_sormhr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -11815,7 +11829,7 @@ void LAPACK_sormhr_base( #define LAPACK_sormhr(...) LAPACK_sormhr_base(__VA_ARGS__) #endif -#define LAPACK_dormlq_base LAPACK_GLOBAL(dormlq,DORMLQ) +#define LAPACK_dormlq_base LAPACK_GLOBAL_SUFFIX(dormlq,DORMLQ) void LAPACK_dormlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11834,7 +11848,7 @@ void LAPACK_dormlq_base( #define LAPACK_dormlq(...) LAPACK_dormlq_base(__VA_ARGS__) #endif -#define LAPACK_sormlq_base LAPACK_GLOBAL(sormlq,SORMLQ) +#define LAPACK_sormlq_base LAPACK_GLOBAL_SUFFIX(sormlq,SORMLQ) void LAPACK_sormlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11853,7 +11867,7 @@ void LAPACK_sormlq_base( #define LAPACK_sormlq(...) LAPACK_sormlq_base(__VA_ARGS__) #endif -#define LAPACK_dormql_base LAPACK_GLOBAL(dormql,DORMQL) +#define LAPACK_dormql_base LAPACK_GLOBAL_SUFFIX(dormql,DORMQL) void LAPACK_dormql_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11872,7 +11886,7 @@ void LAPACK_dormql_base( #define LAPACK_dormql(...) LAPACK_dormql_base(__VA_ARGS__) #endif -#define LAPACK_sormql_base LAPACK_GLOBAL(sormql,SORMQL) +#define LAPACK_sormql_base LAPACK_GLOBAL_SUFFIX(sormql,SORMQL) void LAPACK_sormql_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11891,7 +11905,7 @@ void LAPACK_sormql_base( #define LAPACK_sormql(...) LAPACK_sormql_base(__VA_ARGS__) #endif -#define LAPACK_dormqr_base LAPACK_GLOBAL(dormqr,DORMQR) +#define LAPACK_dormqr_base LAPACK_GLOBAL_SUFFIX(dormqr,DORMQR) void LAPACK_dormqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11910,7 +11924,7 @@ void LAPACK_dormqr_base( #define LAPACK_dormqr(...) LAPACK_dormqr_base(__VA_ARGS__) #endif -#define LAPACK_sormqr_base LAPACK_GLOBAL(sormqr,SORMQR) +#define LAPACK_sormqr_base LAPACK_GLOBAL_SUFFIX(sormqr,SORMQR) void LAPACK_sormqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11929,7 +11943,7 @@ void LAPACK_sormqr_base( #define LAPACK_sormqr(...) LAPACK_sormqr_base(__VA_ARGS__) #endif -#define LAPACK_dormrq_base LAPACK_GLOBAL(dormrq,DORMRQ) +#define LAPACK_dormrq_base LAPACK_GLOBAL_SUFFIX(dormrq,DORMRQ) void LAPACK_dormrq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11948,7 +11962,7 @@ void LAPACK_dormrq_base( #define LAPACK_dormrq(...) LAPACK_dormrq_base(__VA_ARGS__) #endif -#define LAPACK_sormrq_base LAPACK_GLOBAL(sormrq,SORMRQ) +#define LAPACK_sormrq_base LAPACK_GLOBAL_SUFFIX(sormrq,SORMRQ) void LAPACK_sormrq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -11967,7 +11981,7 @@ void LAPACK_sormrq_base( #define LAPACK_sormrq(...) LAPACK_sormrq_base(__VA_ARGS__) #endif -#define LAPACK_dormrz_base LAPACK_GLOBAL(dormrz,DORMRZ) +#define LAPACK_dormrz_base LAPACK_GLOBAL_SUFFIX(dormrz,DORMRZ) void LAPACK_dormrz_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -11986,7 +12000,7 @@ void LAPACK_dormrz_base( #define LAPACK_dormrz(...) LAPACK_dormrz_base(__VA_ARGS__) #endif -#define LAPACK_sormrz_base LAPACK_GLOBAL(sormrz,SORMRZ) +#define LAPACK_sormrz_base LAPACK_GLOBAL_SUFFIX(sormrz,SORMRZ) void LAPACK_sormrz_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -12005,7 +12019,7 @@ void LAPACK_sormrz_base( #define LAPACK_sormrz(...) LAPACK_sormrz_base(__VA_ARGS__) #endif -#define LAPACK_dormtr_base LAPACK_GLOBAL(dormtr,DORMTR) +#define LAPACK_dormtr_base LAPACK_GLOBAL_SUFFIX(dormtr,DORMTR) void LAPACK_dormtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -12024,7 +12038,7 @@ void LAPACK_dormtr_base( #define LAPACK_dormtr(...) LAPACK_dormtr_base(__VA_ARGS__) #endif -#define LAPACK_sormtr_base LAPACK_GLOBAL(sormtr,SORMTR) +#define LAPACK_sormtr_base LAPACK_GLOBAL_SUFFIX(sormtr,SORMTR) void LAPACK_sormtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -12043,7 +12057,7 @@ void LAPACK_sormtr_base( #define LAPACK_sormtr(...) LAPACK_sormtr_base(__VA_ARGS__) #endif -#define LAPACK_cpbcon_base LAPACK_GLOBAL(cpbcon,CPBCON) +#define LAPACK_cpbcon_base LAPACK_GLOBAL_SUFFIX(cpbcon,CPBCON) void LAPACK_cpbcon_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12063,7 +12077,7 @@ void LAPACK_cpbcon_base( #define LAPACK_cpbcon(...) LAPACK_cpbcon_base(__VA_ARGS__) #endif -#define LAPACK_dpbcon_base LAPACK_GLOBAL(dpbcon,DPBCON) +#define LAPACK_dpbcon_base LAPACK_GLOBAL_SUFFIX(dpbcon,DPBCON) void LAPACK_dpbcon_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12083,7 +12097,7 @@ void LAPACK_dpbcon_base( #define LAPACK_dpbcon(...) LAPACK_dpbcon_base(__VA_ARGS__) #endif -#define LAPACK_spbcon_base LAPACK_GLOBAL(spbcon,SPBCON) +#define LAPACK_spbcon_base LAPACK_GLOBAL_SUFFIX(spbcon,SPBCON) void LAPACK_spbcon_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12103,7 +12117,7 @@ void LAPACK_spbcon_base( #define LAPACK_spbcon(...) LAPACK_spbcon_base(__VA_ARGS__) #endif -#define LAPACK_zpbcon_base LAPACK_GLOBAL(zpbcon,ZPBCON) +#define LAPACK_zpbcon_base LAPACK_GLOBAL_SUFFIX(zpbcon,ZPBCON) void LAPACK_zpbcon_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12123,7 +12137,7 @@ void LAPACK_zpbcon_base( #define LAPACK_zpbcon(...) LAPACK_zpbcon_base(__VA_ARGS__) #endif -#define LAPACK_cpbequ_base LAPACK_GLOBAL(cpbequ,CPBEQU) +#define LAPACK_cpbequ_base LAPACK_GLOBAL_SUFFIX(cpbequ,CPBEQU) void LAPACK_cpbequ_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12142,7 +12156,7 @@ void LAPACK_cpbequ_base( #define LAPACK_cpbequ(...) LAPACK_cpbequ_base(__VA_ARGS__) #endif -#define LAPACK_dpbequ_base LAPACK_GLOBAL(dpbequ,DPBEQU) +#define LAPACK_dpbequ_base LAPACK_GLOBAL_SUFFIX(dpbequ,DPBEQU) void LAPACK_dpbequ_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12161,7 +12175,7 @@ void LAPACK_dpbequ_base( #define LAPACK_dpbequ(...) LAPACK_dpbequ_base(__VA_ARGS__) #endif -#define LAPACK_spbequ_base LAPACK_GLOBAL(spbequ,SPBEQU) +#define LAPACK_spbequ_base LAPACK_GLOBAL_SUFFIX(spbequ,SPBEQU) void LAPACK_spbequ_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12180,7 +12194,7 @@ void LAPACK_spbequ_base( #define LAPACK_spbequ(...) LAPACK_spbequ_base(__VA_ARGS__) #endif -#define LAPACK_zpbequ_base LAPACK_GLOBAL(zpbequ,ZPBEQU) +#define LAPACK_zpbequ_base LAPACK_GLOBAL_SUFFIX(zpbequ,ZPBEQU) void LAPACK_zpbequ_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12199,7 +12213,7 @@ void LAPACK_zpbequ_base( #define LAPACK_zpbequ(...) LAPACK_zpbequ_base(__VA_ARGS__) #endif -#define LAPACK_cpbrfs_base LAPACK_GLOBAL(cpbrfs,CPBRFS) +#define LAPACK_cpbrfs_base LAPACK_GLOBAL_SUFFIX(cpbrfs,CPBRFS) void LAPACK_cpbrfs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12222,7 +12236,7 @@ void LAPACK_cpbrfs_base( #define LAPACK_cpbrfs(...) LAPACK_cpbrfs_base(__VA_ARGS__) #endif -#define LAPACK_dpbrfs_base LAPACK_GLOBAL(dpbrfs,DPBRFS) +#define LAPACK_dpbrfs_base LAPACK_GLOBAL_SUFFIX(dpbrfs,DPBRFS) void LAPACK_dpbrfs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12245,7 +12259,7 @@ void LAPACK_dpbrfs_base( #define LAPACK_dpbrfs(...) LAPACK_dpbrfs_base(__VA_ARGS__) #endif -#define LAPACK_spbrfs_base LAPACK_GLOBAL(spbrfs,SPBRFS) +#define LAPACK_spbrfs_base LAPACK_GLOBAL_SUFFIX(spbrfs,SPBRFS) void LAPACK_spbrfs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12268,7 +12282,7 @@ void LAPACK_spbrfs_base( #define LAPACK_spbrfs(...) LAPACK_spbrfs_base(__VA_ARGS__) #endif -#define LAPACK_zpbrfs_base LAPACK_GLOBAL(zpbrfs,ZPBRFS) +#define LAPACK_zpbrfs_base LAPACK_GLOBAL_SUFFIX(zpbrfs,ZPBRFS) void LAPACK_zpbrfs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12291,7 +12305,7 @@ void LAPACK_zpbrfs_base( #define LAPACK_zpbrfs(...) LAPACK_zpbrfs_base(__VA_ARGS__) #endif -#define LAPACK_cpbstf_base LAPACK_GLOBAL(cpbstf,CPBSTF) +#define LAPACK_cpbstf_base LAPACK_GLOBAL_SUFFIX(cpbstf,CPBSTF) void LAPACK_cpbstf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12307,7 +12321,7 @@ void LAPACK_cpbstf_base( #define LAPACK_cpbstf(...) LAPACK_cpbstf_base(__VA_ARGS__) #endif -#define LAPACK_dpbstf_base LAPACK_GLOBAL(dpbstf,DPBSTF) +#define LAPACK_dpbstf_base LAPACK_GLOBAL_SUFFIX(dpbstf,DPBSTF) void LAPACK_dpbstf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12323,7 +12337,7 @@ void LAPACK_dpbstf_base( #define LAPACK_dpbstf(...) LAPACK_dpbstf_base(__VA_ARGS__) #endif -#define LAPACK_spbstf_base LAPACK_GLOBAL(spbstf,SPBSTF) +#define LAPACK_spbstf_base LAPACK_GLOBAL_SUFFIX(spbstf,SPBSTF) void LAPACK_spbstf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12339,7 +12353,7 @@ void LAPACK_spbstf_base( #define LAPACK_spbstf(...) LAPACK_spbstf_base(__VA_ARGS__) #endif -#define LAPACK_zpbstf_base LAPACK_GLOBAL(zpbstf,ZPBSTF) +#define LAPACK_zpbstf_base LAPACK_GLOBAL_SUFFIX(zpbstf,ZPBSTF) void LAPACK_zpbstf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12355,7 +12369,7 @@ void LAPACK_zpbstf_base( #define LAPACK_zpbstf(...) LAPACK_zpbstf_base(__VA_ARGS__) #endif -#define LAPACK_cpbsv_base LAPACK_GLOBAL(cpbsv,CPBSV) +#define LAPACK_cpbsv_base LAPACK_GLOBAL_SUFFIX(cpbsv,CPBSV) void LAPACK_cpbsv_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12372,7 +12386,7 @@ void LAPACK_cpbsv_base( #define LAPACK_cpbsv(...) LAPACK_cpbsv_base(__VA_ARGS__) #endif -#define LAPACK_dpbsv_base LAPACK_GLOBAL(dpbsv,DPBSV) +#define LAPACK_dpbsv_base LAPACK_GLOBAL_SUFFIX(dpbsv,DPBSV) void LAPACK_dpbsv_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12389,7 +12403,7 @@ void LAPACK_dpbsv_base( #define LAPACK_dpbsv(...) LAPACK_dpbsv_base(__VA_ARGS__) #endif -#define LAPACK_spbsv_base LAPACK_GLOBAL(spbsv,SPBSV) +#define LAPACK_spbsv_base LAPACK_GLOBAL_SUFFIX(spbsv,SPBSV) void LAPACK_spbsv_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12406,7 +12420,7 @@ void LAPACK_spbsv_base( #define LAPACK_spbsv(...) LAPACK_spbsv_base(__VA_ARGS__) #endif -#define LAPACK_zpbsv_base LAPACK_GLOBAL(zpbsv,ZPBSV) +#define LAPACK_zpbsv_base LAPACK_GLOBAL_SUFFIX(zpbsv,ZPBSV) void LAPACK_zpbsv_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12423,7 +12437,7 @@ void LAPACK_zpbsv_base( #define LAPACK_zpbsv(...) LAPACK_zpbsv_base(__VA_ARGS__) #endif -#define LAPACK_cpbsvx_base LAPACK_GLOBAL(cpbsvx,CPBSVX) +#define LAPACK_cpbsvx_base LAPACK_GLOBAL_SUFFIX(cpbsvx,CPBSVX) void LAPACK_cpbsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12449,7 +12463,7 @@ void LAPACK_cpbsvx_base( #define LAPACK_cpbsvx(...) LAPACK_cpbsvx_base(__VA_ARGS__) #endif -#define LAPACK_dpbsvx_base LAPACK_GLOBAL(dpbsvx,DPBSVX) +#define LAPACK_dpbsvx_base LAPACK_GLOBAL_SUFFIX(dpbsvx,DPBSVX) void LAPACK_dpbsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12475,7 +12489,7 @@ void LAPACK_dpbsvx_base( #define LAPACK_dpbsvx(...) LAPACK_dpbsvx_base(__VA_ARGS__) #endif -#define LAPACK_spbsvx_base LAPACK_GLOBAL(spbsvx,SPBSVX) +#define LAPACK_spbsvx_base LAPACK_GLOBAL_SUFFIX(spbsvx,SPBSVX) void LAPACK_spbsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12501,7 +12515,7 @@ void LAPACK_spbsvx_base( #define LAPACK_spbsvx(...) LAPACK_spbsvx_base(__VA_ARGS__) #endif -#define LAPACK_zpbsvx_base LAPACK_GLOBAL(zpbsvx,ZPBSVX) +#define LAPACK_zpbsvx_base LAPACK_GLOBAL_SUFFIX(zpbsvx,ZPBSVX) void LAPACK_zpbsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12527,7 +12541,7 @@ void LAPACK_zpbsvx_base( #define LAPACK_zpbsvx(...) LAPACK_zpbsvx_base(__VA_ARGS__) #endif -#define LAPACK_cpbtrf_base LAPACK_GLOBAL(cpbtrf,CPBTRF) +#define LAPACK_cpbtrf_base LAPACK_GLOBAL_SUFFIX(cpbtrf,CPBTRF) void LAPACK_cpbtrf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12543,7 +12557,7 @@ void LAPACK_cpbtrf_base( #define LAPACK_cpbtrf(...) LAPACK_cpbtrf_base(__VA_ARGS__) #endif -#define LAPACK_dpbtrf_base LAPACK_GLOBAL(dpbtrf,DPBTRF) +#define LAPACK_dpbtrf_base LAPACK_GLOBAL_SUFFIX(dpbtrf,DPBTRF) void LAPACK_dpbtrf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12559,7 +12573,7 @@ void LAPACK_dpbtrf_base( #define LAPACK_dpbtrf(...) LAPACK_dpbtrf_base(__VA_ARGS__) #endif -#define LAPACK_spbtrf_base LAPACK_GLOBAL(spbtrf,SPBTRF) +#define LAPACK_spbtrf_base LAPACK_GLOBAL_SUFFIX(spbtrf,SPBTRF) void LAPACK_spbtrf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12575,7 +12589,7 @@ void LAPACK_spbtrf_base( #define LAPACK_spbtrf(...) LAPACK_spbtrf_base(__VA_ARGS__) #endif -#define LAPACK_zpbtrf_base LAPACK_GLOBAL(zpbtrf,ZPBTRF) +#define LAPACK_zpbtrf_base LAPACK_GLOBAL_SUFFIX(zpbtrf,ZPBTRF) void LAPACK_zpbtrf_base( char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -12591,7 +12605,7 @@ void LAPACK_zpbtrf_base( #define LAPACK_zpbtrf(...) LAPACK_zpbtrf_base(__VA_ARGS__) #endif -#define LAPACK_cpbtrs_base LAPACK_GLOBAL(cpbtrs,CPBTRS) +#define LAPACK_cpbtrs_base LAPACK_GLOBAL_SUFFIX(cpbtrs,CPBTRS) void LAPACK_cpbtrs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12608,7 +12622,7 @@ void LAPACK_cpbtrs_base( #define LAPACK_cpbtrs(...) LAPACK_cpbtrs_base(__VA_ARGS__) #endif -#define LAPACK_dpbtrs_base LAPACK_GLOBAL(dpbtrs,DPBTRS) +#define LAPACK_dpbtrs_base LAPACK_GLOBAL_SUFFIX(dpbtrs,DPBTRS) void LAPACK_dpbtrs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12625,7 +12639,7 @@ void LAPACK_dpbtrs_base( #define LAPACK_dpbtrs(...) LAPACK_dpbtrs_base(__VA_ARGS__) #endif -#define LAPACK_spbtrs_base LAPACK_GLOBAL(spbtrs,SPBTRS) +#define LAPACK_spbtrs_base LAPACK_GLOBAL_SUFFIX(spbtrs,SPBTRS) void LAPACK_spbtrs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12642,7 +12656,7 @@ void LAPACK_spbtrs_base( #define LAPACK_spbtrs(...) LAPACK_spbtrs_base(__VA_ARGS__) #endif -#define LAPACK_zpbtrs_base LAPACK_GLOBAL(zpbtrs,ZPBTRS) +#define LAPACK_zpbtrs_base LAPACK_GLOBAL_SUFFIX(zpbtrs,ZPBTRS) void LAPACK_zpbtrs_base( char const* uplo, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -12659,7 +12673,7 @@ void LAPACK_zpbtrs_base( #define LAPACK_zpbtrs(...) LAPACK_zpbtrs_base(__VA_ARGS__) #endif -#define LAPACK_cpftrf_base LAPACK_GLOBAL(cpftrf,CPFTRF) +#define LAPACK_cpftrf_base LAPACK_GLOBAL_SUFFIX(cpftrf,CPFTRF) void LAPACK_cpftrf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12675,7 +12689,7 @@ void LAPACK_cpftrf_base( #define LAPACK_cpftrf(...) LAPACK_cpftrf_base(__VA_ARGS__) #endif -#define LAPACK_dpftrf_base LAPACK_GLOBAL(dpftrf,DPFTRF) +#define LAPACK_dpftrf_base LAPACK_GLOBAL_SUFFIX(dpftrf,DPFTRF) void LAPACK_dpftrf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12691,7 +12705,7 @@ void LAPACK_dpftrf_base( #define LAPACK_dpftrf(...) LAPACK_dpftrf_base(__VA_ARGS__) #endif -#define LAPACK_spftrf_base LAPACK_GLOBAL(spftrf,SPFTRF) +#define LAPACK_spftrf_base LAPACK_GLOBAL_SUFFIX(spftrf,SPFTRF) void LAPACK_spftrf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12707,7 +12721,7 @@ void LAPACK_spftrf_base( #define LAPACK_spftrf(...) LAPACK_spftrf_base(__VA_ARGS__) #endif -#define LAPACK_zpftrf_base LAPACK_GLOBAL(zpftrf,ZPFTRF) +#define LAPACK_zpftrf_base LAPACK_GLOBAL_SUFFIX(zpftrf,ZPFTRF) void LAPACK_zpftrf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12723,7 +12737,7 @@ void LAPACK_zpftrf_base( #define LAPACK_zpftrf(...) LAPACK_zpftrf_base(__VA_ARGS__) #endif -#define LAPACK_cpftri_base LAPACK_GLOBAL(cpftri,CPFTRI) +#define LAPACK_cpftri_base LAPACK_GLOBAL_SUFFIX(cpftri,CPFTRI) void LAPACK_cpftri_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12739,7 +12753,7 @@ void LAPACK_cpftri_base( #define LAPACK_cpftri(...) LAPACK_cpftri_base(__VA_ARGS__) #endif -#define LAPACK_dpftri_base LAPACK_GLOBAL(dpftri,DPFTRI) +#define LAPACK_dpftri_base LAPACK_GLOBAL_SUFFIX(dpftri,DPFTRI) void LAPACK_dpftri_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12755,7 +12769,7 @@ void LAPACK_dpftri_base( #define LAPACK_dpftri(...) LAPACK_dpftri_base(__VA_ARGS__) #endif -#define LAPACK_spftri_base LAPACK_GLOBAL(spftri,SPFTRI) +#define LAPACK_spftri_base LAPACK_GLOBAL_SUFFIX(spftri,SPFTRI) void LAPACK_spftri_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12771,7 +12785,7 @@ void LAPACK_spftri_base( #define LAPACK_spftri(...) LAPACK_spftri_base(__VA_ARGS__) #endif -#define LAPACK_zpftri_base LAPACK_GLOBAL(zpftri,ZPFTRI) +#define LAPACK_zpftri_base LAPACK_GLOBAL_SUFFIX(zpftri,ZPFTRI) void LAPACK_zpftri_base( char const* transr, char const* uplo, lapack_int const* n, @@ -12787,7 +12801,7 @@ void LAPACK_zpftri_base( #define LAPACK_zpftri(...) LAPACK_zpftri_base(__VA_ARGS__) #endif -#define LAPACK_cpftrs_base LAPACK_GLOBAL(cpftrs,CPFTRS) +#define LAPACK_cpftrs_base LAPACK_GLOBAL_SUFFIX(cpftrs,CPFTRS) void LAPACK_cpftrs_base( char const* transr, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -12804,7 +12818,7 @@ void LAPACK_cpftrs_base( #define LAPACK_cpftrs(...) LAPACK_cpftrs_base(__VA_ARGS__) #endif -#define LAPACK_dpftrs_base LAPACK_GLOBAL(dpftrs,DPFTRS) +#define LAPACK_dpftrs_base LAPACK_GLOBAL_SUFFIX(dpftrs,DPFTRS) void LAPACK_dpftrs_base( char const* transr, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -12821,7 +12835,7 @@ void LAPACK_dpftrs_base( #define LAPACK_dpftrs(...) LAPACK_dpftrs_base(__VA_ARGS__) #endif -#define LAPACK_spftrs_base LAPACK_GLOBAL(spftrs,SPFTRS) +#define LAPACK_spftrs_base LAPACK_GLOBAL_SUFFIX(spftrs,SPFTRS) void LAPACK_spftrs_base( char const* transr, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -12838,7 +12852,7 @@ void LAPACK_spftrs_base( #define LAPACK_spftrs(...) LAPACK_spftrs_base(__VA_ARGS__) #endif -#define LAPACK_zpftrs_base LAPACK_GLOBAL(zpftrs,ZPFTRS) +#define LAPACK_zpftrs_base LAPACK_GLOBAL_SUFFIX(zpftrs,ZPFTRS) void LAPACK_zpftrs_base( char const* transr, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -12855,7 +12869,7 @@ void LAPACK_zpftrs_base( #define LAPACK_zpftrs(...) LAPACK_zpftrs_base(__VA_ARGS__) #endif -#define LAPACK_cpocon_base LAPACK_GLOBAL(cpocon,CPOCON) +#define LAPACK_cpocon_base LAPACK_GLOBAL_SUFFIX(cpocon,CPOCON) void LAPACK_cpocon_base( char const* uplo, lapack_int const* n, @@ -12875,7 +12889,7 @@ void LAPACK_cpocon_base( #define LAPACK_cpocon(...) LAPACK_cpocon_base(__VA_ARGS__) #endif -#define LAPACK_dpocon_base LAPACK_GLOBAL(dpocon,DPOCON) +#define LAPACK_dpocon_base LAPACK_GLOBAL_SUFFIX(dpocon,DPOCON) void LAPACK_dpocon_base( char const* uplo, lapack_int const* n, @@ -12895,7 +12909,7 @@ void LAPACK_dpocon_base( #define LAPACK_dpocon(...) LAPACK_dpocon_base(__VA_ARGS__) #endif -#define LAPACK_spocon_base LAPACK_GLOBAL(spocon,SPOCON) +#define LAPACK_spocon_base LAPACK_GLOBAL_SUFFIX(spocon,SPOCON) void LAPACK_spocon_base( char const* uplo, lapack_int const* n, @@ -12915,7 +12929,7 @@ void LAPACK_spocon_base( #define LAPACK_spocon(...) LAPACK_spocon_base(__VA_ARGS__) #endif -#define LAPACK_zpocon_base LAPACK_GLOBAL(zpocon,ZPOCON) +#define LAPACK_zpocon_base LAPACK_GLOBAL_SUFFIX(zpocon,ZPOCON) void LAPACK_zpocon_base( char const* uplo, lapack_int const* n, @@ -12935,7 +12949,7 @@ void LAPACK_zpocon_base( #define LAPACK_zpocon(...) LAPACK_zpocon_base(__VA_ARGS__) #endif -#define LAPACK_cpoequ LAPACK_GLOBAL(cpoequ,CPOEQU) +#define LAPACK_cpoequ LAPACK_GLOBAL_SUFFIX(cpoequ,CPOEQU) void LAPACK_cpoequ( lapack_int const* n, lapack_complex_float const* A, lapack_int const* lda, @@ -12944,7 +12958,7 @@ void LAPACK_cpoequ( float* amax, lapack_int* info ); -#define LAPACK_dpoequ LAPACK_GLOBAL(dpoequ,DPOEQU) +#define LAPACK_dpoequ LAPACK_GLOBAL_SUFFIX(dpoequ,DPOEQU) void LAPACK_dpoequ( lapack_int const* n, double const* A, lapack_int const* lda, @@ -12953,7 +12967,7 @@ void LAPACK_dpoequ( double* amax, lapack_int* info ); -#define LAPACK_spoequ LAPACK_GLOBAL(spoequ,SPOEQU) +#define LAPACK_spoequ LAPACK_GLOBAL_SUFFIX(spoequ,SPOEQU) void LAPACK_spoequ( lapack_int const* n, float const* A, lapack_int const* lda, @@ -12962,7 +12976,7 @@ void LAPACK_spoequ( float* amax, lapack_int* info ); -#define LAPACK_zpoequ LAPACK_GLOBAL(zpoequ,ZPOEQU) +#define LAPACK_zpoequ LAPACK_GLOBAL_SUFFIX(zpoequ,ZPOEQU) void LAPACK_zpoequ( lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, @@ -12971,7 +12985,7 @@ void LAPACK_zpoequ( double* amax, lapack_int* info ); -#define LAPACK_cpoequb LAPACK_GLOBAL(cpoequb,CPOEQUB) +#define LAPACK_cpoequb LAPACK_GLOBAL_SUFFIX(cpoequb,CPOEQUB) void LAPACK_cpoequb( lapack_int const* n, lapack_complex_float const* A, lapack_int const* lda, @@ -12980,7 +12994,7 @@ void LAPACK_cpoequb( float* amax, lapack_int* info ); -#define LAPACK_dpoequb LAPACK_GLOBAL(dpoequb,DPOEQUB) +#define LAPACK_dpoequb LAPACK_GLOBAL_SUFFIX(dpoequb,DPOEQUB) void LAPACK_dpoequb( lapack_int const* n, double const* A, lapack_int const* lda, @@ -12989,7 +13003,7 @@ void LAPACK_dpoequb( double* amax, lapack_int* info ); -#define LAPACK_spoequb LAPACK_GLOBAL(spoequb,SPOEQUB) +#define LAPACK_spoequb LAPACK_GLOBAL_SUFFIX(spoequb,SPOEQUB) void LAPACK_spoequb( lapack_int const* n, float const* A, lapack_int const* lda, @@ -12998,7 +13012,7 @@ void LAPACK_spoequb( float* amax, lapack_int* info ); -#define LAPACK_zpoequb LAPACK_GLOBAL(zpoequb,ZPOEQUB) +#define LAPACK_zpoequb LAPACK_GLOBAL_SUFFIX(zpoequb,ZPOEQUB) void LAPACK_zpoequb( lapack_int const* n, lapack_complex_double const* A, lapack_int const* lda, @@ -13007,7 +13021,7 @@ void LAPACK_zpoequb( double* amax, lapack_int* info ); -#define LAPACK_cporfs_base LAPACK_GLOBAL(cporfs,CPORFS) +#define LAPACK_cporfs_base LAPACK_GLOBAL_SUFFIX(cporfs,CPORFS) void LAPACK_cporfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13030,7 +13044,7 @@ void LAPACK_cporfs_base( #define LAPACK_cporfs(...) LAPACK_cporfs_base(__VA_ARGS__) #endif -#define LAPACK_dporfs_base LAPACK_GLOBAL(dporfs,DPORFS) +#define LAPACK_dporfs_base LAPACK_GLOBAL_SUFFIX(dporfs,DPORFS) void LAPACK_dporfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13053,7 +13067,7 @@ void LAPACK_dporfs_base( #define LAPACK_dporfs(...) LAPACK_dporfs_base(__VA_ARGS__) #endif -#define LAPACK_sporfs_base LAPACK_GLOBAL(sporfs,SPORFS) +#define LAPACK_sporfs_base LAPACK_GLOBAL_SUFFIX(sporfs,SPORFS) void LAPACK_sporfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13076,7 +13090,7 @@ void LAPACK_sporfs_base( #define LAPACK_sporfs(...) LAPACK_sporfs_base(__VA_ARGS__) #endif -#define LAPACK_zporfs_base LAPACK_GLOBAL(zporfs,ZPORFS) +#define LAPACK_zporfs_base LAPACK_GLOBAL_SUFFIX(zporfs,ZPORFS) void LAPACK_zporfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13099,7 +13113,7 @@ void LAPACK_zporfs_base( #define LAPACK_zporfs(...) LAPACK_zporfs_base(__VA_ARGS__) #endif -#define LAPACK_cporfsx_base LAPACK_GLOBAL(cporfsx,CPORFSX) +#define LAPACK_cporfsx_base LAPACK_GLOBAL_SUFFIX(cporfsx,CPORFSX) void LAPACK_cporfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -13126,7 +13140,7 @@ void LAPACK_cporfsx_base( #define LAPACK_cporfsx(...) LAPACK_cporfsx_base(__VA_ARGS__) #endif -#define LAPACK_dporfsx_base LAPACK_GLOBAL(dporfsx,DPORFSX) +#define LAPACK_dporfsx_base LAPACK_GLOBAL_SUFFIX(dporfsx,DPORFSX) void LAPACK_dporfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -13153,7 +13167,7 @@ void LAPACK_dporfsx_base( #define LAPACK_dporfsx(...) LAPACK_dporfsx_base(__VA_ARGS__) #endif -#define LAPACK_sporfsx_base LAPACK_GLOBAL(sporfsx,SPORFSX) +#define LAPACK_sporfsx_base LAPACK_GLOBAL_SUFFIX(sporfsx,SPORFSX) void LAPACK_sporfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -13180,7 +13194,7 @@ void LAPACK_sporfsx_base( #define LAPACK_sporfsx(...) LAPACK_sporfsx_base(__VA_ARGS__) #endif -#define LAPACK_zporfsx_base LAPACK_GLOBAL(zporfsx,ZPORFSX) +#define LAPACK_zporfsx_base LAPACK_GLOBAL_SUFFIX(zporfsx,ZPORFSX) void LAPACK_zporfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -13207,7 +13221,7 @@ void LAPACK_zporfsx_base( #define LAPACK_zporfsx(...) LAPACK_zporfsx_base(__VA_ARGS__) #endif -#define LAPACK_cposv_base LAPACK_GLOBAL(cposv,CPOSV) +#define LAPACK_cposv_base LAPACK_GLOBAL_SUFFIX(cposv,CPOSV) void LAPACK_cposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13224,7 +13238,7 @@ void LAPACK_cposv_base( #define LAPACK_cposv(...) LAPACK_cposv_base(__VA_ARGS__) #endif -#define LAPACK_dposv_base LAPACK_GLOBAL(dposv,DPOSV) +#define LAPACK_dposv_base LAPACK_GLOBAL_SUFFIX(dposv,DPOSV) void LAPACK_dposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13241,7 +13255,7 @@ void LAPACK_dposv_base( #define LAPACK_dposv(...) LAPACK_dposv_base(__VA_ARGS__) #endif -#define LAPACK_sposv_base LAPACK_GLOBAL(sposv,SPOSV) +#define LAPACK_sposv_base LAPACK_GLOBAL_SUFFIX(sposv,SPOSV) void LAPACK_sposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13258,7 +13272,7 @@ void LAPACK_sposv_base( #define LAPACK_sposv(...) LAPACK_sposv_base(__VA_ARGS__) #endif -#define LAPACK_zposv_base LAPACK_GLOBAL(zposv,ZPOSV) +#define LAPACK_zposv_base LAPACK_GLOBAL_SUFFIX(zposv,ZPOSV) void LAPACK_zposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13275,7 +13289,7 @@ void LAPACK_zposv_base( #define LAPACK_zposv(...) LAPACK_zposv_base(__VA_ARGS__) #endif -#define LAPACK_dsposv_base LAPACK_GLOBAL(dsposv,DSPOSV) +#define LAPACK_dsposv_base LAPACK_GLOBAL_SUFFIX(dsposv,DSPOSV) void LAPACK_dsposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13295,7 +13309,7 @@ void LAPACK_dsposv_base( #define LAPACK_dsposv(...) LAPACK_dsposv_base(__VA_ARGS__) #endif -#define LAPACK_zcposv_base LAPACK_GLOBAL(zcposv,ZCPOSV) +#define LAPACK_zcposv_base LAPACK_GLOBAL_SUFFIX(zcposv,ZCPOSV) void LAPACK_zcposv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13316,7 +13330,7 @@ void LAPACK_zcposv_base( #define LAPACK_zcposv(...) LAPACK_zcposv_base(__VA_ARGS__) #endif -#define LAPACK_cposvx_base LAPACK_GLOBAL(cposvx,CPOSVX) +#define LAPACK_cposvx_base LAPACK_GLOBAL_SUFFIX(cposvx,CPOSVX) void LAPACK_cposvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13342,7 +13356,7 @@ void LAPACK_cposvx_base( #define LAPACK_cposvx(...) LAPACK_cposvx_base(__VA_ARGS__) #endif -#define LAPACK_dposvx_base LAPACK_GLOBAL(dposvx,DPOSVX) +#define LAPACK_dposvx_base LAPACK_GLOBAL_SUFFIX(dposvx,DPOSVX) void LAPACK_dposvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13368,7 +13382,7 @@ void LAPACK_dposvx_base( #define LAPACK_dposvx(...) LAPACK_dposvx_base(__VA_ARGS__) #endif -#define LAPACK_sposvx_base LAPACK_GLOBAL(sposvx,SPOSVX) +#define LAPACK_sposvx_base LAPACK_GLOBAL_SUFFIX(sposvx,SPOSVX) void LAPACK_sposvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13394,7 +13408,7 @@ void LAPACK_sposvx_base( #define LAPACK_sposvx(...) LAPACK_sposvx_base(__VA_ARGS__) #endif -#define LAPACK_zposvx_base LAPACK_GLOBAL(zposvx,ZPOSVX) +#define LAPACK_zposvx_base LAPACK_GLOBAL_SUFFIX(zposvx,ZPOSVX) void LAPACK_zposvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13420,7 +13434,7 @@ void LAPACK_zposvx_base( #define LAPACK_zposvx(...) LAPACK_zposvx_base(__VA_ARGS__) #endif -#define LAPACK_cposvxx_base LAPACK_GLOBAL(cposvxx,CPOSVXX) +#define LAPACK_cposvxx_base LAPACK_GLOBAL_SUFFIX(cposvxx,CPOSVXX) void LAPACK_cposvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13449,7 +13463,7 @@ void LAPACK_cposvxx_base( #define LAPACK_cposvxx(...) LAPACK_cposvxx_base(__VA_ARGS__) #endif -#define LAPACK_dposvxx_base LAPACK_GLOBAL(dposvxx,DPOSVXX) +#define LAPACK_dposvxx_base LAPACK_GLOBAL_SUFFIX(dposvxx,DPOSVXX) void LAPACK_dposvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13478,7 +13492,7 @@ void LAPACK_dposvxx_base( #define LAPACK_dposvxx(...) LAPACK_dposvxx_base(__VA_ARGS__) #endif -#define LAPACK_sposvxx_base LAPACK_GLOBAL(sposvxx,SPOSVXX) +#define LAPACK_sposvxx_base LAPACK_GLOBAL_SUFFIX(sposvxx,SPOSVXX) void LAPACK_sposvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13507,7 +13521,7 @@ void LAPACK_sposvxx_base( #define LAPACK_sposvxx(...) LAPACK_sposvxx_base(__VA_ARGS__) #endif -#define LAPACK_zposvxx_base LAPACK_GLOBAL(zposvxx,ZPOSVXX) +#define LAPACK_zposvxx_base LAPACK_GLOBAL_SUFFIX(zposvxx,ZPOSVXX) void LAPACK_zposvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13536,7 +13550,7 @@ void LAPACK_zposvxx_base( #define LAPACK_zposvxx(...) LAPACK_zposvxx_base(__VA_ARGS__) #endif -#define LAPACK_cpotf2_base LAPACK_GLOBAL(cpotf2,CPOTF2) +#define LAPACK_cpotf2_base LAPACK_GLOBAL_SUFFIX(cpotf2,CPOTF2) void LAPACK_cpotf2_base( char const* uplo, lapack_int const* n, @@ -13552,7 +13566,7 @@ void LAPACK_cpotf2_base( #define LAPACK_cpotf2(...) LAPACK_cpotf2_base(__VA_ARGS__) #endif -#define LAPACK_dpotf2_base LAPACK_GLOBAL(dpotf2,DPOTF2) +#define LAPACK_dpotf2_base LAPACK_GLOBAL_SUFFIX(dpotf2,DPOTF2) void LAPACK_dpotf2_base( char const* uplo, lapack_int const* n, @@ -13568,7 +13582,7 @@ void LAPACK_dpotf2_base( #define LAPACK_dpotf2(...) LAPACK_dpotf2_base(__VA_ARGS__) #endif -#define LAPACK_spotf2_base LAPACK_GLOBAL(spotf2,SPOTF2) +#define LAPACK_spotf2_base LAPACK_GLOBAL_SUFFIX(spotf2,SPOTF2) void LAPACK_spotf2_base( char const* uplo, lapack_int const* n, @@ -13584,7 +13598,7 @@ void LAPACK_spotf2_base( #define LAPACK_spotf2(...) LAPACK_spotf2_base(__VA_ARGS__) #endif -#define LAPACK_zpotf2_base LAPACK_GLOBAL(zpotf2,ZPOTF2) +#define LAPACK_zpotf2_base LAPACK_GLOBAL_SUFFIX(zpotf2,ZPOTF2) void LAPACK_zpotf2_base( char const* uplo, lapack_int const* n, @@ -13600,7 +13614,7 @@ void LAPACK_zpotf2_base( #define LAPACK_zpotf2(...) LAPACK_zpotf2_base(__VA_ARGS__) #endif -#define LAPACK_cpotrf_base LAPACK_GLOBAL(cpotrf,CPOTRF) +#define LAPACK_cpotrf_base LAPACK_GLOBAL_SUFFIX(cpotrf,CPOTRF) void LAPACK_cpotrf_base( char const* uplo, lapack_int const* n, @@ -13616,7 +13630,7 @@ void LAPACK_cpotrf_base( #define LAPACK_cpotrf(...) LAPACK_cpotrf_base(__VA_ARGS__) #endif -#define LAPACK_dpotrf_base LAPACK_GLOBAL(dpotrf,DPOTRF) +#define LAPACK_dpotrf_base LAPACK_GLOBAL_SUFFIX(dpotrf,DPOTRF) void LAPACK_dpotrf_base( char const* uplo, lapack_int const* n, @@ -13632,7 +13646,7 @@ void LAPACK_dpotrf_base( #define LAPACK_dpotrf(...) LAPACK_dpotrf_base(__VA_ARGS__) #endif -#define LAPACK_spotrf_base LAPACK_GLOBAL(spotrf,SPOTRF) +#define LAPACK_spotrf_base LAPACK_GLOBAL_SUFFIX(spotrf,SPOTRF) void LAPACK_spotrf_base( char const* uplo, lapack_int const* n, @@ -13648,7 +13662,7 @@ void LAPACK_spotrf_base( #define LAPACK_spotrf(...) LAPACK_spotrf_base(__VA_ARGS__) #endif -#define LAPACK_zpotrf_base LAPACK_GLOBAL(zpotrf,ZPOTRF) +#define LAPACK_zpotrf_base LAPACK_GLOBAL_SUFFIX(zpotrf,ZPOTRF) void LAPACK_zpotrf_base( char const* uplo, lapack_int const* n, @@ -13664,7 +13678,7 @@ void LAPACK_zpotrf_base( #define LAPACK_zpotrf(...) LAPACK_zpotrf_base(__VA_ARGS__) #endif -#define LAPACK_cpotrf2_base LAPACK_GLOBAL(cpotrf2,CPOTRF2) +#define LAPACK_cpotrf2_base LAPACK_GLOBAL_SUFFIX(cpotrf2,CPOTRF2) void LAPACK_cpotrf2_base( char const* uplo, lapack_int const* n, @@ -13680,7 +13694,7 @@ void LAPACK_cpotrf2_base( #define LAPACK_cpotrf2(...) LAPACK_cpotrf2_base(__VA_ARGS__) #endif -#define LAPACK_dpotrf2_base LAPACK_GLOBAL(dpotrf2,DPOTRF2) +#define LAPACK_dpotrf2_base LAPACK_GLOBAL_SUFFIX(dpotrf2,DPOTRF2) void LAPACK_dpotrf2_base( char const* uplo, lapack_int const* n, @@ -13696,7 +13710,7 @@ void LAPACK_dpotrf2_base( #define LAPACK_dpotrf2(...) LAPACK_dpotrf2_base(__VA_ARGS__) #endif -#define LAPACK_spotrf2_base LAPACK_GLOBAL(spotrf2,SPOTRF2) +#define LAPACK_spotrf2_base LAPACK_GLOBAL_SUFFIX(spotrf2,SPOTRF2) void LAPACK_spotrf2_base( char const* uplo, lapack_int const* n, @@ -13712,7 +13726,7 @@ void LAPACK_spotrf2_base( #define LAPACK_spotrf2(...) LAPACK_spotrf2_base(__VA_ARGS__) #endif -#define LAPACK_zpotrf2_base LAPACK_GLOBAL(zpotrf2,ZPOTRF2) +#define LAPACK_zpotrf2_base LAPACK_GLOBAL_SUFFIX(zpotrf2,ZPOTRF2) void LAPACK_zpotrf2_base( char const* uplo, lapack_int const* n, @@ -13728,7 +13742,7 @@ void LAPACK_zpotrf2_base( #define LAPACK_zpotrf2(...) LAPACK_zpotrf2_base(__VA_ARGS__) #endif -#define LAPACK_cpotri_base LAPACK_GLOBAL(cpotri,CPOTRI) +#define LAPACK_cpotri_base LAPACK_GLOBAL_SUFFIX(cpotri,CPOTRI) void LAPACK_cpotri_base( char const* uplo, lapack_int const* n, @@ -13744,7 +13758,7 @@ void LAPACK_cpotri_base( #define LAPACK_cpotri(...) LAPACK_cpotri_base(__VA_ARGS__) #endif -#define LAPACK_dpotri_base LAPACK_GLOBAL(dpotri,DPOTRI) +#define LAPACK_dpotri_base LAPACK_GLOBAL_SUFFIX(dpotri,DPOTRI) void LAPACK_dpotri_base( char const* uplo, lapack_int const* n, @@ -13760,7 +13774,7 @@ void LAPACK_dpotri_base( #define LAPACK_dpotri(...) LAPACK_dpotri_base(__VA_ARGS__) #endif -#define LAPACK_spotri_base LAPACK_GLOBAL(spotri,SPOTRI) +#define LAPACK_spotri_base LAPACK_GLOBAL_SUFFIX(spotri,SPOTRI) void LAPACK_spotri_base( char const* uplo, lapack_int const* n, @@ -13776,7 +13790,7 @@ void LAPACK_spotri_base( #define LAPACK_spotri(...) LAPACK_spotri_base(__VA_ARGS__) #endif -#define LAPACK_zpotri_base LAPACK_GLOBAL(zpotri,ZPOTRI) +#define LAPACK_zpotri_base LAPACK_GLOBAL_SUFFIX(zpotri,ZPOTRI) void LAPACK_zpotri_base( char const* uplo, lapack_int const* n, @@ -13792,7 +13806,7 @@ void LAPACK_zpotri_base( #define LAPACK_zpotri(...) LAPACK_zpotri_base(__VA_ARGS__) #endif -#define LAPACK_cpotrs_base LAPACK_GLOBAL(cpotrs,CPOTRS) +#define LAPACK_cpotrs_base LAPACK_GLOBAL_SUFFIX(cpotrs,CPOTRS) void LAPACK_cpotrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13809,7 +13823,7 @@ void LAPACK_cpotrs_base( #define LAPACK_cpotrs(...) LAPACK_cpotrs_base(__VA_ARGS__) #endif -#define LAPACK_dpotrs_base LAPACK_GLOBAL(dpotrs,DPOTRS) +#define LAPACK_dpotrs_base LAPACK_GLOBAL_SUFFIX(dpotrs,DPOTRS) void LAPACK_dpotrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13826,7 +13840,7 @@ void LAPACK_dpotrs_base( #define LAPACK_dpotrs(...) LAPACK_dpotrs_base(__VA_ARGS__) #endif -#define LAPACK_spotrs_base LAPACK_GLOBAL(spotrs,SPOTRS) +#define LAPACK_spotrs_base LAPACK_GLOBAL_SUFFIX(spotrs,SPOTRS) void LAPACK_spotrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13843,7 +13857,7 @@ void LAPACK_spotrs_base( #define LAPACK_spotrs(...) LAPACK_spotrs_base(__VA_ARGS__) #endif -#define LAPACK_zpotrs_base LAPACK_GLOBAL(zpotrs,ZPOTRS) +#define LAPACK_zpotrs_base LAPACK_GLOBAL_SUFFIX(zpotrs,ZPOTRS) void LAPACK_zpotrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -13860,7 +13874,7 @@ void LAPACK_zpotrs_base( #define LAPACK_zpotrs(...) LAPACK_zpotrs_base(__VA_ARGS__) #endif -#define LAPACK_cppcon_base LAPACK_GLOBAL(cppcon,CPPCON) +#define LAPACK_cppcon_base LAPACK_GLOBAL_SUFFIX(cppcon,CPPCON) void LAPACK_cppcon_base( char const* uplo, lapack_int const* n, @@ -13880,7 +13894,7 @@ void LAPACK_cppcon_base( #define LAPACK_cppcon(...) LAPACK_cppcon_base(__VA_ARGS__) #endif -#define LAPACK_dppcon_base LAPACK_GLOBAL(dppcon,DPPCON) +#define LAPACK_dppcon_base LAPACK_GLOBAL_SUFFIX(dppcon,DPPCON) void LAPACK_dppcon_base( char const* uplo, lapack_int const* n, @@ -13900,7 +13914,7 @@ void LAPACK_dppcon_base( #define LAPACK_dppcon(...) LAPACK_dppcon_base(__VA_ARGS__) #endif -#define LAPACK_sppcon_base LAPACK_GLOBAL(sppcon,SPPCON) +#define LAPACK_sppcon_base LAPACK_GLOBAL_SUFFIX(sppcon,SPPCON) void LAPACK_sppcon_base( char const* uplo, lapack_int const* n, @@ -13920,7 +13934,7 @@ void LAPACK_sppcon_base( #define LAPACK_sppcon(...) LAPACK_sppcon_base(__VA_ARGS__) #endif -#define LAPACK_zppcon_base LAPACK_GLOBAL(zppcon,ZPPCON) +#define LAPACK_zppcon_base LAPACK_GLOBAL_SUFFIX(zppcon,ZPPCON) void LAPACK_zppcon_base( char const* uplo, lapack_int const* n, @@ -13940,7 +13954,7 @@ void LAPACK_zppcon_base( #define LAPACK_zppcon(...) LAPACK_zppcon_base(__VA_ARGS__) #endif -#define LAPACK_cppequ_base LAPACK_GLOBAL(cppequ,CPPEQU) +#define LAPACK_cppequ_base LAPACK_GLOBAL_SUFFIX(cppequ,CPPEQU) void LAPACK_cppequ_base( char const* uplo, lapack_int const* n, @@ -13959,7 +13973,7 @@ void LAPACK_cppequ_base( #define LAPACK_cppequ(...) LAPACK_cppequ_base(__VA_ARGS__) #endif -#define LAPACK_dppequ_base LAPACK_GLOBAL(dppequ,DPPEQU) +#define LAPACK_dppequ_base LAPACK_GLOBAL_SUFFIX(dppequ,DPPEQU) void LAPACK_dppequ_base( char const* uplo, lapack_int const* n, @@ -13978,7 +13992,7 @@ void LAPACK_dppequ_base( #define LAPACK_dppequ(...) LAPACK_dppequ_base(__VA_ARGS__) #endif -#define LAPACK_sppequ_base LAPACK_GLOBAL(sppequ,SPPEQU) +#define LAPACK_sppequ_base LAPACK_GLOBAL_SUFFIX(sppequ,SPPEQU) void LAPACK_sppequ_base( char const* uplo, lapack_int const* n, @@ -13997,7 +14011,7 @@ void LAPACK_sppequ_base( #define LAPACK_sppequ(...) LAPACK_sppequ_base(__VA_ARGS__) #endif -#define LAPACK_zppequ_base LAPACK_GLOBAL(zppequ,ZPPEQU) +#define LAPACK_zppequ_base LAPACK_GLOBAL_SUFFIX(zppequ,ZPPEQU) void LAPACK_zppequ_base( char const* uplo, lapack_int const* n, @@ -14016,7 +14030,7 @@ void LAPACK_zppequ_base( #define LAPACK_zppequ(...) LAPACK_zppequ_base(__VA_ARGS__) #endif -#define LAPACK_cpprfs_base LAPACK_GLOBAL(cpprfs,CPPRFS) +#define LAPACK_cpprfs_base LAPACK_GLOBAL_SUFFIX(cpprfs,CPPRFS) void LAPACK_cpprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14039,7 +14053,7 @@ void LAPACK_cpprfs_base( #define LAPACK_cpprfs(...) LAPACK_cpprfs_base(__VA_ARGS__) #endif -#define LAPACK_dpprfs_base LAPACK_GLOBAL(dpprfs,DPPRFS) +#define LAPACK_dpprfs_base LAPACK_GLOBAL_SUFFIX(dpprfs,DPPRFS) void LAPACK_dpprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14062,7 +14076,7 @@ void LAPACK_dpprfs_base( #define LAPACK_dpprfs(...) LAPACK_dpprfs_base(__VA_ARGS__) #endif -#define LAPACK_spprfs_base LAPACK_GLOBAL(spprfs,SPPRFS) +#define LAPACK_spprfs_base LAPACK_GLOBAL_SUFFIX(spprfs,SPPRFS) void LAPACK_spprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14085,7 +14099,7 @@ void LAPACK_spprfs_base( #define LAPACK_spprfs(...) LAPACK_spprfs_base(__VA_ARGS__) #endif -#define LAPACK_zpprfs_base LAPACK_GLOBAL(zpprfs,ZPPRFS) +#define LAPACK_zpprfs_base LAPACK_GLOBAL_SUFFIX(zpprfs,ZPPRFS) void LAPACK_zpprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14108,7 +14122,7 @@ void LAPACK_zpprfs_base( #define LAPACK_zpprfs(...) LAPACK_zpprfs_base(__VA_ARGS__) #endif -#define LAPACK_cppsv_base LAPACK_GLOBAL(cppsv,CPPSV) +#define LAPACK_cppsv_base LAPACK_GLOBAL_SUFFIX(cppsv,CPPSV) void LAPACK_cppsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14125,7 +14139,7 @@ void LAPACK_cppsv_base( #define LAPACK_cppsv(...) LAPACK_cppsv_base(__VA_ARGS__) #endif -#define LAPACK_dppsv_base LAPACK_GLOBAL(dppsv,DPPSV) +#define LAPACK_dppsv_base LAPACK_GLOBAL_SUFFIX(dppsv,DPPSV) void LAPACK_dppsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14142,7 +14156,7 @@ void LAPACK_dppsv_base( #define LAPACK_dppsv(...) LAPACK_dppsv_base(__VA_ARGS__) #endif -#define LAPACK_sppsv_base LAPACK_GLOBAL(sppsv,SPPSV) +#define LAPACK_sppsv_base LAPACK_GLOBAL_SUFFIX(sppsv,SPPSV) void LAPACK_sppsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14159,7 +14173,7 @@ void LAPACK_sppsv_base( #define LAPACK_sppsv(...) LAPACK_sppsv_base(__VA_ARGS__) #endif -#define LAPACK_zppsv_base LAPACK_GLOBAL(zppsv,ZPPSV) +#define LAPACK_zppsv_base LAPACK_GLOBAL_SUFFIX(zppsv,ZPPSV) void LAPACK_zppsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14176,7 +14190,7 @@ void LAPACK_zppsv_base( #define LAPACK_zppsv(...) LAPACK_zppsv_base(__VA_ARGS__) #endif -#define LAPACK_cppsvx_base LAPACK_GLOBAL(cppsvx,CPPSVX) +#define LAPACK_cppsvx_base LAPACK_GLOBAL_SUFFIX(cppsvx,CPPSVX) void LAPACK_cppsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14202,7 +14216,7 @@ void LAPACK_cppsvx_base( #define LAPACK_cppsvx(...) LAPACK_cppsvx_base(__VA_ARGS__) #endif -#define LAPACK_dppsvx_base LAPACK_GLOBAL(dppsvx,DPPSVX) +#define LAPACK_dppsvx_base LAPACK_GLOBAL_SUFFIX(dppsvx,DPPSVX) void LAPACK_dppsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14228,7 +14242,7 @@ void LAPACK_dppsvx_base( #define LAPACK_dppsvx(...) LAPACK_dppsvx_base(__VA_ARGS__) #endif -#define LAPACK_sppsvx_base LAPACK_GLOBAL(sppsvx,SPPSVX) +#define LAPACK_sppsvx_base LAPACK_GLOBAL_SUFFIX(sppsvx,SPPSVX) void LAPACK_sppsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14254,7 +14268,7 @@ void LAPACK_sppsvx_base( #define LAPACK_sppsvx(...) LAPACK_sppsvx_base(__VA_ARGS__) #endif -#define LAPACK_zppsvx_base LAPACK_GLOBAL(zppsvx,ZPPSVX) +#define LAPACK_zppsvx_base LAPACK_GLOBAL_SUFFIX(zppsvx,ZPPSVX) void LAPACK_zppsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14280,7 +14294,7 @@ void LAPACK_zppsvx_base( #define LAPACK_zppsvx(...) LAPACK_zppsvx_base(__VA_ARGS__) #endif -#define LAPACK_cpptrf_base LAPACK_GLOBAL(cpptrf,CPPTRF) +#define LAPACK_cpptrf_base LAPACK_GLOBAL_SUFFIX(cpptrf,CPPTRF) void LAPACK_cpptrf_base( char const* uplo, lapack_int const* n, @@ -14296,7 +14310,7 @@ void LAPACK_cpptrf_base( #define LAPACK_cpptrf(...) LAPACK_cpptrf_base(__VA_ARGS__) #endif -#define LAPACK_dpptrf_base LAPACK_GLOBAL(dpptrf,DPPTRF) +#define LAPACK_dpptrf_base LAPACK_GLOBAL_SUFFIX(dpptrf,DPPTRF) void LAPACK_dpptrf_base( char const* uplo, lapack_int const* n, @@ -14312,7 +14326,7 @@ void LAPACK_dpptrf_base( #define LAPACK_dpptrf(...) LAPACK_dpptrf_base(__VA_ARGS__) #endif -#define LAPACK_spptrf_base LAPACK_GLOBAL(spptrf,SPPTRF) +#define LAPACK_spptrf_base LAPACK_GLOBAL_SUFFIX(spptrf,SPPTRF) void LAPACK_spptrf_base( char const* uplo, lapack_int const* n, @@ -14328,7 +14342,7 @@ void LAPACK_spptrf_base( #define LAPACK_spptrf(...) LAPACK_spptrf_base(__VA_ARGS__) #endif -#define LAPACK_zpptrf_base LAPACK_GLOBAL(zpptrf,ZPPTRF) +#define LAPACK_zpptrf_base LAPACK_GLOBAL_SUFFIX(zpptrf,ZPPTRF) void LAPACK_zpptrf_base( char const* uplo, lapack_int const* n, @@ -14344,7 +14358,7 @@ void LAPACK_zpptrf_base( #define LAPACK_zpptrf(...) LAPACK_zpptrf_base(__VA_ARGS__) #endif -#define LAPACK_cpptri_base LAPACK_GLOBAL(cpptri,CPPTRI) +#define LAPACK_cpptri_base LAPACK_GLOBAL_SUFFIX(cpptri,CPPTRI) void LAPACK_cpptri_base( char const* uplo, lapack_int const* n, @@ -14360,7 +14374,7 @@ void LAPACK_cpptri_base( #define LAPACK_cpptri(...) LAPACK_cpptri_base(__VA_ARGS__) #endif -#define LAPACK_dpptri_base LAPACK_GLOBAL(dpptri,DPPTRI) +#define LAPACK_dpptri_base LAPACK_GLOBAL_SUFFIX(dpptri,DPPTRI) void LAPACK_dpptri_base( char const* uplo, lapack_int const* n, @@ -14376,7 +14390,7 @@ void LAPACK_dpptri_base( #define LAPACK_dpptri(...) LAPACK_dpptri_base(__VA_ARGS__) #endif -#define LAPACK_spptri_base LAPACK_GLOBAL(spptri,SPPTRI) +#define LAPACK_spptri_base LAPACK_GLOBAL_SUFFIX(spptri,SPPTRI) void LAPACK_spptri_base( char const* uplo, lapack_int const* n, @@ -14392,7 +14406,7 @@ void LAPACK_spptri_base( #define LAPACK_spptri(...) LAPACK_spptri_base(__VA_ARGS__) #endif -#define LAPACK_zpptri_base LAPACK_GLOBAL(zpptri,ZPPTRI) +#define LAPACK_zpptri_base LAPACK_GLOBAL_SUFFIX(zpptri,ZPPTRI) void LAPACK_zpptri_base( char const* uplo, lapack_int const* n, @@ -14408,7 +14422,7 @@ void LAPACK_zpptri_base( #define LAPACK_zpptri(...) LAPACK_zpptri_base(__VA_ARGS__) #endif -#define LAPACK_cpptrs_base LAPACK_GLOBAL(cpptrs,CPPTRS) +#define LAPACK_cpptrs_base LAPACK_GLOBAL_SUFFIX(cpptrs,CPPTRS) void LAPACK_cpptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14425,7 +14439,7 @@ void LAPACK_cpptrs_base( #define LAPACK_cpptrs(...) LAPACK_cpptrs_base(__VA_ARGS__) #endif -#define LAPACK_dpptrs_base LAPACK_GLOBAL(dpptrs,DPPTRS) +#define LAPACK_dpptrs_base LAPACK_GLOBAL_SUFFIX(dpptrs,DPPTRS) void LAPACK_dpptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14442,7 +14456,7 @@ void LAPACK_dpptrs_base( #define LAPACK_dpptrs(...) LAPACK_dpptrs_base(__VA_ARGS__) #endif -#define LAPACK_spptrs_base LAPACK_GLOBAL(spptrs,SPPTRS) +#define LAPACK_spptrs_base LAPACK_GLOBAL_SUFFIX(spptrs,SPPTRS) void LAPACK_spptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14459,7 +14473,7 @@ void LAPACK_spptrs_base( #define LAPACK_spptrs(...) LAPACK_spptrs_base(__VA_ARGS__) #endif -#define LAPACK_zpptrs_base LAPACK_GLOBAL(zpptrs,ZPPTRS) +#define LAPACK_zpptrs_base LAPACK_GLOBAL_SUFFIX(zpptrs,ZPPTRS) void LAPACK_zpptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14476,7 +14490,7 @@ void LAPACK_zpptrs_base( #define LAPACK_zpptrs(...) LAPACK_zpptrs_base(__VA_ARGS__) #endif -#define LAPACK_cpstrf_base LAPACK_GLOBAL(cpstrf,CPSTRF) +#define LAPACK_cpstrf_base LAPACK_GLOBAL_SUFFIX(cpstrf,CPSTRF) void LAPACK_cpstrf_base( char const* uplo, lapack_int const* n, @@ -14494,7 +14508,7 @@ void LAPACK_cpstrf_base( #define LAPACK_cpstrf(...) LAPACK_cpstrf_base(__VA_ARGS__) #endif -#define LAPACK_dpstrf_base LAPACK_GLOBAL(dpstrf,DPSTRF) +#define LAPACK_dpstrf_base LAPACK_GLOBAL_SUFFIX(dpstrf,DPSTRF) void LAPACK_dpstrf_base( char const* uplo, lapack_int const* n, @@ -14512,7 +14526,7 @@ void LAPACK_dpstrf_base( #define LAPACK_dpstrf(...) LAPACK_dpstrf_base(__VA_ARGS__) #endif -#define LAPACK_spstrf_base LAPACK_GLOBAL(spstrf,SPSTRF) +#define LAPACK_spstrf_base LAPACK_GLOBAL_SUFFIX(spstrf,SPSTRF) void LAPACK_spstrf_base( char const* uplo, lapack_int const* n, @@ -14530,7 +14544,7 @@ void LAPACK_spstrf_base( #define LAPACK_spstrf(...) LAPACK_spstrf_base(__VA_ARGS__) #endif -#define LAPACK_zpstrf_base LAPACK_GLOBAL(zpstrf,ZPSTRF) +#define LAPACK_zpstrf_base LAPACK_GLOBAL_SUFFIX(zpstrf,ZPSTRF) void LAPACK_zpstrf_base( char const* uplo, lapack_int const* n, @@ -14548,7 +14562,7 @@ void LAPACK_zpstrf_base( #define LAPACK_zpstrf(...) LAPACK_zpstrf_base(__VA_ARGS__) #endif -#define LAPACK_cptcon LAPACK_GLOBAL(cptcon,CPTCON) +#define LAPACK_cptcon LAPACK_GLOBAL_SUFFIX(cptcon,CPTCON) void LAPACK_cptcon( lapack_int const* n, float const* D, @@ -14558,7 +14572,7 @@ void LAPACK_cptcon( float* rwork, lapack_int* info ); -#define LAPACK_dptcon LAPACK_GLOBAL(dptcon,DPTCON) +#define LAPACK_dptcon LAPACK_GLOBAL_SUFFIX(dptcon,DPTCON) void LAPACK_dptcon( lapack_int const* n, double const* D, @@ -14568,7 +14582,7 @@ void LAPACK_dptcon( double* work, lapack_int* info ); -#define LAPACK_sptcon LAPACK_GLOBAL(sptcon,SPTCON) +#define LAPACK_sptcon LAPACK_GLOBAL_SUFFIX(sptcon,SPTCON) void LAPACK_sptcon( lapack_int const* n, float const* D, @@ -14578,7 +14592,7 @@ void LAPACK_sptcon( float* work, lapack_int* info ); -#define LAPACK_zptcon LAPACK_GLOBAL(zptcon,ZPTCON) +#define LAPACK_zptcon LAPACK_GLOBAL_SUFFIX(zptcon,ZPTCON) void LAPACK_zptcon( lapack_int const* n, double const* D, @@ -14588,7 +14602,7 @@ void LAPACK_zptcon( double* rwork, lapack_int* info ); -#define LAPACK_cpteqr_base LAPACK_GLOBAL(cpteqr,CPTEQR) +#define LAPACK_cpteqr_base LAPACK_GLOBAL_SUFFIX(cpteqr,CPTEQR) void LAPACK_cpteqr_base( char const* compz, lapack_int const* n, @@ -14607,7 +14621,7 @@ void LAPACK_cpteqr_base( #define LAPACK_cpteqr(...) LAPACK_cpteqr_base(__VA_ARGS__) #endif -#define LAPACK_dpteqr_base LAPACK_GLOBAL(dpteqr,DPTEQR) +#define LAPACK_dpteqr_base LAPACK_GLOBAL_SUFFIX(dpteqr,DPTEQR) void LAPACK_dpteqr_base( char const* compz, lapack_int const* n, @@ -14626,7 +14640,7 @@ void LAPACK_dpteqr_base( #define LAPACK_dpteqr(...) LAPACK_dpteqr_base(__VA_ARGS__) #endif -#define LAPACK_spteqr_base LAPACK_GLOBAL(spteqr,SPTEQR) +#define LAPACK_spteqr_base LAPACK_GLOBAL_SUFFIX(spteqr,SPTEQR) void LAPACK_spteqr_base( char const* compz, lapack_int const* n, @@ -14645,7 +14659,7 @@ void LAPACK_spteqr_base( #define LAPACK_spteqr(...) LAPACK_spteqr_base(__VA_ARGS__) #endif -#define LAPACK_zpteqr_base LAPACK_GLOBAL(zpteqr,ZPTEQR) +#define LAPACK_zpteqr_base LAPACK_GLOBAL_SUFFIX(zpteqr,ZPTEQR) void LAPACK_zpteqr_base( char const* compz, lapack_int const* n, @@ -14664,7 +14678,7 @@ void LAPACK_zpteqr_base( #define LAPACK_zpteqr(...) LAPACK_zpteqr_base(__VA_ARGS__) #endif -#define LAPACK_cptrfs_base LAPACK_GLOBAL(cptrfs,CPTRFS) +#define LAPACK_cptrfs_base LAPACK_GLOBAL_SUFFIX(cptrfs,CPTRFS) void LAPACK_cptrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14689,7 +14703,7 @@ void LAPACK_cptrfs_base( #define LAPACK_cptrfs(...) LAPACK_cptrfs_base(__VA_ARGS__) #endif -#define LAPACK_dptrfs LAPACK_GLOBAL(dptrfs,DPTRFS) +#define LAPACK_dptrfs LAPACK_GLOBAL_SUFFIX(dptrfs,DPTRFS) void LAPACK_dptrfs( lapack_int const* n, lapack_int const* nrhs, double const* D, @@ -14703,7 +14717,7 @@ void LAPACK_dptrfs( double* work, lapack_int* info ); -#define LAPACK_sptrfs LAPACK_GLOBAL(sptrfs,SPTRFS) +#define LAPACK_sptrfs LAPACK_GLOBAL_SUFFIX(sptrfs,SPTRFS) void LAPACK_sptrfs( lapack_int const* n, lapack_int const* nrhs, float const* D, @@ -14717,7 +14731,7 @@ void LAPACK_sptrfs( float* work, lapack_int* info ); -#define LAPACK_zptrfs_base LAPACK_GLOBAL(zptrfs,ZPTRFS) +#define LAPACK_zptrfs_base LAPACK_GLOBAL_SUFFIX(zptrfs,ZPTRFS) void LAPACK_zptrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14742,7 +14756,7 @@ void LAPACK_zptrfs_base( #define LAPACK_zptrfs(...) LAPACK_zptrfs_base(__VA_ARGS__) #endif -#define LAPACK_cptsv LAPACK_GLOBAL(cptsv,CPTSV) +#define LAPACK_cptsv LAPACK_GLOBAL_SUFFIX(cptsv,CPTSV) void LAPACK_cptsv( lapack_int const* n, lapack_int const* nrhs, float* D, @@ -14750,7 +14764,7 @@ void LAPACK_cptsv( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_dptsv LAPACK_GLOBAL(dptsv,DPTSV) +#define LAPACK_dptsv LAPACK_GLOBAL_SUFFIX(dptsv,DPTSV) void LAPACK_dptsv( lapack_int const* n, lapack_int const* nrhs, double* D, @@ -14758,7 +14772,7 @@ void LAPACK_dptsv( double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_sptsv LAPACK_GLOBAL(sptsv,SPTSV) +#define LAPACK_sptsv LAPACK_GLOBAL_SUFFIX(sptsv,SPTSV) void LAPACK_sptsv( lapack_int const* n, lapack_int const* nrhs, float* D, @@ -14766,7 +14780,7 @@ void LAPACK_sptsv( float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_zptsv LAPACK_GLOBAL(zptsv,ZPTSV) +#define LAPACK_zptsv LAPACK_GLOBAL_SUFFIX(zptsv,ZPTSV) void LAPACK_zptsv( lapack_int const* n, lapack_int const* nrhs, double* D, @@ -14774,7 +14788,7 @@ void LAPACK_zptsv( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_cptsvx_base LAPACK_GLOBAL(cptsvx,CPTSVX) +#define LAPACK_cptsvx_base LAPACK_GLOBAL_SUFFIX(cptsvx,CPTSVX) void LAPACK_cptsvx_base( char const* fact, lapack_int const* n, lapack_int const* nrhs, @@ -14800,7 +14814,7 @@ void LAPACK_cptsvx_base( #define LAPACK_cptsvx(...) LAPACK_cptsvx_base(__VA_ARGS__) #endif -#define LAPACK_dptsvx_base LAPACK_GLOBAL(dptsvx,DPTSVX) +#define LAPACK_dptsvx_base LAPACK_GLOBAL_SUFFIX(dptsvx,DPTSVX) void LAPACK_dptsvx_base( char const* fact, lapack_int const* n, lapack_int const* nrhs, @@ -14825,7 +14839,7 @@ void LAPACK_dptsvx_base( #define LAPACK_dptsvx(...) LAPACK_dptsvx_base(__VA_ARGS__) #endif -#define LAPACK_sptsvx_base LAPACK_GLOBAL(sptsvx,SPTSVX) +#define LAPACK_sptsvx_base LAPACK_GLOBAL_SUFFIX(sptsvx,SPTSVX) void LAPACK_sptsvx_base( char const* fact, lapack_int const* n, lapack_int const* nrhs, @@ -14850,7 +14864,7 @@ void LAPACK_sptsvx_base( #define LAPACK_sptsvx(...) LAPACK_sptsvx_base(__VA_ARGS__) #endif -#define LAPACK_zptsvx_base LAPACK_GLOBAL(zptsvx,ZPTSVX) +#define LAPACK_zptsvx_base LAPACK_GLOBAL_SUFFIX(zptsvx,ZPTSVX) void LAPACK_zptsvx_base( char const* fact, lapack_int const* n, lapack_int const* nrhs, @@ -14876,35 +14890,35 @@ void LAPACK_zptsvx_base( #define LAPACK_zptsvx(...) LAPACK_zptsvx_base(__VA_ARGS__) #endif -#define LAPACK_cpttrf LAPACK_GLOBAL(cpttrf,CPTTRF) +#define LAPACK_cpttrf LAPACK_GLOBAL_SUFFIX(cpttrf,CPTTRF) void LAPACK_cpttrf( lapack_int const* n, float* D, lapack_complex_float* E, lapack_int* info ); -#define LAPACK_dpttrf LAPACK_GLOBAL(dpttrf,DPTTRF) +#define LAPACK_dpttrf LAPACK_GLOBAL_SUFFIX(dpttrf,DPTTRF) void LAPACK_dpttrf( lapack_int const* n, double* D, double* E, lapack_int* info ); -#define LAPACK_spttrf LAPACK_GLOBAL(spttrf,SPTTRF) +#define LAPACK_spttrf LAPACK_GLOBAL_SUFFIX(spttrf,SPTTRF) void LAPACK_spttrf( lapack_int const* n, float* D, float* E, lapack_int* info ); -#define LAPACK_zpttrf LAPACK_GLOBAL(zpttrf,ZPTTRF) +#define LAPACK_zpttrf LAPACK_GLOBAL_SUFFIX(zpttrf,ZPTTRF) void LAPACK_zpttrf( lapack_int const* n, double* D, lapack_complex_double* E, lapack_int* info ); -#define LAPACK_cpttrs_base LAPACK_GLOBAL(cpttrs,CPTTRS) +#define LAPACK_cpttrs_base LAPACK_GLOBAL_SUFFIX(cpttrs,CPTTRS) void LAPACK_cpttrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14922,7 +14936,7 @@ void LAPACK_cpttrs_base( #define LAPACK_cpttrs(...) LAPACK_cpttrs_base(__VA_ARGS__) #endif -#define LAPACK_dpttrs LAPACK_GLOBAL(dpttrs,DPTTRS) +#define LAPACK_dpttrs LAPACK_GLOBAL_SUFFIX(dpttrs,DPTTRS) void LAPACK_dpttrs( lapack_int const* n, lapack_int const* nrhs, double const* D, @@ -14930,7 +14944,7 @@ void LAPACK_dpttrs( double* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_spttrs LAPACK_GLOBAL(spttrs,SPTTRS) +#define LAPACK_spttrs LAPACK_GLOBAL_SUFFIX(spttrs,SPTTRS) void LAPACK_spttrs( lapack_int const* n, lapack_int const* nrhs, float const* D, @@ -14938,7 +14952,7 @@ void LAPACK_spttrs( float* B, lapack_int const* ldb, lapack_int* info ); -#define LAPACK_zpttrs_base LAPACK_GLOBAL(zpttrs,ZPTTRS) +#define LAPACK_zpttrs_base LAPACK_GLOBAL_SUFFIX(zpttrs,ZPTTRS) void LAPACK_zpttrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -14956,7 +14970,7 @@ void LAPACK_zpttrs_base( #define LAPACK_zpttrs(...) LAPACK_zpttrs_base(__VA_ARGS__) #endif -#define LAPACK_dsbev_base LAPACK_GLOBAL(dsbev,DSBEV) +#define LAPACK_dsbev_base LAPACK_GLOBAL_SUFFIX(dsbev,DSBEV) void LAPACK_dsbev_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -14975,7 +14989,7 @@ void LAPACK_dsbev_base( #define LAPACK_dsbev(...) LAPACK_dsbev_base(__VA_ARGS__) #endif -#define LAPACK_ssbev_base LAPACK_GLOBAL(ssbev,SSBEV) +#define LAPACK_ssbev_base LAPACK_GLOBAL_SUFFIX(ssbev,SSBEV) void LAPACK_ssbev_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -14994,7 +15008,7 @@ void LAPACK_ssbev_base( #define LAPACK_ssbev(...) LAPACK_ssbev_base(__VA_ARGS__) #endif -#define LAPACK_dsbev_2stage_base LAPACK_GLOBAL(dsbev_2stage,DSBEV_2STAGE) +#define LAPACK_dsbev_2stage_base LAPACK_GLOBAL_SUFFIX(dsbev_2stage,DSBEV_2STAGE) void LAPACK_dsbev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15013,7 +15027,7 @@ void LAPACK_dsbev_2stage_base( #define LAPACK_dsbev_2stage(...) LAPACK_dsbev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssbev_2stage_base LAPACK_GLOBAL(ssbev_2stage,SSBEV_2STAGE) +#define LAPACK_ssbev_2stage_base LAPACK_GLOBAL_SUFFIX(ssbev_2stage,SSBEV_2STAGE) void LAPACK_ssbev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15032,7 +15046,7 @@ void LAPACK_ssbev_2stage_base( #define LAPACK_ssbev_2stage(...) LAPACK_ssbev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsbevd_base LAPACK_GLOBAL(dsbevd,DSBEVD) +#define LAPACK_dsbevd_base LAPACK_GLOBAL_SUFFIX(dsbevd,DSBEVD) void LAPACK_dsbevd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15052,7 +15066,7 @@ void LAPACK_dsbevd_base( #define LAPACK_dsbevd(...) LAPACK_dsbevd_base(__VA_ARGS__) #endif -#define LAPACK_ssbevd_base LAPACK_GLOBAL(ssbevd,SSBEVD) +#define LAPACK_ssbevd_base LAPACK_GLOBAL_SUFFIX(ssbevd,SSBEVD) void LAPACK_ssbevd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15072,7 +15086,7 @@ void LAPACK_ssbevd_base( #define LAPACK_ssbevd(...) LAPACK_ssbevd_base(__VA_ARGS__) #endif -#define LAPACK_dsbevd_2stage_base LAPACK_GLOBAL(dsbevd_2stage,DSBEVD_2STAGE) +#define LAPACK_dsbevd_2stage_base LAPACK_GLOBAL_SUFFIX(dsbevd_2stage,DSBEVD_2STAGE) void LAPACK_dsbevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15092,7 +15106,7 @@ void LAPACK_dsbevd_2stage_base( #define LAPACK_dsbevd_2stage(...) LAPACK_dsbevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssbevd_2stage_base LAPACK_GLOBAL(ssbevd_2stage,SSBEVD_2STAGE) +#define LAPACK_ssbevd_2stage_base LAPACK_GLOBAL_SUFFIX(ssbevd_2stage,SSBEVD_2STAGE) void LAPACK_ssbevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15112,7 +15126,7 @@ void LAPACK_ssbevd_2stage_base( #define LAPACK_ssbevd_2stage(...) LAPACK_ssbevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsbevx_base LAPACK_GLOBAL(dsbevx,DSBEVX) +#define LAPACK_dsbevx_base LAPACK_GLOBAL_SUFFIX(dsbevx,DSBEVX) void LAPACK_dsbevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15136,7 +15150,7 @@ void LAPACK_dsbevx_base( #define LAPACK_dsbevx(...) LAPACK_dsbevx_base(__VA_ARGS__) #endif -#define LAPACK_ssbevx_base LAPACK_GLOBAL(ssbevx,SSBEVX) +#define LAPACK_ssbevx_base LAPACK_GLOBAL_SUFFIX(ssbevx,SSBEVX) void LAPACK_ssbevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15160,7 +15174,7 @@ void LAPACK_ssbevx_base( #define LAPACK_ssbevx(...) LAPACK_ssbevx_base(__VA_ARGS__) #endif -#define LAPACK_dsbevx_2stage_base LAPACK_GLOBAL(dsbevx_2stage,DSBEVX_2STAGE) +#define LAPACK_dsbevx_2stage_base LAPACK_GLOBAL_SUFFIX(dsbevx_2stage,DSBEVX_2STAGE) void LAPACK_dsbevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15184,7 +15198,7 @@ void LAPACK_dsbevx_2stage_base( #define LAPACK_dsbevx_2stage(...) LAPACK_dsbevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssbevx_2stage_base LAPACK_GLOBAL(ssbevx_2stage,SSBEVX_2STAGE) +#define LAPACK_ssbevx_2stage_base LAPACK_GLOBAL_SUFFIX(ssbevx_2stage,SSBEVX_2STAGE) void LAPACK_ssbevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15208,7 +15222,7 @@ void LAPACK_ssbevx_2stage_base( #define LAPACK_ssbevx_2stage(...) LAPACK_ssbevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsbgst_base LAPACK_GLOBAL(dsbgst,DSBGST) +#define LAPACK_dsbgst_base LAPACK_GLOBAL_SUFFIX(dsbgst,DSBGST) void LAPACK_dsbgst_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15227,7 +15241,7 @@ void LAPACK_dsbgst_base( #define LAPACK_dsbgst(...) LAPACK_dsbgst_base(__VA_ARGS__) #endif -#define LAPACK_ssbgst_base LAPACK_GLOBAL(ssbgst,SSBGST) +#define LAPACK_ssbgst_base LAPACK_GLOBAL_SUFFIX(ssbgst,SSBGST) void LAPACK_ssbgst_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15246,7 +15260,7 @@ void LAPACK_ssbgst_base( #define LAPACK_ssbgst(...) LAPACK_ssbgst_base(__VA_ARGS__) #endif -#define LAPACK_dsbgv_base LAPACK_GLOBAL(dsbgv,DSBGV) +#define LAPACK_dsbgv_base LAPACK_GLOBAL_SUFFIX(dsbgv,DSBGV) void LAPACK_dsbgv_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15266,7 +15280,7 @@ void LAPACK_dsbgv_base( #define LAPACK_dsbgv(...) LAPACK_dsbgv_base(__VA_ARGS__) #endif -#define LAPACK_ssbgv_base LAPACK_GLOBAL(ssbgv,SSBGV) +#define LAPACK_ssbgv_base LAPACK_GLOBAL_SUFFIX(ssbgv,SSBGV) void LAPACK_ssbgv_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15286,7 +15300,7 @@ void LAPACK_ssbgv_base( #define LAPACK_ssbgv(...) LAPACK_ssbgv_base(__VA_ARGS__) #endif -#define LAPACK_dsbgvd_base LAPACK_GLOBAL(dsbgvd,DSBGVD) +#define LAPACK_dsbgvd_base LAPACK_GLOBAL_SUFFIX(dsbgvd,DSBGVD) void LAPACK_dsbgvd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15307,7 +15321,7 @@ void LAPACK_dsbgvd_base( #define LAPACK_dsbgvd(...) LAPACK_dsbgvd_base(__VA_ARGS__) #endif -#define LAPACK_ssbgvd_base LAPACK_GLOBAL(ssbgvd,SSBGVD) +#define LAPACK_ssbgvd_base LAPACK_GLOBAL_SUFFIX(ssbgvd,SSBGVD) void LAPACK_ssbgvd_base( char const* jobz, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15328,7 +15342,7 @@ void LAPACK_ssbgvd_base( #define LAPACK_ssbgvd(...) LAPACK_ssbgvd_base(__VA_ARGS__) #endif -#define LAPACK_dsbgvx_base LAPACK_GLOBAL(dsbgvx,DSBGVX) +#define LAPACK_dsbgvx_base LAPACK_GLOBAL_SUFFIX(dsbgvx,DSBGVX) void LAPACK_dsbgvx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15353,7 +15367,7 @@ void LAPACK_dsbgvx_base( #define LAPACK_dsbgvx(...) LAPACK_dsbgvx_base(__VA_ARGS__) #endif -#define LAPACK_ssbgvx_base LAPACK_GLOBAL(ssbgvx,SSBGVX) +#define LAPACK_ssbgvx_base LAPACK_GLOBAL_SUFFIX(ssbgvx,SSBGVX) void LAPACK_ssbgvx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, lapack_int const* ka, lapack_int const* kb, @@ -15378,7 +15392,7 @@ void LAPACK_ssbgvx_base( #define LAPACK_ssbgvx(...) LAPACK_ssbgvx_base(__VA_ARGS__) #endif -#define LAPACK_dsbtrd_base LAPACK_GLOBAL(dsbtrd,DSBTRD) +#define LAPACK_dsbtrd_base LAPACK_GLOBAL_SUFFIX(dsbtrd,DSBTRD) void LAPACK_dsbtrd_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15398,7 +15412,7 @@ void LAPACK_dsbtrd_base( #define LAPACK_dsbtrd(...) LAPACK_dsbtrd_base(__VA_ARGS__) #endif -#define LAPACK_ssbtrd_base LAPACK_GLOBAL(ssbtrd,SSBTRD) +#define LAPACK_ssbtrd_base LAPACK_GLOBAL_SUFFIX(ssbtrd,SSBTRD) void LAPACK_ssbtrd_base( char const* vect, char const* uplo, lapack_int const* n, lapack_int const* kd, @@ -15418,7 +15432,7 @@ void LAPACK_ssbtrd_base( #define LAPACK_ssbtrd(...) LAPACK_ssbtrd_base(__VA_ARGS__) #endif -#define LAPACK_dsfrk_base LAPACK_GLOBAL(dsfrk,DSFRK) +#define LAPACK_dsfrk_base LAPACK_GLOBAL_SUFFIX(dsfrk,DSFRK) void LAPACK_dsfrk_base( char const* transr, char const* uplo, char const* trans, lapack_int const* n, lapack_int const* k, @@ -15436,7 +15450,7 @@ void LAPACK_dsfrk_base( #define LAPACK_dsfrk(...) LAPACK_dsfrk_base(__VA_ARGS__) #endif -#define LAPACK_ssfrk_base LAPACK_GLOBAL(ssfrk,SSFRK) +#define LAPACK_ssfrk_base LAPACK_GLOBAL_SUFFIX(ssfrk,SSFRK) void LAPACK_ssfrk_base( char const* transr, char const* uplo, char const* trans, lapack_int const* n, lapack_int const* k, @@ -15454,7 +15468,7 @@ void LAPACK_ssfrk_base( #define LAPACK_ssfrk(...) LAPACK_ssfrk_base(__VA_ARGS__) #endif -#define LAPACK_cspcon_base LAPACK_GLOBAL(cspcon,CSPCON) +#define LAPACK_cspcon_base LAPACK_GLOBAL_SUFFIX(cspcon,CSPCON) void LAPACK_cspcon_base( char const* uplo, lapack_int const* n, @@ -15473,7 +15487,7 @@ void LAPACK_cspcon_base( #define LAPACK_cspcon(...) LAPACK_cspcon_base(__VA_ARGS__) #endif -#define LAPACK_dspcon_base LAPACK_GLOBAL(dspcon,DSPCON) +#define LAPACK_dspcon_base LAPACK_GLOBAL_SUFFIX(dspcon,DSPCON) void LAPACK_dspcon_base( char const* uplo, lapack_int const* n, @@ -15493,7 +15507,7 @@ void LAPACK_dspcon_base( #define LAPACK_dspcon(...) LAPACK_dspcon_base(__VA_ARGS__) #endif -#define LAPACK_sspcon_base LAPACK_GLOBAL(sspcon,SSPCON) +#define LAPACK_sspcon_base LAPACK_GLOBAL_SUFFIX(sspcon,SSPCON) void LAPACK_sspcon_base( char const* uplo, lapack_int const* n, @@ -15513,7 +15527,7 @@ void LAPACK_sspcon_base( #define LAPACK_sspcon(...) LAPACK_sspcon_base(__VA_ARGS__) #endif -#define LAPACK_zspcon_base LAPACK_GLOBAL(zspcon,ZSPCON) +#define LAPACK_zspcon_base LAPACK_GLOBAL_SUFFIX(zspcon,ZSPCON) void LAPACK_zspcon_base( char const* uplo, lapack_int const* n, @@ -15532,7 +15546,7 @@ void LAPACK_zspcon_base( #define LAPACK_zspcon(...) LAPACK_zspcon_base(__VA_ARGS__) #endif -#define LAPACK_dspev_base LAPACK_GLOBAL(dspev,DSPEV) +#define LAPACK_dspev_base LAPACK_GLOBAL_SUFFIX(dspev,DSPEV) void LAPACK_dspev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -15551,7 +15565,7 @@ void LAPACK_dspev_base( #define LAPACK_dspev(...) LAPACK_dspev_base(__VA_ARGS__) #endif -#define LAPACK_sspev_base LAPACK_GLOBAL(sspev,SSPEV) +#define LAPACK_sspev_base LAPACK_GLOBAL_SUFFIX(sspev,SSPEV) void LAPACK_sspev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -15570,7 +15584,7 @@ void LAPACK_sspev_base( #define LAPACK_sspev(...) LAPACK_sspev_base(__VA_ARGS__) #endif -#define LAPACK_dspevd_base LAPACK_GLOBAL(dspevd,DSPEVD) +#define LAPACK_dspevd_base LAPACK_GLOBAL_SUFFIX(dspevd,DSPEVD) void LAPACK_dspevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -15590,7 +15604,7 @@ void LAPACK_dspevd_base( #define LAPACK_dspevd(...) LAPACK_dspevd_base(__VA_ARGS__) #endif -#define LAPACK_sspevd_base LAPACK_GLOBAL(sspevd,SSPEVD) +#define LAPACK_sspevd_base LAPACK_GLOBAL_SUFFIX(sspevd,SSPEVD) void LAPACK_sspevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -15610,7 +15624,7 @@ void LAPACK_sspevd_base( #define LAPACK_sspevd(...) LAPACK_sspevd_base(__VA_ARGS__) #endif -#define LAPACK_dspevx_base LAPACK_GLOBAL(dspevx,DSPEVX) +#define LAPACK_dspevx_base LAPACK_GLOBAL_SUFFIX(dspevx,DSPEVX) void LAPACK_dspevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -15633,7 +15647,7 @@ void LAPACK_dspevx_base( #define LAPACK_dspevx(...) LAPACK_dspevx_base(__VA_ARGS__) #endif -#define LAPACK_sspevx_base LAPACK_GLOBAL(sspevx,SSPEVX) +#define LAPACK_sspevx_base LAPACK_GLOBAL_SUFFIX(sspevx,SSPEVX) void LAPACK_sspevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -15656,7 +15670,7 @@ void LAPACK_sspevx_base( #define LAPACK_sspevx(...) LAPACK_sspevx_base(__VA_ARGS__) #endif -#define LAPACK_dspgst_base LAPACK_GLOBAL(dspgst,DSPGST) +#define LAPACK_dspgst_base LAPACK_GLOBAL_SUFFIX(dspgst,DSPGST) void LAPACK_dspgst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -15673,7 +15687,7 @@ void LAPACK_dspgst_base( #define LAPACK_dspgst(...) LAPACK_dspgst_base(__VA_ARGS__) #endif -#define LAPACK_sspgst_base LAPACK_GLOBAL(sspgst,SSPGST) +#define LAPACK_sspgst_base LAPACK_GLOBAL_SUFFIX(sspgst,SSPGST) void LAPACK_sspgst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -15690,7 +15704,7 @@ void LAPACK_sspgst_base( #define LAPACK_sspgst(...) LAPACK_sspgst_base(__VA_ARGS__) #endif -#define LAPACK_dspgv_base LAPACK_GLOBAL(dspgv,DSPGV) +#define LAPACK_dspgv_base LAPACK_GLOBAL_SUFFIX(dspgv,DSPGV) void LAPACK_dspgv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -15710,7 +15724,7 @@ void LAPACK_dspgv_base( #define LAPACK_dspgv(...) LAPACK_dspgv_base(__VA_ARGS__) #endif -#define LAPACK_sspgv_base LAPACK_GLOBAL(sspgv,SSPGV) +#define LAPACK_sspgv_base LAPACK_GLOBAL_SUFFIX(sspgv,SSPGV) void LAPACK_sspgv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -15730,7 +15744,7 @@ void LAPACK_sspgv_base( #define LAPACK_sspgv(...) LAPACK_sspgv_base(__VA_ARGS__) #endif -#define LAPACK_dspgvd_base LAPACK_GLOBAL(dspgvd,DSPGVD) +#define LAPACK_dspgvd_base LAPACK_GLOBAL_SUFFIX(dspgvd,DSPGVD) void LAPACK_dspgvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -15751,7 +15765,7 @@ void LAPACK_dspgvd_base( #define LAPACK_dspgvd(...) LAPACK_dspgvd_base(__VA_ARGS__) #endif -#define LAPACK_sspgvd_base LAPACK_GLOBAL(sspgvd,SSPGVD) +#define LAPACK_sspgvd_base LAPACK_GLOBAL_SUFFIX(sspgvd,SSPGVD) void LAPACK_sspgvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -15772,7 +15786,7 @@ void LAPACK_sspgvd_base( #define LAPACK_sspgvd(...) LAPACK_sspgvd_base(__VA_ARGS__) #endif -#define LAPACK_dspgvx_base LAPACK_GLOBAL(dspgvx,DSPGVX) +#define LAPACK_dspgvx_base LAPACK_GLOBAL_SUFFIX(dspgvx,DSPGVX) void LAPACK_dspgvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -15796,7 +15810,7 @@ void LAPACK_dspgvx_base( #define LAPACK_dspgvx(...) LAPACK_dspgvx_base(__VA_ARGS__) #endif -#define LAPACK_sspgvx_base LAPACK_GLOBAL(sspgvx,SSPGVX) +#define LAPACK_sspgvx_base LAPACK_GLOBAL_SUFFIX(sspgvx,SSPGVX) void LAPACK_sspgvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -15820,7 +15834,7 @@ void LAPACK_sspgvx_base( #define LAPACK_sspgvx(...) LAPACK_sspgvx_base(__VA_ARGS__) #endif -#define LAPACK_csprfs_base LAPACK_GLOBAL(csprfs,CSPRFS) +#define LAPACK_csprfs_base LAPACK_GLOBAL_SUFFIX(csprfs,CSPRFS) void LAPACK_csprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15843,7 +15857,7 @@ void LAPACK_csprfs_base( #define LAPACK_csprfs(...) LAPACK_csprfs_base(__VA_ARGS__) #endif -#define LAPACK_dsprfs_base LAPACK_GLOBAL(dsprfs,DSPRFS) +#define LAPACK_dsprfs_base LAPACK_GLOBAL_SUFFIX(dsprfs,DSPRFS) void LAPACK_dsprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15866,7 +15880,7 @@ void LAPACK_dsprfs_base( #define LAPACK_dsprfs(...) LAPACK_dsprfs_base(__VA_ARGS__) #endif -#define LAPACK_ssprfs_base LAPACK_GLOBAL(ssprfs,SSPRFS) +#define LAPACK_ssprfs_base LAPACK_GLOBAL_SUFFIX(ssprfs,SSPRFS) void LAPACK_ssprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15889,7 +15903,7 @@ void LAPACK_ssprfs_base( #define LAPACK_ssprfs(...) LAPACK_ssprfs_base(__VA_ARGS__) #endif -#define LAPACK_zsprfs_base LAPACK_GLOBAL(zsprfs,ZSPRFS) +#define LAPACK_zsprfs_base LAPACK_GLOBAL_SUFFIX(zsprfs,ZSPRFS) void LAPACK_zsprfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15912,7 +15926,7 @@ void LAPACK_zsprfs_base( #define LAPACK_zsprfs(...) LAPACK_zsprfs_base(__VA_ARGS__) #endif -#define LAPACK_cspsv_base LAPACK_GLOBAL(cspsv,CSPSV) +#define LAPACK_cspsv_base LAPACK_GLOBAL_SUFFIX(cspsv,CSPSV) void LAPACK_cspsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15929,7 +15943,7 @@ void LAPACK_cspsv_base( #define LAPACK_cspsv(...) LAPACK_cspsv_base(__VA_ARGS__) #endif -#define LAPACK_dspsv_base LAPACK_GLOBAL(dspsv,DSPSV) +#define LAPACK_dspsv_base LAPACK_GLOBAL_SUFFIX(dspsv,DSPSV) void LAPACK_dspsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15946,7 +15960,7 @@ void LAPACK_dspsv_base( #define LAPACK_dspsv(...) LAPACK_dspsv_base(__VA_ARGS__) #endif -#define LAPACK_sspsv_base LAPACK_GLOBAL(sspsv,SSPSV) +#define LAPACK_sspsv_base LAPACK_GLOBAL_SUFFIX(sspsv,SSPSV) void LAPACK_sspsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15963,7 +15977,7 @@ void LAPACK_sspsv_base( #define LAPACK_sspsv(...) LAPACK_sspsv_base(__VA_ARGS__) #endif -#define LAPACK_zspsv_base LAPACK_GLOBAL(zspsv,ZSPSV) +#define LAPACK_zspsv_base LAPACK_GLOBAL_SUFFIX(zspsv,ZSPSV) void LAPACK_zspsv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -15980,7 +15994,7 @@ void LAPACK_zspsv_base( #define LAPACK_zspsv(...) LAPACK_zspsv_base(__VA_ARGS__) #endif -#define LAPACK_cspsvx_base LAPACK_GLOBAL(cspsvx,CSPSVX) +#define LAPACK_cspsvx_base LAPACK_GLOBAL_SUFFIX(cspsvx,CSPSVX) void LAPACK_cspsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16004,7 +16018,7 @@ void LAPACK_cspsvx_base( #define LAPACK_cspsvx(...) LAPACK_cspsvx_base(__VA_ARGS__) #endif -#define LAPACK_dspsvx_base LAPACK_GLOBAL(dspsvx,DSPSVX) +#define LAPACK_dspsvx_base LAPACK_GLOBAL_SUFFIX(dspsvx,DSPSVX) void LAPACK_dspsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16028,7 +16042,7 @@ void LAPACK_dspsvx_base( #define LAPACK_dspsvx(...) LAPACK_dspsvx_base(__VA_ARGS__) #endif -#define LAPACK_sspsvx_base LAPACK_GLOBAL(sspsvx,SSPSVX) +#define LAPACK_sspsvx_base LAPACK_GLOBAL_SUFFIX(sspsvx,SSPSVX) void LAPACK_sspsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16052,7 +16066,7 @@ void LAPACK_sspsvx_base( #define LAPACK_sspsvx(...) LAPACK_sspsvx_base(__VA_ARGS__) #endif -#define LAPACK_zspsvx_base LAPACK_GLOBAL(zspsvx,ZSPSVX) +#define LAPACK_zspsvx_base LAPACK_GLOBAL_SUFFIX(zspsvx,ZSPSVX) void LAPACK_zspsvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16076,7 +16090,7 @@ void LAPACK_zspsvx_base( #define LAPACK_zspsvx(...) LAPACK_zspsvx_base(__VA_ARGS__) #endif -#define LAPACK_dsptrd_base LAPACK_GLOBAL(dsptrd,DSPTRD) +#define LAPACK_dsptrd_base LAPACK_GLOBAL_SUFFIX(dsptrd,DSPTRD) void LAPACK_dsptrd_base( char const* uplo, lapack_int const* n, @@ -16095,7 +16109,7 @@ void LAPACK_dsptrd_base( #define LAPACK_dsptrd(...) LAPACK_dsptrd_base(__VA_ARGS__) #endif -#define LAPACK_ssptrd_base LAPACK_GLOBAL(ssptrd,SSPTRD) +#define LAPACK_ssptrd_base LAPACK_GLOBAL_SUFFIX(ssptrd,SSPTRD) void LAPACK_ssptrd_base( char const* uplo, lapack_int const* n, @@ -16114,7 +16128,7 @@ void LAPACK_ssptrd_base( #define LAPACK_ssptrd(...) LAPACK_ssptrd_base(__VA_ARGS__) #endif -#define LAPACK_csptrf_base LAPACK_GLOBAL(csptrf,CSPTRF) +#define LAPACK_csptrf_base LAPACK_GLOBAL_SUFFIX(csptrf,CSPTRF) void LAPACK_csptrf_base( char const* uplo, lapack_int const* n, @@ -16130,7 +16144,7 @@ void LAPACK_csptrf_base( #define LAPACK_csptrf(...) LAPACK_csptrf_base(__VA_ARGS__) #endif -#define LAPACK_dsptrf_base LAPACK_GLOBAL(dsptrf,DSPTRF) +#define LAPACK_dsptrf_base LAPACK_GLOBAL_SUFFIX(dsptrf,DSPTRF) void LAPACK_dsptrf_base( char const* uplo, lapack_int const* n, @@ -16146,7 +16160,7 @@ void LAPACK_dsptrf_base( #define LAPACK_dsptrf(...) LAPACK_dsptrf_base(__VA_ARGS__) #endif -#define LAPACK_ssptrf_base LAPACK_GLOBAL(ssptrf,SSPTRF) +#define LAPACK_ssptrf_base LAPACK_GLOBAL_SUFFIX(ssptrf,SSPTRF) void LAPACK_ssptrf_base( char const* uplo, lapack_int const* n, @@ -16162,7 +16176,7 @@ void LAPACK_ssptrf_base( #define LAPACK_ssptrf(...) LAPACK_ssptrf_base(__VA_ARGS__) #endif -#define LAPACK_zsptrf_base LAPACK_GLOBAL(zsptrf,ZSPTRF) +#define LAPACK_zsptrf_base LAPACK_GLOBAL_SUFFIX(zsptrf,ZSPTRF) void LAPACK_zsptrf_base( char const* uplo, lapack_int const* n, @@ -16178,7 +16192,7 @@ void LAPACK_zsptrf_base( #define LAPACK_zsptrf(...) LAPACK_zsptrf_base(__VA_ARGS__) #endif -#define LAPACK_csptri_base LAPACK_GLOBAL(csptri,CSPTRI) +#define LAPACK_csptri_base LAPACK_GLOBAL_SUFFIX(csptri,CSPTRI) void LAPACK_csptri_base( char const* uplo, lapack_int const* n, @@ -16195,7 +16209,7 @@ void LAPACK_csptri_base( #define LAPACK_csptri(...) LAPACK_csptri_base(__VA_ARGS__) #endif -#define LAPACK_dsptri_base LAPACK_GLOBAL(dsptri,DSPTRI) +#define LAPACK_dsptri_base LAPACK_GLOBAL_SUFFIX(dsptri,DSPTRI) void LAPACK_dsptri_base( char const* uplo, lapack_int const* n, @@ -16212,7 +16226,7 @@ void LAPACK_dsptri_base( #define LAPACK_dsptri(...) LAPACK_dsptri_base(__VA_ARGS__) #endif -#define LAPACK_ssptri_base LAPACK_GLOBAL(ssptri,SSPTRI) +#define LAPACK_ssptri_base LAPACK_GLOBAL_SUFFIX(ssptri,SSPTRI) void LAPACK_ssptri_base( char const* uplo, lapack_int const* n, @@ -16229,7 +16243,7 @@ void LAPACK_ssptri_base( #define LAPACK_ssptri(...) LAPACK_ssptri_base(__VA_ARGS__) #endif -#define LAPACK_zsptri_base LAPACK_GLOBAL(zsptri,ZSPTRI) +#define LAPACK_zsptri_base LAPACK_GLOBAL_SUFFIX(zsptri,ZSPTRI) void LAPACK_zsptri_base( char const* uplo, lapack_int const* n, @@ -16246,7 +16260,7 @@ void LAPACK_zsptri_base( #define LAPACK_zsptri(...) LAPACK_zsptri_base(__VA_ARGS__) #endif -#define LAPACK_csptrs_base LAPACK_GLOBAL(csptrs,CSPTRS) +#define LAPACK_csptrs_base LAPACK_GLOBAL_SUFFIX(csptrs,CSPTRS) void LAPACK_csptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16263,7 +16277,7 @@ void LAPACK_csptrs_base( #define LAPACK_csptrs(...) LAPACK_csptrs_base(__VA_ARGS__) #endif -#define LAPACK_dsptrs_base LAPACK_GLOBAL(dsptrs,DSPTRS) +#define LAPACK_dsptrs_base LAPACK_GLOBAL_SUFFIX(dsptrs,DSPTRS) void LAPACK_dsptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16280,7 +16294,7 @@ void LAPACK_dsptrs_base( #define LAPACK_dsptrs(...) LAPACK_dsptrs_base(__VA_ARGS__) #endif -#define LAPACK_ssptrs_base LAPACK_GLOBAL(ssptrs,SSPTRS) +#define LAPACK_ssptrs_base LAPACK_GLOBAL_SUFFIX(ssptrs,SSPTRS) void LAPACK_ssptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16297,7 +16311,7 @@ void LAPACK_ssptrs_base( #define LAPACK_ssptrs(...) LAPACK_ssptrs_base(__VA_ARGS__) #endif -#define LAPACK_zsptrs_base LAPACK_GLOBAL(zsptrs,ZSPTRS) +#define LAPACK_zsptrs_base LAPACK_GLOBAL_SUFFIX(zsptrs,ZSPTRS) void LAPACK_zsptrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -16314,7 +16328,7 @@ void LAPACK_zsptrs_base( #define LAPACK_zsptrs(...) LAPACK_zsptrs_base(__VA_ARGS__) #endif -#define LAPACK_dstebz_base LAPACK_GLOBAL(dstebz,DSTEBZ) +#define LAPACK_dstebz_base LAPACK_GLOBAL_SUFFIX(dstebz,DSTEBZ) void LAPACK_dstebz_base( char const* range, char const* order, lapack_int const* n, @@ -16337,7 +16351,7 @@ void LAPACK_dstebz_base( #define LAPACK_dstebz(...) LAPACK_dstebz_base(__VA_ARGS__) #endif -#define LAPACK_sstebz_base LAPACK_GLOBAL(sstebz,SSTEBZ) +#define LAPACK_sstebz_base LAPACK_GLOBAL_SUFFIX(sstebz,SSTEBZ) void LAPACK_sstebz_base( char const* range, char const* order, lapack_int const* n, @@ -16360,7 +16374,7 @@ void LAPACK_sstebz_base( #define LAPACK_sstebz(...) LAPACK_sstebz_base(__VA_ARGS__) #endif -#define LAPACK_cstedc_base LAPACK_GLOBAL(cstedc,CSTEDC) +#define LAPACK_cstedc_base LAPACK_GLOBAL_SUFFIX(cstedc,CSTEDC) void LAPACK_cstedc_base( char const* compz, lapack_int const* n, @@ -16381,7 +16395,7 @@ void LAPACK_cstedc_base( #define LAPACK_cstedc(...) LAPACK_cstedc_base(__VA_ARGS__) #endif -#define LAPACK_dstedc_base LAPACK_GLOBAL(dstedc,DSTEDC) +#define LAPACK_dstedc_base LAPACK_GLOBAL_SUFFIX(dstedc,DSTEDC) void LAPACK_dstedc_base( char const* compz, lapack_int const* n, @@ -16401,7 +16415,7 @@ void LAPACK_dstedc_base( #define LAPACK_dstedc(...) LAPACK_dstedc_base(__VA_ARGS__) #endif -#define LAPACK_sstedc_base LAPACK_GLOBAL(sstedc,SSTEDC) +#define LAPACK_sstedc_base LAPACK_GLOBAL_SUFFIX(sstedc,SSTEDC) void LAPACK_sstedc_base( char const* compz, lapack_int const* n, @@ -16421,7 +16435,7 @@ void LAPACK_sstedc_base( #define LAPACK_sstedc(...) LAPACK_sstedc_base(__VA_ARGS__) #endif -#define LAPACK_zstedc_base LAPACK_GLOBAL(zstedc,ZSTEDC) +#define LAPACK_zstedc_base LAPACK_GLOBAL_SUFFIX(zstedc,ZSTEDC) void LAPACK_zstedc_base( char const* compz, lapack_int const* n, @@ -16442,7 +16456,7 @@ void LAPACK_zstedc_base( #define LAPACK_zstedc(...) LAPACK_zstedc_base(__VA_ARGS__) #endif -#define LAPACK_cstegr_base LAPACK_GLOBAL(cstegr,CSTEGR) +#define LAPACK_cstegr_base LAPACK_GLOBAL_SUFFIX(cstegr,CSTEGR) void LAPACK_cstegr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16466,7 +16480,7 @@ void LAPACK_cstegr_base( #define LAPACK_cstegr(...) LAPACK_cstegr_base(__VA_ARGS__) #endif -#define LAPACK_dstegr_base LAPACK_GLOBAL(dstegr,DSTEGR) +#define LAPACK_dstegr_base LAPACK_GLOBAL_SUFFIX(dstegr,DSTEGR) void LAPACK_dstegr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16490,7 +16504,7 @@ void LAPACK_dstegr_base( #define LAPACK_dstegr(...) LAPACK_dstegr_base(__VA_ARGS__) #endif -#define LAPACK_sstegr_base LAPACK_GLOBAL(sstegr,SSTEGR) +#define LAPACK_sstegr_base LAPACK_GLOBAL_SUFFIX(sstegr,SSTEGR) void LAPACK_sstegr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16514,7 +16528,7 @@ void LAPACK_sstegr_base( #define LAPACK_sstegr(...) LAPACK_sstegr_base(__VA_ARGS__) #endif -#define LAPACK_zstegr_base LAPACK_GLOBAL(zstegr,ZSTEGR) +#define LAPACK_zstegr_base LAPACK_GLOBAL_SUFFIX(zstegr,ZSTEGR) void LAPACK_zstegr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16538,7 +16552,7 @@ void LAPACK_zstegr_base( #define LAPACK_zstegr(...) LAPACK_zstegr_base(__VA_ARGS__) #endif -#define LAPACK_cstein LAPACK_GLOBAL(cstein,CSTEIN) +#define LAPACK_cstein LAPACK_GLOBAL_SUFFIX(cstein,CSTEIN) void LAPACK_cstein( lapack_int const* n, float const* D, @@ -16549,7 +16563,7 @@ void LAPACK_cstein( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info ); -#define LAPACK_dstein LAPACK_GLOBAL(dstein,DSTEIN) +#define LAPACK_dstein LAPACK_GLOBAL_SUFFIX(dstein,DSTEIN) void LAPACK_dstein( lapack_int const* n, double const* D, @@ -16560,7 +16574,7 @@ void LAPACK_dstein( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info ); -#define LAPACK_sstein LAPACK_GLOBAL(sstein,SSTEIN) +#define LAPACK_sstein LAPACK_GLOBAL_SUFFIX(sstein,SSTEIN) void LAPACK_sstein( lapack_int const* n, float const* D, @@ -16571,7 +16585,7 @@ void LAPACK_sstein( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info ); -#define LAPACK_zstein LAPACK_GLOBAL(zstein,ZSTEIN) +#define LAPACK_zstein LAPACK_GLOBAL_SUFFIX(zstein,ZSTEIN) void LAPACK_zstein( lapack_int const* n, double const* D, @@ -16582,7 +16596,7 @@ void LAPACK_zstein( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info ); -#define LAPACK_cstemr_base LAPACK_GLOBAL(cstemr,CSTEMR) +#define LAPACK_cstemr_base LAPACK_GLOBAL_SUFFIX(cstemr,CSTEMR) void LAPACK_cstemr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16605,7 +16619,7 @@ void LAPACK_cstemr_base( #define LAPACK_cstemr(...) LAPACK_cstemr_base(__VA_ARGS__) #endif -#define LAPACK_dstemr_base LAPACK_GLOBAL(dstemr,DSTEMR) +#define LAPACK_dstemr_base LAPACK_GLOBAL_SUFFIX(dstemr,DSTEMR) void LAPACK_dstemr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16628,7 +16642,7 @@ void LAPACK_dstemr_base( #define LAPACK_dstemr(...) LAPACK_dstemr_base(__VA_ARGS__) #endif -#define LAPACK_sstemr_base LAPACK_GLOBAL(sstemr,SSTEMR) +#define LAPACK_sstemr_base LAPACK_GLOBAL_SUFFIX(sstemr,SSTEMR) void LAPACK_sstemr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16651,7 +16665,7 @@ void LAPACK_sstemr_base( #define LAPACK_sstemr(...) LAPACK_sstemr_base(__VA_ARGS__) #endif -#define LAPACK_zstemr_base LAPACK_GLOBAL(zstemr,ZSTEMR) +#define LAPACK_zstemr_base LAPACK_GLOBAL_SUFFIX(zstemr,ZSTEMR) void LAPACK_zstemr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16674,7 +16688,7 @@ void LAPACK_zstemr_base( #define LAPACK_zstemr(...) LAPACK_zstemr_base(__VA_ARGS__) #endif -#define LAPACK_csteqr_base LAPACK_GLOBAL(csteqr,CSTEQR) +#define LAPACK_csteqr_base LAPACK_GLOBAL_SUFFIX(csteqr,CSTEQR) void LAPACK_csteqr_base( char const* compz, lapack_int const* n, @@ -16693,7 +16707,7 @@ void LAPACK_csteqr_base( #define LAPACK_csteqr(...) LAPACK_csteqr_base(__VA_ARGS__) #endif -#define LAPACK_dsteqr_base LAPACK_GLOBAL(dsteqr,DSTEQR) +#define LAPACK_dsteqr_base LAPACK_GLOBAL_SUFFIX(dsteqr,DSTEQR) void LAPACK_dsteqr_base( char const* compz, lapack_int const* n, @@ -16712,7 +16726,7 @@ void LAPACK_dsteqr_base( #define LAPACK_dsteqr(...) LAPACK_dsteqr_base(__VA_ARGS__) #endif -#define LAPACK_ssteqr_base LAPACK_GLOBAL(ssteqr,SSTEQR) +#define LAPACK_ssteqr_base LAPACK_GLOBAL_SUFFIX(ssteqr,SSTEQR) void LAPACK_ssteqr_base( char const* compz, lapack_int const* n, @@ -16731,7 +16745,7 @@ void LAPACK_ssteqr_base( #define LAPACK_ssteqr(...) LAPACK_ssteqr_base(__VA_ARGS__) #endif -#define LAPACK_zsteqr_base LAPACK_GLOBAL(zsteqr,ZSTEQR) +#define LAPACK_zsteqr_base LAPACK_GLOBAL_SUFFIX(zsteqr,ZSTEQR) void LAPACK_zsteqr_base( char const* compz, lapack_int const* n, @@ -16750,21 +16764,21 @@ void LAPACK_zsteqr_base( #define LAPACK_zsteqr(...) LAPACK_zsteqr_base(__VA_ARGS__) #endif -#define LAPACK_dsterf LAPACK_GLOBAL(dsterf,DSTERF) +#define LAPACK_dsterf LAPACK_GLOBAL_SUFFIX(dsterf,DSTERF) void LAPACK_dsterf( lapack_int const* n, double* D, double* E, lapack_int* info ); -#define LAPACK_ssterf LAPACK_GLOBAL(ssterf,SSTERF) +#define LAPACK_ssterf LAPACK_GLOBAL_SUFFIX(ssterf,SSTERF) void LAPACK_ssterf( lapack_int const* n, float* D, float* E, lapack_int* info ); -#define LAPACK_dstev_base LAPACK_GLOBAL(dstev,DSTEV) +#define LAPACK_dstev_base LAPACK_GLOBAL_SUFFIX(dstev,DSTEV) void LAPACK_dstev_base( char const* jobz, lapack_int const* n, @@ -16783,7 +16797,7 @@ void LAPACK_dstev_base( #define LAPACK_dstev(...) LAPACK_dstev_base(__VA_ARGS__) #endif -#define LAPACK_sstev_base LAPACK_GLOBAL(sstev,SSTEV) +#define LAPACK_sstev_base LAPACK_GLOBAL_SUFFIX(sstev,SSTEV) void LAPACK_sstev_base( char const* jobz, lapack_int const* n, @@ -16802,7 +16816,7 @@ void LAPACK_sstev_base( #define LAPACK_sstev(...) LAPACK_sstev_base(__VA_ARGS__) #endif -#define LAPACK_dstevd_base LAPACK_GLOBAL(dstevd,DSTEVD) +#define LAPACK_dstevd_base LAPACK_GLOBAL_SUFFIX(dstevd,DSTEVD) void LAPACK_dstevd_base( char const* jobz, lapack_int const* n, @@ -16822,7 +16836,7 @@ void LAPACK_dstevd_base( #define LAPACK_dstevd(...) LAPACK_dstevd_base(__VA_ARGS__) #endif -#define LAPACK_sstevd_base LAPACK_GLOBAL(sstevd,SSTEVD) +#define LAPACK_sstevd_base LAPACK_GLOBAL_SUFFIX(sstevd,SSTEVD) void LAPACK_sstevd_base( char const* jobz, lapack_int const* n, @@ -16842,7 +16856,7 @@ void LAPACK_sstevd_base( #define LAPACK_sstevd(...) LAPACK_sstevd_base(__VA_ARGS__) #endif -#define LAPACK_dstevr_base LAPACK_GLOBAL(dstevr,DSTEVR) +#define LAPACK_dstevr_base LAPACK_GLOBAL_SUFFIX(dstevr,DSTEVR) void LAPACK_dstevr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16866,7 +16880,7 @@ void LAPACK_dstevr_base( #define LAPACK_dstevr(...) LAPACK_dstevr_base(__VA_ARGS__) #endif -#define LAPACK_sstevr_base LAPACK_GLOBAL(sstevr,SSTEVR) +#define LAPACK_sstevr_base LAPACK_GLOBAL_SUFFIX(sstevr,SSTEVR) void LAPACK_sstevr_base( char const* jobz, char const* range, lapack_int const* n, @@ -16890,7 +16904,7 @@ void LAPACK_sstevr_base( #define LAPACK_sstevr(...) LAPACK_sstevr_base(__VA_ARGS__) #endif -#define LAPACK_dstevx_base LAPACK_GLOBAL(dstevx,DSTEVX) +#define LAPACK_dstevx_base LAPACK_GLOBAL_SUFFIX(dstevx,DSTEVX) void LAPACK_dstevx_base( char const* jobz, char const* range, lapack_int const* n, @@ -16914,7 +16928,7 @@ void LAPACK_dstevx_base( #define LAPACK_dstevx(...) LAPACK_dstevx_base(__VA_ARGS__) #endif -#define LAPACK_sstevx_base LAPACK_GLOBAL(sstevx,SSTEVX) +#define LAPACK_sstevx_base LAPACK_GLOBAL_SUFFIX(sstevx,SSTEVX) void LAPACK_sstevx_base( char const* jobz, char const* range, lapack_int const* n, @@ -16938,7 +16952,7 @@ void LAPACK_sstevx_base( #define LAPACK_sstevx(...) LAPACK_sstevx_base(__VA_ARGS__) #endif -#define LAPACK_csycon_base LAPACK_GLOBAL(csycon,CSYCON) +#define LAPACK_csycon_base LAPACK_GLOBAL_SUFFIX(csycon,CSYCON) void LAPACK_csycon_base( char const* uplo, lapack_int const* n, @@ -16957,7 +16971,7 @@ void LAPACK_csycon_base( #define LAPACK_csycon(...) LAPACK_csycon_base(__VA_ARGS__) #endif -#define LAPACK_dsycon_base LAPACK_GLOBAL(dsycon,DSYCON) +#define LAPACK_dsycon_base LAPACK_GLOBAL_SUFFIX(dsycon,DSYCON) void LAPACK_dsycon_base( char const* uplo, lapack_int const* n, @@ -16977,7 +16991,7 @@ void LAPACK_dsycon_base( #define LAPACK_dsycon(...) LAPACK_dsycon_base(__VA_ARGS__) #endif -#define LAPACK_ssycon_base LAPACK_GLOBAL(ssycon,SSYCON) +#define LAPACK_ssycon_base LAPACK_GLOBAL_SUFFIX(ssycon,SSYCON) void LAPACK_ssycon_base( char const* uplo, lapack_int const* n, @@ -16997,7 +17011,7 @@ void LAPACK_ssycon_base( #define LAPACK_ssycon(...) LAPACK_ssycon_base(__VA_ARGS__) #endif -#define LAPACK_zsycon_base LAPACK_GLOBAL(zsycon,ZSYCON) +#define LAPACK_zsycon_base LAPACK_GLOBAL_SUFFIX(zsycon,ZSYCON) void LAPACK_zsycon_base( char const* uplo, lapack_int const* n, @@ -17016,7 +17030,7 @@ void LAPACK_zsycon_base( #define LAPACK_zsycon(...) LAPACK_zsycon_base(__VA_ARGS__) #endif -#define LAPACK_csycon_3_base LAPACK_GLOBAL(csycon_3,CSYCON_3) +#define LAPACK_csycon_3_base LAPACK_GLOBAL_SUFFIX(csycon_3,CSYCON_3) void LAPACK_csycon_3_base( char const* uplo, lapack_int const* n, @@ -17036,7 +17050,7 @@ void LAPACK_csycon_3_base( #define LAPACK_csycon_3(...) LAPACK_csycon_3_base(__VA_ARGS__) #endif -#define LAPACK_dsycon_3_base LAPACK_GLOBAL(dsycon_3,DSYCON_3) +#define LAPACK_dsycon_3_base LAPACK_GLOBAL_SUFFIX(dsycon_3,DSYCON_3) void LAPACK_dsycon_3_base( char const* uplo, lapack_int const* n, @@ -17057,7 +17071,7 @@ void LAPACK_dsycon_3_base( #define LAPACK_dsycon_3(...) LAPACK_dsycon_3_base(__VA_ARGS__) #endif -#define LAPACK_ssycon_3_base LAPACK_GLOBAL(ssycon_3,SSYCON_3) +#define LAPACK_ssycon_3_base LAPACK_GLOBAL_SUFFIX(ssycon_3,SSYCON_3) void LAPACK_ssycon_3_base( char const* uplo, lapack_int const* n, @@ -17078,7 +17092,7 @@ void LAPACK_ssycon_3_base( #define LAPACK_ssycon_3(...) LAPACK_ssycon_3_base(__VA_ARGS__) #endif -#define LAPACK_zsycon_3_base LAPACK_GLOBAL(zsycon_3,ZSYCON_3) +#define LAPACK_zsycon_3_base LAPACK_GLOBAL_SUFFIX(zsycon_3,ZSYCON_3) void LAPACK_zsycon_3_base( char const* uplo, lapack_int const* n, @@ -17098,7 +17112,7 @@ void LAPACK_zsycon_3_base( #define LAPACK_zsycon_3(...) LAPACK_zsycon_3_base(__VA_ARGS__) #endif -#define LAPACK_csyconv_base LAPACK_GLOBAL(csyconv,CSYCONV) +#define LAPACK_csyconv_base LAPACK_GLOBAL_SUFFIX(csyconv,CSYCONV) void LAPACK_csyconv_base( char const* uplo, char const* way, lapack_int const* n, @@ -17115,7 +17129,7 @@ void LAPACK_csyconv_base( #define LAPACK_csyconv(...) LAPACK_csyconv_base(__VA_ARGS__) #endif -#define LAPACK_dsyconv_base LAPACK_GLOBAL(dsyconv,DSYCONV) +#define LAPACK_dsyconv_base LAPACK_GLOBAL_SUFFIX(dsyconv,DSYCONV) void LAPACK_dsyconv_base( char const* uplo, char const* way, lapack_int const* n, @@ -17132,7 +17146,7 @@ void LAPACK_dsyconv_base( #define LAPACK_dsyconv(...) LAPACK_dsyconv_base(__VA_ARGS__) #endif -#define LAPACK_ssyconv_base LAPACK_GLOBAL(ssyconv,SSYCONV) +#define LAPACK_ssyconv_base LAPACK_GLOBAL_SUFFIX(ssyconv,SSYCONV) void LAPACK_ssyconv_base( char const* uplo, char const* way, lapack_int const* n, @@ -17149,7 +17163,7 @@ void LAPACK_ssyconv_base( #define LAPACK_ssyconv(...) LAPACK_ssyconv_base(__VA_ARGS__) #endif -#define LAPACK_zsyconv_base LAPACK_GLOBAL(zsyconv,ZSYCONV) +#define LAPACK_zsyconv_base LAPACK_GLOBAL_SUFFIX(zsyconv,ZSYCONV) void LAPACK_zsyconv_base( char const* uplo, char const* way, lapack_int const* n, @@ -17166,7 +17180,7 @@ void LAPACK_zsyconv_base( #define LAPACK_zsyconv(...) LAPACK_zsyconv_base(__VA_ARGS__) #endif -#define LAPACK_csyequb_base LAPACK_GLOBAL(csyequb,CSYEQUB) +#define LAPACK_csyequb_base LAPACK_GLOBAL_SUFFIX(csyequb,CSYEQUB) void LAPACK_csyequb_base( char const* uplo, lapack_int const* n, @@ -17186,7 +17200,7 @@ void LAPACK_csyequb_base( #define LAPACK_csyequb(...) LAPACK_csyequb_base(__VA_ARGS__) #endif -#define LAPACK_dsyequb_base LAPACK_GLOBAL(dsyequb,DSYEQUB) +#define LAPACK_dsyequb_base LAPACK_GLOBAL_SUFFIX(dsyequb,DSYEQUB) void LAPACK_dsyequb_base( char const* uplo, lapack_int const* n, @@ -17206,7 +17220,7 @@ void LAPACK_dsyequb_base( #define LAPACK_dsyequb(...) LAPACK_dsyequb_base(__VA_ARGS__) #endif -#define LAPACK_ssyequb_base LAPACK_GLOBAL(ssyequb,SSYEQUB) +#define LAPACK_ssyequb_base LAPACK_GLOBAL_SUFFIX(ssyequb,SSYEQUB) void LAPACK_ssyequb_base( char const* uplo, lapack_int const* n, @@ -17226,7 +17240,7 @@ void LAPACK_ssyequb_base( #define LAPACK_ssyequb(...) LAPACK_ssyequb_base(__VA_ARGS__) #endif -#define LAPACK_zsyequb_base LAPACK_GLOBAL(zsyequb,ZSYEQUB) +#define LAPACK_zsyequb_base LAPACK_GLOBAL_SUFFIX(zsyequb,ZSYEQUB) void LAPACK_zsyequb_base( char const* uplo, lapack_int const* n, @@ -17246,7 +17260,7 @@ void LAPACK_zsyequb_base( #define LAPACK_zsyequb(...) LAPACK_zsyequb_base(__VA_ARGS__) #endif -#define LAPACK_dsyev_base LAPACK_GLOBAL(dsyev,DSYEV) +#define LAPACK_dsyev_base LAPACK_GLOBAL_SUFFIX(dsyev,DSYEV) void LAPACK_dsyev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17264,7 +17278,7 @@ void LAPACK_dsyev_base( #define LAPACK_dsyev(...) LAPACK_dsyev_base(__VA_ARGS__) #endif -#define LAPACK_ssyev_base LAPACK_GLOBAL(ssyev,SSYEV) +#define LAPACK_ssyev_base LAPACK_GLOBAL_SUFFIX(ssyev,SSYEV) void LAPACK_ssyev_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17282,7 +17296,7 @@ void LAPACK_ssyev_base( #define LAPACK_ssyev(...) LAPACK_ssyev_base(__VA_ARGS__) #endif -#define LAPACK_dsyev_2stage_base LAPACK_GLOBAL(dsyev_2stage,DSYEV_2STAGE) +#define LAPACK_dsyev_2stage_base LAPACK_GLOBAL_SUFFIX(dsyev_2stage,DSYEV_2STAGE) void LAPACK_dsyev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17300,7 +17314,7 @@ void LAPACK_dsyev_2stage_base( #define LAPACK_dsyev_2stage(...) LAPACK_dsyev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssyev_2stage_base LAPACK_GLOBAL(ssyev_2stage,SSYEV_2STAGE) +#define LAPACK_ssyev_2stage_base LAPACK_GLOBAL_SUFFIX(ssyev_2stage,SSYEV_2STAGE) void LAPACK_ssyev_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17318,7 +17332,7 @@ void LAPACK_ssyev_2stage_base( #define LAPACK_ssyev_2stage(...) LAPACK_ssyev_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsyevd_base LAPACK_GLOBAL(dsyevd,DSYEVD) +#define LAPACK_dsyevd_base LAPACK_GLOBAL_SUFFIX(dsyevd,DSYEVD) void LAPACK_dsyevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17337,7 +17351,7 @@ void LAPACK_dsyevd_base( #define LAPACK_dsyevd(...) LAPACK_dsyevd_base(__VA_ARGS__) #endif -#define LAPACK_ssyevd_base LAPACK_GLOBAL(ssyevd,SSYEVD) +#define LAPACK_ssyevd_base LAPACK_GLOBAL_SUFFIX(ssyevd,SSYEVD) void LAPACK_ssyevd_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17356,7 +17370,7 @@ void LAPACK_ssyevd_base( #define LAPACK_ssyevd(...) LAPACK_ssyevd_base(__VA_ARGS__) #endif -#define LAPACK_dsyevd_2stage_base LAPACK_GLOBAL(dsyevd_2stage,DSYEVD_2STAGE) +#define LAPACK_dsyevd_2stage_base LAPACK_GLOBAL_SUFFIX(dsyevd_2stage,DSYEVD_2STAGE) void LAPACK_dsyevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17375,7 +17389,7 @@ void LAPACK_dsyevd_2stage_base( #define LAPACK_dsyevd_2stage(...) LAPACK_dsyevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssyevd_2stage_base LAPACK_GLOBAL(ssyevd_2stage,SSYEVD_2STAGE) +#define LAPACK_ssyevd_2stage_base LAPACK_GLOBAL_SUFFIX(ssyevd_2stage,SSYEVD_2STAGE) void LAPACK_ssyevd_2stage_base( char const* jobz, char const* uplo, lapack_int const* n, @@ -17394,7 +17408,7 @@ void LAPACK_ssyevd_2stage_base( #define LAPACK_ssyevd_2stage(...) LAPACK_ssyevd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsyevr_base LAPACK_GLOBAL(dsyevr,DSYEVR) +#define LAPACK_dsyevr_base LAPACK_GLOBAL_SUFFIX(dsyevr,DSYEVR) void LAPACK_dsyevr_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17417,7 +17431,7 @@ void LAPACK_dsyevr_base( #define LAPACK_dsyevr(...) LAPACK_dsyevr_base(__VA_ARGS__) #endif -#define LAPACK_ssyevr_base LAPACK_GLOBAL(ssyevr,SSYEVR) +#define LAPACK_ssyevr_base LAPACK_GLOBAL_SUFFIX(ssyevr,SSYEVR) void LAPACK_ssyevr_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17440,7 +17454,7 @@ void LAPACK_ssyevr_base( #define LAPACK_ssyevr(...) LAPACK_ssyevr_base(__VA_ARGS__) #endif -#define LAPACK_dsyevr_2stage_base LAPACK_GLOBAL(dsyevr_2stage,DSYEVR_2STAGE) +#define LAPACK_dsyevr_2stage_base LAPACK_GLOBAL_SUFFIX(dsyevr_2stage,DSYEVR_2STAGE) void LAPACK_dsyevr_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17463,7 +17477,7 @@ void LAPACK_dsyevr_2stage_base( #define LAPACK_dsyevr_2stage(...) LAPACK_dsyevr_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssyevr_2stage_base LAPACK_GLOBAL(ssyevr_2stage,SSYEVR_2STAGE) +#define LAPACK_ssyevr_2stage_base LAPACK_GLOBAL_SUFFIX(ssyevr_2stage,SSYEVR_2STAGE) void LAPACK_ssyevr_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17486,7 +17500,7 @@ void LAPACK_ssyevr_2stage_base( #define LAPACK_ssyevr_2stage(...) LAPACK_ssyevr_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsyevx_base LAPACK_GLOBAL(dsyevx,DSYEVX) +#define LAPACK_dsyevx_base LAPACK_GLOBAL_SUFFIX(dsyevx,DSYEVX) void LAPACK_dsyevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17509,7 +17523,7 @@ void LAPACK_dsyevx_base( #define LAPACK_dsyevx(...) LAPACK_dsyevx_base(__VA_ARGS__) #endif -#define LAPACK_ssyevx_base LAPACK_GLOBAL(ssyevx,SSYEVX) +#define LAPACK_ssyevx_base LAPACK_GLOBAL_SUFFIX(ssyevx,SSYEVX) void LAPACK_ssyevx_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17532,7 +17546,7 @@ void LAPACK_ssyevx_base( #define LAPACK_ssyevx(...) LAPACK_ssyevx_base(__VA_ARGS__) #endif -#define LAPACK_dsyevx_2stage_base LAPACK_GLOBAL(dsyevx_2stage,DSYEVX_2STAGE) +#define LAPACK_dsyevx_2stage_base LAPACK_GLOBAL_SUFFIX(dsyevx_2stage,DSYEVX_2STAGE) void LAPACK_dsyevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17555,7 +17569,7 @@ void LAPACK_dsyevx_2stage_base( #define LAPACK_dsyevx_2stage(...) LAPACK_dsyevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssyevx_2stage_base LAPACK_GLOBAL(ssyevx_2stage,SSYEVX_2STAGE) +#define LAPACK_ssyevx_2stage_base LAPACK_GLOBAL_SUFFIX(ssyevx_2stage,SSYEVX_2STAGE) void LAPACK_ssyevx_2stage_base( char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17578,7 +17592,7 @@ void LAPACK_ssyevx_2stage_base( #define LAPACK_ssyevx_2stage(...) LAPACK_ssyevx_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsygst_base LAPACK_GLOBAL(dsygst,DSYGST) +#define LAPACK_dsygst_base LAPACK_GLOBAL_SUFFIX(dsygst,DSYGST) void LAPACK_dsygst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -17595,7 +17609,7 @@ void LAPACK_dsygst_base( #define LAPACK_dsygst(...) LAPACK_dsygst_base(__VA_ARGS__) #endif -#define LAPACK_ssygst_base LAPACK_GLOBAL(ssygst,SSYGST) +#define LAPACK_ssygst_base LAPACK_GLOBAL_SUFFIX(ssygst,SSYGST) void LAPACK_ssygst_base( lapack_int const* itype, char const* uplo, lapack_int const* n, @@ -17612,7 +17626,7 @@ void LAPACK_ssygst_base( #define LAPACK_ssygst(...) LAPACK_ssygst_base(__VA_ARGS__) #endif -#define LAPACK_dsygv_base LAPACK_GLOBAL(dsygv,DSYGV) +#define LAPACK_dsygv_base LAPACK_GLOBAL_SUFFIX(dsygv,DSYGV) void LAPACK_dsygv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17631,7 +17645,7 @@ void LAPACK_dsygv_base( #define LAPACK_dsygv(...) LAPACK_dsygv_base(__VA_ARGS__) #endif -#define LAPACK_ssygv_base LAPACK_GLOBAL(ssygv,SSYGV) +#define LAPACK_ssygv_base LAPACK_GLOBAL_SUFFIX(ssygv,SSYGV) void LAPACK_ssygv_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17650,7 +17664,7 @@ void LAPACK_ssygv_base( #define LAPACK_ssygv(...) LAPACK_ssygv_base(__VA_ARGS__) #endif -#define LAPACK_dsygv_2stage_base LAPACK_GLOBAL(dsygv_2stage,DSYGV_2STAGE) +#define LAPACK_dsygv_2stage_base LAPACK_GLOBAL_SUFFIX(dsygv_2stage,DSYGV_2STAGE) void LAPACK_dsygv_2stage_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17669,7 +17683,7 @@ void LAPACK_dsygv_2stage_base( #define LAPACK_dsygv_2stage(...) LAPACK_dsygv_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssygv_2stage_base LAPACK_GLOBAL(ssygv_2stage,SSYGV_2STAGE) +#define LAPACK_ssygv_2stage_base LAPACK_GLOBAL_SUFFIX(ssygv_2stage,SSYGV_2STAGE) void LAPACK_ssygv_2stage_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17688,7 +17702,7 @@ void LAPACK_ssygv_2stage_base( #define LAPACK_ssygv_2stage(...) LAPACK_ssygv_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsygvd_base LAPACK_GLOBAL(dsygvd,DSYGVD) +#define LAPACK_dsygvd_base LAPACK_GLOBAL_SUFFIX(dsygvd,DSYGVD) void LAPACK_dsygvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17708,7 +17722,7 @@ void LAPACK_dsygvd_base( #define LAPACK_dsygvd(...) LAPACK_dsygvd_base(__VA_ARGS__) #endif -#define LAPACK_ssygvd_base LAPACK_GLOBAL(ssygvd,SSYGVD) +#define LAPACK_ssygvd_base LAPACK_GLOBAL_SUFFIX(ssygvd,SSYGVD) void LAPACK_ssygvd_base( lapack_int const* itype, char const* jobz, char const* uplo, lapack_int const* n, @@ -17728,7 +17742,7 @@ void LAPACK_ssygvd_base( #define LAPACK_ssygvd(...) LAPACK_ssygvd_base(__VA_ARGS__) #endif -#define LAPACK_dsygvx_base LAPACK_GLOBAL(dsygvx,DSYGVX) +#define LAPACK_dsygvx_base LAPACK_GLOBAL_SUFFIX(dsygvx,DSYGVX) void LAPACK_dsygvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17752,7 +17766,7 @@ void LAPACK_dsygvx_base( #define LAPACK_dsygvx(...) LAPACK_dsygvx_base(__VA_ARGS__) #endif -#define LAPACK_ssygvx_base LAPACK_GLOBAL(ssygvx,SSYGVX) +#define LAPACK_ssygvx_base LAPACK_GLOBAL_SUFFIX(ssygvx,SSYGVX) void LAPACK_ssygvx_base( lapack_int const* itype, char const* jobz, char const* range, char const* uplo, lapack_int const* n, @@ -17776,7 +17790,7 @@ void LAPACK_ssygvx_base( #define LAPACK_ssygvx(...) LAPACK_ssygvx_base(__VA_ARGS__) #endif -#define LAPACK_csyr_base LAPACK_GLOBAL(csyr,CSYR) +#define LAPACK_csyr_base LAPACK_GLOBAL_SUFFIX(csyr,CSYR) void LAPACK_csyr_base( char const* uplo, lapack_int const* n, @@ -17793,7 +17807,7 @@ void LAPACK_csyr_base( #define LAPACK_csyr(...) LAPACK_csyr_base(__VA_ARGS__) #endif -#define LAPACK_zsyr_base LAPACK_GLOBAL(zsyr,ZSYR) +#define LAPACK_zsyr_base LAPACK_GLOBAL_SUFFIX(zsyr,ZSYR) void LAPACK_zsyr_base( char const* uplo, lapack_int const* n, @@ -17810,7 +17824,7 @@ void LAPACK_zsyr_base( #define LAPACK_zsyr(...) LAPACK_zsyr_base(__VA_ARGS__) #endif -#define LAPACK_csyrfs_base LAPACK_GLOBAL(csyrfs,CSYRFS) +#define LAPACK_csyrfs_base LAPACK_GLOBAL_SUFFIX(csyrfs,CSYRFS) void LAPACK_csyrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -17833,7 +17847,7 @@ void LAPACK_csyrfs_base( #define LAPACK_csyrfs(...) LAPACK_csyrfs_base(__VA_ARGS__) #endif -#define LAPACK_dsyrfs_base LAPACK_GLOBAL(dsyrfs,DSYRFS) +#define LAPACK_dsyrfs_base LAPACK_GLOBAL_SUFFIX(dsyrfs,DSYRFS) void LAPACK_dsyrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -17856,7 +17870,7 @@ void LAPACK_dsyrfs_base( #define LAPACK_dsyrfs(...) LAPACK_dsyrfs_base(__VA_ARGS__) #endif -#define LAPACK_ssyrfs_base LAPACK_GLOBAL(ssyrfs,SSYRFS) +#define LAPACK_ssyrfs_base LAPACK_GLOBAL_SUFFIX(ssyrfs,SSYRFS) void LAPACK_ssyrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -17879,7 +17893,7 @@ void LAPACK_ssyrfs_base( #define LAPACK_ssyrfs(...) LAPACK_ssyrfs_base(__VA_ARGS__) #endif -#define LAPACK_zsyrfs_base LAPACK_GLOBAL(zsyrfs,ZSYRFS) +#define LAPACK_zsyrfs_base LAPACK_GLOBAL_SUFFIX(zsyrfs,ZSYRFS) void LAPACK_zsyrfs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -17902,7 +17916,7 @@ void LAPACK_zsyrfs_base( #define LAPACK_zsyrfs(...) LAPACK_zsyrfs_base(__VA_ARGS__) #endif -#define LAPACK_csyrfsx_base LAPACK_GLOBAL(csyrfsx,CSYRFSX) +#define LAPACK_csyrfsx_base LAPACK_GLOBAL_SUFFIX(csyrfsx,CSYRFSX) void LAPACK_csyrfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -17929,7 +17943,7 @@ void LAPACK_csyrfsx_base( #define LAPACK_csyrfsx(...) LAPACK_csyrfsx_base(__VA_ARGS__) #endif -#define LAPACK_dsyrfsx_base LAPACK_GLOBAL(dsyrfsx,DSYRFSX) +#define LAPACK_dsyrfsx_base LAPACK_GLOBAL_SUFFIX(dsyrfsx,DSYRFSX) void LAPACK_dsyrfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -17956,7 +17970,7 @@ void LAPACK_dsyrfsx_base( #define LAPACK_dsyrfsx(...) LAPACK_dsyrfsx_base(__VA_ARGS__) #endif -#define LAPACK_ssyrfsx_base LAPACK_GLOBAL(ssyrfsx,SSYRFSX) +#define LAPACK_ssyrfsx_base LAPACK_GLOBAL_SUFFIX(ssyrfsx,SSYRFSX) void LAPACK_ssyrfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -17983,7 +17997,7 @@ void LAPACK_ssyrfsx_base( #define LAPACK_ssyrfsx(...) LAPACK_ssyrfsx_base(__VA_ARGS__) #endif -#define LAPACK_zsyrfsx_base LAPACK_GLOBAL(zsyrfsx,ZSYRFSX) +#define LAPACK_zsyrfsx_base LAPACK_GLOBAL_SUFFIX(zsyrfsx,ZSYRFSX) void LAPACK_zsyrfsx_base( char const* uplo, char const* equed, lapack_int const* n, lapack_int const* nrhs, @@ -18010,7 +18024,7 @@ void LAPACK_zsyrfsx_base( #define LAPACK_zsyrfsx(...) LAPACK_zsyrfsx_base(__VA_ARGS__) #endif -#define LAPACK_csysv_base LAPACK_GLOBAL(csysv,CSYSV) +#define LAPACK_csysv_base LAPACK_GLOBAL_SUFFIX(csysv,CSYSV) void LAPACK_csysv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18028,7 +18042,7 @@ void LAPACK_csysv_base( #define LAPACK_csysv(...) LAPACK_csysv_base(__VA_ARGS__) #endif -#define LAPACK_dsysv_base LAPACK_GLOBAL(dsysv,DSYSV) +#define LAPACK_dsysv_base LAPACK_GLOBAL_SUFFIX(dsysv,DSYSV) void LAPACK_dsysv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18046,7 +18060,7 @@ void LAPACK_dsysv_base( #define LAPACK_dsysv(...) LAPACK_dsysv_base(__VA_ARGS__) #endif -#define LAPACK_ssysv_base LAPACK_GLOBAL(ssysv,SSYSV) +#define LAPACK_ssysv_base LAPACK_GLOBAL_SUFFIX(ssysv,SSYSV) void LAPACK_ssysv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18064,7 +18078,7 @@ void LAPACK_ssysv_base( #define LAPACK_ssysv(...) LAPACK_ssysv_base(__VA_ARGS__) #endif -#define LAPACK_zsysv_base LAPACK_GLOBAL(zsysv,ZSYSV) +#define LAPACK_zsysv_base LAPACK_GLOBAL_SUFFIX(zsysv,ZSYSV) void LAPACK_zsysv_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18082,7 +18096,7 @@ void LAPACK_zsysv_base( #define LAPACK_zsysv(...) LAPACK_zsysv_base(__VA_ARGS__) #endif -#define LAPACK_csysv_aa_base LAPACK_GLOBAL(csysv_aa,CSYSV_AA) +#define LAPACK_csysv_aa_base LAPACK_GLOBAL_SUFFIX(csysv_aa,CSYSV_AA) void LAPACK_csysv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18100,7 +18114,7 @@ void LAPACK_csysv_aa_base( #define LAPACK_csysv_aa(...) LAPACK_csysv_aa_base(__VA_ARGS__) #endif -#define LAPACK_dsysv_aa_base LAPACK_GLOBAL(dsysv_aa,DSYSV_AA) +#define LAPACK_dsysv_aa_base LAPACK_GLOBAL_SUFFIX(dsysv_aa,DSYSV_AA) void LAPACK_dsysv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18118,7 +18132,7 @@ void LAPACK_dsysv_aa_base( #define LAPACK_dsysv_aa(...) LAPACK_dsysv_aa_base(__VA_ARGS__) #endif -#define LAPACK_ssysv_aa_base LAPACK_GLOBAL(ssysv_aa,SSYSV_AA) +#define LAPACK_ssysv_aa_base LAPACK_GLOBAL_SUFFIX(ssysv_aa,SSYSV_AA) void LAPACK_ssysv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18136,7 +18150,7 @@ void LAPACK_ssysv_aa_base( #define LAPACK_ssysv_aa(...) LAPACK_ssysv_aa_base(__VA_ARGS__) #endif -#define LAPACK_zsysv_aa_base LAPACK_GLOBAL(zsysv_aa,ZSYSV_AA) +#define LAPACK_zsysv_aa_base LAPACK_GLOBAL_SUFFIX(zsysv_aa,ZSYSV_AA) void LAPACK_zsysv_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18154,7 +18168,7 @@ void LAPACK_zsysv_aa_base( #define LAPACK_zsysv_aa(...) LAPACK_zsysv_aa_base(__VA_ARGS__) #endif -#define LAPACK_csysv_aa_2stage_base LAPACK_GLOBAL(csysv_aa_2stage,CSYSV_AA_2STAGE) +#define LAPACK_csysv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(csysv_aa_2stage,CSYSV_AA_2STAGE) void LAPACK_csysv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18173,7 +18187,7 @@ void LAPACK_csysv_aa_2stage_base( #define LAPACK_csysv_aa_2stage(...) LAPACK_csysv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsysv_aa_2stage_base LAPACK_GLOBAL(dsysv_aa_2stage,DSYSV_AA_2STAGE) +#define LAPACK_dsysv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(dsysv_aa_2stage,DSYSV_AA_2STAGE) void LAPACK_dsysv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18192,7 +18206,7 @@ void LAPACK_dsysv_aa_2stage_base( #define LAPACK_dsysv_aa_2stage(...) LAPACK_dsysv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssysv_aa_2stage_base LAPACK_GLOBAL(ssysv_aa_2stage,SSYSV_AA_2STAGE) +#define LAPACK_ssysv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(ssysv_aa_2stage,SSYSV_AA_2STAGE) void LAPACK_ssysv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18211,7 +18225,7 @@ void LAPACK_ssysv_aa_2stage_base( #define LAPACK_ssysv_aa_2stage(...) LAPACK_ssysv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zsysv_aa_2stage_base LAPACK_GLOBAL(zsysv_aa_2stage,ZSYSV_AA_2STAGE) +#define LAPACK_zsysv_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zsysv_aa_2stage,ZSYSV_AA_2STAGE) void LAPACK_zsysv_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18230,7 +18244,7 @@ void LAPACK_zsysv_aa_2stage_base( #define LAPACK_zsysv_aa_2stage(...) LAPACK_zsysv_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_csysv_rk_base LAPACK_GLOBAL(csysv_rk,CSYSV_RK) +#define LAPACK_csysv_rk_base LAPACK_GLOBAL_SUFFIX(csysv_rk,CSYSV_RK) void LAPACK_csysv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18249,7 +18263,7 @@ void LAPACK_csysv_rk_base( #define LAPACK_csysv_rk(...) LAPACK_csysv_rk_base(__VA_ARGS__) #endif -#define LAPACK_dsysv_rk_base LAPACK_GLOBAL(dsysv_rk,DSYSV_RK) +#define LAPACK_dsysv_rk_base LAPACK_GLOBAL_SUFFIX(dsysv_rk,DSYSV_RK) void LAPACK_dsysv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18268,7 +18282,7 @@ void LAPACK_dsysv_rk_base( #define LAPACK_dsysv_rk(...) LAPACK_dsysv_rk_base(__VA_ARGS__) #endif -#define LAPACK_ssysv_rk_base LAPACK_GLOBAL(ssysv_rk,SSYSV_RK) +#define LAPACK_ssysv_rk_base LAPACK_GLOBAL_SUFFIX(ssysv_rk,SSYSV_RK) void LAPACK_ssysv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18287,7 +18301,7 @@ void LAPACK_ssysv_rk_base( #define LAPACK_ssysv_rk(...) LAPACK_ssysv_rk_base(__VA_ARGS__) #endif -#define LAPACK_zsysv_rk_base LAPACK_GLOBAL(zsysv_rk,ZSYSV_RK) +#define LAPACK_zsysv_rk_base LAPACK_GLOBAL_SUFFIX(zsysv_rk,ZSYSV_RK) void LAPACK_zsysv_rk_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18306,7 +18320,7 @@ void LAPACK_zsysv_rk_base( #define LAPACK_zsysv_rk(...) LAPACK_zsysv_rk_base(__VA_ARGS__) #endif -#define LAPACK_csysv_rook_base LAPACK_GLOBAL(csysv_rook,CSYSV_ROOK) +#define LAPACK_csysv_rook_base LAPACK_GLOBAL_SUFFIX(csysv_rook,CSYSV_ROOK) void LAPACK_csysv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18324,7 +18338,7 @@ void LAPACK_csysv_rook_base( #define LAPACK_csysv_rook(...) LAPACK_csysv_rook_base(__VA_ARGS__) #endif -#define LAPACK_dsysv_rook_base LAPACK_GLOBAL(dsysv_rook,DSYSV_ROOK) +#define LAPACK_dsysv_rook_base LAPACK_GLOBAL_SUFFIX(dsysv_rook,DSYSV_ROOK) void LAPACK_dsysv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18342,7 +18356,7 @@ void LAPACK_dsysv_rook_base( #define LAPACK_dsysv_rook(...) LAPACK_dsysv_rook_base(__VA_ARGS__) #endif -#define LAPACK_ssysv_rook_base LAPACK_GLOBAL(ssysv_rook,SSYSV_ROOK) +#define LAPACK_ssysv_rook_base LAPACK_GLOBAL_SUFFIX(ssysv_rook,SSYSV_ROOK) void LAPACK_ssysv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18360,7 +18374,7 @@ void LAPACK_ssysv_rook_base( #define LAPACK_ssysv_rook(...) LAPACK_ssysv_rook_base(__VA_ARGS__) #endif -#define LAPACK_zsysv_rook_base LAPACK_GLOBAL(zsysv_rook,ZSYSV_ROOK) +#define LAPACK_zsysv_rook_base LAPACK_GLOBAL_SUFFIX(zsysv_rook,ZSYSV_ROOK) void LAPACK_zsysv_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18378,7 +18392,7 @@ void LAPACK_zsysv_rook_base( #define LAPACK_zsysv_rook(...) LAPACK_zsysv_rook_base(__VA_ARGS__) #endif -#define LAPACK_csysvx_base LAPACK_GLOBAL(csysvx,CSYSVX) +#define LAPACK_csysvx_base LAPACK_GLOBAL_SUFFIX(csysvx,CSYSVX) void LAPACK_csysvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18402,7 +18416,7 @@ void LAPACK_csysvx_base( #define LAPACK_csysvx(...) LAPACK_csysvx_base(__VA_ARGS__) #endif -#define LAPACK_dsysvx_base LAPACK_GLOBAL(dsysvx,DSYSVX) +#define LAPACK_dsysvx_base LAPACK_GLOBAL_SUFFIX(dsysvx,DSYSVX) void LAPACK_dsysvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18426,7 +18440,7 @@ void LAPACK_dsysvx_base( #define LAPACK_dsysvx(...) LAPACK_dsysvx_base(__VA_ARGS__) #endif -#define LAPACK_ssysvx_base LAPACK_GLOBAL(ssysvx,SSYSVX) +#define LAPACK_ssysvx_base LAPACK_GLOBAL_SUFFIX(ssysvx,SSYSVX) void LAPACK_ssysvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18450,7 +18464,7 @@ void LAPACK_ssysvx_base( #define LAPACK_ssysvx(...) LAPACK_ssysvx_base(__VA_ARGS__) #endif -#define LAPACK_zsysvx_base LAPACK_GLOBAL(zsysvx,ZSYSVX) +#define LAPACK_zsysvx_base LAPACK_GLOBAL_SUFFIX(zsysvx,ZSYSVX) void LAPACK_zsysvx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18474,7 +18488,7 @@ void LAPACK_zsysvx_base( #define LAPACK_zsysvx(...) LAPACK_zsysvx_base(__VA_ARGS__) #endif -#define LAPACK_csysvxx_base LAPACK_GLOBAL(csysvxx,CSYSVXX) +#define LAPACK_csysvxx_base LAPACK_GLOBAL_SUFFIX(csysvxx,CSYSVXX) void LAPACK_csysvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18503,7 +18517,7 @@ void LAPACK_csysvxx_base( #define LAPACK_csysvxx(...) LAPACK_csysvxx_base(__VA_ARGS__) #endif -#define LAPACK_dsysvxx_base LAPACK_GLOBAL(dsysvxx,DSYSVXX) +#define LAPACK_dsysvxx_base LAPACK_GLOBAL_SUFFIX(dsysvxx,DSYSVXX) void LAPACK_dsysvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18532,7 +18546,7 @@ void LAPACK_dsysvxx_base( #define LAPACK_dsysvxx(...) LAPACK_dsysvxx_base(__VA_ARGS__) #endif -#define LAPACK_ssysvxx_base LAPACK_GLOBAL(ssysvxx,SSYSVXX) +#define LAPACK_ssysvxx_base LAPACK_GLOBAL_SUFFIX(ssysvxx,SSYSVXX) void LAPACK_ssysvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18561,7 +18575,7 @@ void LAPACK_ssysvxx_base( #define LAPACK_ssysvxx(...) LAPACK_ssysvxx_base(__VA_ARGS__) #endif -#define LAPACK_zsysvxx_base LAPACK_GLOBAL(zsysvxx,ZSYSVXX) +#define LAPACK_zsysvxx_base LAPACK_GLOBAL_SUFFIX(zsysvxx,ZSYSVXX) void LAPACK_zsysvxx_base( char const* fact, char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -18590,7 +18604,7 @@ void LAPACK_zsysvxx_base( #define LAPACK_zsysvxx(...) LAPACK_zsysvxx_base(__VA_ARGS__) #endif -#define LAPACK_csyswapr_base LAPACK_GLOBAL(csyswapr,CSYSWAPR) +#define LAPACK_csyswapr_base LAPACK_GLOBAL_SUFFIX(csyswapr,CSYSWAPR) void LAPACK_csyswapr_base( char const* uplo, lapack_int const* n, @@ -18605,7 +18619,7 @@ void LAPACK_csyswapr_base( #define LAPACK_csyswapr(...) LAPACK_csyswapr_base(__VA_ARGS__) #endif -#define LAPACK_dsyswapr_base LAPACK_GLOBAL(dsyswapr,DSYSWAPR) +#define LAPACK_dsyswapr_base LAPACK_GLOBAL_SUFFIX(dsyswapr,DSYSWAPR) void LAPACK_dsyswapr_base( char const* uplo, lapack_int const* n, @@ -18620,7 +18634,7 @@ void LAPACK_dsyswapr_base( #define LAPACK_dsyswapr(...) LAPACK_dsyswapr_base(__VA_ARGS__) #endif -#define LAPACK_ssyswapr_base LAPACK_GLOBAL(ssyswapr,SSYSWAPR) +#define LAPACK_ssyswapr_base LAPACK_GLOBAL_SUFFIX(ssyswapr,SSYSWAPR) void LAPACK_ssyswapr_base( char const* uplo, lapack_int const* n, @@ -18635,7 +18649,7 @@ void LAPACK_ssyswapr_base( #define LAPACK_ssyswapr(...) LAPACK_ssyswapr_base(__VA_ARGS__) #endif -#define LAPACK_zsyswapr_base LAPACK_GLOBAL(zsyswapr,ZSYSWAPR) +#define LAPACK_zsyswapr_base LAPACK_GLOBAL_SUFFIX(zsyswapr,ZSYSWAPR) void LAPACK_zsyswapr_base( char const* uplo, lapack_int const* n, @@ -18650,7 +18664,7 @@ void LAPACK_zsyswapr_base( #define LAPACK_zsyswapr(...) LAPACK_zsyswapr_base(__VA_ARGS__) #endif -#define LAPACK_dsytrd_base LAPACK_GLOBAL(dsytrd,DSYTRD) +#define LAPACK_dsytrd_base LAPACK_GLOBAL_SUFFIX(dsytrd,DSYTRD) void LAPACK_dsytrd_base( char const* uplo, lapack_int const* n, @@ -18670,7 +18684,7 @@ void LAPACK_dsytrd_base( #define LAPACK_dsytrd(...) LAPACK_dsytrd_base(__VA_ARGS__) #endif -#define LAPACK_ssytrd_base LAPACK_GLOBAL(ssytrd,SSYTRD) +#define LAPACK_ssytrd_base LAPACK_GLOBAL_SUFFIX(ssytrd,SSYTRD) void LAPACK_ssytrd_base( char const* uplo, lapack_int const* n, @@ -18690,7 +18704,7 @@ void LAPACK_ssytrd_base( #define LAPACK_ssytrd(...) LAPACK_ssytrd_base(__VA_ARGS__) #endif -#define LAPACK_dsytrd_2stage_base LAPACK_GLOBAL(dsytrd_2stage,DSYTRD_2STAGE) +#define LAPACK_dsytrd_2stage_base LAPACK_GLOBAL_SUFFIX(dsytrd_2stage,DSYTRD_2STAGE) void LAPACK_dsytrd_2stage_base( char const* vect, char const* uplo, lapack_int const* n, @@ -18711,7 +18725,7 @@ void LAPACK_dsytrd_2stage_base( #define LAPACK_dsytrd_2stage(...) LAPACK_dsytrd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssytrd_2stage_base LAPACK_GLOBAL(ssytrd_2stage,SSYTRD_2STAGE) +#define LAPACK_ssytrd_2stage_base LAPACK_GLOBAL_SUFFIX(ssytrd_2stage,SSYTRD_2STAGE) void LAPACK_ssytrd_2stage_base( char const* vect, char const* uplo, lapack_int const* n, @@ -18732,7 +18746,7 @@ void LAPACK_ssytrd_2stage_base( #define LAPACK_ssytrd_2stage(...) LAPACK_ssytrd_2stage_base(__VA_ARGS__) #endif -#define LAPACK_csytrf_base LAPACK_GLOBAL(csytrf,CSYTRF) +#define LAPACK_csytrf_base LAPACK_GLOBAL_SUFFIX(csytrf,CSYTRF) void LAPACK_csytrf_base( char const* uplo, lapack_int const* n, @@ -18749,7 +18763,7 @@ void LAPACK_csytrf_base( #define LAPACK_csytrf(...) LAPACK_csytrf_base(__VA_ARGS__) #endif -#define LAPACK_dsytrf_base LAPACK_GLOBAL(dsytrf,DSYTRF) +#define LAPACK_dsytrf_base LAPACK_GLOBAL_SUFFIX(dsytrf,DSYTRF) void LAPACK_dsytrf_base( char const* uplo, lapack_int const* n, @@ -18766,7 +18780,7 @@ void LAPACK_dsytrf_base( #define LAPACK_dsytrf(...) LAPACK_dsytrf_base(__VA_ARGS__) #endif -#define LAPACK_ssytrf_base LAPACK_GLOBAL(ssytrf,SSYTRF) +#define LAPACK_ssytrf_base LAPACK_GLOBAL_SUFFIX(ssytrf,SSYTRF) void LAPACK_ssytrf_base( char const* uplo, lapack_int const* n, @@ -18783,7 +18797,7 @@ void LAPACK_ssytrf_base( #define LAPACK_ssytrf(...) LAPACK_ssytrf_base(__VA_ARGS__) #endif -#define LAPACK_zsytrf_base LAPACK_GLOBAL(zsytrf,ZSYTRF) +#define LAPACK_zsytrf_base LAPACK_GLOBAL_SUFFIX(zsytrf,ZSYTRF) void LAPACK_zsytrf_base( char const* uplo, lapack_int const* n, @@ -18800,7 +18814,7 @@ void LAPACK_zsytrf_base( #define LAPACK_zsytrf(...) LAPACK_zsytrf_base(__VA_ARGS__) #endif -#define LAPACK_csytrf_aa_base LAPACK_GLOBAL(csytrf_aa,CSYTRF_AA) +#define LAPACK_csytrf_aa_base LAPACK_GLOBAL_SUFFIX(csytrf_aa,CSYTRF_AA) void LAPACK_csytrf_aa_base( char const* uplo, lapack_int const* n, @@ -18817,7 +18831,7 @@ void LAPACK_csytrf_aa_base( #define LAPACK_csytrf_aa(...) LAPACK_csytrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_dsytrf_aa_base LAPACK_GLOBAL(dsytrf_aa,DSYTRF_AA) +#define LAPACK_dsytrf_aa_base LAPACK_GLOBAL_SUFFIX(dsytrf_aa,DSYTRF_AA) void LAPACK_dsytrf_aa_base( char const* uplo, lapack_int const* n, @@ -18834,7 +18848,7 @@ void LAPACK_dsytrf_aa_base( #define LAPACK_dsytrf_aa(...) LAPACK_dsytrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_ssytrf_aa_base LAPACK_GLOBAL(ssytrf_aa,SSYTRF_AA) +#define LAPACK_ssytrf_aa_base LAPACK_GLOBAL_SUFFIX(ssytrf_aa,SSYTRF_AA) void LAPACK_ssytrf_aa_base( char const* uplo, lapack_int const* n, @@ -18851,7 +18865,7 @@ void LAPACK_ssytrf_aa_base( #define LAPACK_ssytrf_aa(...) LAPACK_ssytrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_zsytrf_aa_base LAPACK_GLOBAL(zsytrf_aa,ZSYTRF_AA) +#define LAPACK_zsytrf_aa_base LAPACK_GLOBAL_SUFFIX(zsytrf_aa,ZSYTRF_AA) void LAPACK_zsytrf_aa_base( char const* uplo, lapack_int const* n, @@ -18868,7 +18882,7 @@ void LAPACK_zsytrf_aa_base( #define LAPACK_zsytrf_aa(...) LAPACK_zsytrf_aa_base(__VA_ARGS__) #endif -#define LAPACK_csytrf_aa_2stage_base LAPACK_GLOBAL(csytrf_aa_2stage,CSYTRF_AA_2STAGE) +#define LAPACK_csytrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(csytrf_aa_2stage,CSYTRF_AA_2STAGE) void LAPACK_csytrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -18886,7 +18900,7 @@ void LAPACK_csytrf_aa_2stage_base( #define LAPACK_csytrf_aa_2stage(...) LAPACK_csytrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsytrf_aa_2stage_base LAPACK_GLOBAL(dsytrf_aa_2stage,DSYTRF_AA_2STAGE) +#define LAPACK_dsytrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(dsytrf_aa_2stage,DSYTRF_AA_2STAGE) void LAPACK_dsytrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -18904,7 +18918,7 @@ void LAPACK_dsytrf_aa_2stage_base( #define LAPACK_dsytrf_aa_2stage(...) LAPACK_dsytrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssytrf_aa_2stage_base LAPACK_GLOBAL(ssytrf_aa_2stage,SSYTRF_AA_2STAGE) +#define LAPACK_ssytrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(ssytrf_aa_2stage,SSYTRF_AA_2STAGE) void LAPACK_ssytrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -18922,7 +18936,7 @@ void LAPACK_ssytrf_aa_2stage_base( #define LAPACK_ssytrf_aa_2stage(...) LAPACK_ssytrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zsytrf_aa_2stage_base LAPACK_GLOBAL(zsytrf_aa_2stage,ZSYTRF_AA_2STAGE) +#define LAPACK_zsytrf_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zsytrf_aa_2stage,ZSYTRF_AA_2STAGE) void LAPACK_zsytrf_aa_2stage_base( char const* uplo, lapack_int const* n, @@ -18940,7 +18954,7 @@ void LAPACK_zsytrf_aa_2stage_base( #define LAPACK_zsytrf_aa_2stage(...) LAPACK_zsytrf_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_csytrf_rk_base LAPACK_GLOBAL(csytrf_rk,CSYTRF_RK) +#define LAPACK_csytrf_rk_base LAPACK_GLOBAL_SUFFIX(csytrf_rk,CSYTRF_RK) void LAPACK_csytrf_rk_base( char const* uplo, lapack_int const* n, @@ -18958,7 +18972,7 @@ void LAPACK_csytrf_rk_base( #define LAPACK_csytrf_rk(...) LAPACK_csytrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_dsytrf_rk_base LAPACK_GLOBAL(dsytrf_rk,DSYTRF_RK) +#define LAPACK_dsytrf_rk_base LAPACK_GLOBAL_SUFFIX(dsytrf_rk,DSYTRF_RK) void LAPACK_dsytrf_rk_base( char const* uplo, lapack_int const* n, @@ -18976,7 +18990,7 @@ void LAPACK_dsytrf_rk_base( #define LAPACK_dsytrf_rk(...) LAPACK_dsytrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_ssytrf_rk_base LAPACK_GLOBAL(ssytrf_rk,SSYTRF_RK) +#define LAPACK_ssytrf_rk_base LAPACK_GLOBAL_SUFFIX(ssytrf_rk,SSYTRF_RK) void LAPACK_ssytrf_rk_base( char const* uplo, lapack_int const* n, @@ -18994,7 +19008,7 @@ void LAPACK_ssytrf_rk_base( #define LAPACK_ssytrf_rk(...) LAPACK_ssytrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_zsytrf_rk_base LAPACK_GLOBAL(zsytrf_rk,ZSYTRF_RK) +#define LAPACK_zsytrf_rk_base LAPACK_GLOBAL_SUFFIX(zsytrf_rk,ZSYTRF_RK) void LAPACK_zsytrf_rk_base( char const* uplo, lapack_int const* n, @@ -19012,7 +19026,7 @@ void LAPACK_zsytrf_rk_base( #define LAPACK_zsytrf_rk(...) LAPACK_zsytrf_rk_base(__VA_ARGS__) #endif -#define LAPACK_csytrf_rook_base LAPACK_GLOBAL(csytrf_rook,CSYTRF_ROOK) +#define LAPACK_csytrf_rook_base LAPACK_GLOBAL_SUFFIX(csytrf_rook,CSYTRF_ROOK) void LAPACK_csytrf_rook_base( char const* uplo, lapack_int const* n, @@ -19029,7 +19043,7 @@ void LAPACK_csytrf_rook_base( #define LAPACK_csytrf_rook(...) LAPACK_csytrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_dsytrf_rook_base LAPACK_GLOBAL(dsytrf_rook,DSYTRF_ROOK) +#define LAPACK_dsytrf_rook_base LAPACK_GLOBAL_SUFFIX(dsytrf_rook,DSYTRF_ROOK) void LAPACK_dsytrf_rook_base( char const* uplo, lapack_int const* n, @@ -19046,7 +19060,7 @@ void LAPACK_dsytrf_rook_base( #define LAPACK_dsytrf_rook(...) LAPACK_dsytrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_ssytrf_rook_base LAPACK_GLOBAL(ssytrf_rook,SSYTRF_ROOK) +#define LAPACK_ssytrf_rook_base LAPACK_GLOBAL_SUFFIX(ssytrf_rook,SSYTRF_ROOK) void LAPACK_ssytrf_rook_base( char const* uplo, lapack_int const* n, @@ -19063,7 +19077,7 @@ void LAPACK_ssytrf_rook_base( #define LAPACK_ssytrf_rook(...) LAPACK_ssytrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_zsytrf_rook_base LAPACK_GLOBAL(zsytrf_rook,ZSYTRF_ROOK) +#define LAPACK_zsytrf_rook_base LAPACK_GLOBAL_SUFFIX(zsytrf_rook,ZSYTRF_ROOK) void LAPACK_zsytrf_rook_base( char const* uplo, lapack_int const* n, @@ -19080,7 +19094,7 @@ void LAPACK_zsytrf_rook_base( #define LAPACK_zsytrf_rook(...) LAPACK_zsytrf_rook_base(__VA_ARGS__) #endif -#define LAPACK_csytri_base LAPACK_GLOBAL(csytri,CSYTRI) +#define LAPACK_csytri_base LAPACK_GLOBAL_SUFFIX(csytri,CSYTRI) void LAPACK_csytri_base( char const* uplo, lapack_int const* n, @@ -19097,7 +19111,7 @@ void LAPACK_csytri_base( #define LAPACK_csytri(...) LAPACK_csytri_base(__VA_ARGS__) #endif -#define LAPACK_dsytri_base LAPACK_GLOBAL(dsytri,DSYTRI) +#define LAPACK_dsytri_base LAPACK_GLOBAL_SUFFIX(dsytri,DSYTRI) void LAPACK_dsytri_base( char const* uplo, lapack_int const* n, @@ -19114,7 +19128,7 @@ void LAPACK_dsytri_base( #define LAPACK_dsytri(...) LAPACK_dsytri_base(__VA_ARGS__) #endif -#define LAPACK_ssytri_base LAPACK_GLOBAL(ssytri,SSYTRI) +#define LAPACK_ssytri_base LAPACK_GLOBAL_SUFFIX(ssytri,SSYTRI) void LAPACK_ssytri_base( char const* uplo, lapack_int const* n, @@ -19131,7 +19145,7 @@ void LAPACK_ssytri_base( #define LAPACK_ssytri(...) LAPACK_ssytri_base(__VA_ARGS__) #endif -#define LAPACK_zsytri_base LAPACK_GLOBAL(zsytri,ZSYTRI) +#define LAPACK_zsytri_base LAPACK_GLOBAL_SUFFIX(zsytri,ZSYTRI) void LAPACK_zsytri_base( char const* uplo, lapack_int const* n, @@ -19148,7 +19162,7 @@ void LAPACK_zsytri_base( #define LAPACK_zsytri(...) LAPACK_zsytri_base(__VA_ARGS__) #endif -#define LAPACK_csytri2_base LAPACK_GLOBAL(csytri2,CSYTRI2) +#define LAPACK_csytri2_base LAPACK_GLOBAL_SUFFIX(csytri2,CSYTRI2) void LAPACK_csytri2_base( char const* uplo, lapack_int const* n, @@ -19165,7 +19179,7 @@ void LAPACK_csytri2_base( #define LAPACK_csytri2(...) LAPACK_csytri2_base(__VA_ARGS__) #endif -#define LAPACK_dsytri2_base LAPACK_GLOBAL(dsytri2,DSYTRI2) +#define LAPACK_dsytri2_base LAPACK_GLOBAL_SUFFIX(dsytri2,DSYTRI2) void LAPACK_dsytri2_base( char const* uplo, lapack_int const* n, @@ -19182,7 +19196,7 @@ void LAPACK_dsytri2_base( #define LAPACK_dsytri2(...) LAPACK_dsytri2_base(__VA_ARGS__) #endif -#define LAPACK_ssytri2_base LAPACK_GLOBAL(ssytri2,SSYTRI2) +#define LAPACK_ssytri2_base LAPACK_GLOBAL_SUFFIX(ssytri2,SSYTRI2) void LAPACK_ssytri2_base( char const* uplo, lapack_int const* n, @@ -19199,7 +19213,7 @@ void LAPACK_ssytri2_base( #define LAPACK_ssytri2(...) LAPACK_ssytri2_base(__VA_ARGS__) #endif -#define LAPACK_zsytri2_base LAPACK_GLOBAL(zsytri2,ZSYTRI2) +#define LAPACK_zsytri2_base LAPACK_GLOBAL_SUFFIX(zsytri2,ZSYTRI2) void LAPACK_zsytri2_base( char const* uplo, lapack_int const* n, @@ -19216,7 +19230,7 @@ void LAPACK_zsytri2_base( #define LAPACK_zsytri2(...) LAPACK_zsytri2_base(__VA_ARGS__) #endif -#define LAPACK_csytri2x_base LAPACK_GLOBAL(csytri2x,CSYTRI2X) +#define LAPACK_csytri2x_base LAPACK_GLOBAL_SUFFIX(csytri2x,CSYTRI2X) void LAPACK_csytri2x_base( char const* uplo, lapack_int const* n, @@ -19233,7 +19247,7 @@ void LAPACK_csytri2x_base( #define LAPACK_csytri2x(...) LAPACK_csytri2x_base(__VA_ARGS__) #endif -#define LAPACK_dsytri2x_base LAPACK_GLOBAL(dsytri2x,DSYTRI2X) +#define LAPACK_dsytri2x_base LAPACK_GLOBAL_SUFFIX(dsytri2x,DSYTRI2X) void LAPACK_dsytri2x_base( char const* uplo, lapack_int const* n, @@ -19250,7 +19264,7 @@ void LAPACK_dsytri2x_base( #define LAPACK_dsytri2x(...) LAPACK_dsytri2x_base(__VA_ARGS__) #endif -#define LAPACK_ssytri2x_base LAPACK_GLOBAL(ssytri2x,SSYTRI2X) +#define LAPACK_ssytri2x_base LAPACK_GLOBAL_SUFFIX(ssytri2x,SSYTRI2X) void LAPACK_ssytri2x_base( char const* uplo, lapack_int const* n, @@ -19267,7 +19281,7 @@ void LAPACK_ssytri2x_base( #define LAPACK_ssytri2x(...) LAPACK_ssytri2x_base(__VA_ARGS__) #endif -#define LAPACK_zsytri2x_base LAPACK_GLOBAL(zsytri2x,ZSYTRI2X) +#define LAPACK_zsytri2x_base LAPACK_GLOBAL_SUFFIX(zsytri2x,ZSYTRI2X) void LAPACK_zsytri2x_base( char const* uplo, lapack_int const* n, @@ -19284,7 +19298,7 @@ void LAPACK_zsytri2x_base( #define LAPACK_zsytri2x(...) LAPACK_zsytri2x_base(__VA_ARGS__) #endif -#define LAPACK_csytri_3_base LAPACK_GLOBAL(csytri_3,CSYTRI_3) +#define LAPACK_csytri_3_base LAPACK_GLOBAL_SUFFIX(csytri_3,CSYTRI_3) void LAPACK_csytri_3_base( char const* uplo, lapack_int const* n, @@ -19302,7 +19316,7 @@ void LAPACK_csytri_3_base( #define LAPACK_csytri_3(...) LAPACK_csytri_3_base(__VA_ARGS__) #endif -#define LAPACK_dsytri_3_base LAPACK_GLOBAL(dsytri_3,DSYTRI_3) +#define LAPACK_dsytri_3_base LAPACK_GLOBAL_SUFFIX(dsytri_3,DSYTRI_3) void LAPACK_dsytri_3_base( char const* uplo, lapack_int const* n, @@ -19320,7 +19334,7 @@ void LAPACK_dsytri_3_base( #define LAPACK_dsytri_3(...) LAPACK_dsytri_3_base(__VA_ARGS__) #endif -#define LAPACK_ssytri_3_base LAPACK_GLOBAL(ssytri_3,SSYTRI_3) +#define LAPACK_ssytri_3_base LAPACK_GLOBAL_SUFFIX(ssytri_3,SSYTRI_3) void LAPACK_ssytri_3_base( char const* uplo, lapack_int const* n, @@ -19338,7 +19352,7 @@ void LAPACK_ssytri_3_base( #define LAPACK_ssytri_3(...) LAPACK_ssytri_3_base(__VA_ARGS__) #endif -#define LAPACK_zsytri_3_base LAPACK_GLOBAL(zsytri_3,ZSYTRI_3) +#define LAPACK_zsytri_3_base LAPACK_GLOBAL_SUFFIX(zsytri_3,ZSYTRI_3) void LAPACK_zsytri_3_base( char const* uplo, lapack_int const* n, @@ -19356,7 +19370,7 @@ void LAPACK_zsytri_3_base( #define LAPACK_zsytri_3(...) LAPACK_zsytri_3_base(__VA_ARGS__) #endif -#define LAPACK_csytrs_base LAPACK_GLOBAL(csytrs,CSYTRS) +#define LAPACK_csytrs_base LAPACK_GLOBAL_SUFFIX(csytrs,CSYTRS) void LAPACK_csytrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19373,7 +19387,7 @@ void LAPACK_csytrs_base( #define LAPACK_csytrs(...) LAPACK_csytrs_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs_base LAPACK_GLOBAL(dsytrs,DSYTRS) +#define LAPACK_dsytrs_base LAPACK_GLOBAL_SUFFIX(dsytrs,DSYTRS) void LAPACK_dsytrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19390,7 +19404,7 @@ void LAPACK_dsytrs_base( #define LAPACK_dsytrs(...) LAPACK_dsytrs_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs_base LAPACK_GLOBAL(ssytrs,SSYTRS) +#define LAPACK_ssytrs_base LAPACK_GLOBAL_SUFFIX(ssytrs,SSYTRS) void LAPACK_ssytrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19407,7 +19421,7 @@ void LAPACK_ssytrs_base( #define LAPACK_ssytrs(...) LAPACK_ssytrs_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs_base LAPACK_GLOBAL(zsytrs,ZSYTRS) +#define LAPACK_zsytrs_base LAPACK_GLOBAL_SUFFIX(zsytrs,ZSYTRS) void LAPACK_zsytrs_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19424,7 +19438,7 @@ void LAPACK_zsytrs_base( #define LAPACK_zsytrs(...) LAPACK_zsytrs_base(__VA_ARGS__) #endif -#define LAPACK_csytrs2_base LAPACK_GLOBAL(csytrs2,CSYTRS2) +#define LAPACK_csytrs2_base LAPACK_GLOBAL_SUFFIX(csytrs2,CSYTRS2) void LAPACK_csytrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19442,7 +19456,7 @@ void LAPACK_csytrs2_base( #define LAPACK_csytrs2(...) LAPACK_csytrs2_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs2_base LAPACK_GLOBAL(dsytrs2,DSYTRS2) +#define LAPACK_dsytrs2_base LAPACK_GLOBAL_SUFFIX(dsytrs2,DSYTRS2) void LAPACK_dsytrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19460,7 +19474,7 @@ void LAPACK_dsytrs2_base( #define LAPACK_dsytrs2(...) LAPACK_dsytrs2_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs2_base LAPACK_GLOBAL(ssytrs2,SSYTRS2) +#define LAPACK_ssytrs2_base LAPACK_GLOBAL_SUFFIX(ssytrs2,SSYTRS2) void LAPACK_ssytrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19478,7 +19492,7 @@ void LAPACK_ssytrs2_base( #define LAPACK_ssytrs2(...) LAPACK_ssytrs2_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs2_base LAPACK_GLOBAL(zsytrs2,ZSYTRS2) +#define LAPACK_zsytrs2_base LAPACK_GLOBAL_SUFFIX(zsytrs2,ZSYTRS2) void LAPACK_zsytrs2_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19496,7 +19510,7 @@ void LAPACK_zsytrs2_base( #define LAPACK_zsytrs2(...) LAPACK_zsytrs2_base(__VA_ARGS__) #endif -#define LAPACK_csytrs_3_base LAPACK_GLOBAL(csytrs_3,CSYTRS_3) +#define LAPACK_csytrs_3_base LAPACK_GLOBAL_SUFFIX(csytrs_3,CSYTRS_3) void LAPACK_csytrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19514,7 +19528,7 @@ void LAPACK_csytrs_3_base( #define LAPACK_csytrs_3(...) LAPACK_csytrs_3_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs_3_base LAPACK_GLOBAL(dsytrs_3,DSYTRS_3) +#define LAPACK_dsytrs_3_base LAPACK_GLOBAL_SUFFIX(dsytrs_3,DSYTRS_3) void LAPACK_dsytrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19532,7 +19546,7 @@ void LAPACK_dsytrs_3_base( #define LAPACK_dsytrs_3(...) LAPACK_dsytrs_3_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs_3_base LAPACK_GLOBAL(ssytrs_3,SSYTRS_3) +#define LAPACK_ssytrs_3_base LAPACK_GLOBAL_SUFFIX(ssytrs_3,SSYTRS_3) void LAPACK_ssytrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19550,7 +19564,7 @@ void LAPACK_ssytrs_3_base( #define LAPACK_ssytrs_3(...) LAPACK_ssytrs_3_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs_3_base LAPACK_GLOBAL(zsytrs_3,ZSYTRS_3) +#define LAPACK_zsytrs_3_base LAPACK_GLOBAL_SUFFIX(zsytrs_3,ZSYTRS_3) void LAPACK_zsytrs_3_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19568,7 +19582,7 @@ void LAPACK_zsytrs_3_base( #define LAPACK_zsytrs_3(...) LAPACK_zsytrs_3_base(__VA_ARGS__) #endif -#define LAPACK_csytrs_aa_base LAPACK_GLOBAL(csytrs_aa,CSYTRS_AA) +#define LAPACK_csytrs_aa_base LAPACK_GLOBAL_SUFFIX(csytrs_aa,CSYTRS_AA) void LAPACK_csytrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19586,7 +19600,7 @@ void LAPACK_csytrs_aa_base( #define LAPACK_csytrs_aa(...) LAPACK_csytrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs_aa_base LAPACK_GLOBAL(dsytrs_aa,DSYTRS_AA) +#define LAPACK_dsytrs_aa_base LAPACK_GLOBAL_SUFFIX(dsytrs_aa,DSYTRS_AA) void LAPACK_dsytrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19604,7 +19618,7 @@ void LAPACK_dsytrs_aa_base( #define LAPACK_dsytrs_aa(...) LAPACK_dsytrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs_aa_base LAPACK_GLOBAL(ssytrs_aa,SSYTRS_AA) +#define LAPACK_ssytrs_aa_base LAPACK_GLOBAL_SUFFIX(ssytrs_aa,SSYTRS_AA) void LAPACK_ssytrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19622,7 +19636,7 @@ void LAPACK_ssytrs_aa_base( #define LAPACK_ssytrs_aa(...) LAPACK_ssytrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs_aa_base LAPACK_GLOBAL(zsytrs_aa,ZSYTRS_AA) +#define LAPACK_zsytrs_aa_base LAPACK_GLOBAL_SUFFIX(zsytrs_aa,ZSYTRS_AA) void LAPACK_zsytrs_aa_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19640,7 +19654,7 @@ void LAPACK_zsytrs_aa_base( #define LAPACK_zsytrs_aa(...) LAPACK_zsytrs_aa_base(__VA_ARGS__) #endif -#define LAPACK_csytrs_aa_2stage_base LAPACK_GLOBAL(csytrs_aa_2stage,CSYTRS_AA_2STAGE) +#define LAPACK_csytrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(csytrs_aa_2stage,CSYTRS_AA_2STAGE) void LAPACK_csytrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19658,7 +19672,7 @@ void LAPACK_csytrs_aa_2stage_base( #define LAPACK_csytrs_aa_2stage(...) LAPACK_csytrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs_aa_2stage_base LAPACK_GLOBAL(dsytrs_aa_2stage,DSYTRS_AA_2STAGE) +#define LAPACK_dsytrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(dsytrs_aa_2stage,DSYTRS_AA_2STAGE) void LAPACK_dsytrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19676,7 +19690,7 @@ void LAPACK_dsytrs_aa_2stage_base( #define LAPACK_dsytrs_aa_2stage(...) LAPACK_dsytrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs_aa_2stage_base LAPACK_GLOBAL(ssytrs_aa_2stage,SSYTRS_AA_2STAGE) +#define LAPACK_ssytrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(ssytrs_aa_2stage,SSYTRS_AA_2STAGE) void LAPACK_ssytrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19694,7 +19708,7 @@ void LAPACK_ssytrs_aa_2stage_base( #define LAPACK_ssytrs_aa_2stage(...) LAPACK_ssytrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs_aa_2stage_base LAPACK_GLOBAL(zsytrs_aa_2stage,ZSYTRS_AA_2STAGE) +#define LAPACK_zsytrs_aa_2stage_base LAPACK_GLOBAL_SUFFIX(zsytrs_aa_2stage,ZSYTRS_AA_2STAGE) void LAPACK_zsytrs_aa_2stage_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19712,7 +19726,7 @@ void LAPACK_zsytrs_aa_2stage_base( #define LAPACK_zsytrs_aa_2stage(...) LAPACK_zsytrs_aa_2stage_base(__VA_ARGS__) #endif -#define LAPACK_csytrs_rook_base LAPACK_GLOBAL(csytrs_rook,CSYTRS_ROOK) +#define LAPACK_csytrs_rook_base LAPACK_GLOBAL_SUFFIX(csytrs_rook,CSYTRS_ROOK) void LAPACK_csytrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19729,7 +19743,7 @@ void LAPACK_csytrs_rook_base( #define LAPACK_csytrs_rook(...) LAPACK_csytrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_dsytrs_rook_base LAPACK_GLOBAL(dsytrs_rook,DSYTRS_ROOK) +#define LAPACK_dsytrs_rook_base LAPACK_GLOBAL_SUFFIX(dsytrs_rook,DSYTRS_ROOK) void LAPACK_dsytrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19746,7 +19760,7 @@ void LAPACK_dsytrs_rook_base( #define LAPACK_dsytrs_rook(...) LAPACK_dsytrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_ssytrs_rook_base LAPACK_GLOBAL(ssytrs_rook,SSYTRS_ROOK) +#define LAPACK_ssytrs_rook_base LAPACK_GLOBAL_SUFFIX(ssytrs_rook,SSYTRS_ROOK) void LAPACK_ssytrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19763,7 +19777,7 @@ void LAPACK_ssytrs_rook_base( #define LAPACK_ssytrs_rook(...) LAPACK_ssytrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_zsytrs_rook_base LAPACK_GLOBAL(zsytrs_rook,ZSYTRS_ROOK) +#define LAPACK_zsytrs_rook_base LAPACK_GLOBAL_SUFFIX(zsytrs_rook,ZSYTRS_ROOK) void LAPACK_zsytrs_rook_base( char const* uplo, lapack_int const* n, lapack_int const* nrhs, @@ -19780,7 +19794,7 @@ void LAPACK_zsytrs_rook_base( #define LAPACK_zsytrs_rook(...) LAPACK_zsytrs_rook_base(__VA_ARGS__) #endif -#define LAPACK_ctbcon_base LAPACK_GLOBAL(ctbcon,CTBCON) +#define LAPACK_ctbcon_base LAPACK_GLOBAL_SUFFIX(ctbcon,CTBCON) void LAPACK_ctbcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* kd, @@ -19799,7 +19813,7 @@ void LAPACK_ctbcon_base( #define LAPACK_ctbcon(...) LAPACK_ctbcon_base(__VA_ARGS__) #endif -#define LAPACK_dtbcon_base LAPACK_GLOBAL(dtbcon,DTBCON) +#define LAPACK_dtbcon_base LAPACK_GLOBAL_SUFFIX(dtbcon,DTBCON) void LAPACK_dtbcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* kd, @@ -19818,7 +19832,7 @@ void LAPACK_dtbcon_base( #define LAPACK_dtbcon(...) LAPACK_dtbcon_base(__VA_ARGS__) #endif -#define LAPACK_stbcon_base LAPACK_GLOBAL(stbcon,STBCON) +#define LAPACK_stbcon_base LAPACK_GLOBAL_SUFFIX(stbcon,STBCON) void LAPACK_stbcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* kd, @@ -19837,7 +19851,7 @@ void LAPACK_stbcon_base( #define LAPACK_stbcon(...) LAPACK_stbcon_base(__VA_ARGS__) #endif -#define LAPACK_ztbcon_base LAPACK_GLOBAL(ztbcon,ZTBCON) +#define LAPACK_ztbcon_base LAPACK_GLOBAL_SUFFIX(ztbcon,ZTBCON) void LAPACK_ztbcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, lapack_int const* kd, @@ -19856,7 +19870,7 @@ void LAPACK_ztbcon_base( #define LAPACK_ztbcon(...) LAPACK_ztbcon_base(__VA_ARGS__) #endif -#define LAPACK_ctbrfs_base LAPACK_GLOBAL(ctbrfs,CTBRFS) +#define LAPACK_ctbrfs_base LAPACK_GLOBAL_SUFFIX(ctbrfs,CTBRFS) void LAPACK_ctbrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19878,7 +19892,7 @@ void LAPACK_ctbrfs_base( #define LAPACK_ctbrfs(...) LAPACK_ctbrfs_base(__VA_ARGS__) #endif -#define LAPACK_dtbrfs_base LAPACK_GLOBAL(dtbrfs,DTBRFS) +#define LAPACK_dtbrfs_base LAPACK_GLOBAL_SUFFIX(dtbrfs,DTBRFS) void LAPACK_dtbrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19900,7 +19914,7 @@ void LAPACK_dtbrfs_base( #define LAPACK_dtbrfs(...) LAPACK_dtbrfs_base(__VA_ARGS__) #endif -#define LAPACK_stbrfs_base LAPACK_GLOBAL(stbrfs,STBRFS) +#define LAPACK_stbrfs_base LAPACK_GLOBAL_SUFFIX(stbrfs,STBRFS) void LAPACK_stbrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19922,7 +19936,7 @@ void LAPACK_stbrfs_base( #define LAPACK_stbrfs(...) LAPACK_stbrfs_base(__VA_ARGS__) #endif -#define LAPACK_ztbrfs_base LAPACK_GLOBAL(ztbrfs,ZTBRFS) +#define LAPACK_ztbrfs_base LAPACK_GLOBAL_SUFFIX(ztbrfs,ZTBRFS) void LAPACK_ztbrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19944,7 +19958,7 @@ void LAPACK_ztbrfs_base( #define LAPACK_ztbrfs(...) LAPACK_ztbrfs_base(__VA_ARGS__) #endif -#define LAPACK_ctbtrs_base LAPACK_GLOBAL(ctbtrs,CTBTRS) +#define LAPACK_ctbtrs_base LAPACK_GLOBAL_SUFFIX(ctbtrs,CTBTRS) void LAPACK_ctbtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19961,7 +19975,7 @@ void LAPACK_ctbtrs_base( #define LAPACK_ctbtrs(...) LAPACK_ctbtrs_base(__VA_ARGS__) #endif -#define LAPACK_dtbtrs_base LAPACK_GLOBAL(dtbtrs,DTBTRS) +#define LAPACK_dtbtrs_base LAPACK_GLOBAL_SUFFIX(dtbtrs,DTBTRS) void LAPACK_dtbtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19978,7 +19992,7 @@ void LAPACK_dtbtrs_base( #define LAPACK_dtbtrs(...) LAPACK_dtbtrs_base(__VA_ARGS__) #endif -#define LAPACK_stbtrs_base LAPACK_GLOBAL(stbtrs,STBTRS) +#define LAPACK_stbtrs_base LAPACK_GLOBAL_SUFFIX(stbtrs,STBTRS) void LAPACK_stbtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -19995,7 +20009,7 @@ void LAPACK_stbtrs_base( #define LAPACK_stbtrs(...) LAPACK_stbtrs_base(__VA_ARGS__) #endif -#define LAPACK_ztbtrs_base LAPACK_GLOBAL(ztbtrs,ZTBTRS) +#define LAPACK_ztbtrs_base LAPACK_GLOBAL_SUFFIX(ztbtrs,ZTBTRS) void LAPACK_ztbtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, @@ -20012,7 +20026,7 @@ void LAPACK_ztbtrs_base( #define LAPACK_ztbtrs(...) LAPACK_ztbtrs_base(__VA_ARGS__) #endif -#define LAPACK_ctfsm_base LAPACK_GLOBAL(ctfsm,CTFSM) +#define LAPACK_ctfsm_base LAPACK_GLOBAL_SUFFIX(ctfsm,CTFSM) void LAPACK_ctfsm_base( char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, lapack_int const* m, lapack_int const* n, @@ -20029,7 +20043,7 @@ void LAPACK_ctfsm_base( #define LAPACK_ctfsm(...) LAPACK_ctfsm_base(__VA_ARGS__) #endif -#define LAPACK_dtfsm_base LAPACK_GLOBAL(dtfsm,DTFSM) +#define LAPACK_dtfsm_base LAPACK_GLOBAL_SUFFIX(dtfsm,DTFSM) void LAPACK_dtfsm_base( char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, lapack_int const* m, lapack_int const* n, @@ -20046,7 +20060,7 @@ void LAPACK_dtfsm_base( #define LAPACK_dtfsm(...) LAPACK_dtfsm_base(__VA_ARGS__) #endif -#define LAPACK_stfsm_base LAPACK_GLOBAL(stfsm,STFSM) +#define LAPACK_stfsm_base LAPACK_GLOBAL_SUFFIX(stfsm,STFSM) void LAPACK_stfsm_base( char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, lapack_int const* m, lapack_int const* n, @@ -20063,7 +20077,7 @@ void LAPACK_stfsm_base( #define LAPACK_stfsm(...) LAPACK_stfsm_base(__VA_ARGS__) #endif -#define LAPACK_ztfsm_base LAPACK_GLOBAL(ztfsm,ZTFSM) +#define LAPACK_ztfsm_base LAPACK_GLOBAL_SUFFIX(ztfsm,ZTFSM) void LAPACK_ztfsm_base( char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, lapack_int const* m, lapack_int const* n, @@ -20080,7 +20094,7 @@ void LAPACK_ztfsm_base( #define LAPACK_ztfsm(...) LAPACK_ztfsm_base(__VA_ARGS__) #endif -#define LAPACK_ctftri_base LAPACK_GLOBAL(ctftri,CTFTRI) +#define LAPACK_ctftri_base LAPACK_GLOBAL_SUFFIX(ctftri,CTFTRI) void LAPACK_ctftri_base( char const* transr, char const* uplo, char const* diag, lapack_int const* n, @@ -20096,7 +20110,7 @@ void LAPACK_ctftri_base( #define LAPACK_ctftri(...) LAPACK_ctftri_base(__VA_ARGS__) #endif -#define LAPACK_dtftri_base LAPACK_GLOBAL(dtftri,DTFTRI) +#define LAPACK_dtftri_base LAPACK_GLOBAL_SUFFIX(dtftri,DTFTRI) void LAPACK_dtftri_base( char const* transr, char const* uplo, char const* diag, lapack_int const* n, @@ -20112,7 +20126,7 @@ void LAPACK_dtftri_base( #define LAPACK_dtftri(...) LAPACK_dtftri_base(__VA_ARGS__) #endif -#define LAPACK_stftri_base LAPACK_GLOBAL(stftri,STFTRI) +#define LAPACK_stftri_base LAPACK_GLOBAL_SUFFIX(stftri,STFTRI) void LAPACK_stftri_base( char const* transr, char const* uplo, char const* diag, lapack_int const* n, @@ -20128,7 +20142,7 @@ void LAPACK_stftri_base( #define LAPACK_stftri(...) LAPACK_stftri_base(__VA_ARGS__) #endif -#define LAPACK_ztftri_base LAPACK_GLOBAL(ztftri,ZTFTRI) +#define LAPACK_ztftri_base LAPACK_GLOBAL_SUFFIX(ztftri,ZTFTRI) void LAPACK_ztftri_base( char const* transr, char const* uplo, char const* diag, lapack_int const* n, @@ -20144,7 +20158,7 @@ void LAPACK_ztftri_base( #define LAPACK_ztftri(...) LAPACK_ztftri_base(__VA_ARGS__) #endif -#define LAPACK_ctfttp_base LAPACK_GLOBAL(ctfttp,CTFTTP) +#define LAPACK_ctfttp_base LAPACK_GLOBAL_SUFFIX(ctfttp,CTFTTP) void LAPACK_ctfttp_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20161,7 +20175,7 @@ void LAPACK_ctfttp_base( #define LAPACK_ctfttp(...) LAPACK_ctfttp_base(__VA_ARGS__) #endif -#define LAPACK_dtfttp_base LAPACK_GLOBAL(dtfttp,DTFTTP) +#define LAPACK_dtfttp_base LAPACK_GLOBAL_SUFFIX(dtfttp,DTFTTP) void LAPACK_dtfttp_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20178,7 +20192,7 @@ void LAPACK_dtfttp_base( #define LAPACK_dtfttp(...) LAPACK_dtfttp_base(__VA_ARGS__) #endif -#define LAPACK_stfttp_base LAPACK_GLOBAL(stfttp,STFTTP) +#define LAPACK_stfttp_base LAPACK_GLOBAL_SUFFIX(stfttp,STFTTP) void LAPACK_stfttp_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20195,7 +20209,7 @@ void LAPACK_stfttp_base( #define LAPACK_stfttp(...) LAPACK_stfttp_base(__VA_ARGS__) #endif -#define LAPACK_ztfttp_base LAPACK_GLOBAL(ztfttp,ZTFTTP) +#define LAPACK_ztfttp_base LAPACK_GLOBAL_SUFFIX(ztfttp,ZTFTTP) void LAPACK_ztfttp_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20212,7 +20226,7 @@ void LAPACK_ztfttp_base( #define LAPACK_ztfttp(...) LAPACK_ztfttp_base(__VA_ARGS__) #endif -#define LAPACK_ctfttr_base LAPACK_GLOBAL(ctfttr,CTFTTR) +#define LAPACK_ctfttr_base LAPACK_GLOBAL_SUFFIX(ctfttr,CTFTTR) void LAPACK_ctfttr_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20229,7 +20243,7 @@ void LAPACK_ctfttr_base( #define LAPACK_ctfttr(...) LAPACK_ctfttr_base(__VA_ARGS__) #endif -#define LAPACK_dtfttr_base LAPACK_GLOBAL(dtfttr,DTFTTR) +#define LAPACK_dtfttr_base LAPACK_GLOBAL_SUFFIX(dtfttr,DTFTTR) void LAPACK_dtfttr_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20246,7 +20260,7 @@ void LAPACK_dtfttr_base( #define LAPACK_dtfttr(...) LAPACK_dtfttr_base(__VA_ARGS__) #endif -#define LAPACK_stfttr_base LAPACK_GLOBAL(stfttr,STFTTR) +#define LAPACK_stfttr_base LAPACK_GLOBAL_SUFFIX(stfttr,STFTTR) void LAPACK_stfttr_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20263,7 +20277,7 @@ void LAPACK_stfttr_base( #define LAPACK_stfttr(...) LAPACK_stfttr_base(__VA_ARGS__) #endif -#define LAPACK_ztfttr_base LAPACK_GLOBAL(ztfttr,ZTFTTR) +#define LAPACK_ztfttr_base LAPACK_GLOBAL_SUFFIX(ztfttr,ZTFTTR) void LAPACK_ztfttr_base( char const* transr, char const* uplo, lapack_int const* n, @@ -20280,7 +20294,7 @@ void LAPACK_ztfttr_base( #define LAPACK_ztfttr(...) LAPACK_ztfttr_base(__VA_ARGS__) #endif -#define LAPACK_ctgevc_base LAPACK_GLOBAL(ctgevc,CTGEVC) +#define LAPACK_ctgevc_base LAPACK_GLOBAL_SUFFIX(ctgevc,CTGEVC) void LAPACK_ctgevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -20302,7 +20316,7 @@ void LAPACK_ctgevc_base( #define LAPACK_ctgevc(...) LAPACK_ctgevc_base(__VA_ARGS__) #endif -#define LAPACK_dtgevc_base LAPACK_GLOBAL(dtgevc,DTGEVC) +#define LAPACK_dtgevc_base LAPACK_GLOBAL_SUFFIX(dtgevc,DTGEVC) void LAPACK_dtgevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -20323,7 +20337,7 @@ void LAPACK_dtgevc_base( #define LAPACK_dtgevc(...) LAPACK_dtgevc_base(__VA_ARGS__) #endif -#define LAPACK_stgevc_base LAPACK_GLOBAL(stgevc,STGEVC) +#define LAPACK_stgevc_base LAPACK_GLOBAL_SUFFIX(stgevc,STGEVC) void LAPACK_stgevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -20344,7 +20358,7 @@ void LAPACK_stgevc_base( #define LAPACK_stgevc(...) LAPACK_stgevc_base(__VA_ARGS__) #endif -#define LAPACK_ztgevc_base LAPACK_GLOBAL(ztgevc,ZTGEVC) +#define LAPACK_ztgevc_base LAPACK_GLOBAL_SUFFIX(ztgevc,ZTGEVC) void LAPACK_ztgevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -20366,7 +20380,7 @@ void LAPACK_ztgevc_base( #define LAPACK_ztgevc(...) LAPACK_ztgevc_base(__VA_ARGS__) #endif -#define LAPACK_ctgexc LAPACK_GLOBAL(ctgexc,CTGEXC) +#define LAPACK_ctgexc LAPACK_GLOBAL_SUFFIX(ctgexc,CTGEXC) void LAPACK_ctgexc( lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -20375,7 +20389,7 @@ void LAPACK_ctgexc( lapack_complex_float* Z, lapack_int const* ldz, lapack_int const* ifst, lapack_int* ilst, lapack_int* info ); -#define LAPACK_dtgexc LAPACK_GLOBAL(dtgexc,DTGEXC) +#define LAPACK_dtgexc LAPACK_GLOBAL_SUFFIX(dtgexc,DTGEXC) void LAPACK_dtgexc( lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, double* A, lapack_int const* lda, @@ -20385,7 +20399,7 @@ void LAPACK_dtgexc( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_stgexc LAPACK_GLOBAL(stgexc,STGEXC) +#define LAPACK_stgexc LAPACK_GLOBAL_SUFFIX(stgexc,STGEXC) void LAPACK_stgexc( lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, float* A, lapack_int const* lda, @@ -20395,7 +20409,7 @@ void LAPACK_stgexc( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_ztgexc LAPACK_GLOBAL(ztgexc,ZTGEXC) +#define LAPACK_ztgexc LAPACK_GLOBAL_SUFFIX(ztgexc,ZTGEXC) void LAPACK_ztgexc( lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -20404,7 +20418,7 @@ void LAPACK_ztgexc( lapack_complex_double* Z, lapack_int const* ldz, lapack_int const* ifst, lapack_int* ilst, lapack_int* info ); -#define LAPACK_ctgsen LAPACK_GLOBAL(ctgsen,CTGSEN) +#define LAPACK_ctgsen LAPACK_GLOBAL_SUFFIX(ctgsen,CTGSEN) void LAPACK_ctgsen( lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -20420,7 +20434,7 @@ void LAPACK_ctgsen( lapack_int* iwork, lapack_int const* liwork, lapack_int* info ); -#define LAPACK_dtgsen LAPACK_GLOBAL(dtgsen,DTGSEN) +#define LAPACK_dtgsen LAPACK_GLOBAL_SUFFIX(dtgsen,DTGSEN) void LAPACK_dtgsen( lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, double* A, lapack_int const* lda, @@ -20437,7 +20451,7 @@ void LAPACK_dtgsen( lapack_int* iwork, lapack_int const* liwork, lapack_int* info ); -#define LAPACK_stgsen LAPACK_GLOBAL(stgsen,STGSEN) +#define LAPACK_stgsen LAPACK_GLOBAL_SUFFIX(stgsen,STGSEN) void LAPACK_stgsen( lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, float* A, lapack_int const* lda, @@ -20454,7 +20468,7 @@ void LAPACK_stgsen( lapack_int* iwork, lapack_int const* liwork, lapack_int* info ); -#define LAPACK_ztgsen LAPACK_GLOBAL(ztgsen,ZTGSEN) +#define LAPACK_ztgsen LAPACK_GLOBAL_SUFFIX(ztgsen,ZTGSEN) void LAPACK_ztgsen( lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -20470,7 +20484,7 @@ void LAPACK_ztgsen( lapack_int* iwork, lapack_int const* liwork, lapack_int* info ); -#define LAPACK_ctgsja_base LAPACK_GLOBAL(ctgsja,CTGSJA) +#define LAPACK_ctgsja_base LAPACK_GLOBAL_SUFFIX(ctgsja,CTGSJA) void LAPACK_ctgsja_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -20495,7 +20509,7 @@ void LAPACK_ctgsja_base( #define LAPACK_ctgsja(...) LAPACK_ctgsja_base(__VA_ARGS__) #endif -#define LAPACK_dtgsja_base LAPACK_GLOBAL(dtgsja,DTGSJA) +#define LAPACK_dtgsja_base LAPACK_GLOBAL_SUFFIX(dtgsja,DTGSJA) void LAPACK_dtgsja_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -20520,7 +20534,7 @@ void LAPACK_dtgsja_base( #define LAPACK_dtgsja(...) LAPACK_dtgsja_base(__VA_ARGS__) #endif -#define LAPACK_stgsja_base LAPACK_GLOBAL(stgsja,STGSJA) +#define LAPACK_stgsja_base LAPACK_GLOBAL_SUFFIX(stgsja,STGSJA) void LAPACK_stgsja_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -20545,7 +20559,7 @@ void LAPACK_stgsja_base( #define LAPACK_stgsja(...) LAPACK_stgsja_base(__VA_ARGS__) #endif -#define LAPACK_ztgsja_base LAPACK_GLOBAL(ztgsja,ZTGSJA) +#define LAPACK_ztgsja_base LAPACK_GLOBAL_SUFFIX(ztgsja,ZTGSJA) void LAPACK_ztgsja_base( char const* jobu, char const* jobv, char const* jobq, lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -20570,7 +20584,7 @@ void LAPACK_ztgsja_base( #define LAPACK_ztgsja(...) LAPACK_ztgsja_base(__VA_ARGS__) #endif -#define LAPACK_ctgsna_base LAPACK_GLOBAL(ctgsna,CTGSNA) +#define LAPACK_ctgsna_base LAPACK_GLOBAL_SUFFIX(ctgsna,CTGSNA) void LAPACK_ctgsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -20594,7 +20608,7 @@ void LAPACK_ctgsna_base( #define LAPACK_ctgsna(...) LAPACK_ctgsna_base(__VA_ARGS__) #endif -#define LAPACK_dtgsna_base LAPACK_GLOBAL(dtgsna,DTGSNA) +#define LAPACK_dtgsna_base LAPACK_GLOBAL_SUFFIX(dtgsna,DTGSNA) void LAPACK_dtgsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -20618,7 +20632,7 @@ void LAPACK_dtgsna_base( #define LAPACK_dtgsna(...) LAPACK_dtgsna_base(__VA_ARGS__) #endif -#define LAPACK_stgsna_base LAPACK_GLOBAL(stgsna,STGSNA) +#define LAPACK_stgsna_base LAPACK_GLOBAL_SUFFIX(stgsna,STGSNA) void LAPACK_stgsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -20642,7 +20656,7 @@ void LAPACK_stgsna_base( #define LAPACK_stgsna(...) LAPACK_stgsna_base(__VA_ARGS__) #endif -#define LAPACK_ztgsna_base LAPACK_GLOBAL(ztgsna,ZTGSNA) +#define LAPACK_ztgsna_base LAPACK_GLOBAL_SUFFIX(ztgsna,ZTGSNA) void LAPACK_ztgsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -20666,7 +20680,7 @@ void LAPACK_ztgsna_base( #define LAPACK_ztgsna(...) LAPACK_ztgsna_base(__VA_ARGS__) #endif -#define LAPACK_ctgsyl_base LAPACK_GLOBAL(ctgsyl,CTGSYL) +#define LAPACK_ctgsyl_base LAPACK_GLOBAL_SUFFIX(ctgsyl,CTGSYL) void LAPACK_ctgsyl_base( char const* trans, lapack_int const* ijob, lapack_int const* m, lapack_int const* n, @@ -20691,7 +20705,7 @@ void LAPACK_ctgsyl_base( #define LAPACK_ctgsyl(...) LAPACK_ctgsyl_base(__VA_ARGS__) #endif -#define LAPACK_dtgsyl_base LAPACK_GLOBAL(dtgsyl,DTGSYL) +#define LAPACK_dtgsyl_base LAPACK_GLOBAL_SUFFIX(dtgsyl,DTGSYL) void LAPACK_dtgsyl_base( char const* trans, lapack_int const* ijob, lapack_int const* m, lapack_int const* n, @@ -20716,7 +20730,7 @@ void LAPACK_dtgsyl_base( #define LAPACK_dtgsyl(...) LAPACK_dtgsyl_base(__VA_ARGS__) #endif -#define LAPACK_stgsyl_base LAPACK_GLOBAL(stgsyl,STGSYL) +#define LAPACK_stgsyl_base LAPACK_GLOBAL_SUFFIX(stgsyl,STGSYL) void LAPACK_stgsyl_base( char const* trans, lapack_int const* ijob, lapack_int const* m, lapack_int const* n, @@ -20741,7 +20755,7 @@ void LAPACK_stgsyl_base( #define LAPACK_stgsyl(...) LAPACK_stgsyl_base(__VA_ARGS__) #endif -#define LAPACK_ztgsyl_base LAPACK_GLOBAL(ztgsyl,ZTGSYL) +#define LAPACK_ztgsyl_base LAPACK_GLOBAL_SUFFIX(ztgsyl,ZTGSYL) void LAPACK_ztgsyl_base( char const* trans, lapack_int const* ijob, lapack_int const* m, lapack_int const* n, @@ -20766,7 +20780,7 @@ void LAPACK_ztgsyl_base( #define LAPACK_ztgsyl(...) LAPACK_ztgsyl_base(__VA_ARGS__) #endif -#define LAPACK_ctpcon_base LAPACK_GLOBAL(ctpcon,CTPCON) +#define LAPACK_ctpcon_base LAPACK_GLOBAL_SUFFIX(ctpcon,CTPCON) void LAPACK_ctpcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -20785,7 +20799,7 @@ void LAPACK_ctpcon_base( #define LAPACK_ctpcon(...) LAPACK_ctpcon_base(__VA_ARGS__) #endif -#define LAPACK_dtpcon_base LAPACK_GLOBAL(dtpcon,DTPCON) +#define LAPACK_dtpcon_base LAPACK_GLOBAL_SUFFIX(dtpcon,DTPCON) void LAPACK_dtpcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -20804,7 +20818,7 @@ void LAPACK_dtpcon_base( #define LAPACK_dtpcon(...) LAPACK_dtpcon_base(__VA_ARGS__) #endif -#define LAPACK_stpcon_base LAPACK_GLOBAL(stpcon,STPCON) +#define LAPACK_stpcon_base LAPACK_GLOBAL_SUFFIX(stpcon,STPCON) void LAPACK_stpcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -20823,7 +20837,7 @@ void LAPACK_stpcon_base( #define LAPACK_stpcon(...) LAPACK_stpcon_base(__VA_ARGS__) #endif -#define LAPACK_ztpcon_base LAPACK_GLOBAL(ztpcon,ZTPCON) +#define LAPACK_ztpcon_base LAPACK_GLOBAL_SUFFIX(ztpcon,ZTPCON) void LAPACK_ztpcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -20842,7 +20856,7 @@ void LAPACK_ztpcon_base( #define LAPACK_ztpcon(...) LAPACK_ztpcon_base(__VA_ARGS__) #endif -#define LAPACK_ctplqt LAPACK_GLOBAL(ctplqt,CTPLQT) +#define LAPACK_ctplqt LAPACK_GLOBAL_SUFFIX(ctplqt,CTPLQT) void LAPACK_ctplqt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, lapack_complex_float* A, lapack_int const* lda, @@ -20851,7 +20865,7 @@ void LAPACK_ctplqt( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dtplqt LAPACK_GLOBAL(dtplqt,DTPLQT) +#define LAPACK_dtplqt LAPACK_GLOBAL_SUFFIX(dtplqt,DTPLQT) void LAPACK_dtplqt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, double* A, lapack_int const* lda, @@ -20860,7 +20874,7 @@ void LAPACK_dtplqt( double* work, lapack_int* info ); -#define LAPACK_stplqt LAPACK_GLOBAL(stplqt,STPLQT) +#define LAPACK_stplqt LAPACK_GLOBAL_SUFFIX(stplqt,STPLQT) void LAPACK_stplqt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, float* A, lapack_int const* lda, @@ -20869,7 +20883,7 @@ void LAPACK_stplqt( float* work, lapack_int* info ); -#define LAPACK_ztplqt LAPACK_GLOBAL(ztplqt,ZTPLQT) +#define LAPACK_ztplqt LAPACK_GLOBAL_SUFFIX(ztplqt,ZTPLQT) void LAPACK_ztplqt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, lapack_complex_double* A, lapack_int const* lda, @@ -20878,7 +20892,7 @@ void LAPACK_ztplqt( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_ctplqt2 LAPACK_GLOBAL(ctplqt2,CTPLQT2) +#define LAPACK_ctplqt2 LAPACK_GLOBAL_SUFFIX(ctplqt2,CTPLQT2) void LAPACK_ctplqt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_complex_float* A, lapack_int const* lda, @@ -20886,7 +20900,7 @@ void LAPACK_ctplqt2( lapack_complex_float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_dtplqt2 LAPACK_GLOBAL(dtplqt2,DTPLQT2) +#define LAPACK_dtplqt2 LAPACK_GLOBAL_SUFFIX(dtplqt2,DTPLQT2) void LAPACK_dtplqt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, double* A, lapack_int const* lda, @@ -20894,7 +20908,7 @@ void LAPACK_dtplqt2( double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_stplqt2 LAPACK_GLOBAL(stplqt2,STPLQT2) +#define LAPACK_stplqt2 LAPACK_GLOBAL_SUFFIX(stplqt2,STPLQT2) void LAPACK_stplqt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, float* A, lapack_int const* lda, @@ -20902,7 +20916,7 @@ void LAPACK_stplqt2( float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_ztplqt2 LAPACK_GLOBAL(ztplqt2,ZTPLQT2) +#define LAPACK_ztplqt2 LAPACK_GLOBAL_SUFFIX(ztplqt2,ZTPLQT2) void LAPACK_ztplqt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_complex_double* A, lapack_int const* lda, @@ -20910,7 +20924,7 @@ void LAPACK_ztplqt2( lapack_complex_double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_ctpmlqt_base LAPACK_GLOBAL(ctpmlqt,CTPMLQT) +#define LAPACK_ctpmlqt_base LAPACK_GLOBAL_SUFFIX(ctpmlqt,CTPMLQT) void LAPACK_ctpmlqt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, @@ -20930,7 +20944,7 @@ void LAPACK_ctpmlqt_base( #define LAPACK_ctpmlqt(...) LAPACK_ctpmlqt_base(__VA_ARGS__) #endif -#define LAPACK_dtpmlqt_base LAPACK_GLOBAL(dtpmlqt,DTPMLQT) +#define LAPACK_dtpmlqt_base LAPACK_GLOBAL_SUFFIX(dtpmlqt,DTPMLQT) void LAPACK_dtpmlqt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, @@ -20950,7 +20964,7 @@ void LAPACK_dtpmlqt_base( #define LAPACK_dtpmlqt(...) LAPACK_dtpmlqt_base(__VA_ARGS__) #endif -#define LAPACK_stpmlqt_base LAPACK_GLOBAL(stpmlqt,STPMLQT) +#define LAPACK_stpmlqt_base LAPACK_GLOBAL_SUFFIX(stpmlqt,STPMLQT) void LAPACK_stpmlqt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, @@ -20970,7 +20984,7 @@ void LAPACK_stpmlqt_base( #define LAPACK_stpmlqt(...) LAPACK_stpmlqt_base(__VA_ARGS__) #endif -#define LAPACK_ztpmlqt_base LAPACK_GLOBAL(ztpmlqt,ZTPMLQT) +#define LAPACK_ztpmlqt_base LAPACK_GLOBAL_SUFFIX(ztpmlqt,ZTPMLQT) void LAPACK_ztpmlqt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, @@ -20990,7 +21004,7 @@ void LAPACK_ztpmlqt_base( #define LAPACK_ztpmlqt(...) LAPACK_ztpmlqt_base(__VA_ARGS__) #endif -#define LAPACK_ctpmqrt_base LAPACK_GLOBAL(ctpmqrt,CTPMQRT) +#define LAPACK_ctpmqrt_base LAPACK_GLOBAL_SUFFIX(ctpmqrt,CTPMQRT) void LAPACK_ctpmqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, @@ -21010,7 +21024,7 @@ void LAPACK_ctpmqrt_base( #define LAPACK_ctpmqrt(...) LAPACK_ctpmqrt_base(__VA_ARGS__) #endif -#define LAPACK_dtpmqrt_base LAPACK_GLOBAL(dtpmqrt,DTPMQRT) +#define LAPACK_dtpmqrt_base LAPACK_GLOBAL_SUFFIX(dtpmqrt,DTPMQRT) void LAPACK_dtpmqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, @@ -21030,7 +21044,7 @@ void LAPACK_dtpmqrt_base( #define LAPACK_dtpmqrt(...) LAPACK_dtpmqrt_base(__VA_ARGS__) #endif -#define LAPACK_stpmqrt_base LAPACK_GLOBAL(stpmqrt,STPMQRT) +#define LAPACK_stpmqrt_base LAPACK_GLOBAL_SUFFIX(stpmqrt,STPMQRT) void LAPACK_stpmqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, @@ -21050,7 +21064,7 @@ void LAPACK_stpmqrt_base( #define LAPACK_stpmqrt(...) LAPACK_stpmqrt_base(__VA_ARGS__) #endif -#define LAPACK_ztpmqrt_base LAPACK_GLOBAL(ztpmqrt,ZTPMQRT) +#define LAPACK_ztpmqrt_base LAPACK_GLOBAL_SUFFIX(ztpmqrt,ZTPMQRT) void LAPACK_ztpmqrt_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, @@ -21070,7 +21084,7 @@ void LAPACK_ztpmqrt_base( #define LAPACK_ztpmqrt(...) LAPACK_ztpmqrt_base(__VA_ARGS__) #endif -#define LAPACK_ctpqrt LAPACK_GLOBAL(ctpqrt,CTPQRT) +#define LAPACK_ctpqrt LAPACK_GLOBAL_SUFFIX(ctpqrt,CTPQRT) void LAPACK_ctpqrt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, lapack_complex_float* A, lapack_int const* lda, @@ -21079,7 +21093,7 @@ void LAPACK_ctpqrt( lapack_complex_float* work, lapack_int* info ); -#define LAPACK_dtpqrt LAPACK_GLOBAL(dtpqrt,DTPQRT) +#define LAPACK_dtpqrt LAPACK_GLOBAL_SUFFIX(dtpqrt,DTPQRT) void LAPACK_dtpqrt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, double* A, lapack_int const* lda, @@ -21088,7 +21102,7 @@ void LAPACK_dtpqrt( double* work, lapack_int* info ); -#define LAPACK_stpqrt LAPACK_GLOBAL(stpqrt,STPQRT) +#define LAPACK_stpqrt LAPACK_GLOBAL_SUFFIX(stpqrt,STPQRT) void LAPACK_stpqrt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, float* A, lapack_int const* lda, @@ -21097,7 +21111,7 @@ void LAPACK_stpqrt( float* work, lapack_int* info ); -#define LAPACK_ztpqrt LAPACK_GLOBAL(ztpqrt,ZTPQRT) +#define LAPACK_ztpqrt LAPACK_GLOBAL_SUFFIX(ztpqrt,ZTPQRT) void LAPACK_ztpqrt( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, lapack_complex_double* A, lapack_int const* lda, @@ -21106,7 +21120,7 @@ void LAPACK_ztpqrt( lapack_complex_double* work, lapack_int* info ); -#define LAPACK_ctpqrt2 LAPACK_GLOBAL(ctpqrt2,CTPQRT2) +#define LAPACK_ctpqrt2 LAPACK_GLOBAL_SUFFIX(ctpqrt2,CTPQRT2) void LAPACK_ctpqrt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_complex_float* A, lapack_int const* lda, @@ -21114,7 +21128,7 @@ void LAPACK_ctpqrt2( lapack_complex_float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_dtpqrt2 LAPACK_GLOBAL(dtpqrt2,DTPQRT2) +#define LAPACK_dtpqrt2 LAPACK_GLOBAL_SUFFIX(dtpqrt2,DTPQRT2) void LAPACK_dtpqrt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, double* A, lapack_int const* lda, @@ -21122,7 +21136,7 @@ void LAPACK_dtpqrt2( double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_stpqrt2 LAPACK_GLOBAL(stpqrt2,STPQRT2) +#define LAPACK_stpqrt2 LAPACK_GLOBAL_SUFFIX(stpqrt2,STPQRT2) void LAPACK_stpqrt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, float* A, lapack_int const* lda, @@ -21130,7 +21144,7 @@ void LAPACK_stpqrt2( float* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_ztpqrt2 LAPACK_GLOBAL(ztpqrt2,ZTPQRT2) +#define LAPACK_ztpqrt2 LAPACK_GLOBAL_SUFFIX(ztpqrt2,ZTPQRT2) void LAPACK_ztpqrt2( lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_complex_double* A, lapack_int const* lda, @@ -21138,7 +21152,7 @@ void LAPACK_ztpqrt2( lapack_complex_double* T, lapack_int const* ldt, lapack_int* info ); -#define LAPACK_ctprfb_base LAPACK_GLOBAL(ctprfb,CTPRFB) +#define LAPACK_ctprfb_base LAPACK_GLOBAL_SUFFIX(ctprfb,CTPRFB) void LAPACK_ctprfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -21157,7 +21171,7 @@ void LAPACK_ctprfb_base( #define LAPACK_ctprfb(...) LAPACK_ctprfb_base(__VA_ARGS__) #endif -#define LAPACK_dtprfb_base LAPACK_GLOBAL(dtprfb,DTPRFB) +#define LAPACK_dtprfb_base LAPACK_GLOBAL_SUFFIX(dtprfb,DTPRFB) void LAPACK_dtprfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -21176,7 +21190,7 @@ void LAPACK_dtprfb_base( #define LAPACK_dtprfb(...) LAPACK_dtprfb_base(__VA_ARGS__) #endif -#define LAPACK_stprfb_base LAPACK_GLOBAL(stprfb,STPRFB) +#define LAPACK_stprfb_base LAPACK_GLOBAL_SUFFIX(stprfb,STPRFB) void LAPACK_stprfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -21195,7 +21209,7 @@ void LAPACK_stprfb_base( #define LAPACK_stprfb(...) LAPACK_stprfb_base(__VA_ARGS__) #endif -#define LAPACK_ztprfb_base LAPACK_GLOBAL(ztprfb,ZTPRFB) +#define LAPACK_ztprfb_base LAPACK_GLOBAL_SUFFIX(ztprfb,ZTPRFB) void LAPACK_ztprfb_base( char const* side, char const* trans, char const* direct, char const* storev, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -21214,7 +21228,7 @@ void LAPACK_ztprfb_base( #define LAPACK_ztprfb(...) LAPACK_ztprfb_base(__VA_ARGS__) #endif -#define LAPACK_ctprfs_base LAPACK_GLOBAL(ctprfs,CTPRFS) +#define LAPACK_ctprfs_base LAPACK_GLOBAL_SUFFIX(ctprfs,CTPRFS) void LAPACK_ctprfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21236,7 +21250,7 @@ void LAPACK_ctprfs_base( #define LAPACK_ctprfs(...) LAPACK_ctprfs_base(__VA_ARGS__) #endif -#define LAPACK_dtprfs_base LAPACK_GLOBAL(dtprfs,DTPRFS) +#define LAPACK_dtprfs_base LAPACK_GLOBAL_SUFFIX(dtprfs,DTPRFS) void LAPACK_dtprfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21258,7 +21272,7 @@ void LAPACK_dtprfs_base( #define LAPACK_dtprfs(...) LAPACK_dtprfs_base(__VA_ARGS__) #endif -#define LAPACK_stprfs_base LAPACK_GLOBAL(stprfs,STPRFS) +#define LAPACK_stprfs_base LAPACK_GLOBAL_SUFFIX(stprfs,STPRFS) void LAPACK_stprfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21280,7 +21294,7 @@ void LAPACK_stprfs_base( #define LAPACK_stprfs(...) LAPACK_stprfs_base(__VA_ARGS__) #endif -#define LAPACK_ztprfs_base LAPACK_GLOBAL(ztprfs,ZTPRFS) +#define LAPACK_ztprfs_base LAPACK_GLOBAL_SUFFIX(ztprfs,ZTPRFS) void LAPACK_ztprfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21302,7 +21316,7 @@ void LAPACK_ztprfs_base( #define LAPACK_ztprfs(...) LAPACK_ztprfs_base(__VA_ARGS__) #endif -#define LAPACK_ctptri_base LAPACK_GLOBAL(ctptri,CTPTRI) +#define LAPACK_ctptri_base LAPACK_GLOBAL_SUFFIX(ctptri,CTPTRI) void LAPACK_ctptri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -21318,7 +21332,7 @@ void LAPACK_ctptri_base( #define LAPACK_ctptri(...) LAPACK_ctptri_base(__VA_ARGS__) #endif -#define LAPACK_dtptri_base LAPACK_GLOBAL(dtptri,DTPTRI) +#define LAPACK_dtptri_base LAPACK_GLOBAL_SUFFIX(dtptri,DTPTRI) void LAPACK_dtptri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -21334,7 +21348,7 @@ void LAPACK_dtptri_base( #define LAPACK_dtptri(...) LAPACK_dtptri_base(__VA_ARGS__) #endif -#define LAPACK_stptri_base LAPACK_GLOBAL(stptri,STPTRI) +#define LAPACK_stptri_base LAPACK_GLOBAL_SUFFIX(stptri,STPTRI) void LAPACK_stptri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -21350,7 +21364,7 @@ void LAPACK_stptri_base( #define LAPACK_stptri(...) LAPACK_stptri_base(__VA_ARGS__) #endif -#define LAPACK_ztptri_base LAPACK_GLOBAL(ztptri,ZTPTRI) +#define LAPACK_ztptri_base LAPACK_GLOBAL_SUFFIX(ztptri,ZTPTRI) void LAPACK_ztptri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -21366,7 +21380,7 @@ void LAPACK_ztptri_base( #define LAPACK_ztptri(...) LAPACK_ztptri_base(__VA_ARGS__) #endif -#define LAPACK_ctptrs_base LAPACK_GLOBAL(ctptrs,CTPTRS) +#define LAPACK_ctptrs_base LAPACK_GLOBAL_SUFFIX(ctptrs,CTPTRS) void LAPACK_ctptrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21383,7 +21397,7 @@ void LAPACK_ctptrs_base( #define LAPACK_ctptrs(...) LAPACK_ctptrs_base(__VA_ARGS__) #endif -#define LAPACK_dtptrs_base LAPACK_GLOBAL(dtptrs,DTPTRS) +#define LAPACK_dtptrs_base LAPACK_GLOBAL_SUFFIX(dtptrs,DTPTRS) void LAPACK_dtptrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21400,7 +21414,7 @@ void LAPACK_dtptrs_base( #define LAPACK_dtptrs(...) LAPACK_dtptrs_base(__VA_ARGS__) #endif -#define LAPACK_stptrs_base LAPACK_GLOBAL(stptrs,STPTRS) +#define LAPACK_stptrs_base LAPACK_GLOBAL_SUFFIX(stptrs,STPTRS) void LAPACK_stptrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21417,7 +21431,7 @@ void LAPACK_stptrs_base( #define LAPACK_stptrs(...) LAPACK_stptrs_base(__VA_ARGS__) #endif -#define LAPACK_ztptrs_base LAPACK_GLOBAL(ztptrs,ZTPTRS) +#define LAPACK_ztptrs_base LAPACK_GLOBAL_SUFFIX(ztptrs,ZTPTRS) void LAPACK_ztptrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21434,7 +21448,7 @@ void LAPACK_ztptrs_base( #define LAPACK_ztptrs(...) LAPACK_ztptrs_base(__VA_ARGS__) #endif -#define LAPACK_ctpttf_base LAPACK_GLOBAL(ctpttf,CTPTTF) +#define LAPACK_ctpttf_base LAPACK_GLOBAL_SUFFIX(ctpttf,CTPTTF) void LAPACK_ctpttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -21451,7 +21465,7 @@ void LAPACK_ctpttf_base( #define LAPACK_ctpttf(...) LAPACK_ctpttf_base(__VA_ARGS__) #endif -#define LAPACK_dtpttf_base LAPACK_GLOBAL(dtpttf,DTPTTF) +#define LAPACK_dtpttf_base LAPACK_GLOBAL_SUFFIX(dtpttf,DTPTTF) void LAPACK_dtpttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -21468,7 +21482,7 @@ void LAPACK_dtpttf_base( #define LAPACK_dtpttf(...) LAPACK_dtpttf_base(__VA_ARGS__) #endif -#define LAPACK_stpttf_base LAPACK_GLOBAL(stpttf,STPTTF) +#define LAPACK_stpttf_base LAPACK_GLOBAL_SUFFIX(stpttf,STPTTF) void LAPACK_stpttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -21485,7 +21499,7 @@ void LAPACK_stpttf_base( #define LAPACK_stpttf(...) LAPACK_stpttf_base(__VA_ARGS__) #endif -#define LAPACK_ztpttf_base LAPACK_GLOBAL(ztpttf,ZTPTTF) +#define LAPACK_ztpttf_base LAPACK_GLOBAL_SUFFIX(ztpttf,ZTPTTF) void LAPACK_ztpttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -21502,7 +21516,7 @@ void LAPACK_ztpttf_base( #define LAPACK_ztpttf(...) LAPACK_ztpttf_base(__VA_ARGS__) #endif -#define LAPACK_ctpttr_base LAPACK_GLOBAL(ctpttr,CTPTTR) +#define LAPACK_ctpttr_base LAPACK_GLOBAL_SUFFIX(ctpttr,CTPTTR) void LAPACK_ctpttr_base( char const* uplo, lapack_int const* n, @@ -21519,7 +21533,7 @@ void LAPACK_ctpttr_base( #define LAPACK_ctpttr(...) LAPACK_ctpttr_base(__VA_ARGS__) #endif -#define LAPACK_dtpttr_base LAPACK_GLOBAL(dtpttr,DTPTTR) +#define LAPACK_dtpttr_base LAPACK_GLOBAL_SUFFIX(dtpttr,DTPTTR) void LAPACK_dtpttr_base( char const* uplo, lapack_int const* n, @@ -21536,7 +21550,7 @@ void LAPACK_dtpttr_base( #define LAPACK_dtpttr(...) LAPACK_dtpttr_base(__VA_ARGS__) #endif -#define LAPACK_stpttr_base LAPACK_GLOBAL(stpttr,STPTTR) +#define LAPACK_stpttr_base LAPACK_GLOBAL_SUFFIX(stpttr,STPTTR) void LAPACK_stpttr_base( char const* uplo, lapack_int const* n, @@ -21553,7 +21567,7 @@ void LAPACK_stpttr_base( #define LAPACK_stpttr(...) LAPACK_stpttr_base(__VA_ARGS__) #endif -#define LAPACK_ztpttr_base LAPACK_GLOBAL(ztpttr,ZTPTTR) +#define LAPACK_ztpttr_base LAPACK_GLOBAL_SUFFIX(ztpttr,ZTPTTR) void LAPACK_ztpttr_base( char const* uplo, lapack_int const* n, @@ -21570,7 +21584,7 @@ void LAPACK_ztpttr_base( #define LAPACK_ztpttr(...) LAPACK_ztpttr_base(__VA_ARGS__) #endif -#define LAPACK_ctrcon_base LAPACK_GLOBAL(ctrcon,CTRCON) +#define LAPACK_ctrcon_base LAPACK_GLOBAL_SUFFIX(ctrcon,CTRCON) void LAPACK_ctrcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -21589,7 +21603,7 @@ void LAPACK_ctrcon_base( #define LAPACK_ctrcon(...) LAPACK_ctrcon_base(__VA_ARGS__) #endif -#define LAPACK_dtrcon_base LAPACK_GLOBAL(dtrcon,DTRCON) +#define LAPACK_dtrcon_base LAPACK_GLOBAL_SUFFIX(dtrcon,DTRCON) void LAPACK_dtrcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -21608,7 +21622,7 @@ void LAPACK_dtrcon_base( #define LAPACK_dtrcon(...) LAPACK_dtrcon_base(__VA_ARGS__) #endif -#define LAPACK_strcon_base LAPACK_GLOBAL(strcon,STRCON) +#define LAPACK_strcon_base LAPACK_GLOBAL_SUFFIX(strcon,STRCON) void LAPACK_strcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -21627,7 +21641,7 @@ void LAPACK_strcon_base( #define LAPACK_strcon(...) LAPACK_strcon_base(__VA_ARGS__) #endif -#define LAPACK_ztrcon_base LAPACK_GLOBAL(ztrcon,ZTRCON) +#define LAPACK_ztrcon_base LAPACK_GLOBAL_SUFFIX(ztrcon,ZTRCON) void LAPACK_ztrcon_base( char const* norm, char const* uplo, char const* diag, lapack_int const* n, @@ -21646,7 +21660,7 @@ void LAPACK_ztrcon_base( #define LAPACK_ztrcon(...) LAPACK_ztrcon_base(__VA_ARGS__) #endif -#define LAPACK_ctrevc_base LAPACK_GLOBAL(ctrevc,CTREVC) +#define LAPACK_ctrevc_base LAPACK_GLOBAL_SUFFIX(ctrevc,CTREVC) void LAPACK_ctrevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -21667,7 +21681,7 @@ void LAPACK_ctrevc_base( #define LAPACK_ctrevc(...) LAPACK_ctrevc_base(__VA_ARGS__) #endif -#define LAPACK_dtrevc_base LAPACK_GLOBAL(dtrevc,DTREVC) +#define LAPACK_dtrevc_base LAPACK_GLOBAL_SUFFIX(dtrevc,DTREVC) void LAPACK_dtrevc_base( char const* side, char const* howmny, lapack_logical* select, @@ -21687,7 +21701,7 @@ void LAPACK_dtrevc_base( #define LAPACK_dtrevc(...) LAPACK_dtrevc_base(__VA_ARGS__) #endif -#define LAPACK_strevc_base LAPACK_GLOBAL(strevc,STREVC) +#define LAPACK_strevc_base LAPACK_GLOBAL_SUFFIX(strevc,STREVC) void LAPACK_strevc_base( char const* side, char const* howmny, lapack_logical* select, @@ -21707,7 +21721,7 @@ void LAPACK_strevc_base( #define LAPACK_strevc(...) LAPACK_strevc_base(__VA_ARGS__) #endif -#define LAPACK_ztrevc_base LAPACK_GLOBAL(ztrevc,ZTREVC) +#define LAPACK_ztrevc_base LAPACK_GLOBAL_SUFFIX(ztrevc,ZTREVC) void LAPACK_ztrevc_base( char const* side, char const* howmny, lapack_logical const* select, @@ -21728,7 +21742,7 @@ void LAPACK_ztrevc_base( #define LAPACK_ztrevc(...) LAPACK_ztrevc_base(__VA_ARGS__) #endif -#define LAPACK_ctrevc3_base LAPACK_GLOBAL(ctrevc3,CTREVC3) +#define LAPACK_ctrevc3_base LAPACK_GLOBAL_SUFFIX(ctrevc3,CTREVC3) void LAPACK_ctrevc3_base( char const* side, char const* howmny, lapack_logical const* select, @@ -21749,7 +21763,7 @@ void LAPACK_ctrevc3_base( #define LAPACK_ctrevc3(...) LAPACK_ctrevc3_base(__VA_ARGS__) #endif -#define LAPACK_dtrevc3_base LAPACK_GLOBAL(dtrevc3,DTREVC3) +#define LAPACK_dtrevc3_base LAPACK_GLOBAL_SUFFIX(dtrevc3,DTREVC3) void LAPACK_dtrevc3_base( char const* side, char const* howmny, lapack_logical* select, @@ -21769,7 +21783,7 @@ void LAPACK_dtrevc3_base( #define LAPACK_dtrevc3(...) LAPACK_dtrevc3_base(__VA_ARGS__) #endif -#define LAPACK_strevc3_base LAPACK_GLOBAL(strevc3,STREVC3) +#define LAPACK_strevc3_base LAPACK_GLOBAL_SUFFIX(strevc3,STREVC3) void LAPACK_strevc3_base( char const* side, char const* howmny, lapack_logical* select, @@ -21789,7 +21803,7 @@ void LAPACK_strevc3_base( #define LAPACK_strevc3(...) LAPACK_strevc3_base(__VA_ARGS__) #endif -#define LAPACK_ztrevc3_base LAPACK_GLOBAL(ztrevc3,ZTREVC3) +#define LAPACK_ztrevc3_base LAPACK_GLOBAL_SUFFIX(ztrevc3,ZTREVC3) void LAPACK_ztrevc3_base( char const* side, char const* howmny, lapack_logical const* select, @@ -21810,7 +21824,7 @@ void LAPACK_ztrevc3_base( #define LAPACK_ztrevc3(...) LAPACK_ztrevc3_base(__VA_ARGS__) #endif -#define LAPACK_ctrexc_base LAPACK_GLOBAL(ctrexc,CTREXC) +#define LAPACK_ctrexc_base LAPACK_GLOBAL_SUFFIX(ctrexc,CTREXC) void LAPACK_ctrexc_base( char const* compq, lapack_int const* n, @@ -21827,7 +21841,7 @@ void LAPACK_ctrexc_base( #define LAPACK_ctrexc(...) LAPACK_ctrexc_base(__VA_ARGS__) #endif -#define LAPACK_dtrexc_base LAPACK_GLOBAL(dtrexc,DTREXC) +#define LAPACK_dtrexc_base LAPACK_GLOBAL_SUFFIX(dtrexc,DTREXC) void LAPACK_dtrexc_base( char const* compq, lapack_int const* n, @@ -21845,7 +21859,7 @@ void LAPACK_dtrexc_base( #define LAPACK_dtrexc(...) LAPACK_dtrexc_base(__VA_ARGS__) #endif -#define LAPACK_strexc_base LAPACK_GLOBAL(strexc,STREXC) +#define LAPACK_strexc_base LAPACK_GLOBAL_SUFFIX(strexc,STREXC) void LAPACK_strexc_base( char const* compq, lapack_int const* n, @@ -21863,7 +21877,7 @@ void LAPACK_strexc_base( #define LAPACK_strexc(...) LAPACK_strexc_base(__VA_ARGS__) #endif -#define LAPACK_ztrexc_base LAPACK_GLOBAL(ztrexc,ZTREXC) +#define LAPACK_ztrexc_base LAPACK_GLOBAL_SUFFIX(ztrexc,ZTREXC) void LAPACK_ztrexc_base( char const* compq, lapack_int const* n, @@ -21880,7 +21894,7 @@ void LAPACK_ztrexc_base( #define LAPACK_ztrexc(...) LAPACK_ztrexc_base(__VA_ARGS__) #endif -#define LAPACK_ctrrfs_base LAPACK_GLOBAL(ctrrfs,CTRRFS) +#define LAPACK_ctrrfs_base LAPACK_GLOBAL_SUFFIX(ctrrfs,CTRRFS) void LAPACK_ctrrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21902,7 +21916,7 @@ void LAPACK_ctrrfs_base( #define LAPACK_ctrrfs(...) LAPACK_ctrrfs_base(__VA_ARGS__) #endif -#define LAPACK_dtrrfs_base LAPACK_GLOBAL(dtrrfs,DTRRFS) +#define LAPACK_dtrrfs_base LAPACK_GLOBAL_SUFFIX(dtrrfs,DTRRFS) void LAPACK_dtrrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21924,7 +21938,7 @@ void LAPACK_dtrrfs_base( #define LAPACK_dtrrfs(...) LAPACK_dtrrfs_base(__VA_ARGS__) #endif -#define LAPACK_strrfs_base LAPACK_GLOBAL(strrfs,STRRFS) +#define LAPACK_strrfs_base LAPACK_GLOBAL_SUFFIX(strrfs,STRRFS) void LAPACK_strrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21946,7 +21960,7 @@ void LAPACK_strrfs_base( #define LAPACK_strrfs(...) LAPACK_strrfs_base(__VA_ARGS__) #endif -#define LAPACK_ztrrfs_base LAPACK_GLOBAL(ztrrfs,ZTRRFS) +#define LAPACK_ztrrfs_base LAPACK_GLOBAL_SUFFIX(ztrrfs,ZTRRFS) void LAPACK_ztrrfs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -21968,7 +21982,7 @@ void LAPACK_ztrrfs_base( #define LAPACK_ztrrfs(...) LAPACK_ztrrfs_base(__VA_ARGS__) #endif -#define LAPACK_ctrsen_base LAPACK_GLOBAL(ctrsen,CTRSEN) +#define LAPACK_ctrsen_base LAPACK_GLOBAL_SUFFIX(ctrsen,CTRSEN) void LAPACK_ctrsen_base( char const* job, char const* compq, lapack_logical const* select, @@ -21990,7 +22004,7 @@ void LAPACK_ctrsen_base( #define LAPACK_ctrsen(...) LAPACK_ctrsen_base(__VA_ARGS__) #endif -#define LAPACK_dtrsen_base LAPACK_GLOBAL(dtrsen,DTRSEN) +#define LAPACK_dtrsen_base LAPACK_GLOBAL_SUFFIX(dtrsen,DTRSEN) void LAPACK_dtrsen_base( char const* job, char const* compq, lapack_logical const* select, @@ -22014,7 +22028,7 @@ void LAPACK_dtrsen_base( #define LAPACK_dtrsen(...) LAPACK_dtrsen_base(__VA_ARGS__) #endif -#define LAPACK_strsen_base LAPACK_GLOBAL(strsen,STRSEN) +#define LAPACK_strsen_base LAPACK_GLOBAL_SUFFIX(strsen,STRSEN) void LAPACK_strsen_base( char const* job, char const* compq, lapack_logical const* select, @@ -22038,7 +22052,7 @@ void LAPACK_strsen_base( #define LAPACK_strsen(...) LAPACK_strsen_base(__VA_ARGS__) #endif -#define LAPACK_ztrsen_base LAPACK_GLOBAL(ztrsen,ZTRSEN) +#define LAPACK_ztrsen_base LAPACK_GLOBAL_SUFFIX(ztrsen,ZTRSEN) void LAPACK_ztrsen_base( char const* job, char const* compq, lapack_logical const* select, @@ -22060,7 +22074,7 @@ void LAPACK_ztrsen_base( #define LAPACK_ztrsen(...) LAPACK_ztrsen_base(__VA_ARGS__) #endif -#define LAPACK_ctrsna_base LAPACK_GLOBAL(ctrsna,CTRSNA) +#define LAPACK_ctrsna_base LAPACK_GLOBAL_SUFFIX(ctrsna,CTRSNA) void LAPACK_ctrsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -22083,7 +22097,7 @@ void LAPACK_ctrsna_base( #define LAPACK_ctrsna(...) LAPACK_ctrsna_base(__VA_ARGS__) #endif -#define LAPACK_dtrsna_base LAPACK_GLOBAL(dtrsna,DTRSNA) +#define LAPACK_dtrsna_base LAPACK_GLOBAL_SUFFIX(dtrsna,DTRSNA) void LAPACK_dtrsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -22106,7 +22120,7 @@ void LAPACK_dtrsna_base( #define LAPACK_dtrsna(...) LAPACK_dtrsna_base(__VA_ARGS__) #endif -#define LAPACK_strsna_base LAPACK_GLOBAL(strsna,STRSNA) +#define LAPACK_strsna_base LAPACK_GLOBAL_SUFFIX(strsna,STRSNA) void LAPACK_strsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -22129,7 +22143,7 @@ void LAPACK_strsna_base( #define LAPACK_strsna(...) LAPACK_strsna_base(__VA_ARGS__) #endif -#define LAPACK_ztrsna_base LAPACK_GLOBAL(ztrsna,ZTRSNA) +#define LAPACK_ztrsna_base LAPACK_GLOBAL_SUFFIX(ztrsna,ZTRSNA) void LAPACK_ztrsna_base( char const* job, char const* howmny, lapack_logical const* select, @@ -22152,7 +22166,7 @@ void LAPACK_ztrsna_base( #define LAPACK_ztrsna(...) LAPACK_ztrsna_base(__VA_ARGS__) #endif -#define LAPACK_ctrsyl_base LAPACK_GLOBAL(ctrsyl,CTRSYL) +#define LAPACK_ctrsyl_base LAPACK_GLOBAL_SUFFIX(ctrsyl,CTRSYL) void LAPACK_ctrsyl_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22171,7 +22185,7 @@ void LAPACK_ctrsyl_base( #define LAPACK_ctrsyl(...) LAPACK_ctrsyl_base(__VA_ARGS__) #endif -#define LAPACK_dtrsyl_base LAPACK_GLOBAL(dtrsyl,DTRSYL) +#define LAPACK_dtrsyl_base LAPACK_GLOBAL_SUFFIX(dtrsyl,DTRSYL) void LAPACK_dtrsyl_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22190,7 +22204,7 @@ void LAPACK_dtrsyl_base( #define LAPACK_dtrsyl(...) LAPACK_dtrsyl_base(__VA_ARGS__) #endif -#define LAPACK_strsyl_base LAPACK_GLOBAL(strsyl,STRSYL) +#define LAPACK_strsyl_base LAPACK_GLOBAL_SUFFIX(strsyl,STRSYL) void LAPACK_strsyl_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22209,7 +22223,7 @@ void LAPACK_strsyl_base( #define LAPACK_strsyl(...) LAPACK_strsyl_base(__VA_ARGS__) #endif -#define LAPACK_ztrsyl_base LAPACK_GLOBAL(ztrsyl,ZTRSYL) +#define LAPACK_ztrsyl_base LAPACK_GLOBAL_SUFFIX(ztrsyl,ZTRSYL) void LAPACK_ztrsyl_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22228,7 +22242,7 @@ void LAPACK_ztrsyl_base( #define LAPACK_ztrsyl(...) LAPACK_ztrsyl_base(__VA_ARGS__) #endif -#define LAPACK_ctrsyl3_base LAPACK_GLOBAL(ctrsyl3,CTRSYL3) +#define LAPACK_ctrsyl3_base LAPACK_GLOBAL_SUFFIX(ctrsyl3,CTRSYL3) void LAPACK_ctrsyl3_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22247,7 +22261,7 @@ void LAPACK_ctrsyl3_base( #define LAPACK_ctrsyl3(...) LAPACK_ctrsyl3_base(__VA_ARGS__) #endif -#define LAPACK_dtrsyl3_base LAPACK_GLOBAL(dtrsyl3,DTRSYL3) +#define LAPACK_dtrsyl3_base LAPACK_GLOBAL_SUFFIX(dtrsyl3,DTRSYL3) void LAPACK_dtrsyl3_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22267,7 +22281,7 @@ void LAPACK_dtrsyl3_base( #define LAPACK_dtrsyl3(...) LAPACK_dtrsyl3_base(__VA_ARGS__) #endif -#define LAPACK_strsyl3_base LAPACK_GLOBAL(strsyl3,STRSYL3) +#define LAPACK_strsyl3_base LAPACK_GLOBAL_SUFFIX(strsyl3,STRSYL3) void LAPACK_strsyl3_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22287,7 +22301,7 @@ void LAPACK_strsyl3_base( #define LAPACK_strsyl3(...) LAPACK_strsyl3_base(__VA_ARGS__) #endif -#define LAPACK_ztrsyl3_base LAPACK_GLOBAL(ztrsyl3,ZTRSYL3) +#define LAPACK_ztrsyl3_base LAPACK_GLOBAL_SUFFIX(ztrsyl3,ZTRSYL3) void LAPACK_ztrsyl3_base( char const* trana, char const* tranb, lapack_int const* isgn, lapack_int const* m, lapack_int const* n, @@ -22306,7 +22320,7 @@ void LAPACK_ztrsyl3_base( #define LAPACK_ztrsyl3(...) LAPACK_ztrsyl3_base(__VA_ARGS__) #endif -#define LAPACK_ctrtri_base LAPACK_GLOBAL(ctrtri,CTRTRI) +#define LAPACK_ctrtri_base LAPACK_GLOBAL_SUFFIX(ctrtri,CTRTRI) void LAPACK_ctrtri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -22322,7 +22336,7 @@ void LAPACK_ctrtri_base( #define LAPACK_ctrtri(...) LAPACK_ctrtri_base(__VA_ARGS__) #endif -#define LAPACK_dtrtri_base LAPACK_GLOBAL(dtrtri,DTRTRI) +#define LAPACK_dtrtri_base LAPACK_GLOBAL_SUFFIX(dtrtri,DTRTRI) void LAPACK_dtrtri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -22338,7 +22352,7 @@ void LAPACK_dtrtri_base( #define LAPACK_dtrtri(...) LAPACK_dtrtri_base(__VA_ARGS__) #endif -#define LAPACK_strtri_base LAPACK_GLOBAL(strtri,STRTRI) +#define LAPACK_strtri_base LAPACK_GLOBAL_SUFFIX(strtri,STRTRI) void LAPACK_strtri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -22354,7 +22368,7 @@ void LAPACK_strtri_base( #define LAPACK_strtri(...) LAPACK_strtri_base(__VA_ARGS__) #endif -#define LAPACK_ztrtri_base LAPACK_GLOBAL(ztrtri,ZTRTRI) +#define LAPACK_ztrtri_base LAPACK_GLOBAL_SUFFIX(ztrtri,ZTRTRI) void LAPACK_ztrtri_base( char const* uplo, char const* diag, lapack_int const* n, @@ -22370,7 +22384,7 @@ void LAPACK_ztrtri_base( #define LAPACK_ztrtri(...) LAPACK_ztrtri_base(__VA_ARGS__) #endif -#define LAPACK_ctrtrs_base LAPACK_GLOBAL(ctrtrs,CTRTRS) +#define LAPACK_ctrtrs_base LAPACK_GLOBAL_SUFFIX(ctrtrs,CTRTRS) void LAPACK_ctrtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -22387,7 +22401,7 @@ void LAPACK_ctrtrs_base( #define LAPACK_ctrtrs(...) LAPACK_ctrtrs_base(__VA_ARGS__) #endif -#define LAPACK_dtrtrs_base LAPACK_GLOBAL(dtrtrs,DTRTRS) +#define LAPACK_dtrtrs_base LAPACK_GLOBAL_SUFFIX(dtrtrs,DTRTRS) void LAPACK_dtrtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -22404,7 +22418,7 @@ void LAPACK_dtrtrs_base( #define LAPACK_dtrtrs(...) LAPACK_dtrtrs_base(__VA_ARGS__) #endif -#define LAPACK_strtrs_base LAPACK_GLOBAL(strtrs,STRTRS) +#define LAPACK_strtrs_base LAPACK_GLOBAL_SUFFIX(strtrs,STRTRS) void LAPACK_strtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -22421,7 +22435,7 @@ void LAPACK_strtrs_base( #define LAPACK_strtrs(...) LAPACK_strtrs_base(__VA_ARGS__) #endif -#define LAPACK_ztrtrs_base LAPACK_GLOBAL(ztrtrs,ZTRTRS) +#define LAPACK_ztrtrs_base LAPACK_GLOBAL_SUFFIX(ztrtrs,ZTRTRS) void LAPACK_ztrtrs_base( char const* uplo, char const* trans, char const* diag, lapack_int const* n, lapack_int const* nrhs, @@ -22438,7 +22452,7 @@ void LAPACK_ztrtrs_base( #define LAPACK_ztrtrs(...) LAPACK_ztrtrs_base(__VA_ARGS__) #endif -#define LAPACK_ctrttf_base LAPACK_GLOBAL(ctrttf,CTRTTF) +#define LAPACK_ctrttf_base LAPACK_GLOBAL_SUFFIX(ctrttf,CTRTTF) void LAPACK_ctrttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -22455,7 +22469,7 @@ void LAPACK_ctrttf_base( #define LAPACK_ctrttf(...) LAPACK_ctrttf_base(__VA_ARGS__) #endif -#define LAPACK_dtrttf_base LAPACK_GLOBAL(dtrttf,DTRTTF) +#define LAPACK_dtrttf_base LAPACK_GLOBAL_SUFFIX(dtrttf,DTRTTF) void LAPACK_dtrttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -22472,7 +22486,7 @@ void LAPACK_dtrttf_base( #define LAPACK_dtrttf(...) LAPACK_dtrttf_base(__VA_ARGS__) #endif -#define LAPACK_strttf_base LAPACK_GLOBAL(strttf,STRTTF) +#define LAPACK_strttf_base LAPACK_GLOBAL_SUFFIX(strttf,STRTTF) void LAPACK_strttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -22489,7 +22503,7 @@ void LAPACK_strttf_base( #define LAPACK_strttf(...) LAPACK_strttf_base(__VA_ARGS__) #endif -#define LAPACK_ztrttf_base LAPACK_GLOBAL(ztrttf,ZTRTTF) +#define LAPACK_ztrttf_base LAPACK_GLOBAL_SUFFIX(ztrttf,ZTRTTF) void LAPACK_ztrttf_base( char const* transr, char const* uplo, lapack_int const* n, @@ -22506,7 +22520,7 @@ void LAPACK_ztrttf_base( #define LAPACK_ztrttf(...) LAPACK_ztrttf_base(__VA_ARGS__) #endif -#define LAPACK_ctrttp_base LAPACK_GLOBAL(ctrttp,CTRTTP) +#define LAPACK_ctrttp_base LAPACK_GLOBAL_SUFFIX(ctrttp,CTRTTP) void LAPACK_ctrttp_base( char const* uplo, lapack_int const* n, @@ -22523,7 +22537,7 @@ void LAPACK_ctrttp_base( #define LAPACK_ctrttp(...) LAPACK_ctrttp_base(__VA_ARGS__) #endif -#define LAPACK_dtrttp_base LAPACK_GLOBAL(dtrttp,DTRTTP) +#define LAPACK_dtrttp_base LAPACK_GLOBAL_SUFFIX(dtrttp,DTRTTP) void LAPACK_dtrttp_base( char const* uplo, lapack_int const* n, @@ -22540,7 +22554,7 @@ void LAPACK_dtrttp_base( #define LAPACK_dtrttp(...) LAPACK_dtrttp_base(__VA_ARGS__) #endif -#define LAPACK_strttp_base LAPACK_GLOBAL(strttp,STRTTP) +#define LAPACK_strttp_base LAPACK_GLOBAL_SUFFIX(strttp,STRTTP) void LAPACK_strttp_base( char const* uplo, lapack_int const* n, @@ -22557,7 +22571,7 @@ void LAPACK_strttp_base( #define LAPACK_strttp(...) LAPACK_strttp_base(__VA_ARGS__) #endif -#define LAPACK_ztrttp_base LAPACK_GLOBAL(ztrttp,ZTRTTP) +#define LAPACK_ztrttp_base LAPACK_GLOBAL_SUFFIX(ztrttp,ZTRTTP) void LAPACK_ztrttp_base( char const* uplo, lapack_int const* n, @@ -22574,7 +22588,7 @@ void LAPACK_ztrttp_base( #define LAPACK_ztrttp(...) LAPACK_ztrttp_base(__VA_ARGS__) #endif -#define LAPACK_ctzrzf LAPACK_GLOBAL(ctzrzf,CTZRZF) +#define LAPACK_ctzrzf LAPACK_GLOBAL_SUFFIX(ctzrzf,CTZRZF) void LAPACK_ctzrzf( lapack_int const* m, lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, @@ -22582,7 +22596,7 @@ void LAPACK_ctzrzf( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_dtzrzf LAPACK_GLOBAL(dtzrzf,DTZRZF) +#define LAPACK_dtzrzf LAPACK_GLOBAL_SUFFIX(dtzrzf,DTZRZF) void LAPACK_dtzrzf( lapack_int const* m, lapack_int const* n, double* A, lapack_int const* lda, @@ -22590,7 +22604,7 @@ void LAPACK_dtzrzf( double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_stzrzf LAPACK_GLOBAL(stzrzf,STZRZF) +#define LAPACK_stzrzf LAPACK_GLOBAL_SUFFIX(stzrzf,STZRZF) void LAPACK_stzrzf( lapack_int const* m, lapack_int const* n, float* A, lapack_int const* lda, @@ -22598,7 +22612,7 @@ void LAPACK_stzrzf( float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_ztzrzf LAPACK_GLOBAL(ztzrzf,ZTZRZF) +#define LAPACK_ztzrzf LAPACK_GLOBAL_SUFFIX(ztzrzf,ZTZRZF) void LAPACK_ztzrzf( lapack_int const* m, lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, @@ -22606,7 +22620,7 @@ void LAPACK_ztzrzf( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cunbdb_base LAPACK_GLOBAL(cunbdb,CUNBDB) +#define LAPACK_cunbdb_base LAPACK_GLOBAL_SUFFIX(cunbdb,CUNBDB) void LAPACK_cunbdb_base( char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22632,7 +22646,7 @@ void LAPACK_cunbdb_base( #define LAPACK_cunbdb(...) LAPACK_cunbdb_base(__VA_ARGS__) #endif -#define LAPACK_zunbdb_base LAPACK_GLOBAL(zunbdb,ZUNBDB) +#define LAPACK_zunbdb_base LAPACK_GLOBAL_SUFFIX(zunbdb,ZUNBDB) void LAPACK_zunbdb_base( char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22658,7 +22672,7 @@ void LAPACK_zunbdb_base( #define LAPACK_zunbdb(...) LAPACK_zunbdb_base(__VA_ARGS__) #endif -#define LAPACK_cuncsd_base LAPACK_GLOBAL(cuncsd,CUNCSD) +#define LAPACK_cuncsd_base LAPACK_GLOBAL_SUFFIX(cuncsd,CUNCSD) void LAPACK_cuncsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22685,7 +22699,7 @@ void LAPACK_cuncsd_base( #define LAPACK_cuncsd(...) LAPACK_cuncsd_base(__VA_ARGS__) #endif -#define LAPACK_zuncsd_base LAPACK_GLOBAL(zuncsd,ZUNCSD) +#define LAPACK_zuncsd_base LAPACK_GLOBAL_SUFFIX(zuncsd,ZUNCSD) void LAPACK_zuncsd_base( char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22712,7 +22726,7 @@ void LAPACK_zuncsd_base( #define LAPACK_zuncsd(...) LAPACK_zuncsd_base(__VA_ARGS__) #endif -#define LAPACK_cuncsd2by1_base LAPACK_GLOBAL(cuncsd2by1,CUNCSD2BY1) +#define LAPACK_cuncsd2by1_base LAPACK_GLOBAL_SUFFIX(cuncsd2by1,CUNCSD2BY1) void LAPACK_cuncsd2by1_base( char const* jobu1, char const* jobu2, char const* jobv1t, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22736,7 +22750,7 @@ void LAPACK_cuncsd2by1_base( #define LAPACK_cuncsd2by1(...) LAPACK_cuncsd2by1_base(__VA_ARGS__) #endif -#define LAPACK_zuncsd2by1_base LAPACK_GLOBAL(zuncsd2by1,ZUNCSD2BY1) +#define LAPACK_zuncsd2by1_base LAPACK_GLOBAL_SUFFIX(zuncsd2by1,ZUNCSD2BY1) void LAPACK_zuncsd2by1_base( char const* jobu1, char const* jobu2, char const* jobv1t, lapack_int const* m, lapack_int const* p, lapack_int const* q, @@ -22760,7 +22774,7 @@ void LAPACK_zuncsd2by1_base( #define LAPACK_zuncsd2by1(...) LAPACK_zuncsd2by1_base(__VA_ARGS__) #endif -#define LAPACK_cungbr_base LAPACK_GLOBAL(cungbr,CUNGBR) +#define LAPACK_cungbr_base LAPACK_GLOBAL_SUFFIX(cungbr,CUNGBR) void LAPACK_cungbr_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -22778,7 +22792,7 @@ void LAPACK_cungbr_base( #define LAPACK_cungbr(...) LAPACK_cungbr_base(__VA_ARGS__) #endif -#define LAPACK_zungbr_base LAPACK_GLOBAL(zungbr,ZUNGBR) +#define LAPACK_zungbr_base LAPACK_GLOBAL_SUFFIX(zungbr,ZUNGBR) void LAPACK_zungbr_base( char const* vect, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -22796,7 +22810,7 @@ void LAPACK_zungbr_base( #define LAPACK_zungbr(...) LAPACK_zungbr_base(__VA_ARGS__) #endif -#define LAPACK_cunghr LAPACK_GLOBAL(cunghr,CUNGHR) +#define LAPACK_cunghr LAPACK_GLOBAL_SUFFIX(cunghr,CUNGHR) void LAPACK_cunghr( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, lapack_complex_float* A, lapack_int const* lda, @@ -22804,7 +22818,7 @@ void LAPACK_cunghr( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zunghr LAPACK_GLOBAL(zunghr,ZUNGHR) +#define LAPACK_zunghr LAPACK_GLOBAL_SUFFIX(zunghr,ZUNGHR) void LAPACK_zunghr( lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, lapack_complex_double* A, lapack_int const* lda, @@ -22812,7 +22826,7 @@ void LAPACK_zunghr( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cunglq LAPACK_GLOBAL(cunglq,CUNGLQ) +#define LAPACK_cunglq LAPACK_GLOBAL_SUFFIX(cunglq,CUNGLQ) void LAPACK_cunglq( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_float* A, lapack_int const* lda, @@ -22820,7 +22834,7 @@ void LAPACK_cunglq( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zunglq LAPACK_GLOBAL(zunglq,ZUNGLQ) +#define LAPACK_zunglq LAPACK_GLOBAL_SUFFIX(zunglq,ZUNGLQ) void LAPACK_zunglq( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_double* A, lapack_int const* lda, @@ -22828,7 +22842,7 @@ void LAPACK_zunglq( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cungql LAPACK_GLOBAL(cungql,CUNGQL) +#define LAPACK_cungql LAPACK_GLOBAL_SUFFIX(cungql,CUNGQL) void LAPACK_cungql( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_float* A, lapack_int const* lda, @@ -22836,7 +22850,7 @@ void LAPACK_cungql( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zungql LAPACK_GLOBAL(zungql,ZUNGQL) +#define LAPACK_zungql LAPACK_GLOBAL_SUFFIX(zungql,ZUNGQL) void LAPACK_zungql( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_double* A, lapack_int const* lda, @@ -22844,7 +22858,7 @@ void LAPACK_zungql( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cungqr LAPACK_GLOBAL(cungqr,CUNGQR) +#define LAPACK_cungqr LAPACK_GLOBAL_SUFFIX(cungqr,CUNGQR) void LAPACK_cungqr( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_float* A, lapack_int const* lda, @@ -22852,7 +22866,7 @@ void LAPACK_cungqr( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zungqr LAPACK_GLOBAL(zungqr,ZUNGQR) +#define LAPACK_zungqr LAPACK_GLOBAL_SUFFIX(zungqr,ZUNGQR) void LAPACK_zungqr( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_double* A, lapack_int const* lda, @@ -22860,7 +22874,7 @@ void LAPACK_zungqr( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cungrq LAPACK_GLOBAL(cungrq,CUNGRQ) +#define LAPACK_cungrq LAPACK_GLOBAL_SUFFIX(cungrq,CUNGRQ) void LAPACK_cungrq( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_float* A, lapack_int const* lda, @@ -22868,7 +22882,7 @@ void LAPACK_cungrq( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zungrq LAPACK_GLOBAL(zungrq,ZUNGRQ) +#define LAPACK_zungrq LAPACK_GLOBAL_SUFFIX(zungrq,ZUNGRQ) void LAPACK_zungrq( lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_complex_double* A, lapack_int const* lda, @@ -22876,7 +22890,7 @@ void LAPACK_zungrq( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cungtr_base LAPACK_GLOBAL(cungtr,CUNGTR) +#define LAPACK_cungtr_base LAPACK_GLOBAL_SUFFIX(cungtr,CUNGTR) void LAPACK_cungtr_base( char const* uplo, lapack_int const* n, @@ -22894,7 +22908,7 @@ void LAPACK_cungtr_base( #define LAPACK_cungtr(...) LAPACK_cungtr_base(__VA_ARGS__) #endif -#define LAPACK_zungtr_base LAPACK_GLOBAL(zungtr,ZUNGTR) +#define LAPACK_zungtr_base LAPACK_GLOBAL_SUFFIX(zungtr,ZUNGTR) void LAPACK_zungtr_base( char const* uplo, lapack_int const* n, @@ -22912,7 +22926,7 @@ void LAPACK_zungtr_base( #define LAPACK_zungtr(...) LAPACK_zungtr_base(__VA_ARGS__) #endif -#define LAPACK_cungtsqr_row LAPACK_GLOBAL(cungtsqr_row,CUNGTSQR_ROW) +#define LAPACK_cungtsqr_row LAPACK_GLOBAL_SUFFIX(cungtsqr_row,CUNGTSQR_ROW) void LAPACK_cungtsqr_row( lapack_int const* m, lapack_int const* n, lapack_int const* mb, lapack_int const* nb, @@ -22921,7 +22935,7 @@ void LAPACK_cungtsqr_row( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_zungtsqr_row LAPACK_GLOBAL(zungtsqr_row,ZUNGTSQR_ROW) +#define LAPACK_zungtsqr_row LAPACK_GLOBAL_SUFFIX(zungtsqr_row,ZUNGTSQR_ROW) void LAPACK_zungtsqr_row( lapack_int const* m, lapack_int const* n, lapack_int const* mb, lapack_int const* nb, @@ -22930,7 +22944,7 @@ void LAPACK_zungtsqr_row( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info ); -#define LAPACK_cunhr_col LAPACK_GLOBAL(cunhr_col,CUNHR_COL) +#define LAPACK_cunhr_col LAPACK_GLOBAL_SUFFIX(cunhr_col,CUNHR_COL) void LAPACK_cunhr_col( lapack_int const* m, lapack_int const* n, lapack_int const* nb, lapack_complex_float* A, @@ -22938,7 +22952,7 @@ void LAPACK_cunhr_col( lapack_int const* ldt, lapack_complex_float* D, lapack_int* info ); -#define LAPACK_zunhr_col LAPACK_GLOBAL(zunhr_col,ZUNHR_COL) +#define LAPACK_zunhr_col LAPACK_GLOBAL_SUFFIX(zunhr_col,ZUNHR_COL) void LAPACK_zunhr_col( lapack_int const* m, lapack_int const* n, lapack_int const* nb, lapack_complex_double* A, @@ -22946,7 +22960,7 @@ void LAPACK_zunhr_col( lapack_int const* ldt, lapack_complex_double* D, lapack_int* info ); -#define LAPACK_cunmbr_base LAPACK_GLOBAL(cunmbr,CUNMBR) +#define LAPACK_cunmbr_base LAPACK_GLOBAL_SUFFIX(cunmbr,CUNMBR) void LAPACK_cunmbr_base( char const* vect, char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -22965,7 +22979,7 @@ void LAPACK_cunmbr_base( #define LAPACK_cunmbr(...) LAPACK_cunmbr_base(__VA_ARGS__) #endif -#define LAPACK_zunmbr_base LAPACK_GLOBAL(zunmbr,ZUNMBR) +#define LAPACK_zunmbr_base LAPACK_GLOBAL_SUFFIX(zunmbr,ZUNMBR) void LAPACK_zunmbr_base( char const* vect, char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -22984,7 +22998,7 @@ void LAPACK_zunmbr_base( #define LAPACK_zunmbr(...) LAPACK_zunmbr_base(__VA_ARGS__) #endif -#define LAPACK_cunmhr_base LAPACK_GLOBAL(cunmhr,CUNMHR) +#define LAPACK_cunmhr_base LAPACK_GLOBAL_SUFFIX(cunmhr,CUNMHR) void LAPACK_cunmhr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -23003,7 +23017,7 @@ void LAPACK_cunmhr_base( #define LAPACK_cunmhr(...) LAPACK_cunmhr_base(__VA_ARGS__) #endif -#define LAPACK_zunmhr_base LAPACK_GLOBAL(zunmhr,ZUNMHR) +#define LAPACK_zunmhr_base LAPACK_GLOBAL_SUFFIX(zunmhr,ZUNMHR) void LAPACK_zunmhr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, @@ -23022,7 +23036,7 @@ void LAPACK_zunmhr_base( #define LAPACK_zunmhr(...) LAPACK_zunmhr_base(__VA_ARGS__) #endif -#define LAPACK_cunmlq_base LAPACK_GLOBAL(cunmlq,CUNMLQ) +#define LAPACK_cunmlq_base LAPACK_GLOBAL_SUFFIX(cunmlq,CUNMLQ) void LAPACK_cunmlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23041,7 +23055,7 @@ void LAPACK_cunmlq_base( #define LAPACK_cunmlq(...) LAPACK_cunmlq_base(__VA_ARGS__) #endif -#define LAPACK_zunmlq_base LAPACK_GLOBAL(zunmlq,ZUNMLQ) +#define LAPACK_zunmlq_base LAPACK_GLOBAL_SUFFIX(zunmlq,ZUNMLQ) void LAPACK_zunmlq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23060,7 +23074,7 @@ void LAPACK_zunmlq_base( #define LAPACK_zunmlq(...) LAPACK_zunmlq_base(__VA_ARGS__) #endif -#define LAPACK_cunmql_base LAPACK_GLOBAL(cunmql,CUNMQL) +#define LAPACK_cunmql_base LAPACK_GLOBAL_SUFFIX(cunmql,CUNMQL) void LAPACK_cunmql_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23079,7 +23093,7 @@ void LAPACK_cunmql_base( #define LAPACK_cunmql(...) LAPACK_cunmql_base(__VA_ARGS__) #endif -#define LAPACK_zunmql_base LAPACK_GLOBAL(zunmql,ZUNMQL) +#define LAPACK_zunmql_base LAPACK_GLOBAL_SUFFIX(zunmql,ZUNMQL) void LAPACK_zunmql_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23098,7 +23112,7 @@ void LAPACK_zunmql_base( #define LAPACK_zunmql(...) LAPACK_zunmql_base(__VA_ARGS__) #endif -#define LAPACK_cunmqr_base LAPACK_GLOBAL(cunmqr,CUNMQR) +#define LAPACK_cunmqr_base LAPACK_GLOBAL_SUFFIX(cunmqr,CUNMQR) void LAPACK_cunmqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23117,7 +23131,7 @@ void LAPACK_cunmqr_base( #define LAPACK_cunmqr(...) LAPACK_cunmqr_base(__VA_ARGS__) #endif -#define LAPACK_zunmqr_base LAPACK_GLOBAL(zunmqr,ZUNMQR) +#define LAPACK_zunmqr_base LAPACK_GLOBAL_SUFFIX(zunmqr,ZUNMQR) void LAPACK_zunmqr_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23136,7 +23150,7 @@ void LAPACK_zunmqr_base( #define LAPACK_zunmqr(...) LAPACK_zunmqr_base(__VA_ARGS__) #endif -#define LAPACK_cunmrq_base LAPACK_GLOBAL(cunmrq,CUNMRQ) +#define LAPACK_cunmrq_base LAPACK_GLOBAL_SUFFIX(cunmrq,CUNMRQ) void LAPACK_cunmrq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23155,7 +23169,7 @@ void LAPACK_cunmrq_base( #define LAPACK_cunmrq(...) LAPACK_cunmrq_base(__VA_ARGS__) #endif -#define LAPACK_zunmrq_base LAPACK_GLOBAL(zunmrq,ZUNMRQ) +#define LAPACK_zunmrq_base LAPACK_GLOBAL_SUFFIX(zunmrq,ZUNMRQ) void LAPACK_zunmrq_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, @@ -23174,7 +23188,7 @@ void LAPACK_zunmrq_base( #define LAPACK_zunmrq(...) LAPACK_zunmrq_base(__VA_ARGS__) #endif -#define LAPACK_cunmrz_base LAPACK_GLOBAL(cunmrz,CUNMRZ) +#define LAPACK_cunmrz_base LAPACK_GLOBAL_SUFFIX(cunmrz,CUNMRZ) void LAPACK_cunmrz_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -23193,7 +23207,7 @@ void LAPACK_cunmrz_base( #define LAPACK_cunmrz(...) LAPACK_cunmrz_base(__VA_ARGS__) #endif -#define LAPACK_zunmrz_base LAPACK_GLOBAL(zunmrz,ZUNMRZ) +#define LAPACK_zunmrz_base LAPACK_GLOBAL_SUFFIX(zunmrz,ZUNMRZ) void LAPACK_zunmrz_base( char const* side, char const* trans, lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, @@ -23212,7 +23226,7 @@ void LAPACK_zunmrz_base( #define LAPACK_zunmrz(...) LAPACK_zunmrz_base(__VA_ARGS__) #endif -#define LAPACK_cunmtr_base LAPACK_GLOBAL(cunmtr,CUNMTR) +#define LAPACK_cunmtr_base LAPACK_GLOBAL_SUFFIX(cunmtr,CUNMTR) void LAPACK_cunmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -23231,7 +23245,7 @@ void LAPACK_cunmtr_base( #define LAPACK_cunmtr(...) LAPACK_cunmtr_base(__VA_ARGS__) #endif -#define LAPACK_zunmtr_base LAPACK_GLOBAL(zunmtr,ZUNMTR) +#define LAPACK_zunmtr_base LAPACK_GLOBAL_SUFFIX(zunmtr,ZUNMTR) void LAPACK_zunmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -23250,7 +23264,7 @@ void LAPACK_zunmtr_base( #define LAPACK_zunmtr(...) LAPACK_zunmtr_base(__VA_ARGS__) #endif -#define LAPACK_cupgtr_base LAPACK_GLOBAL(cupgtr,CUPGTR) +#define LAPACK_cupgtr_base LAPACK_GLOBAL_SUFFIX(cupgtr,CUPGTR) void LAPACK_cupgtr_base( char const* uplo, lapack_int const* n, @@ -23269,7 +23283,7 @@ void LAPACK_cupgtr_base( #define LAPACK_cupgtr(...) LAPACK_cupgtr_base(__VA_ARGS__) #endif -#define LAPACK_zupgtr_base LAPACK_GLOBAL(zupgtr,ZUPGTR) +#define LAPACK_zupgtr_base LAPACK_GLOBAL_SUFFIX(zupgtr,ZUPGTR) void LAPACK_zupgtr_base( char const* uplo, lapack_int const* n, @@ -23288,7 +23302,7 @@ void LAPACK_zupgtr_base( #define LAPACK_zupgtr(...) LAPACK_zupgtr_base(__VA_ARGS__) #endif -#define LAPACK_cupmtr_base LAPACK_GLOBAL(cupmtr,CUPMTR) +#define LAPACK_cupmtr_base LAPACK_GLOBAL_SUFFIX(cupmtr,CUPMTR) void LAPACK_cupmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, @@ -23307,7 +23321,7 @@ void LAPACK_cupmtr_base( #define LAPACK_cupmtr(...) LAPACK_cupmtr_base(__VA_ARGS__) #endif -#define LAPACK_zupmtr_base LAPACK_GLOBAL(zupmtr,ZUPMTR) +#define LAPACK_zupmtr_base LAPACK_GLOBAL_SUFFIX(zupmtr,ZUPMTR) void LAPACK_zupmtr_base( char const* side, char const* uplo, char const* trans, lapack_int const* m, lapack_int const* n, diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index 377e2a6bbc..82cc4e6c1e 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -58,6 +58,21 @@ extern "C" { lapack_complex_float lapack_make_complex_float( float re, float im ); lapack_complex_double lapack_make_complex_double( double re, double im ); +/* + * Integer specific API + */ +#ifdef LAPACKE_API64 +#ifndef API_SUFFIX +#define API_SUFFIX(a) a##_64 +#endif +#include "lapacke_64.h" +#else +#ifndef API_SUFFIX +#define API_SUFFIX(a) a +#endif +#endif + + /* C-LAPACK function prototypes */ lapack_int LAPACKE_sbdsdc( int matrix_layout, char uplo, char compq, diff --git a/LAPACKE/include/lapacke_64.h b/LAPACKE/include/lapacke_64.h new file mode 100644 index 0000000000..0e3900e45c --- /dev/null +++ b/LAPACKE/include/lapacke_64.h @@ -0,0 +1,12863 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +****************************************************************************** +* Contents: Native C interface to LAPACK +* Author: Intel Corporation +*****************************************************************************/ + +#ifndef _LAPACKE_64_H_ +#define _LAPACKE_64_H_ + +#include "lapacke.h" + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + +/* C-LAPACK function prototypes */ + +int64_t LAPACKE_sbdsdc_64( int matrix_layout, char uplo, char compq, + int64_t n, float* d, float* e, float* u, + int64_t ldu, float* vt, int64_t ldvt, float* q, + int64_t* iq ); +int64_t LAPACKE_dbdsdc_64( int matrix_layout, char uplo, char compq, + int64_t n, double* d, double* e, double* u, + int64_t ldu, double* vt, int64_t ldvt, + double* q, int64_t* iq ); + +int64_t LAPACKE_sbdsqr_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + float* d, float* e, float* vt, int64_t ldvt, + float* u, int64_t ldu, float* c, int64_t ldc ); +int64_t LAPACKE_dbdsqr_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + double* d, double* e, double* vt, int64_t ldvt, + double* u, int64_t ldu, double* c, + int64_t ldc ); +int64_t LAPACKE_cbdsqr_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + float* d, float* e, lapack_complex_float* vt, + int64_t ldvt, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* c, + int64_t ldc ); +int64_t LAPACKE_zbdsqr_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + double* d, double* e, lapack_complex_double* vt, + int64_t ldvt, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* c, + int64_t ldc ); +int64_t LAPACKE_sbdsvdx_64( int matrix_layout, char uplo, char jobz, char range, + int64_t n, float* d, float* e, + float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, float* z, int64_t ldz, + int64_t* superb ); +int64_t LAPACKE_dbdsvdx_64( int matrix_layout, char uplo, char jobz, char range, + int64_t n, double* d, double* e, + double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, double* z, int64_t ldz, + int64_t* superb ); +int64_t LAPACKE_sdisna_64( char job, int64_t m, int64_t n, const float* d, + float* sep ); +int64_t LAPACKE_ddisna_64( char job, int64_t m, int64_t n, + const double* d, double* sep ); + +int64_t LAPACKE_sgbbrd_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, float* ab, int64_t ldab, float* d, + float* e, float* q, int64_t ldq, float* pt, + int64_t ldpt, float* c, int64_t ldc ); +int64_t LAPACKE_dgbbrd_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, double* ab, int64_t ldab, + double* d, double* e, double* q, int64_t ldq, + double* pt, int64_t ldpt, double* c, + int64_t ldc ); +int64_t LAPACKE_cgbbrd_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, lapack_complex_float* ab, + int64_t ldab, float* d, float* e, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* pt, int64_t ldpt, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zgbbrd_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, lapack_complex_double* ab, + int64_t ldab, double* d, double* e, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* pt, int64_t ldpt, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_sgbcon_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, const int64_t* ipiv, float anorm, + float* rcond ); +int64_t LAPACKE_dgbcon_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, const int64_t* ipiv, + double anorm, double* rcond ); +int64_t LAPACKE_cgbcon_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zgbcon_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, int64_t ldab, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_sgbequ_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, float* r, float* c, float* rowcnd, + float* colcnd, float* amax ); +int64_t LAPACKE_dgbequ_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); +int64_t LAPACKE_cgbequ_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + float* r, float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_zgbequ_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, int64_t ldab, + double* r, double* c, double* rowcnd, double* colcnd, + double* amax ); + +int64_t LAPACKE_sgbequb_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, float* r, float* c, float* rowcnd, + float* colcnd, float* amax ); +int64_t LAPACKE_dgbequb_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); +int64_t LAPACKE_cgbequb_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + float* r, float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_zgbequb_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, int64_t ldab, + double* r, double* c, double* rowcnd, + double* colcnd, double* amax ); + +int64_t LAPACKE_sgbrfs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const float* ab, int64_t ldab, const float* afb, + int64_t ldafb, const int64_t* ipiv, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_dgbrfs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const double* ab, int64_t ldab, const double* afb, + int64_t ldafb, const int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr ); +int64_t LAPACKE_cgbrfs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* afb, int64_t ldafb, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zgbrfs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + const lapack_complex_double* afb, int64_t ldafb, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sgbrfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const float* ab, int64_t ldab, + const float* afb, int64_t ldafb, + const int64_t* ipiv, const float* r, + const float* c, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dgbrfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const double* ab, int64_t ldab, + const double* afb, int64_t ldafb, + const int64_t* ipiv, const double* r, + const double* c, const double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); +int64_t LAPACKE_cgbrfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const lapack_complex_float* ab, + int64_t ldab, const lapack_complex_float* afb, + int64_t ldafb, const int64_t* ipiv, + const float* r, const float* c, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_zgbrfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const lapack_complex_double* ab, + int64_t ldab, const lapack_complex_double* afb, + int64_t ldafb, const int64_t* ipiv, + const double* r, const double* c, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); + +int64_t LAPACKE_sgbsv_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, float* ab, + int64_t ldab, int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dgbsv_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, double* ab, + int64_t ldab, int64_t* ipiv, double* b, + int64_t ldb ); +int64_t LAPACKE_cgbsv_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgbsv_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sgbsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, float* ab, int64_t ldab, + float* afb, int64_t ldafb, int64_t* ipiv, + char* equed, float* r, float* c, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* rpivot ); +int64_t LAPACKE_dgbsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, double* ab, int64_t ldab, + double* afb, int64_t ldafb, int64_t* ipiv, + char* equed, double* r, double* c, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* rpivot ); +int64_t LAPACKE_cgbsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + float* r, float* c, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, float* rpivot ); +int64_t LAPACKE_zgbsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + double* r, double* c, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, double* rpivot ); + +int64_t LAPACKE_sgbsvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, float* ab, int64_t ldab, + float* afb, int64_t ldafb, int64_t* ipiv, + char* equed, float* r, float* c, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dgbsvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, double* ab, int64_t ldab, + double* afb, int64_t ldafb, int64_t* ipiv, + char* equed, double* r, double* c, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); +int64_t LAPACKE_cgbsvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + float* r, float* c, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_zgbsvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + double* r, double* c, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* rpvgrw, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); + +int64_t LAPACKE_sgbtrf_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, float* ab, + int64_t ldab, int64_t* ipiv ); +int64_t LAPACKE_dgbtrf_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, double* ab, + int64_t ldab, int64_t* ipiv ); +int64_t LAPACKE_cgbtrf_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + lapack_complex_float* ab, int64_t ldab, + int64_t* ipiv ); +int64_t LAPACKE_zgbtrf_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + lapack_complex_double* ab, int64_t ldab, + int64_t* ipiv ); + +int64_t LAPACKE_sgbtrs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const float* ab, int64_t ldab, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dgbtrs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const double* ab, int64_t ldab, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_cgbtrs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgbtrs_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + const int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sgebak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const float* scale, + int64_t m, float* v, int64_t ldv ); +int64_t LAPACKE_dgebak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const double* scale, + int64_t m, double* v, int64_t ldv ); +int64_t LAPACKE_cgebak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const float* scale, + int64_t m, lapack_complex_float* v, + int64_t ldv ); +int64_t LAPACKE_zgebak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const double* scale, + int64_t m, lapack_complex_double* v, + int64_t ldv ); + +int64_t LAPACKE_sgebal_64( int matrix_layout, char job, int64_t n, float* a, + int64_t lda, int64_t* ilo, int64_t* ihi, + float* scale ); +int64_t LAPACKE_dgebal_64( int matrix_layout, char job, int64_t n, double* a, + int64_t lda, int64_t* ilo, int64_t* ihi, + double* scale ); +int64_t LAPACKE_cgebal_64( int matrix_layout, char job, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ilo, int64_t* ihi, float* scale ); +int64_t LAPACKE_zgebal_64( int matrix_layout, char job, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ilo, int64_t* ihi, double* scale ); + +int64_t LAPACKE_sgebrd_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* d, float* e, + float* tauq, float* taup ); +int64_t LAPACKE_dgebrd_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* d, double* e, + double* tauq, double* taup ); +int64_t LAPACKE_cgebrd_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, float* d, + float* e, lapack_complex_float* tauq, + lapack_complex_float* taup ); +int64_t LAPACKE_zgebrd_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, double* d, + double* e, lapack_complex_double* tauq, + lapack_complex_double* taup ); + +int64_t LAPACKE_sgecon_64( int matrix_layout, char norm, int64_t n, + const float* a, int64_t lda, float anorm, + float* rcond ); +int64_t LAPACKE_dgecon_64( int matrix_layout, char norm, int64_t n, + const double* a, int64_t lda, double anorm, + double* rcond ); +int64_t LAPACKE_cgecon_64( int matrix_layout, char norm, int64_t n, + const lapack_complex_float* a, int64_t lda, + float anorm, float* rcond ); +int64_t LAPACKE_zgecon_64( int matrix_layout, char norm, int64_t n, + const lapack_complex_double* a, int64_t lda, + double anorm, double* rcond ); + +int64_t LAPACKE_sgeequ_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, float* r, float* c, + float* rowcnd, float* colcnd, float* amax ); +int64_t LAPACKE_dgeequ_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, double* r, + double* c, double* rowcnd, double* colcnd, + double* amax ); +int64_t LAPACKE_cgeequ_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* r, float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_zgeequ_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* r, double* c, double* rowcnd, double* colcnd, + double* amax ); + +int64_t LAPACKE_sgeequb_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, float* r, float* c, + float* rowcnd, float* colcnd, float* amax ); +int64_t LAPACKE_dgeequb_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, double* r, + double* c, double* rowcnd, double* colcnd, + double* amax ); +int64_t LAPACKE_cgeequb_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* r, float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_zgeequb_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* r, double* c, double* rowcnd, + double* colcnd, double* amax ); + +int64_t LAPACKE_sgees_64( int matrix_layout, char jobvs, char sort, + LAPACK_S_SELECT2 select, int64_t n, float* a, + int64_t lda, int64_t* sdim, float* wr, + float* wi, float* vs, int64_t ldvs ); +int64_t LAPACKE_dgees_64( int matrix_layout, char jobvs, char sort, + LAPACK_D_SELECT2 select, int64_t n, double* a, + int64_t lda, int64_t* sdim, double* wr, + double* wi, double* vs, int64_t ldvs ); +int64_t LAPACKE_cgees_64( int matrix_layout, char jobvs, char sort, + LAPACK_C_SELECT1 select, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* sdim, lapack_complex_float* w, + lapack_complex_float* vs, int64_t ldvs ); +int64_t LAPACKE_zgees_64( int matrix_layout, char jobvs, char sort, + LAPACK_Z_SELECT1 select, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* sdim, lapack_complex_double* w, + lapack_complex_double* vs, int64_t ldvs ); + +int64_t LAPACKE_sgeesx_64( int matrix_layout, char jobvs, char sort, + LAPACK_S_SELECT2 select, char sense, int64_t n, + float* a, int64_t lda, int64_t* sdim, + float* wr, float* wi, float* vs, int64_t ldvs, + float* rconde, float* rcondv ); +int64_t LAPACKE_dgeesx_64( int matrix_layout, char jobvs, char sort, + LAPACK_D_SELECT2 select, char sense, int64_t n, + double* a, int64_t lda, int64_t* sdim, + double* wr, double* wi, double* vs, int64_t ldvs, + double* rconde, double* rcondv ); +int64_t LAPACKE_cgeesx_64( int matrix_layout, char jobvs, char sort, + LAPACK_C_SELECT1 select, char sense, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* sdim, lapack_complex_float* w, + lapack_complex_float* vs, int64_t ldvs, + float* rconde, float* rcondv ); +int64_t LAPACKE_zgeesx_64( int matrix_layout, char jobvs, char sort, + LAPACK_Z_SELECT1 select, char sense, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* sdim, lapack_complex_double* w, + lapack_complex_double* vs, int64_t ldvs, + double* rconde, double* rcondv ); + +int64_t LAPACKE_sgeev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, float* a, int64_t lda, float* wr, + float* wi, float* vl, int64_t ldvl, float* vr, + int64_t ldvr ); +int64_t LAPACKE_dgeev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, double* a, int64_t lda, double* wr, + double* wi, double* vl, int64_t ldvl, double* vr, + int64_t ldvr ); +int64_t LAPACKE_cgeev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_float* a, int64_t lda, + lapack_complex_float* w, lapack_complex_float* vl, + int64_t ldvl, lapack_complex_float* vr, + int64_t ldvr ); +int64_t LAPACKE_zgeev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* w, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr ); + +int64_t LAPACKE_sgeevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, float* a, + int64_t lda, float* wr, float* wi, float* vl, + int64_t ldvl, float* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, float* scale, + float* abnrm, float* rconde, float* rcondv ); +int64_t LAPACKE_dgeevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, double* a, + int64_t lda, double* wr, double* wi, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, double* scale, + double* abnrm, double* rconde, double* rcondv ); +int64_t LAPACKE_cgeevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* w, lapack_complex_float* vl, + int64_t ldvl, lapack_complex_float* vr, + int64_t ldvr, int64_t* ilo, int64_t* ihi, + float* scale, float* abnrm, float* rconde, + float* rcondv ); +int64_t LAPACKE_zgeevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* w, lapack_complex_double* vl, + int64_t ldvl, lapack_complex_double* vr, + int64_t ldvr, int64_t* ilo, int64_t* ihi, + double* scale, double* abnrm, double* rconde, + double* rcondv ); + +int64_t LAPACKE_sgehrd_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, float* a, int64_t lda, + float* tau ); +int64_t LAPACKE_dgehrd_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, double* a, int64_t lda, + double* tau ); +int64_t LAPACKE_cgehrd_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tau ); +int64_t LAPACKE_zgehrd_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tau ); + +int64_t LAPACKE_sgejsv_64( int matrix_layout, char joba, char jobu, char jobv, + char jobr, char jobt, char jobp, int64_t m, + int64_t n, float* a, int64_t lda, float* sva, + float* u, int64_t ldu, float* v, int64_t ldv, + float* stat, int64_t* istat ); +int64_t LAPACKE_dgejsv_64( int matrix_layout, char joba, char jobu, char jobv, + char jobr, char jobt, char jobp, int64_t m, + int64_t n, double* a, int64_t lda, double* sva, + double* u, int64_t ldu, double* v, int64_t ldv, + double* stat, int64_t* istat ); +int64_t LAPACKE_cgejsv_64( int matrix_layout, char joba, char jobu, char jobv, + char jobr, char jobt, char jobp, int64_t m, + int64_t n, lapack_complex_float* a, int64_t lda, float* sva, + lapack_complex_float* u, int64_t ldu, lapack_complex_float* v, int64_t ldv, + float* stat, int64_t* istat ); +int64_t LAPACKE_zgejsv_64( int matrix_layout, char joba, char jobu, char jobv, + char jobr, char jobt, char jobp, int64_t m, + int64_t n, lapack_complex_double* a, int64_t lda, double* sva, + lapack_complex_double* u, int64_t ldu, lapack_complex_double* v, int64_t ldv, + double* stat, int64_t* istat ); + +int64_t LAPACKE_sgelq2_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgelq2_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgelq2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgelq2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgelqf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgelqf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgelqf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgelqf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgels_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* b, int64_t ldb ); +int64_t LAPACKE_dgels_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* b, int64_t ldb ); +int64_t LAPACKE_cgels_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zgels_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sgelsd_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank ); +int64_t LAPACKE_dgelsd_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* s, double rcond, + int64_t* rank ); +int64_t LAPACKE_cgelsd_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank ); +int64_t LAPACKE_zgelsd_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* s, double rcond, + int64_t* rank ); + +int64_t LAPACKE_sgelss_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank ); +int64_t LAPACKE_dgelss_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* s, double rcond, + int64_t* rank ); +int64_t LAPACKE_cgelss_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank ); +int64_t LAPACKE_zgelss_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* s, double rcond, + int64_t* rank ); + +int64_t LAPACKE_sgelsy_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, float* b, + int64_t ldb, int64_t* jpvt, float rcond, + int64_t* rank ); +int64_t LAPACKE_dgelsy_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, int64_t* jpvt, + double rcond, int64_t* rank ); +int64_t LAPACKE_cgelsy_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, int64_t* jpvt, float rcond, + int64_t* rank ); +int64_t LAPACKE_zgelsy_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, int64_t* jpvt, double rcond, + int64_t* rank ); + +int64_t LAPACKE_sgeqlf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgeqlf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgeqlf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgeqlf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgeqp3_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* jpvt, + float* tau ); +int64_t LAPACKE_dgeqp3_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* jpvt, + double* tau ); +int64_t LAPACKE_cgeqp3_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* jpvt, lapack_complex_float* tau ); +int64_t LAPACKE_zgeqp3_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* jpvt, lapack_complex_double* tau ); + +int64_t LAPACKE_sgeqpf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* jpvt, + float* tau ); +int64_t LAPACKE_dgeqpf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* jpvt, + double* tau ); +int64_t LAPACKE_cgeqpf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* jpvt, lapack_complex_float* tau ); +int64_t LAPACKE_zgeqpf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* jpvt, lapack_complex_double* tau ); + +int64_t LAPACKE_sgeqr2_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgeqr2_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgeqr2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgeqr2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgeqrf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgeqrf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgeqrf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgeqrf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgeqrfp_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgeqrfp_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgeqrfp_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgeqrfp_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgerfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dgerfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const double* af, int64_t ldaf, + const int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr ); +int64_t LAPACKE_cgerfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zgerfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sgerfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, int64_t ldaf, + const int64_t* ipiv, const float* r, + const float* c, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dgerfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, int64_t ldaf, + const int64_t* ipiv, const double* r, + const double* c, const double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); +int64_t LAPACKE_cgerfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, int64_t ldaf, + const int64_t* ipiv, const float* r, + const float* c, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_zgerfsx_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, int64_t ldaf, + const int64_t* ipiv, const double* r, + const double* c, const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); + +int64_t LAPACKE_sgerqf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dgerqf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_cgerqf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_zgerqf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_sgesdd_64( int matrix_layout, char jobz, int64_t m, + int64_t n, float* a, int64_t lda, float* s, + float* u, int64_t ldu, float* vt, + int64_t ldvt ); +int64_t LAPACKE_dgesdd_64( int matrix_layout, char jobz, int64_t m, + int64_t n, double* a, int64_t lda, double* s, + double* u, int64_t ldu, double* vt, + int64_t ldvt ); +int64_t LAPACKE_cgesdd_64( int matrix_layout, char jobz, int64_t m, + int64_t n, lapack_complex_float* a, + int64_t lda, float* s, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* vt, + int64_t ldvt ); +int64_t LAPACKE_zgesdd_64( int matrix_layout, char jobz, int64_t m, + int64_t n, lapack_complex_double* a, + int64_t lda, double* s, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* vt, + int64_t ldvt ); + +int64_t LAPACKE_sgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + float* a, int64_t lda, int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + double* a, int64_t lda, int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); +int64_t LAPACKE_dsgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + double* a, int64_t lda, int64_t* ipiv, + double* b, int64_t ldb, double* x, int64_t ldx, + int64_t* iter ); +int64_t LAPACKE_zcgesv_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, int64_t* iter ); + +int64_t LAPACKE_sgesvd_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, float* a, int64_t lda, + float* s, float* u, int64_t ldu, float* vt, + int64_t ldvt, float* superb ); +int64_t LAPACKE_dgesvd_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, double* a, + int64_t lda, double* s, double* u, int64_t ldu, + double* vt, int64_t ldvt, double* superb ); +int64_t LAPACKE_cgesvd_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float* s, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* vt, + int64_t ldvt, float* superb ); +int64_t LAPACKE_zgesvd_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double* s, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* vt, + int64_t ldvt, double* superb ); + +int64_t LAPACKE_sgesvdx_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, float* u, int64_t ldu, + float* vt, int64_t ldvt, + int64_t* superb ); +int64_t LAPACKE_dgesvdx_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, double* u, int64_t ldu, + double* vt, int64_t ldvt, + int64_t* superb ); +int64_t LAPACKE_cgesvdx_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, lapack_complex_float* u, int64_t ldu, + lapack_complex_float* vt, int64_t ldvt, + int64_t* superb ); +int64_t LAPACKE_zgesvdx_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, lapack_complex_double* u, int64_t ldu, + lapack_complex_double* vt, int64_t ldvt, + int64_t* superb ); + +int64_t LAPACKE_sgesvdq_64( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + int64_t m, int64_t n, float* a, int64_t lda, + float* s, float* u, int64_t ldu, float* v, + int64_t ldv, int64_t* numrank ); +int64_t LAPACKE_dgesvdq_64( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + int64_t m, int64_t n, double* a, + int64_t lda, double* s, double* u, int64_t ldu, + double* v, int64_t ldv, int64_t* numrank); +int64_t LAPACKE_cgesvdq_64( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float* s, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, + int64_t ldv, int64_t* numrank ); +int64_t LAPACKE_zgesvdq_64( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double* s, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, + int64_t ldv, int64_t* numrank ); + +int64_t LAPACKE_sgesvj_64( int matrix_layout, char joba, char jobu, char jobv, + int64_t m, int64_t n, float* a, int64_t lda, + float* sva, int64_t mv, float* v, int64_t ldv, + float* stat ); +int64_t LAPACKE_dgesvj_64( int matrix_layout, char joba, char jobu, char jobv, + int64_t m, int64_t n, double* a, + int64_t lda, double* sva, int64_t mv, + double* v, int64_t ldv, double* stat ); +int64_t LAPACKE_cgesvj_64( int matrix_layout, char joba, char jobu, char jobv, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float* sva, int64_t mv, + lapack_complex_float* v, int64_t ldv, float* stat ); +int64_t LAPACKE_zgesvj_64( int matrix_layout, char joba, char jobu, char jobv, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double* sva, int64_t mv, + lapack_complex_double* v, int64_t ldv, double* stat ); + +int64_t LAPACKE_sgesvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, float* c, + float* b, int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* rpivot ); +int64_t LAPACKE_dgesvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, double* c, + double* b, int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* rpivot ); +int64_t LAPACKE_cgesvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, float* c, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* rpivot ); +int64_t LAPACKE_zgesvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, double* c, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* rpivot ); + +int64_t LAPACKE_sgesvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, float* c, + float* b, int64_t ldb, float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dgesvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, double* c, + double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* rpvgrw, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); +int64_t LAPACKE_cgesvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, float* c, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_zgesvxx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, double* c, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); + +int64_t LAPACKE_sgetf2_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetf2_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetf2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetf2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetrf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetrf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetrf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetrf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetrf2_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetrf2_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetrf2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetrf2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetri_64( int matrix_layout, int64_t n, float* a, + int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_dgetri_64( int matrix_layout, int64_t n, double* a, + int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_cgetri_64( int matrix_layout, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_zgetri_64( int matrix_layout, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv ); + +int64_t LAPACKE_sgetrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dgetrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_cgetrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zgetrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sggbak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const float* lscale, + const float* rscale, int64_t m, float* v, + int64_t ldv ); +int64_t LAPACKE_dggbak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const double* lscale, + const double* rscale, int64_t m, double* v, + int64_t ldv ); +int64_t LAPACKE_cggbak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const float* lscale, + const float* rscale, int64_t m, + lapack_complex_float* v, int64_t ldv ); +int64_t LAPACKE_zggbak_64( int matrix_layout, char job, char side, int64_t n, + int64_t ilo, int64_t ihi, const double* lscale, + const double* rscale, int64_t m, + lapack_complex_double* v, int64_t ldv ); + +int64_t LAPACKE_sggbal_64( int matrix_layout, char job, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, float* lscale, + float* rscale ); +int64_t LAPACKE_dggbal_64( int matrix_layout, char job, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, double* lscale, + double* rscale ); +int64_t LAPACKE_cggbal_64( int matrix_layout, char job, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, float* lscale, + float* rscale ); +int64_t LAPACKE_zggbal_64( int matrix_layout, char job, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, double* lscale, + double* rscale ); + +int64_t LAPACKE_sgges_64( int matrix_layout, char jobvsl, char jobvsr, char sort, + LAPACK_S_SELECT3 selctg, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + int64_t* sdim, float* alphar, float* alphai, + float* beta, float* vsl, int64_t ldvsl, float* vsr, + int64_t ldvsr ); +int64_t LAPACKE_dgges_64( int matrix_layout, char jobvsl, char jobvsr, char sort, + LAPACK_D_SELECT3 selctg, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + int64_t* sdim, double* alphar, double* alphai, + double* beta, double* vsl, int64_t ldvsl, + double* vsr, int64_t ldvsr ); +int64_t LAPACKE_cgges_64( int matrix_layout, char jobvsl, char jobvsr, char sort, + LAPACK_C_SELECT2 selctg, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* sdim, lapack_complex_float* alpha, + lapack_complex_float* beta, lapack_complex_float* vsl, + int64_t ldvsl, lapack_complex_float* vsr, + int64_t ldvsr ); +int64_t LAPACKE_zgges_64( int matrix_layout, char jobvsl, char jobvsr, char sort, + LAPACK_Z_SELECT2 selctg, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* sdim, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr ); + +int64_t LAPACKE_sgges3_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_S_SELECT3 selctg, int64_t n, + float* a, int64_t lda, float* b, int64_t ldb, + int64_t* sdim, float* alphar, float* alphai, + float* beta, float* vsl, int64_t ldvsl, + float* vsr, int64_t ldvsr ); +int64_t LAPACKE_dgges3_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_D_SELECT3 selctg, int64_t n, + double* a, int64_t lda, double* b, int64_t ldb, + int64_t* sdim, double* alphar, double* alphai, + double* beta, double* vsl, int64_t ldvsl, + double* vsr, int64_t ldvsr ); +int64_t LAPACKE_cgges3_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_C_SELECT2 selctg, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* sdim, lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vsl, int64_t ldvsl, + lapack_complex_float* vsr, int64_t ldvsr ); +int64_t LAPACKE_zgges3_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_Z_SELECT2 selctg, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* sdim, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr ); + +int64_t LAPACKE_sggesx_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_S_SELECT3 selctg, char sense, + int64_t n, float* a, int64_t lda, float* b, + int64_t ldb, int64_t* sdim, float* alphar, + float* alphai, float* beta, float* vsl, + int64_t ldvsl, float* vsr, int64_t ldvsr, + float* rconde, float* rcondv ); +int64_t LAPACKE_dggesx_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_D_SELECT3 selctg, char sense, + int64_t n, double* a, int64_t lda, double* b, + int64_t ldb, int64_t* sdim, double* alphar, + double* alphai, double* beta, double* vsl, + int64_t ldvsl, double* vsr, int64_t ldvsr, + double* rconde, double* rcondv ); +int64_t LAPACKE_cggesx_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_C_SELECT2 selctg, char sense, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, int64_t* sdim, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vsl, int64_t ldvsl, + lapack_complex_float* vsr, int64_t ldvsr, + float* rconde, float* rcondv ); +int64_t LAPACKE_zggesx_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_Z_SELECT2 selctg, char sense, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, int64_t* sdim, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr, + double* rconde, double* rcondv ); + +int64_t LAPACKE_sggev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, float* a, int64_t lda, float* b, + int64_t ldb, float* alphar, float* alphai, + float* beta, float* vl, int64_t ldvl, float* vr, + int64_t ldvr ); +int64_t LAPACKE_dggev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, double* a, int64_t lda, double* b, + int64_t ldb, double* alphar, double* alphai, + double* beta, double* vl, int64_t ldvl, double* vr, + int64_t ldvr ); +int64_t LAPACKE_cggev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, lapack_complex_float* vl, + int64_t ldvl, lapack_complex_float* vr, + int64_t ldvr ); +int64_t LAPACKE_zggev_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr ); + +int64_t LAPACKE_sggev3_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, + float* alphar, float* alphai, float* beta, + float* vl, int64_t ldvl, + float* vr, int64_t ldvr ); +int64_t LAPACKE_dggev3_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, + double* alphar, double* alphai, double* beta, + double* vl, int64_t ldvl, + double* vr, int64_t ldvr ); +int64_t LAPACKE_cggev3_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr ); +int64_t LAPACKE_zggev3_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr ); + +int64_t LAPACKE_sggevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* alphar, float* alphai, float* beta, float* vl, + int64_t ldvl, float* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, float* lscale, + float* rscale, float* abnrm, float* bbnrm, + float* rconde, float* rcondv ); +int64_t LAPACKE_dggevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* alphar, double* alphai, double* beta, + double* vl, int64_t ldvl, double* vr, + int64_t ldvr, int64_t* ilo, int64_t* ihi, + double* lscale, double* rscale, double* abnrm, + double* bbnrm, double* rconde, double* rcondv ); +int64_t LAPACKE_cggevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, lapack_complex_float* vl, + int64_t ldvl, lapack_complex_float* vr, + int64_t ldvr, int64_t* ilo, int64_t* ihi, + float* lscale, float* rscale, float* abnrm, + float* bbnrm, float* rconde, float* rcondv ); +int64_t LAPACKE_zggevx_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, double* lscale, + double* rscale, double* abnrm, double* bbnrm, + double* rconde, double* rcondv ); + +int64_t LAPACKE_sggglm_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, float* a, int64_t lda, float* b, + int64_t ldb, float* d, float* x, float* y ); +int64_t LAPACKE_dggglm_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, double* a, int64_t lda, double* b, + int64_t ldb, double* d, double* x, double* y ); +int64_t LAPACKE_cggglm_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* d, + lapack_complex_float* x, lapack_complex_float* y ); +int64_t LAPACKE_zggglm_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* d, + lapack_complex_double* x, lapack_complex_double* y ); + +int64_t LAPACKE_sgghrd_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* a, int64_t lda, float* b, int64_t ldb, + float* q, int64_t ldq, float* z, int64_t ldz ); +int64_t LAPACKE_dgghrd_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* a, int64_t lda, double* b, int64_t ldb, + double* q, int64_t ldq, double* z, + int64_t ldz ); +int64_t LAPACKE_cgghrd_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zgghrd_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_sgghd3_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* a, int64_t lda, float* b, int64_t ldb, + float* q, int64_t ldq, float* z, int64_t ldz ); +int64_t LAPACKE_dgghd3_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* a, int64_t lda, double* b, int64_t ldb, + double* q, int64_t ldq, double* z, + int64_t ldz ); +int64_t LAPACKE_cgghd3_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zgghd3_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_sgglse_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, float* a, int64_t lda, float* b, + int64_t ldb, float* c, float* d, float* x ); +int64_t LAPACKE_dgglse_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, double* a, int64_t lda, double* b, + int64_t ldb, double* c, double* d, double* x ); +int64_t LAPACKE_cgglse_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* c, + lapack_complex_float* d, lapack_complex_float* x ); +int64_t LAPACKE_zgglse_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* c, + lapack_complex_double* d, lapack_complex_double* x ); + +int64_t LAPACKE_sggqrf_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, float* a, int64_t lda, float* taua, + float* b, int64_t ldb, float* taub ); +int64_t LAPACKE_dggqrf_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, double* a, int64_t lda, + double* taua, double* b, int64_t ldb, + double* taub ); +int64_t LAPACKE_cggqrf_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* taua, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* taub ); +int64_t LAPACKE_zggqrf_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* taua, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* taub ); + +int64_t LAPACKE_sggrqf_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, float* a, int64_t lda, float* taua, + float* b, int64_t ldb, float* taub ); +int64_t LAPACKE_dggrqf_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, double* a, int64_t lda, + double* taua, double* b, int64_t ldb, + double* taub ); +int64_t LAPACKE_cggrqf_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* taua, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* taub ); +int64_t LAPACKE_zggrqf_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* taua, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* taub ); + +int64_t LAPACKE_sggsvd_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, float* a, + int64_t lda, float* b, int64_t ldb, + float* alpha, float* beta, float* u, int64_t ldu, + float* v, int64_t ldv, float* q, int64_t ldq, + int64_t* iwork ); +int64_t LAPACKE_dggsvd_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, double* a, + int64_t lda, double* b, int64_t ldb, + double* alpha, double* beta, double* u, + int64_t ldu, double* v, int64_t ldv, double* q, + int64_t ldq, int64_t* iwork ); +int64_t LAPACKE_cggsvd_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float* alpha, float* beta, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, + int64_t ldv, lapack_complex_float* q, + int64_t ldq, int64_t* iwork ); +int64_t LAPACKE_zggsvd_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* alpha, double* beta, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + int64_t* iwork ); + +int64_t LAPACKE_sggsvd3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, float* a, + int64_t lda, float* b, int64_t ldb, + float* alpha, float* beta, float* u, int64_t ldu, + float* v, int64_t ldv, float* q, int64_t ldq, + int64_t* iwork ); +int64_t LAPACKE_dggsvd3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, double* a, + int64_t lda, double* b, int64_t ldb, + double* alpha, double* beta, double* u, + int64_t ldu, double* v, int64_t ldv, double* q, + int64_t ldq, int64_t* iwork ); +int64_t LAPACKE_cggsvd3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float* alpha, float* beta, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, + int64_t ldv, lapack_complex_float* q, + int64_t ldq, int64_t* iwork ); +int64_t LAPACKE_zggsvd3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t n, int64_t p, + int64_t* k, int64_t* l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* alpha, double* beta, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + int64_t* iwork ); + +int64_t LAPACKE_sggsvp_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, float* u, + int64_t ldu, float* v, int64_t ldv, float* q, + int64_t ldq ); +int64_t LAPACKE_dggsvp_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double tola, double tolb, int64_t* k, + int64_t* l, double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq ); +int64_t LAPACKE_cggsvp_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq ); +int64_t LAPACKE_zggsvp_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double tola, double tolb, int64_t* k, + int64_t* l, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, + int64_t ldv, lapack_complex_double* q, + int64_t ldq ); + +int64_t LAPACKE_sggsvp3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, float* u, + int64_t ldu, float* v, int64_t ldv, float* q, + int64_t ldq ); +int64_t LAPACKE_dggsvp3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double tola, double tolb, int64_t* k, + int64_t* l, double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq ); +int64_t LAPACKE_cggsvp3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq ); +int64_t LAPACKE_zggsvp3_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double tola, double tolb, int64_t* k, + int64_t* l, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, + int64_t ldv, lapack_complex_double* q, + int64_t ldq ); + +int64_t LAPACKE_sgtcon_64( char norm, int64_t n, const float* dl, + const float* d, const float* du, const float* du2, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_dgtcon_64( char norm, int64_t n, const double* dl, + const double* d, const double* du, const double* du2, + const int64_t* ipiv, double anorm, + double* rcond ); +int64_t LAPACKE_cgtcon_64( char norm, int64_t n, + const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* du2, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zgtcon_64( char norm, int64_t n, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* du2, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_sgtrfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* dl, const float* d, + const float* du, const float* dlf, const float* df, + const float* duf, const float* du2, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dgtrfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* dl, const double* d, + const double* du, const double* dlf, + const double* df, const double* duf, + const double* du2, const int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr ); +int64_t LAPACKE_cgtrfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* dlf, + const lapack_complex_float* df, + const lapack_complex_float* duf, + const lapack_complex_float* du2, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zgtrfs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* dlf, + const lapack_complex_double* df, + const lapack_complex_double* duf, + const lapack_complex_double* du2, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sgtsv_64( int matrix_layout, int64_t n, int64_t nrhs, + float* dl, float* d, float* du, float* b, + int64_t ldb ); +int64_t LAPACKE_dgtsv_64( int matrix_layout, int64_t n, int64_t nrhs, + double* dl, double* d, double* du, double* b, + int64_t ldb ); +int64_t LAPACKE_cgtsv_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_float* dl, lapack_complex_float* d, + lapack_complex_float* du, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgtsv_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* dl, lapack_complex_double* d, + lapack_complex_double* du, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sgtsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, const float* dl, + const float* d, const float* du, float* dlf, + float* df, float* duf, float* du2, int64_t* ipiv, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dgtsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, const double* dl, + const double* d, const double* du, double* dlf, + double* df, double* duf, double* du2, + int64_t* ipiv, const double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* ferr, double* berr ); +int64_t LAPACKE_cgtsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + lapack_complex_float* dlf, lapack_complex_float* df, + lapack_complex_float* duf, lapack_complex_float* du2, + int64_t* ipiv, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_zgtsvx_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + lapack_complex_double* dlf, + lapack_complex_double* df, + lapack_complex_double* duf, + lapack_complex_double* du2, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_sgttrf_64( int64_t n, float* dl, float* d, float* du, + float* du2, int64_t* ipiv ); +int64_t LAPACKE_dgttrf_64( int64_t n, double* dl, double* d, double* du, + double* du2, int64_t* ipiv ); +int64_t LAPACKE_cgttrf_64( int64_t n, lapack_complex_float* dl, + lapack_complex_float* d, lapack_complex_float* du, + lapack_complex_float* du2, int64_t* ipiv ); +int64_t LAPACKE_zgttrf_64( int64_t n, lapack_complex_double* dl, + lapack_complex_double* d, lapack_complex_double* du, + lapack_complex_double* du2, int64_t* ipiv ); + +int64_t LAPACKE_sgttrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* dl, const float* d, + const float* du, const float* du2, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dgttrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* dl, const double* d, + const double* du, const double* du2, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_cgttrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* du2, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgttrs_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* du2, + const int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_chbev_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab, float* w, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhbev_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab, double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_chbevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab, float* w, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhbevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab, double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_chbevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_zhbevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* q, int64_t ldq, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chbgst_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* bb, int64_t ldbb, + lapack_complex_float* x, int64_t ldx ); +int64_t LAPACKE_zhbgst_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + const lapack_complex_double* bb, int64_t ldbb, + lapack_complex_double* x, int64_t ldx ); + +int64_t LAPACKE_chbgv_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* bb, int64_t ldbb, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhbgv_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* bb, int64_t ldbb, double* w, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chbgvd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* bb, int64_t ldbb, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhbgvd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* bb, int64_t ldbb, + double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_chbgvx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* bb, int64_t ldbb, + lapack_complex_float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_zhbgvx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* bb, int64_t ldbb, + lapack_complex_double* q, int64_t ldq, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chbtrd_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab, float* d, float* e, + lapack_complex_float* q, int64_t ldq ); +int64_t LAPACKE_zhbtrd_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab, double* d, double* e, + lapack_complex_double* q, int64_t ldq ); + +int64_t LAPACKE_checon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zhecon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_cheequb_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zheequb_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_cheev_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, float* w ); +int64_t LAPACKE_zheev_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, double* w ); + +int64_t LAPACKE_cheevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, float* w ); +int64_t LAPACKE_zheevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double* w ); + +int64_t LAPACKE_cheevr_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_zheevr_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, int64_t ldz, + int64_t* isuppz ); + +int64_t LAPACKE_cheevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_zheevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chegst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhegst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_chegv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* w ); +int64_t LAPACKE_zhegv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* w ); + +int64_t LAPACKE_chegvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* w ); +int64_t LAPACKE_zhegvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* w ); + +int64_t LAPACKE_chegvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_zhegvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_cherfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zherfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_cherfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, int64_t ldaf, + const int64_t* ipiv, const float* s, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_zherfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, int64_t ldaf, + const int64_t* ipiv, const double* s, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); + +int64_t LAPACKE_chesv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhesv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chesvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* af, + int64_t ldaf, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zhesvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* af, + int64_t ldaf, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_chesvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_zhesvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); + +int64_t LAPACKE_chetrd_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, float* d, + float* e, lapack_complex_float* tau ); +int64_t LAPACKE_zhetrd_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, double* d, + double* e, lapack_complex_double* tau ); + +int64_t LAPACKE_chetrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zhetrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_chetri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_zhetri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv ); + +int64_t LAPACKE_chetrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chfrk_64( int matrix_layout, char transr, char uplo, char trans, + int64_t n, int64_t k, float alpha, + const lapack_complex_float* a, int64_t lda, + float beta, lapack_complex_float* c ); +int64_t LAPACKE_zhfrk_64( int matrix_layout, char transr, char uplo, char trans, + int64_t n, int64_t k, double alpha, + const lapack_complex_double* a, int64_t lda, + double beta, lapack_complex_double* c ); + +int64_t LAPACKE_shgeqz_64( int matrix_layout, char job, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* h, int64_t ldh, float* t, int64_t ldt, + float* alphar, float* alphai, float* beta, float* q, + int64_t ldq, float* z, int64_t ldz ); +int64_t LAPACKE_dhgeqz_64( int matrix_layout, char job, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* h, int64_t ldh, double* t, int64_t ldt, + double* alphar, double* alphai, double* beta, + double* q, int64_t ldq, double* z, + int64_t ldz ); +int64_t LAPACKE_chgeqz_64( int matrix_layout, char job, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* h, int64_t ldh, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* alpha, + lapack_complex_float* beta, lapack_complex_float* q, + int64_t ldq, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhgeqz_64( int matrix_layout, char job, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* h, int64_t ldh, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chpcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zhpcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_chpev_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* ap, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhpev_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* ap, double* w, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chpevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* ap, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhpevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* ap, double* w, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chpevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_float* ap, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_zhpevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_double* ap, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chpgst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_float* ap, + const lapack_complex_float* bp ); +int64_t LAPACKE_zhpgst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_double* ap, + const lapack_complex_double* bp ); + +int64_t LAPACKE_chpgv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* ap, + lapack_complex_float* bp, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhpgv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_double* ap, + lapack_complex_double* bp, double* w, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chpgvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* ap, + lapack_complex_float* bp, float* w, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zhpgvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_double* ap, + lapack_complex_double* bp, double* w, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_chpgvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_float* ap, lapack_complex_float* bp, + float vl, float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_zhpgvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_double* ap, lapack_complex_double* bp, + double vl, double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zhprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + const lapack_complex_double* afp, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_chpsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhpsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_chpsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + lapack_complex_float* afp, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zhpsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + lapack_complex_double* afp, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_chptrd_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, float* d, float* e, + lapack_complex_float* tau ); +int64_t LAPACKE_zhptrd_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, double* d, double* e, + lapack_complex_double* tau ); + +int64_t LAPACKE_chptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, int64_t* ipiv ); +int64_t LAPACKE_zhptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, int64_t* ipiv ); + +int64_t LAPACKE_chptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, const int64_t* ipiv ); +int64_t LAPACKE_zhptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, const int64_t* ipiv ); + +int64_t LAPACKE_chptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + const int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_shsein_64( int matrix_layout, char job, char eigsrc, char initv, + lapack_logical* select, int64_t n, const float* h, + int64_t ldh, float* wr, const float* wi, + float* vl, int64_t ldvl, float* vr, + int64_t ldvr, int64_t mm, int64_t* m, + int64_t* ifaill, int64_t* ifailr ); +int64_t LAPACKE_dhsein_64( int matrix_layout, char job, char eigsrc, char initv, + lapack_logical* select, int64_t n, + const double* h, int64_t ldh, double* wr, + const double* wi, double* vl, int64_t ldvl, + double* vr, int64_t ldvr, int64_t mm, + int64_t* m, int64_t* ifaill, + int64_t* ifailr ); +int64_t LAPACKE_chsein_64( int matrix_layout, char job, char eigsrc, char initv, + const lapack_logical* select, int64_t n, + const lapack_complex_float* h, int64_t ldh, + lapack_complex_float* w, lapack_complex_float* vl, + int64_t ldvl, lapack_complex_float* vr, + int64_t ldvr, int64_t mm, int64_t* m, + int64_t* ifaill, int64_t* ifailr ); +int64_t LAPACKE_zhsein_64( int matrix_layout, char job, char eigsrc, char initv, + const lapack_logical* select, int64_t n, + const lapack_complex_double* h, int64_t ldh, + lapack_complex_double* w, lapack_complex_double* vl, + int64_t ldvl, lapack_complex_double* vr, + int64_t ldvr, int64_t mm, int64_t* m, + int64_t* ifaill, int64_t* ifailr ); + +int64_t LAPACKE_shseqr_64( int matrix_layout, char job, char compz, int64_t n, + int64_t ilo, int64_t ihi, float* h, + int64_t ldh, float* wr, float* wi, float* z, + int64_t ldz ); +int64_t LAPACKE_dhseqr_64( int matrix_layout, char job, char compz, int64_t n, + int64_t ilo, int64_t ihi, double* h, + int64_t ldh, double* wr, double* wi, double* z, + int64_t ldz ); +int64_t LAPACKE_chseqr_64( int matrix_layout, char job, char compz, int64_t n, + int64_t ilo, int64_t ihi, + lapack_complex_float* h, int64_t ldh, + lapack_complex_float* w, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhseqr_64( int matrix_layout, char job, char compz, int64_t n, + int64_t ilo, int64_t ihi, + lapack_complex_double* h, int64_t ldh, + lapack_complex_double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_clacgv_64( int64_t n, lapack_complex_float* x, + int64_t incx ); +int64_t LAPACKE_zlacgv_64( int64_t n, lapack_complex_double* x, + int64_t incx ); + +int64_t LAPACKE_slacn2_64( int64_t n, float* v, float* x, int64_t* isgn, + float* est, int64_t* kase, int64_t* isave ); +int64_t LAPACKE_dlacn2_64( int64_t n, double* v, double* x, int64_t* isgn, + double* est, int64_t* kase, int64_t* isave ); +int64_t LAPACKE_clacn2_64( int64_t n, lapack_complex_float* v, + lapack_complex_float* x, + float* est, int64_t* kase, int64_t* isave ); +int64_t LAPACKE_zlacn2_64( int64_t n, lapack_complex_double* v, + lapack_complex_double* x, + double* est, int64_t* kase, int64_t* isave ); + +int64_t LAPACKE_slacpy_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const float* a, int64_t lda, float* b, + int64_t ldb ); +int64_t LAPACKE_dlacpy_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const double* a, int64_t lda, double* b, + int64_t ldb ); +int64_t LAPACKE_clacpy_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zlacpy_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_clacp2_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zlacp2_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_zlag2c_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + lapack_complex_float* sa, int64_t ldsa ); + +int64_t LAPACKE_slag2d_64( int matrix_layout, int64_t m, int64_t n, + const float* sa, int64_t ldsa, double* a, + int64_t lda ); + +int64_t LAPACKE_dlag2s_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, float* sa, + int64_t ldsa ); + +int64_t LAPACKE_clag2z_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* sa, int64_t ldsa, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_slagge_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* d, + float* a, int64_t lda, int64_t* iseed ); +int64_t LAPACKE_dlagge_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* d, + double* a, int64_t lda, int64_t* iseed ); +int64_t LAPACKE_clagge_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* d, + lapack_complex_float* a, int64_t lda, + int64_t* iseed ); +int64_t LAPACKE_zlagge_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* d, + lapack_complex_double* a, int64_t lda, + int64_t* iseed ); + +float LAPACKE_slamch_64( char cmach ); +double LAPACKE_dlamch_64( char cmach ); + +float LAPACKE_slangb_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab ); +double LAPACKE_dlangb_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab ); +float LAPACKE_clangb_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab ); +double LAPACKE_zlangb_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, int64_t ldab ); + +float LAPACKE_slange_64( int matrix_layout, char norm, int64_t m, + int64_t n, const float* a, int64_t lda ); +double LAPACKE_dlange_64( int matrix_layout, char norm, int64_t m, + int64_t n, const double* a, int64_t lda ); +float LAPACKE_clange_64( int matrix_layout, char norm, int64_t m, + int64_t n, const lapack_complex_float* a, + int64_t lda ); +double LAPACKE_zlange_64( int matrix_layout, char norm, int64_t m, + int64_t n, const lapack_complex_double* a, + int64_t lda ); + +float LAPACKE_clanhe_64( int matrix_layout, char norm, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda ); +double LAPACKE_zlanhe_64( int matrix_layout, char norm, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_clacrm_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, + int64_t lda, const float* b, + int64_t ldb, lapack_complex_float* c, + int64_t ldc ); +int64_t LAPACKE_zlacrm_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, + int64_t lda, const double* b, + int64_t ldb, lapack_complex_double* c, + int64_t ldc ); + +int64_t LAPACKE_clarcm_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, + const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* c, + int64_t ldc ); +int64_t LAPACKE_zlarcm_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, + const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* c, + int64_t ldc ); + +float LAPACKE_slansy_64( int matrix_layout, char norm, char uplo, int64_t n, + const float* a, int64_t lda ); +double LAPACKE_dlansy_64( int matrix_layout, char norm, char uplo, int64_t n, + const double* a, int64_t lda ); +float LAPACKE_clansy_64( int matrix_layout, char norm, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda ); +double LAPACKE_zlansy_64( int matrix_layout, char norm, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda ); + +float LAPACKE_slantr_64( int matrix_layout, char norm, char uplo, char diag, + int64_t m, int64_t n, const float* a, + int64_t lda ); +double LAPACKE_dlantr_64( int matrix_layout, char norm, char uplo, char diag, + int64_t m, int64_t n, const double* a, + int64_t lda ); +float LAPACKE_clantr_64( int matrix_layout, char norm, char uplo, char diag, + int64_t m, int64_t n, const lapack_complex_float* a, + int64_t lda ); +double LAPACKE_zlantr_64( int matrix_layout, char norm, char uplo, char diag, + int64_t m, int64_t n, const lapack_complex_double* a, + int64_t lda ); + + +int64_t LAPACKE_slarfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, const float* v, int64_t ldv, + const float* t, int64_t ldt, float* c, + int64_t ldc ); +int64_t LAPACKE_dlarfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, const double* v, int64_t ldv, + const double* t, int64_t ldt, double* c, + int64_t ldc ); +int64_t LAPACKE_clarfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, const lapack_complex_float* v, + int64_t ldv, const lapack_complex_float* t, + int64_t ldt, lapack_complex_float* c, + int64_t ldc ); +int64_t LAPACKE_zlarfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, const lapack_complex_double* v, + int64_t ldv, const lapack_complex_double* t, + int64_t ldt, lapack_complex_double* c, + int64_t ldc ); + +int64_t LAPACKE_slarfg_64( int64_t n, float* alpha, float* x, + int64_t incx, float* tau ); +int64_t LAPACKE_dlarfg_64( int64_t n, double* alpha, double* x, + int64_t incx, double* tau ); +int64_t LAPACKE_clarfg_64( int64_t n, lapack_complex_float* alpha, + lapack_complex_float* x, int64_t incx, + lapack_complex_float* tau ); +int64_t LAPACKE_zlarfg_64( int64_t n, lapack_complex_double* alpha, + lapack_complex_double* x, int64_t incx, + lapack_complex_double* tau ); + +int64_t LAPACKE_slarft_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, const float* v, + int64_t ldv, const float* tau, float* t, + int64_t ldt ); +int64_t LAPACKE_dlarft_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, const double* v, + int64_t ldv, const double* tau, double* t, + int64_t ldt ); +int64_t LAPACKE_clarft_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* tau, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zlarft_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* tau, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_slarfx_64( int matrix_layout, char side, int64_t m, + int64_t n, const float* v, float tau, float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_dlarfx_64( int matrix_layout, char side, int64_t m, + int64_t n, const double* v, double tau, double* c, + int64_t ldc, double* work ); +int64_t LAPACKE_clarfx_64( int matrix_layout, char side, int64_t m, + int64_t n, const lapack_complex_float* v, + lapack_complex_float tau, lapack_complex_float* c, + int64_t ldc, lapack_complex_float* work ); +int64_t LAPACKE_zlarfx_64( int matrix_layout, char side, int64_t m, + int64_t n, const lapack_complex_double* v, + lapack_complex_double tau, lapack_complex_double* c, + int64_t ldc, lapack_complex_double* work ); + +int64_t LAPACKE_slarnv_64( int64_t idist, int64_t* iseed, int64_t n, + float* x ); +int64_t LAPACKE_dlarnv_64( int64_t idist, int64_t* iseed, int64_t n, + double* x ); +int64_t LAPACKE_clarnv_64( int64_t idist, int64_t* iseed, int64_t n, + lapack_complex_float* x ); +int64_t LAPACKE_zlarnv_64( int64_t idist, int64_t* iseed, int64_t n, + lapack_complex_double* x ); + +int64_t LAPACKE_slascl_64( int matrix_layout, char type, int64_t kl, + int64_t ku, float cfrom, float cto, + int64_t m, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dlascl_64( int matrix_layout, char type, int64_t kl, + int64_t ku, double cfrom, double cto, + int64_t m, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_clascl_64( int matrix_layout, char type, int64_t kl, + int64_t ku, float cfrom, float cto, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda ); +int64_t LAPACKE_zlascl_64( int matrix_layout, char type, int64_t kl, + int64_t ku, double cfrom, double cto, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda ); + +int64_t LAPACKE_slaset_64( int matrix_layout, char uplo, int64_t m, + int64_t n, float alpha, float beta, float* a, + int64_t lda ); +int64_t LAPACKE_dlaset_64( int matrix_layout, char uplo, int64_t m, + int64_t n, double alpha, double beta, double* a, + int64_t lda ); +int64_t LAPACKE_claset_64( int matrix_layout, char uplo, int64_t m, + int64_t n, lapack_complex_float alpha, + lapack_complex_float beta, lapack_complex_float* a, + int64_t lda ); +int64_t LAPACKE_zlaset_64( int matrix_layout, char uplo, int64_t m, + int64_t n, lapack_complex_double alpha, + lapack_complex_double beta, lapack_complex_double* a, + int64_t lda ); + +int64_t LAPACKE_slasrt_64( char id, int64_t n, float* d ); +int64_t LAPACKE_dlasrt_64( char id, int64_t n, double* d ); + +int64_t LAPACKE_slassq_64( int64_t n, float* x, int64_t incx, float* scale, float* sumsq ); +int64_t LAPACKE_dlassq_64( int64_t n, double* x, int64_t incx, double* scale, double* sumsq ); +int64_t LAPACKE_classq_64( int64_t n, lapack_complex_float* x, int64_t incx, float* scale, float* sumsq ); +int64_t LAPACKE_zlassq_64( int64_t n, lapack_complex_double* x, int64_t incx, double* scale, double* sumsq ); + +int64_t LAPACKE_slaswp_64( int matrix_layout, int64_t n, float* a, + int64_t lda, int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); +int64_t LAPACKE_dlaswp_64( int matrix_layout, int64_t n, double* a, + int64_t lda, int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); +int64_t LAPACKE_claswp_64( int matrix_layout, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t k1, int64_t k2, const int64_t* ipiv, + int64_t incx ); +int64_t LAPACKE_zlaswp_64( int matrix_layout, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t k1, int64_t k2, const int64_t* ipiv, + int64_t incx ); + +int64_t LAPACKE_slatms_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, float* d, + int64_t mode, float cond, float dmax, + int64_t kl, int64_t ku, char pack, float* a, + int64_t lda ); +int64_t LAPACKE_dlatms_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, double* d, + int64_t mode, double cond, double dmax, + int64_t kl, int64_t ku, char pack, double* a, + int64_t lda ); +int64_t LAPACKE_clatms_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, float* d, + int64_t mode, float cond, float dmax, + int64_t kl, int64_t ku, char pack, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zlatms_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, double* d, + int64_t mode, double cond, double dmax, + int64_t kl, int64_t ku, char pack, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_slauum_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dlauum_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_clauum_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zlauum_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_sopgtr_64( int matrix_layout, char uplo, int64_t n, + const float* ap, const float* tau, float* q, + int64_t ldq ); +int64_t LAPACKE_dopgtr_64( int matrix_layout, char uplo, int64_t n, + const double* ap, const double* tau, double* q, + int64_t ldq ); + +int64_t LAPACKE_sopmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, const float* ap, + const float* tau, float* c, int64_t ldc ); +int64_t LAPACKE_dopmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, const double* ap, + const double* tau, double* c, int64_t ldc ); + +int64_t LAPACKE_sorgbr_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorgbr_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, double* a, + int64_t lda, const double* tau ); + +int64_t LAPACKE_sorghr_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorghr_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, double* a, int64_t lda, + const double* tau ); + +int64_t LAPACKE_sorglq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorglq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau ); + +int64_t LAPACKE_sorgql_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorgql_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau ); + +int64_t LAPACKE_sorgqr_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorgqr_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau ); + +int64_t LAPACKE_sorgrq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau ); +int64_t LAPACKE_dorgrq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau ); + +int64_t LAPACKE_sorgtr_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, const float* tau ); +int64_t LAPACKE_dorgtr_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, const double* tau ); + +int64_t LAPACKE_sorgtsqr_row_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb, int64_t nb, + float* a, int64_t lda, + const float* t, int64_t ldt ); +int64_t LAPACKE_dorgtsqr_row_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb, int64_t nb, + double* a, int64_t lda, + const double* t, int64_t ldt ); + +int64_t LAPACKE_sormbr_64( int matrix_layout, char vect, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, const float* tau, + float* c, int64_t ldc ); +int64_t LAPACKE_dormbr_64( int matrix_layout, char vect, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, const double* tau, + double* c, int64_t ldc ); + +int64_t LAPACKE_sormhr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc ); +int64_t LAPACKE_dormhr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc ); + +int64_t LAPACKE_sormlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, const float* tau, + float* c, int64_t ldc ); +int64_t LAPACKE_dormlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, const double* tau, + double* c, int64_t ldc ); + +int64_t LAPACKE_sormql_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, const float* tau, + float* c, int64_t ldc ); +int64_t LAPACKE_dormql_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, const double* tau, + double* c, int64_t ldc ); + +int64_t LAPACKE_sormqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, const float* tau, + float* c, int64_t ldc ); +int64_t LAPACKE_dormqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, const double* tau, + double* c, int64_t ldc ); + +int64_t LAPACKE_sormrq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, const float* tau, + float* c, int64_t ldc ); +int64_t LAPACKE_dormrq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, const double* tau, + double* c, int64_t ldc ); + +int64_t LAPACKE_sormrz_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc ); +int64_t LAPACKE_dormrz_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc ); + +int64_t LAPACKE_sormtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, const float* a, + int64_t lda, const float* tau, float* c, + int64_t ldc ); +int64_t LAPACKE_dormtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, const double* a, + int64_t lda, const double* tau, double* c, + int64_t ldc ); + +int64_t LAPACKE_spbcon_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const float* ab, int64_t ldab, + float anorm, float* rcond ); +int64_t LAPACKE_dpbcon_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const double* ab, int64_t ldab, + double anorm, double* rcond ); +int64_t LAPACKE_cpbcon_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_float* ab, + int64_t ldab, float anorm, float* rcond ); +int64_t LAPACKE_zpbcon_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_double* ab, + int64_t ldab, double anorm, double* rcond ); + +int64_t LAPACKE_spbequ_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const float* ab, int64_t ldab, + float* s, float* scond, float* amax ); +int64_t LAPACKE_dpbequ_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const double* ab, int64_t ldab, + double* s, double* scond, double* amax ); +int64_t LAPACKE_cpbequ_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_float* ab, + int64_t ldab, float* s, float* scond, + float* amax ); +int64_t LAPACKE_zpbequ_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_double* ab, + int64_t ldab, double* s, double* scond, + double* amax ); + +int64_t LAPACKE_spbrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const float* ab, + int64_t ldab, const float* afb, int64_t ldafb, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_dpbrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const double* ab, + int64_t ldab, const double* afb, int64_t ldafb, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr ); +int64_t LAPACKE_cpbrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* afb, int64_t ldafb, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zpbrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + const lapack_complex_double* afb, int64_t ldafb, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_spbstf_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, float* bb, int64_t ldbb ); +int64_t LAPACKE_dpbstf_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, double* bb, int64_t ldbb ); +int64_t LAPACKE_cpbstf_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, lapack_complex_float* bb, + int64_t ldbb ); +int64_t LAPACKE_zpbstf_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, lapack_complex_double* bb, + int64_t ldbb ); + +int64_t LAPACKE_spbsv_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, float* ab, + int64_t ldab, float* b, int64_t ldb ); +int64_t LAPACKE_dpbsv_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, double* ab, + int64_t ldab, double* b, int64_t ldb ); +int64_t LAPACKE_cpbsv_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpbsv_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spbsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t kd, int64_t nrhs, float* ab, + int64_t ldab, float* afb, int64_t ldafb, + char* equed, float* s, float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dpbsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t kd, int64_t nrhs, double* ab, + int64_t ldab, double* afb, int64_t ldafb, + char* equed, double* s, double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* ferr, double* berr ); +int64_t LAPACKE_cpbsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* afb, int64_t ldafb, + char* equed, float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_zpbsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* afb, int64_t ldafb, + char* equed, double* s, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr ); + +int64_t LAPACKE_spbtrf_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab ); +int64_t LAPACKE_dpbtrf_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab ); +int64_t LAPACKE_cpbtrf_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab ); +int64_t LAPACKE_zpbtrf_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab ); + +int64_t LAPACKE_spbtrs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const float* ab, + int64_t ldab, float* b, int64_t ldb ); +int64_t LAPACKE_dpbtrs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const double* ab, + int64_t ldab, double* b, int64_t ldb ); +int64_t LAPACKE_cpbtrs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpbtrs_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spftrf_64( int matrix_layout, char transr, char uplo, + int64_t n, float* a ); +int64_t LAPACKE_dpftrf_64( int matrix_layout, char transr, char uplo, + int64_t n, double* a ); +int64_t LAPACKE_cpftrf_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_float* a ); +int64_t LAPACKE_zpftrf_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_double* a ); + +int64_t LAPACKE_spftri_64( int matrix_layout, char transr, char uplo, + int64_t n, float* a ); +int64_t LAPACKE_dpftri_64( int matrix_layout, char transr, char uplo, + int64_t n, double* a ); +int64_t LAPACKE_cpftri_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_float* a ); +int64_t LAPACKE_zpftri_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_double* a ); + +int64_t LAPACKE_spftrs_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, const float* a, + float* b, int64_t ldb ); +int64_t LAPACKE_dpftrs_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, const double* a, + double* b, int64_t ldb ); +int64_t LAPACKE_cpftrs_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpftrs_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spocon_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float anorm, + float* rcond ); +int64_t LAPACKE_dpocon_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double anorm, + double* rcond ); +int64_t LAPACKE_cpocon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float anorm, float* rcond ); +int64_t LAPACKE_zpocon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double anorm, double* rcond ); + +int64_t LAPACKE_spoequ_64( int matrix_layout, int64_t n, const float* a, + int64_t lda, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dpoequ_64( int matrix_layout, int64_t n, const double* a, + int64_t lda, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cpoequ_64( int matrix_layout, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zpoequ_64( int matrix_layout, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_spoequb_64( int matrix_layout, int64_t n, const float* a, + int64_t lda, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dpoequb_64( int matrix_layout, int64_t n, const double* a, + int64_t lda, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cpoequb_64( int matrix_layout, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zpoequb_64( int matrix_layout, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_sporfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dporfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const double* af, int64_t ldaf, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr ); +int64_t LAPACKE_cporfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_zporfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* ferr, double* berr ); + +int64_t LAPACKE_sporfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, int64_t ldaf, + const float* s, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dporfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, int64_t ldaf, + const double* s, const double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); +int64_t LAPACKE_cporfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, int64_t ldaf, + const float* s, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_zporfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, int64_t ldaf, + const double* s, const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); + +int64_t LAPACKE_sposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, float* b, + int64_t ldb ); +int64_t LAPACKE_dposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, double* b, + int64_t ldb ); +int64_t LAPACKE_cposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); +int64_t LAPACKE_dsposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* x, int64_t ldx, + int64_t* iter ); +int64_t LAPACKE_zcposv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, int64_t* iter ); + +int64_t LAPACKE_sposvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, float* af, + int64_t ldaf, char* equed, float* s, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_dposvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* af, int64_t ldaf, char* equed, double* s, + double* b, int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); +int64_t LAPACKE_cposvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* af, + int64_t ldaf, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zposvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* af, + int64_t ldaf, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_sposvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + char* equed, float* s, float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, + float* rpvgrw, float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_dposvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + char* equed, double* s, double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* rpvgrw, double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); +int64_t LAPACKE_cposvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + char* equed, float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_zposvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + char* equed, double* s, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* rpvgrw, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); + +int64_t LAPACKE_spotrf2_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dpotrf2_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_cpotrf2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotrf2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotrf_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dpotrf_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_cpotrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotri_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dpotri_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_cpotri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + float* b, int64_t ldb ); +int64_t LAPACKE_dpotrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + double* b, int64_t ldb ); +int64_t LAPACKE_cpotrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zpotrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sppcon_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float anorm, float* rcond ); +int64_t LAPACKE_dppcon_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double anorm, double* rcond ); +int64_t LAPACKE_cppcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, float anorm, + float* rcond ); +int64_t LAPACKE_zppcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, double anorm, + double* rcond ); + +int64_t LAPACKE_sppequ_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dppequ_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cppequ_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, float* s, + float* scond, float* amax ); +int64_t LAPACKE_zppequ_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, double* s, + double* scond, double* amax ); + +int64_t LAPACKE_spprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, const float* afp, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_dpprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, const double* afp, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr ); +int64_t LAPACKE_cpprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zpprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + const lapack_complex_double* afp, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sppsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* ap, float* b, + int64_t ldb ); +int64_t LAPACKE_dppsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* ap, double* b, + int64_t ldb ); +int64_t LAPACKE_cppsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zppsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sppsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, float* ap, float* afp, char* equed, + float* s, float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dppsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, double* ap, double* afp, + char* equed, double* s, double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* ferr, double* berr ); +int64_t LAPACKE_cppsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + lapack_complex_float* afp, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zppsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + lapack_complex_double* afp, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_spptrf_64( int matrix_layout, char uplo, int64_t n, + float* ap ); +int64_t LAPACKE_dpptrf_64( int matrix_layout, char uplo, int64_t n, + double* ap ); +int64_t LAPACKE_cpptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap ); +int64_t LAPACKE_zpptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap ); + +int64_t LAPACKE_spptri_64( int matrix_layout, char uplo, int64_t n, + float* ap ); +int64_t LAPACKE_dpptri_64( int matrix_layout, char uplo, int64_t n, + double* ap ); +int64_t LAPACKE_cpptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap ); +int64_t LAPACKE_zpptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap ); + +int64_t LAPACKE_spptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, float* b, + int64_t ldb ); +int64_t LAPACKE_dpptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, double* b, + int64_t ldb ); +int64_t LAPACKE_cpptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spstrf_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, int64_t* piv, int64_t* rank, + float tol ); +int64_t LAPACKE_dpstrf_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, int64_t* piv, int64_t* rank, + double tol ); +int64_t LAPACKE_cpstrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* piv, int64_t* rank, float tol ); +int64_t LAPACKE_zpstrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* piv, int64_t* rank, double tol ); + +int64_t LAPACKE_sptcon_64( int64_t n, const float* d, const float* e, + float anorm, float* rcond ); +int64_t LAPACKE_dptcon_64( int64_t n, const double* d, const double* e, + double anorm, double* rcond ); +int64_t LAPACKE_cptcon_64( int64_t n, const float* d, + const lapack_complex_float* e, float anorm, + float* rcond ); +int64_t LAPACKE_zptcon_64( int64_t n, const double* d, + const lapack_complex_double* e, double anorm, + double* rcond ); + +int64_t LAPACKE_spteqr_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, float* z, int64_t ldz ); +int64_t LAPACKE_dpteqr_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz ); +int64_t LAPACKE_cpteqr_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zpteqr_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_sptrfs_64( int matrix_layout, int64_t n, int64_t nrhs, + const float* d, const float* e, const float* df, + const float* ef, const float* b, int64_t ldb, + float* x, int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_dptrfs_64( int matrix_layout, int64_t n, int64_t nrhs, + const double* d, const double* e, const double* df, + const double* ef, const double* b, int64_t ldb, + double* x, int64_t ldx, double* ferr, + double* berr ); +int64_t LAPACKE_cptrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, const float* df, + const lapack_complex_float* ef, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zptrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, const double* df, + const lapack_complex_double* ef, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sptsv_64( int matrix_layout, int64_t n, int64_t nrhs, + float* d, float* e, float* b, int64_t ldb ); +int64_t LAPACKE_dptsv_64( int matrix_layout, int64_t n, int64_t nrhs, + double* d, double* e, double* b, int64_t ldb ); +int64_t LAPACKE_cptsv_64( int matrix_layout, int64_t n, int64_t nrhs, + float* d, lapack_complex_float* e, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zptsv_64( int matrix_layout, int64_t n, int64_t nrhs, + double* d, lapack_complex_double* e, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sptsvx_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const float* d, const float* e, + float* df, float* ef, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dptsvx_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const double* d, const double* e, + double* df, double* ef, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); +int64_t LAPACKE_cptsvx_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, float* df, + lapack_complex_float* ef, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zptsvx_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, double* df, + lapack_complex_double* ef, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_spttrf_64( int64_t n, float* d, float* e ); +int64_t LAPACKE_dpttrf_64( int64_t n, double* d, double* e ); +int64_t LAPACKE_cpttrf_64( int64_t n, float* d, lapack_complex_float* e ); +int64_t LAPACKE_zpttrf_64( int64_t n, double* d, lapack_complex_double* e ); + +int64_t LAPACKE_spttrs_64( int matrix_layout, int64_t n, int64_t nrhs, + const float* d, const float* e, float* b, + int64_t ldb ); +int64_t LAPACKE_dpttrs_64( int matrix_layout, int64_t n, int64_t nrhs, + const double* d, const double* e, double* b, + int64_t ldb ); +int64_t LAPACKE_cpttrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpttrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_ssbev_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab, float* w, + float* z, int64_t ldz ); +int64_t LAPACKE_dsbev_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab, double* w, + double* z, int64_t ldz ); + +int64_t LAPACKE_ssbevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab, float* w, + float* z, int64_t ldz ); +int64_t LAPACKE_dsbevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_ssbevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsbevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* q, int64_t ldq, + double vl, double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssbgst_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t ka, int64_t kb, float* ab, + int64_t ldab, const float* bb, int64_t ldbb, + float* x, int64_t ldx ); +int64_t LAPACKE_dsbgst_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t ka, int64_t kb, double* ab, + int64_t ldab, const double* bb, int64_t ldbb, + double* x, int64_t ldx ); + +int64_t LAPACKE_ssbgv_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, float* ab, + int64_t ldab, float* bb, int64_t ldbb, float* w, + float* z, int64_t ldz ); +int64_t LAPACKE_dsbgv_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, double* ab, + int64_t ldab, double* bb, int64_t ldbb, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_ssbgvd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, float* ab, + int64_t ldab, float* bb, int64_t ldbb, + float* w, float* z, int64_t ldz ); +int64_t LAPACKE_dsbgvd_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t ka, int64_t kb, double* ab, + int64_t ldab, double* bb, int64_t ldbb, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_ssbgvx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t ka, int64_t kb, + float* ab, int64_t ldab, float* bb, + int64_t ldbb, float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsbgvx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t ka, int64_t kb, + double* ab, int64_t ldab, double* bb, + int64_t ldbb, double* q, int64_t ldq, + double vl, double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssbtrd_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab, float* d, + float* e, float* q, int64_t ldq ); +int64_t LAPACKE_dsbtrd_64( int matrix_layout, char vect, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab, + double* d, double* e, double* q, int64_t ldq ); + +int64_t LAPACKE_ssfrk_64( int matrix_layout, char transr, char uplo, char trans, + int64_t n, int64_t k, float alpha, + const float* a, int64_t lda, float beta, + float* c ); +int64_t LAPACKE_dsfrk_64( int matrix_layout, char transr, char uplo, char trans, + int64_t n, int64_t k, double alpha, + const double* a, int64_t lda, double beta, + double* c ); + +int64_t LAPACKE_sspcon_64( int matrix_layout, char uplo, int64_t n, + const float* ap, const int64_t* ipiv, float anorm, + float* rcond ); +int64_t LAPACKE_dspcon_64( int matrix_layout, char uplo, int64_t n, + const double* ap, const int64_t* ipiv, + double anorm, double* rcond ); +int64_t LAPACKE_cspcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zspcon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_sspev_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* ap, float* w, float* z, int64_t ldz ); +int64_t LAPACKE_dspev_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* ap, double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_sspevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* ap, float* w, float* z, int64_t ldz ); +int64_t LAPACKE_dspevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* ap, double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_sspevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, float* ap, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dspevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, double* ap, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_sspgst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, float* ap, const float* bp ); +int64_t LAPACKE_dspgst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, double* ap, const double* bp ); + +int64_t LAPACKE_sspgv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* ap, float* bp, + float* w, float* z, int64_t ldz ); +int64_t LAPACKE_dspgv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* ap, double* bp, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_sspgvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* ap, float* bp, + float* w, float* z, int64_t ldz ); +int64_t LAPACKE_dspgvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* ap, double* bp, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_sspgvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, float* ap, + float* bp, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, float* w, + float* z, int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_dspgvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, double* ap, + double* bp, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_ssprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, const float* afp, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dsprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, const double* afp, + const int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr ); +int64_t LAPACKE_csprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zsprfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + const lapack_complex_double* afp, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_sspsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* ap, int64_t* ipiv, + float* b, int64_t ldb ); +int64_t LAPACKE_dspsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* ap, int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cspsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zspsv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sspsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const float* ap, float* afp, + int64_t* ipiv, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dspsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const double* ap, double* afp, + int64_t* ipiv, const double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* ferr, double* berr ); +int64_t LAPACKE_cspsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + lapack_complex_float* afp, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zspsvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + lapack_complex_double* afp, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_ssptrd_64( int matrix_layout, char uplo, int64_t n, float* ap, + float* d, float* e, float* tau ); +int64_t LAPACKE_dsptrd_64( int matrix_layout, char uplo, int64_t n, + double* ap, double* d, double* e, double* tau ); + +int64_t LAPACKE_ssptrf_64( int matrix_layout, char uplo, int64_t n, float* ap, + int64_t* ipiv ); +int64_t LAPACKE_dsptrf_64( int matrix_layout, char uplo, int64_t n, + double* ap, int64_t* ipiv ); +int64_t LAPACKE_csptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, int64_t* ipiv ); +int64_t LAPACKE_zsptrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, int64_t* ipiv ); + +int64_t LAPACKE_ssptri_64( int matrix_layout, char uplo, int64_t n, float* ap, + const int64_t* ipiv ); +int64_t LAPACKE_dsptri_64( int matrix_layout, char uplo, int64_t n, + double* ap, const int64_t* ipiv ); +int64_t LAPACKE_csptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, const int64_t* ipiv ); +int64_t LAPACKE_zsptri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, const int64_t* ipiv ); + +int64_t LAPACKE_ssptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dsptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_csptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zsptrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* ap, + const int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sstebz_64( char range, char order, int64_t n, float vl, + float vu, int64_t il, int64_t iu, float abstol, + const float* d, const float* e, int64_t* m, + int64_t* nsplit, float* w, int64_t* iblock, + int64_t* isplit ); +int64_t LAPACKE_dstebz_64( char range, char order, int64_t n, double vl, + double vu, int64_t il, int64_t iu, + double abstol, const double* d, const double* e, + int64_t* m, int64_t* nsplit, double* w, + int64_t* iblock, int64_t* isplit ); + +int64_t LAPACKE_sstedc_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, float* z, int64_t ldz ); +int64_t LAPACKE_dstedc_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz ); +int64_t LAPACKE_cstedc_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zstedc_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_sstegr_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_dstegr_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz ); +int64_t LAPACKE_cstegr_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* isuppz ); +int64_t LAPACKE_zstegr_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* isuppz ); + +int64_t LAPACKE_sstein_64( int matrix_layout, int64_t n, const float* d, + const float* e, int64_t m, const float* w, + const int64_t* iblock, const int64_t* isplit, + float* z, int64_t ldz, int64_t* ifailv ); +int64_t LAPACKE_dstein_64( int matrix_layout, int64_t n, const double* d, + const double* e, int64_t m, const double* w, + const int64_t* iblock, const int64_t* isplit, + double* z, int64_t ldz, int64_t* ifailv ); +int64_t LAPACKE_cstein_64( int matrix_layout, int64_t n, const float* d, + const float* e, int64_t m, const float* w, + const int64_t* iblock, const int64_t* isplit, + lapack_complex_float* z, int64_t ldz, + int64_t* ifailv ); +int64_t LAPACKE_zstein_64( int matrix_layout, int64_t n, const double* d, + const double* e, int64_t m, const double* w, + const int64_t* iblock, const int64_t* isplit, + lapack_complex_double* z, int64_t ldz, + int64_t* ifailv ); + +int64_t LAPACKE_sstemr_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, int64_t* m, + float* w, float* z, int64_t ldz, int64_t nzc, + int64_t* isuppz, lapack_logical* tryrac ); +int64_t LAPACKE_dstemr_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + int64_t* m, double* w, double* z, int64_t ldz, + int64_t nzc, int64_t* isuppz, + lapack_logical* tryrac ); +int64_t LAPACKE_cstemr_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, int64_t* m, + float* w, lapack_complex_float* z, int64_t ldz, + int64_t nzc, int64_t* isuppz, + lapack_logical* tryrac ); +int64_t LAPACKE_zstemr_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + int64_t* m, double* w, lapack_complex_double* z, + int64_t ldz, int64_t nzc, int64_t* isuppz, + lapack_logical* tryrac ); + +int64_t LAPACKE_ssteqr_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, float* z, int64_t ldz ); +int64_t LAPACKE_dsteqr_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz ); +int64_t LAPACKE_csteqr_64( int matrix_layout, char compz, int64_t n, float* d, + float* e, lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zsteqr_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_ssterf_64( int64_t n, float* d, float* e ); +int64_t LAPACKE_dsterf_64( int64_t n, double* d, double* e ); + +int64_t LAPACKE_sstev_64( int matrix_layout, char jobz, int64_t n, float* d, + float* e, float* z, int64_t ldz ); +int64_t LAPACKE_dstev_64( int matrix_layout, char jobz, int64_t n, double* d, + double* e, double* z, int64_t ldz ); + +int64_t LAPACKE_sstevd_64( int matrix_layout, char jobz, int64_t n, float* d, + float* e, float* z, int64_t ldz ); +int64_t LAPACKE_dstevd_64( int matrix_layout, char jobz, int64_t n, double* d, + double* e, double* z, int64_t ldz ); + +int64_t LAPACKE_sstevr_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_dstevr_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz ); + +int64_t LAPACKE_sstevx_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dstevx_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssycon_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_dsycon_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond ); +int64_t LAPACKE_csycon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zsycon_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond ); + +int64_t LAPACKE_ssyequb_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float* s, + float* scond, float* amax ); +int64_t LAPACKE_dsyequb_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double* s, + double* scond, double* amax ); +int64_t LAPACKE_csyequb_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zsyequb_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_ssyev_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* a, int64_t lda, float* w ); +int64_t LAPACKE_dsyev_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* a, int64_t lda, double* w ); + +int64_t LAPACKE_ssyevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* a, int64_t lda, float* w ); +int64_t LAPACKE_dsyevd_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* a, int64_t lda, double* w ); + +int64_t LAPACKE_ssyevr_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, float* a, int64_t lda, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_dsyevr_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, double* a, int64_t lda, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz ); + +int64_t LAPACKE_ssyevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, float* a, int64_t lda, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsyevx_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, double* a, int64_t lda, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssygst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, float* a, int64_t lda, + const float* b, int64_t ldb ); +int64_t LAPACKE_dsygst_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, double* a, int64_t lda, + const double* b, int64_t ldb ); + +int64_t LAPACKE_ssygv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, float* w ); +int64_t LAPACKE_dsygv_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double* w ); + +int64_t LAPACKE_ssygvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, float* w ); +int64_t LAPACKE_dsygvd_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double* w ); + +int64_t LAPACKE_ssygvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsygvx_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssyrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dsyrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const double* af, int64_t ldaf, + const int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr ); +int64_t LAPACKE_csyrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_zsyrfs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_ssyrfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, int64_t ldaf, + const int64_t* ipiv, const float* s, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dsyrfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, int64_t ldaf, + const int64_t* ipiv, const double* s, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); +int64_t LAPACKE_csyrfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, int64_t ldaf, + const int64_t* ipiv, const float* s, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params ); +int64_t LAPACKE_zsyrfsx_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, int64_t ldaf, + const int64_t* ipiv, const double* s, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params ); + +int64_t LAPACKE_ssysv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dsysv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_csysv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsysv_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_ssysvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + float* af, int64_t ldaf, int64_t* ipiv, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr ); +int64_t LAPACKE_dsysvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + double* af, int64_t ldaf, int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr ); +int64_t LAPACKE_csysvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* af, + int64_t ldaf, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr ); +int64_t LAPACKE_zsysvx_64( int matrix_layout, char fact, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* af, + int64_t ldaf, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr ); + +int64_t LAPACKE_ssysvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_dsysvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); +int64_t LAPACKE_csysvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params ); +int64_t LAPACKE_zsysvxx_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params ); + +int64_t LAPACKE_ssytrd_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, float* d, float* e, float* tau ); +int64_t LAPACKE_dsytrd_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, double* d, double* e, double* tau ); + +int64_t LAPACKE_ssytrf_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dsytrf_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_csytrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zsytrf_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_ssytri_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_dsytri_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_csytri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_zsytri_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv ); + +int64_t LAPACKE_ssytrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_csytrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stbcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, int64_t kd, const float* ab, + int64_t ldab, float* rcond ); +int64_t LAPACKE_dtbcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, int64_t kd, const double* ab, + int64_t ldab, double* rcond ); +int64_t LAPACKE_ctbcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, int64_t kd, + const lapack_complex_float* ab, int64_t ldab, + float* rcond ); +int64_t LAPACKE_ztbcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, int64_t kd, + const lapack_complex_double* ab, int64_t ldab, + double* rcond ); + +int64_t LAPACKE_stbrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const float* ab, int64_t ldab, const float* b, + int64_t ldb, const float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_dtbrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const double* ab, int64_t ldab, const double* b, + int64_t ldb, const double* x, int64_t ldx, + double* ferr, double* berr ); +int64_t LAPACKE_ctbrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_ztbrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_stbtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const float* ab, int64_t ldab, float* b, + int64_t ldb ); +int64_t LAPACKE_dtbtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const double* ab, int64_t ldab, double* b, + int64_t ldb ); +int64_t LAPACKE_ctbtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztbtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stfsm_64( int matrix_layout, char transr, char side, char uplo, + char trans, char diag, int64_t m, int64_t n, + float alpha, const float* a, float* b, + int64_t ldb ); +int64_t LAPACKE_dtfsm_64( int matrix_layout, char transr, char side, char uplo, + char trans, char diag, int64_t m, int64_t n, + double alpha, const double* a, double* b, + int64_t ldb ); +int64_t LAPACKE_ctfsm_64( int matrix_layout, char transr, char side, char uplo, + char trans, char diag, int64_t m, int64_t n, + lapack_complex_float alpha, + const lapack_complex_float* a, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztfsm_64( int matrix_layout, char transr, char side, char uplo, + char trans, char diag, int64_t m, int64_t n, + lapack_complex_double alpha, + const lapack_complex_double* a, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stftri_64( int matrix_layout, char transr, char uplo, char diag, + int64_t n, float* a ); +int64_t LAPACKE_dtftri_64( int matrix_layout, char transr, char uplo, char diag, + int64_t n, double* a ); +int64_t LAPACKE_ctftri_64( int matrix_layout, char transr, char uplo, char diag, + int64_t n, lapack_complex_float* a ); +int64_t LAPACKE_ztftri_64( int matrix_layout, char transr, char uplo, char diag, + int64_t n, lapack_complex_double* a ); + +int64_t LAPACKE_stfttp_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* arf, float* ap ); +int64_t LAPACKE_dtfttp_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* arf, double* ap ); +int64_t LAPACKE_ctfttp_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* arf, + lapack_complex_float* ap ); +int64_t LAPACKE_ztfttp_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* arf, + lapack_complex_double* ap ); + +int64_t LAPACKE_stfttr_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* arf, float* a, + int64_t lda ); +int64_t LAPACKE_dtfttr_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* arf, double* a, + int64_t lda ); +int64_t LAPACKE_ctfttr_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* arf, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_ztfttr_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* arf, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_stgevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const float* s, int64_t lds, const float* p, + int64_t ldp, float* vl, int64_t ldvl, + float* vr, int64_t ldvr, int64_t mm, + int64_t* m ); +int64_t LAPACKE_dtgevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const double* s, int64_t lds, const double* p, + int64_t ldp, double* vl, int64_t ldvl, + double* vr, int64_t ldvr, int64_t mm, + int64_t* m ); +int64_t LAPACKE_ctgevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* s, int64_t lds, + const lapack_complex_float* p, int64_t ldp, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t mm, int64_t* m ); +int64_t LAPACKE_ztgevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* s, int64_t lds, + const lapack_complex_double* p, int64_t ldp, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t mm, int64_t* m ); + +int64_t LAPACKE_stgexc_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, float* q, + int64_t ldq, float* z, int64_t ldz, + int64_t* ifst, int64_t* ilst ); +int64_t LAPACKE_dtgexc_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, double* q, + int64_t ldq, double* z, int64_t ldz, + int64_t* ifst, int64_t* ilst ); +int64_t LAPACKE_ctgexc_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz, + int64_t ifst, int64_t ilst ); +int64_t LAPACKE_ztgexc_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + int64_t ifst, int64_t ilst ); + +int64_t LAPACKE_stgsen_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* alphar, float* alphai, float* beta, float* q, + int64_t ldq, float* z, int64_t ldz, + int64_t* m, float* pl, float* pr, float* dif ); +int64_t LAPACKE_dtgsen_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + double* a, int64_t lda, double* b, int64_t ldb, + double* alphar, double* alphai, double* beta, + double* q, int64_t ldq, double* z, int64_t ldz, + int64_t* m, double* pl, double* pr, double* dif ); +int64_t LAPACKE_ctgsen_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, lapack_complex_float* q, + int64_t ldq, lapack_complex_float* z, + int64_t ldz, int64_t* m, float* pl, float* pr, + float* dif ); +int64_t LAPACKE_ztgsen_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + int64_t* m, double* pl, double* pr, double* dif ); + +int64_t LAPACKE_stgsja_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + int64_t k, int64_t l, float* a, int64_t lda, + float* b, int64_t ldb, float tola, float tolb, + float* alpha, float* beta, float* u, int64_t ldu, + float* v, int64_t ldv, float* q, int64_t ldq, + int64_t* ncycle ); +int64_t LAPACKE_dtgsja_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + int64_t k, int64_t l, double* a, + int64_t lda, double* b, int64_t ldb, + double tola, double tolb, double* alpha, + double* beta, double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq, + int64_t* ncycle ); +int64_t LAPACKE_ctgsja_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + int64_t k, int64_t l, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float tola, float tolb, float* alpha, + float* beta, lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq, + int64_t* ncycle ); +int64_t LAPACKE_ztgsja_64( int matrix_layout, char jobu, char jobv, char jobq, + int64_t m, int64_t p, int64_t n, + int64_t k, int64_t l, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double tola, double tolb, + double* alpha, double* beta, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + int64_t* ncycle ); + +int64_t LAPACKE_stgsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const float* a, int64_t lda, const float* b, + int64_t ldb, const float* vl, int64_t ldvl, + const float* vr, int64_t ldvr, float* s, + float* dif, int64_t mm, int64_t* m ); +int64_t LAPACKE_dtgsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const double* a, int64_t lda, const double* b, + int64_t ldb, const double* vl, int64_t ldvl, + const double* vr, int64_t ldvr, double* s, + double* dif, int64_t mm, int64_t* m ); +int64_t LAPACKE_ctgsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* vl, int64_t ldvl, + const lapack_complex_float* vr, int64_t ldvr, + float* s, float* dif, int64_t mm, int64_t* m ); +int64_t LAPACKE_ztgsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* vl, int64_t ldvl, + const lapack_complex_double* vr, int64_t ldvr, + double* s, double* dif, int64_t mm, + int64_t* m ); + +int64_t LAPACKE_stgsyl_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, const float* a, + int64_t lda, const float* b, int64_t ldb, + float* c, int64_t ldc, const float* d, + int64_t ldd, const float* e, int64_t lde, + float* f, int64_t ldf, float* scale, float* dif ); +int64_t LAPACKE_dtgsyl_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, const double* a, + int64_t lda, const double* b, int64_t ldb, + double* c, int64_t ldc, const double* d, + int64_t ldd, const double* e, int64_t lde, + double* f, int64_t ldf, double* scale, + double* dif ); +int64_t LAPACKE_ctgsyl_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* c, int64_t ldc, + const lapack_complex_float* d, int64_t ldd, + const lapack_complex_float* e, int64_t lde, + lapack_complex_float* f, int64_t ldf, + float* scale, float* dif ); +int64_t LAPACKE_ztgsyl_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + const lapack_complex_double* d, int64_t ldd, + const lapack_complex_double* e, int64_t lde, + lapack_complex_double* f, int64_t ldf, + double* scale, double* dif ); + +int64_t LAPACKE_stpcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const float* ap, float* rcond ); +int64_t LAPACKE_dtpcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const double* ap, double* rcond ); +int64_t LAPACKE_ctpcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const lapack_complex_float* ap, + float* rcond ); +int64_t LAPACKE_ztpcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const lapack_complex_double* ap, + double* rcond ); + +int64_t LAPACKE_stprfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const float* ap, + const float* b, int64_t ldb, const float* x, + int64_t ldx, float* ferr, float* berr ); +int64_t LAPACKE_dtprfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const double* ap, + const double* b, int64_t ldb, const double* x, + int64_t ldx, double* ferr, double* berr ); +int64_t LAPACKE_ctprfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_ztprfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_stptri_64( int matrix_layout, char uplo, char diag, int64_t n, + float* ap ); +int64_t LAPACKE_dtptri_64( int matrix_layout, char uplo, char diag, int64_t n, + double* ap ); +int64_t LAPACKE_ctptri_64( int matrix_layout, char uplo, char diag, int64_t n, + lapack_complex_float* ap ); +int64_t LAPACKE_ztptri_64( int matrix_layout, char uplo, char diag, int64_t n, + lapack_complex_double* ap ); + +int64_t LAPACKE_stptrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const float* ap, + float* b, int64_t ldb ); +int64_t LAPACKE_dtptrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const double* ap, + double* b, int64_t ldb ); +int64_t LAPACKE_ctptrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztptrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stpttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* ap, float* arf ); +int64_t LAPACKE_dtpttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* ap, double* arf ); +int64_t LAPACKE_ctpttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* ap, + lapack_complex_float* arf ); +int64_t LAPACKE_ztpttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* ap, + lapack_complex_double* arf ); + +int64_t LAPACKE_stpttr_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float* a, int64_t lda ); +int64_t LAPACKE_dtpttr_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double* a, int64_t lda ); +int64_t LAPACKE_ctpttr_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_ztpttr_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_strcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const float* a, int64_t lda, + float* rcond ); +int64_t LAPACKE_dtrcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const double* a, int64_t lda, + double* rcond ); +int64_t LAPACKE_ctrcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const lapack_complex_float* a, + int64_t lda, float* rcond ); +int64_t LAPACKE_ztrcon_64( int matrix_layout, char norm, char uplo, char diag, + int64_t n, const lapack_complex_double* a, + int64_t lda, double* rcond ); + +int64_t LAPACKE_strevc_64( int matrix_layout, char side, char howmny, + lapack_logical* select, int64_t n, const float* t, + int64_t ldt, float* vl, int64_t ldvl, + float* vr, int64_t ldvr, int64_t mm, + int64_t* m ); +int64_t LAPACKE_dtrevc_64( int matrix_layout, char side, char howmny, + lapack_logical* select, int64_t n, + const double* t, int64_t ldt, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + int64_t mm, int64_t* m ); +int64_t LAPACKE_ctrevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t mm, int64_t* m ); +int64_t LAPACKE_ztrevc_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t mm, int64_t* m ); + +int64_t LAPACKE_strexc_64( int matrix_layout, char compq, int64_t n, float* t, + int64_t ldt, float* q, int64_t ldq, + int64_t* ifst, int64_t* ilst ); +int64_t LAPACKE_dtrexc_64( int matrix_layout, char compq, int64_t n, + double* t, int64_t ldt, double* q, int64_t ldq, + int64_t* ifst, int64_t* ilst ); +int64_t LAPACKE_ctrexc_64( int matrix_layout, char compq, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* q, int64_t ldq, + int64_t ifst, int64_t ilst ); +int64_t LAPACKE_ztrexc_64( int matrix_layout, char compq, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* q, int64_t ldq, + int64_t ifst, int64_t ilst ); + +int64_t LAPACKE_strrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* b, int64_t ldb, + const float* x, int64_t ldx, float* ferr, + float* berr ); +int64_t LAPACKE_dtrrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* b, int64_t ldb, + const double* x, int64_t ldx, double* ferr, + double* berr ); +int64_t LAPACKE_ctrrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr ); +int64_t LAPACKE_ztrrfs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr ); + +int64_t LAPACKE_strsen_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, float* t, + int64_t ldt, float* q, int64_t ldq, float* wr, + float* wi, int64_t* m, float* s, float* sep ); +int64_t LAPACKE_dtrsen_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + double* t, int64_t ldt, double* q, int64_t ldq, + double* wr, double* wi, int64_t* m, double* s, + double* sep ); +int64_t LAPACKE_ctrsen_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* w, int64_t* m, float* s, + float* sep ); +int64_t LAPACKE_ztrsen_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* w, int64_t* m, double* s, + double* sep ); + +int64_t LAPACKE_strsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const float* t, int64_t ldt, const float* vl, + int64_t ldvl, const float* vr, int64_t ldvr, + float* s, float* sep, int64_t mm, int64_t* m ); +int64_t LAPACKE_dtrsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const double* t, int64_t ldt, const double* vl, + int64_t ldvl, const double* vr, int64_t ldvr, + double* s, double* sep, int64_t mm, + int64_t* m ); +int64_t LAPACKE_ctrsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* t, int64_t ldt, + const lapack_complex_float* vl, int64_t ldvl, + const lapack_complex_float* vr, int64_t ldvr, + float* s, float* sep, int64_t mm, int64_t* m ); +int64_t LAPACKE_ztrsna_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* t, int64_t ldt, + const lapack_complex_double* vl, int64_t ldvl, + const lapack_complex_double* vr, int64_t ldvr, + double* s, double* sep, int64_t mm, + int64_t* m ); + +int64_t LAPACKE_strsyl_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const float* a, int64_t lda, const float* b, + int64_t ldb, float* c, int64_t ldc, + float* scale ); +int64_t LAPACKE_dtrsyl_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const double* a, int64_t lda, const double* b, + int64_t ldb, double* c, int64_t ldc, + double* scale ); +int64_t LAPACKE_ctrsyl_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* c, int64_t ldc, + float* scale ); +int64_t LAPACKE_ztrsyl_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + double* scale ); + +int64_t LAPACKE_strsyl3_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const float* a, int64_t lda, const float* b, + int64_t ldb, float* c, int64_t ldc, + float* scale ); +int64_t LAPACKE_dtrsyl3_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const double* a, int64_t lda, const double* b, + int64_t ldb, double* c, int64_t ldc, + double* scale ); +int64_t LAPACKE_ztrsyl3_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + double* scale ); + +int64_t LAPACKE_strtri_64( int matrix_layout, char uplo, char diag, int64_t n, + float* a, int64_t lda ); +int64_t LAPACKE_dtrtri_64( int matrix_layout, char uplo, char diag, int64_t n, + double* a, int64_t lda ); +int64_t LAPACKE_ctrtri_64( int matrix_layout, char uplo, char diag, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_ztrtri_64( int matrix_layout, char uplo, char diag, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_strtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, float* b, int64_t ldb ); +int64_t LAPACKE_dtrtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, double* b, int64_t ldb ); +int64_t LAPACKE_ctrtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztrtrs_64( int matrix_layout, char uplo, char trans, char diag, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_strttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* a, int64_t lda, + float* arf ); +int64_t LAPACKE_dtrttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* a, int64_t lda, + double* arf ); +int64_t LAPACKE_ctrttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* arf ); +int64_t LAPACKE_ztrttf_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* arf ); + +int64_t LAPACKE_strttp_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float* ap ); +int64_t LAPACKE_dtrttp_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double* ap ); +int64_t LAPACKE_ctrttp_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* ap ); +int64_t LAPACKE_ztrttp_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* ap ); + +int64_t LAPACKE_stzrzf_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau ); +int64_t LAPACKE_dtzrzf_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau ); +int64_t LAPACKE_ctzrzf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau ); +int64_t LAPACKE_ztzrzf_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau ); + +int64_t LAPACKE_cungbr_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zungbr_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cunghr_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zunghr_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cunglq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zunglq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cungql_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zungql_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cungqr_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zungqr_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cungrq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau ); +int64_t LAPACKE_zungrq_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau ); + +int64_t LAPACKE_cungtr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau ); +int64_t LAPACKE_zungtr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau ); + +int64_t LAPACKE_cungtsqr_row_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb, int64_t nb, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zungtsqr_row_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb, int64_t nb, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_cunmbr_64( int matrix_layout, char vect, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmbr_64( int matrix_layout, char vect, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmhr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmhr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmql_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmql_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmrq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmrq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmrz_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmrz_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cunmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zunmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_cupgtr_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const lapack_complex_float* tau, + lapack_complex_float* q, int64_t ldq ); +int64_t LAPACKE_zupgtr_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const lapack_complex_double* tau, + lapack_complex_double* q, int64_t ldq ); + +int64_t LAPACKE_cupmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, + const lapack_complex_float* ap, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zupmtr_64( int matrix_layout, char side, char uplo, char trans, + int64_t m, int64_t n, + const lapack_complex_double* ap, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_sbdsdc_work_64( int matrix_layout, char uplo, char compq, + int64_t n, float* d, float* e, float* u, + int64_t ldu, float* vt, int64_t ldvt, + float* q, int64_t* iq, float* work, + int64_t* iwork ); +int64_t LAPACKE_dbdsdc_work_64( int matrix_layout, char uplo, char compq, + int64_t n, double* d, double* e, double* u, + int64_t ldu, double* vt, int64_t ldvt, + double* q, int64_t* iq, double* work, + int64_t* iwork ); + +int64_t LAPACKE_sbdsvdx_work_64( int matrix_layout, char uplo, char jobz, char range, + int64_t n, float* d, float* e, + float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, float* z, int64_t ldz, + float* work, int64_t* iwork ); +int64_t LAPACKE_dbdsvdx_work_64( int matrix_layout, char uplo, char jobz, char range, + int64_t n, double* d, double* e, + double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, double* z, int64_t ldz, + double* work, int64_t* iwork ); + +int64_t LAPACKE_sbdsqr_work_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + float* d, float* e, float* vt, int64_t ldvt, + float* u, int64_t ldu, float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_dbdsqr_work_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + double* d, double* e, double* vt, + int64_t ldvt, double* u, int64_t ldu, + double* c, int64_t ldc, double* work ); +int64_t LAPACKE_cbdsqr_work_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + float* d, float* e, lapack_complex_float* vt, + int64_t ldvt, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_zbdsqr_work_64( int matrix_layout, char uplo, int64_t n, + int64_t ncvt, int64_t nru, int64_t ncc, + double* d, double* e, lapack_complex_double* vt, + int64_t ldvt, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* c, + int64_t ldc, double* work ); + +int64_t LAPACKE_sdisna_work_64( char job, int64_t m, int64_t n, + const float* d, float* sep ); +int64_t LAPACKE_ddisna_work_64( char job, int64_t m, int64_t n, + const double* d, double* sep ); + +int64_t LAPACKE_sgbbrd_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, float* ab, int64_t ldab, + float* d, float* e, float* q, int64_t ldq, + float* pt, int64_t ldpt, float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_dgbbrd_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, double* ab, int64_t ldab, + double* d, double* e, double* q, int64_t ldq, + double* pt, int64_t ldpt, double* c, + int64_t ldc, double* work ); +int64_t LAPACKE_cgbbrd_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, lapack_complex_float* ab, + int64_t ldab, float* d, float* e, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* pt, int64_t ldpt, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgbbrd_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t ncc, int64_t kl, + int64_t ku, lapack_complex_double* ab, + int64_t ldab, double* d, double* e, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* pt, int64_t ldpt, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgbcon_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, const int64_t* ipiv, + float anorm, float* rcond, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgbcon_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, const int64_t* ipiv, + double anorm, double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgbcon_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgbcon_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, + int64_t ldab, const int64_t* ipiv, + double anorm, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgbequ_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, float* r, float* c, + float* rowcnd, float* colcnd, float* amax ); +int64_t LAPACKE_dgbequ_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); +int64_t LAPACKE_cgbequ_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + float* r, float* c, float* rowcnd, + float* colcnd, float* amax ); +int64_t LAPACKE_zgbequ_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); + +int64_t LAPACKE_sgbequb_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, float* r, float* c, + float* rowcnd, float* colcnd, float* amax ); +int64_t LAPACKE_dgbequb_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); +int64_t LAPACKE_cgbequb_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, + int64_t ldab, float* r, float* c, + float* rowcnd, float* colcnd, float* amax ); +int64_t LAPACKE_zgbequb_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, + int64_t ldab, double* r, double* c, + double* rowcnd, double* colcnd, double* amax ); + +int64_t LAPACKE_sgbrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const float* ab, int64_t ldab, + const float* afb, int64_t ldafb, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgbrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const double* ab, int64_t ldab, + const double* afb, int64_t ldafb, + const int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgbrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* afb, + int64_t ldafb, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgbrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, + const lapack_complex_double* afb, + int64_t ldafb, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgbrfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const float* ab, + int64_t ldab, const float* afb, + int64_t ldafb, const int64_t* ipiv, + const float* r, const float* c, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgbrfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, const double* ab, + int64_t ldab, const double* afb, + int64_t ldafb, const int64_t* ipiv, + const double* r, const double* c, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgbrfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, + const lapack_complex_float* ab, + int64_t ldab, + const lapack_complex_float* afb, + int64_t ldafb, const int64_t* ipiv, + const float* r, const float* c, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgbrfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, + const lapack_complex_double* afb, + int64_t ldafb, const int64_t* ipiv, + const double* r, const double* c, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sgbsv_work_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, float* ab, + int64_t ldab, int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dgbsv_work_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, double* ab, + int64_t ldab, int64_t* ipiv, double* b, + int64_t ldb ); +int64_t LAPACKE_cgbsv_work_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgbsv_work_64( int matrix_layout, int64_t n, int64_t kl, + int64_t ku, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sgbsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, float* ab, int64_t ldab, + float* afb, int64_t ldafb, int64_t* ipiv, + char* equed, float* r, float* c, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dgbsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, double* ab, int64_t ldab, + double* afb, int64_t ldafb, int64_t* ipiv, + char* equed, double* r, double* c, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cgbsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + float* r, float* c, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgbsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* afb, + int64_t ldafb, int64_t* ipiv, char* equed, + double* r, double* c, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sgbsvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, float* ab, int64_t ldab, + float* afb, int64_t ldafb, int64_t* ipiv, + char* equed, float* r, float* c, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgbsvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, double* ab, int64_t ldab, + double* afb, int64_t ldafb, + int64_t* ipiv, char* equed, double* r, + double* c, double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgbsvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* afb, + int64_t ldafb, int64_t* ipiv, + char* equed, float* r, float* c, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgbsvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t kl, int64_t ku, + int64_t nrhs, lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* afb, + int64_t ldafb, int64_t* ipiv, + char* equed, double* r, double* c, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sgbtrf_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, float* ab, + int64_t ldab, int64_t* ipiv ); +int64_t LAPACKE_dgbtrf_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, double* ab, + int64_t ldab, int64_t* ipiv ); +int64_t LAPACKE_cgbtrf_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + lapack_complex_float* ab, int64_t ldab, + int64_t* ipiv ); +int64_t LAPACKE_zgbtrf_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, + lapack_complex_double* ab, int64_t ldab, + int64_t* ipiv ); + +int64_t LAPACKE_sgbtrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const float* ab, int64_t ldab, + const int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dgbtrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const double* ab, int64_t ldab, + const int64_t* ipiv, double* b, + int64_t ldb ); +int64_t LAPACKE_cgbtrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgbtrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t kl, int64_t ku, int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sgebak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const float* scale, int64_t m, float* v, + int64_t ldv ); +int64_t LAPACKE_dgebak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const double* scale, int64_t m, double* v, + int64_t ldv ); +int64_t LAPACKE_cgebak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const float* scale, int64_t m, + lapack_complex_float* v, int64_t ldv ); +int64_t LAPACKE_zgebak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const double* scale, int64_t m, + lapack_complex_double* v, int64_t ldv ); + +int64_t LAPACKE_sgebal_work_64( int matrix_layout, char job, int64_t n, + float* a, int64_t lda, int64_t* ilo, + int64_t* ihi, float* scale ); +int64_t LAPACKE_dgebal_work_64( int matrix_layout, char job, int64_t n, + double* a, int64_t lda, int64_t* ilo, + int64_t* ihi, double* scale ); +int64_t LAPACKE_cgebal_work_64( int matrix_layout, char job, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ilo, int64_t* ihi, + float* scale ); +int64_t LAPACKE_zgebal_work_64( int matrix_layout, char job, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ilo, int64_t* ihi, + double* scale ); + +int64_t LAPACKE_sgebrd_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* d, float* e, + float* tauq, float* taup, float* work, + int64_t lwork ); +int64_t LAPACKE_dgebrd_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* d, double* e, + double* tauq, double* taup, double* work, + int64_t lwork ); +int64_t LAPACKE_cgebrd_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + float* d, float* e, lapack_complex_float* tauq, + lapack_complex_float* taup, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgebrd_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + double* d, double* e, + lapack_complex_double* tauq, + lapack_complex_double* taup, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgecon_work_64( int matrix_layout, char norm, int64_t n, + const float* a, int64_t lda, float anorm, + float* rcond, float* work, int64_t* iwork ); +int64_t LAPACKE_dgecon_work_64( int matrix_layout, char norm, int64_t n, + const double* a, int64_t lda, double anorm, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgecon_work_64( int matrix_layout, char norm, int64_t n, + const lapack_complex_float* a, int64_t lda, + float anorm, float* rcond, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgecon_work_64( int matrix_layout, char norm, int64_t n, + const lapack_complex_double* a, int64_t lda, + double anorm, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgeequ_work_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, float* r, + float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_dgeequ_work_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, double* r, + double* c, double* rowcnd, double* colcnd, + double* amax ); +int64_t LAPACKE_cgeequ_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* r, float* c, float* rowcnd, + float* colcnd, float* amax ); +int64_t LAPACKE_zgeequ_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* r, double* c, double* rowcnd, + double* colcnd, double* amax ); + +int64_t LAPACKE_sgeequb_work_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, float* r, + float* c, float* rowcnd, float* colcnd, + float* amax ); +int64_t LAPACKE_dgeequb_work_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, double* r, + double* c, double* rowcnd, double* colcnd, + double* amax ); +int64_t LAPACKE_cgeequb_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* r, float* c, float* rowcnd, + float* colcnd, float* amax ); +int64_t LAPACKE_zgeequb_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* r, double* c, double* rowcnd, + double* colcnd, double* amax ); + +int64_t LAPACKE_sgees_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_S_SELECT2 select, int64_t n, float* a, + int64_t lda, int64_t* sdim, float* wr, + float* wi, float* vs, int64_t ldvs, + float* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_dgees_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_D_SELECT2 select, int64_t n, double* a, + int64_t lda, int64_t* sdim, double* wr, + double* wi, double* vs, int64_t ldvs, + double* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_cgees_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_C_SELECT1 select, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* sdim, lapack_complex_float* w, + lapack_complex_float* vs, int64_t ldvs, + lapack_complex_float* work, int64_t lwork, + float* rwork, lapack_logical* bwork ); +int64_t LAPACKE_zgees_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_Z_SELECT1 select, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* sdim, lapack_complex_double* w, + lapack_complex_double* vs, int64_t ldvs, + lapack_complex_double* work, int64_t lwork, + double* rwork, lapack_logical* bwork ); + +int64_t LAPACKE_sgeesx_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_S_SELECT2 select, char sense, + int64_t n, float* a, int64_t lda, + int64_t* sdim, float* wr, float* wi, + float* vs, int64_t ldvs, float* rconde, + float* rcondv, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork, + lapack_logical* bwork ); +int64_t LAPACKE_dgeesx_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_D_SELECT2 select, char sense, + int64_t n, double* a, int64_t lda, + int64_t* sdim, double* wr, double* wi, + double* vs, int64_t ldvs, double* rconde, + double* rcondv, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork, + lapack_logical* bwork ); +int64_t LAPACKE_cgeesx_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_C_SELECT1 select, char sense, + int64_t n, lapack_complex_float* a, + int64_t lda, int64_t* sdim, + lapack_complex_float* w, + lapack_complex_float* vs, int64_t ldvs, + float* rconde, float* rcondv, + lapack_complex_float* work, int64_t lwork, + float* rwork, lapack_logical* bwork ); +int64_t LAPACKE_zgeesx_work_64( int matrix_layout, char jobvs, char sort, + LAPACK_Z_SELECT1 select, char sense, + int64_t n, lapack_complex_double* a, + int64_t lda, int64_t* sdim, + lapack_complex_double* w, + lapack_complex_double* vs, int64_t ldvs, + double* rconde, double* rcondv, + lapack_complex_double* work, int64_t lwork, + double* rwork, lapack_logical* bwork ); + +int64_t LAPACKE_sgeev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, float* a, int64_t lda, + float* wr, float* wi, float* vl, int64_t ldvl, + float* vr, int64_t ldvr, float* work, + int64_t lwork ); +int64_t LAPACKE_dgeev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, double* a, int64_t lda, + double* wr, double* wi, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + double* work, int64_t lwork ); +int64_t LAPACKE_cgeev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* w, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zgeev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* w, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_sgeevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, float* a, + int64_t lda, float* wr, float* wi, float* vl, + int64_t ldvl, float* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, float* scale, + float* abnrm, float* rconde, float* rcondv, + float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dgeevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, double* a, + int64_t lda, double* wr, double* wi, + double* vl, int64_t ldvl, double* vr, + int64_t ldvr, int64_t* ilo, + int64_t* ihi, double* scale, double* abnrm, + double* rconde, double* rcondv, double* work, + int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_cgeevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* w, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, float* scale, + float* abnrm, float* rconde, float* rcondv, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zgeevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* w, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, double* scale, + double* abnrm, double* rconde, double* rcondv, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_sgehrd_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, float* a, int64_t lda, + float* tau, float* work, int64_t lwork ); +int64_t LAPACKE_dgehrd_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, double* a, int64_t lda, + double* tau, double* work, int64_t lwork ); +int64_t LAPACKE_cgehrd_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgehrd_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgejsv_work_64( int matrix_layout, char joba, char jobu, + char jobv, char jobr, char jobt, char jobp, + int64_t m, int64_t n, float* a, + int64_t lda, float* sva, float* u, + int64_t ldu, float* v, int64_t ldv, + float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dgejsv_work_64( int matrix_layout, char joba, char jobu, + char jobv, char jobr, char jobt, char jobp, + int64_t m, int64_t n, double* a, + int64_t lda, double* sva, double* u, + int64_t ldu, double* v, int64_t ldv, + double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_cgejsv_work_64( int matrix_layout, char joba, char jobu, + char jobv, char jobr, char jobt, char jobp, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float* sva, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, int64_t ldv, + lapack_complex_float* cwork, int64_t lwork, + float* work, int64_t lrwork, + int64_t* iwork ); +int64_t LAPACKE_zgejsv_work_64( int matrix_layout, char joba, char jobu, + char jobv, char jobr, char jobt, char jobp, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double* sva, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, int64_t ldv, + lapack_complex_double* cwork, int64_t lwork, + double* work, int64_t lrwork, + int64_t* iwork ); + +int64_t LAPACKE_sgelq2_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work ); +int64_t LAPACKE_dgelq2_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work ); +int64_t LAPACKE_cgelq2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work ); +int64_t LAPACKE_zgelq2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work ); + +int64_t LAPACKE_sgelqf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dgelqf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_cgelqf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgelqf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgels_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dgels_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_cgels_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgels_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgelsd_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* b, int64_t ldb, float* s, float rcond, + int64_t* rank, float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dgelsd_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* s, + double rcond, int64_t* rank, double* work, + int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_cgelsd_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t* iwork ); +int64_t LAPACKE_zgelsd_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* s, double rcond, + int64_t* rank, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t* iwork ); + +int64_t LAPACKE_sgelss_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* b, int64_t ldb, float* s, float rcond, + int64_t* rank, float* work, + int64_t lwork ); +int64_t LAPACKE_dgelss_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* s, + double rcond, int64_t* rank, double* work, + int64_t lwork ); +int64_t LAPACKE_cgelss_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* s, float rcond, + int64_t* rank, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zgelss_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* s, double rcond, + int64_t* rank, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +int64_t LAPACKE_sgelsy_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* b, int64_t ldb, int64_t* jpvt, + float rcond, int64_t* rank, float* work, + int64_t lwork ); +int64_t LAPACKE_dgelsy_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, int64_t* jpvt, + double rcond, int64_t* rank, double* work, + int64_t lwork ); +int64_t LAPACKE_cgelsy_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, int64_t* jpvt, float rcond, + int64_t* rank, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zgelsy_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, int64_t* jpvt, double rcond, + int64_t* rank, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +int64_t LAPACKE_sgeqlf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dgeqlf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_cgeqlf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgeqlf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgeqp3_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* jpvt, + float* tau, float* work, int64_t lwork ); +int64_t LAPACKE_dgeqp3_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* jpvt, + double* tau, double* work, int64_t lwork ); +int64_t LAPACKE_cgeqp3_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* jpvt, lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zgeqp3_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* jpvt, lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_sgeqpf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* jpvt, + float* tau, float* work ); +int64_t LAPACKE_dgeqpf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* jpvt, + double* tau, double* work ); +int64_t LAPACKE_cgeqpf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* jpvt, lapack_complex_float* tau, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgeqpf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* jpvt, lapack_complex_double* tau, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgeqr2_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work ); +int64_t LAPACKE_dgeqr2_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work ); +int64_t LAPACKE_cgeqr2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work ); +int64_t LAPACKE_zgeqr2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work ); + +int64_t LAPACKE_sgeqrf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dgeqrf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_cgeqrf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgeqrf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgeqrfp_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dgeqrfp_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_cgeqrfp_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgeqrfp_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_sgerfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgerfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cgerfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgerfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgerfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, + int64_t ldaf, const int64_t* ipiv, + const float* r, const float* c, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgerfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const int64_t* ipiv, + const double* r, const double* c, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgerfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const float* r, const float* c, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgerfsx_work_64( int matrix_layout, char trans, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const double* r, const double* c, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sgerqf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dgerqf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_cgerqf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgerqf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgesdd_work_64( int matrix_layout, char jobz, int64_t m, + int64_t n, float* a, int64_t lda, + float* s, float* u, int64_t ldu, float* vt, + int64_t ldvt, float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dgesdd_work_64( int matrix_layout, char jobz, int64_t m, + int64_t n, double* a, int64_t lda, + double* s, double* u, int64_t ldu, + double* vt, int64_t ldvt, double* work, + int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_cgesdd_work_64( int matrix_layout, char jobz, int64_t m, + int64_t n, lapack_complex_float* a, + int64_t lda, float* s, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* vt, int64_t ldvt, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t* iwork ); +int64_t LAPACKE_zgesdd_work_64( int matrix_layout, char jobz, int64_t m, + int64_t n, lapack_complex_double* a, + int64_t lda, double* s, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* vt, int64_t ldvt, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t* iwork ); + +int64_t LAPACKE_sgedmd_work_64( int matrix_layout, char jobs, char jobz, + char jobf, int64_t whtsvd, int64_t m, + int64_t n, float* x, int64_t ldx, + float* y, int64_t ldy, int64_t k, + float* reig, float* imeig, float* z, + int64_t ldz, float* res, float* b, + int64_t ldb, float* w, int64_t ldw, + float* s, int64_t lds, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_dgedmd_work_64( int matrix_layout, char jobs, char jobz, + char jobf, int64_t whtsvd, int64_t m, + int64_t n, double* x, int64_t ldx, + double* y, int64_t ldy, int64_t k, + double* reig, double* imeig, double* z, + int64_t ldz, double* res, double* b, + int64_t ldb, double* w, int64_t ldw, + double* s, int64_t lds, double* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_cgedmd_work_64( int matrix_layout, char jobs, char jobz, + char jobf, int64_t whtsvd, int64_t m, + int64_t n, lapack_complex_float* x, + int64_t ldx, lapack_complex_float* y, + int64_t ldy, int64_t k, + lapack_complex_float* reig, + lapack_complex_float* imeig, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* res, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* w, int64_t ldw, + lapack_complex_float* s, int64_t lds, + lapack_complex_float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_zgedmd_work_64( int matrix_layout, char jobs, char jobz, + char jobf, int64_t whtsvd, int64_t m, + int64_t n, lapack_complex_double* x, + int64_t ldx, lapack_complex_double* y, + int64_t ldy, int64_t k, + lapack_complex_double* reig, + lapack_complex_double* imeig, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* res, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* w, int64_t ldw, + lapack_complex_double* s, int64_t lds, + lapack_complex_double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_sgedmdq_work_64( int matrix_layout, char jobs, char jobz, + char jobr, char jobq, char jobt, char jobf, + int64_t whtsvd, int64_t m, int64_t n, + float* f, int64_t ldf, float* x, + int64_t ldx, float* y, int64_t ldy, + int64_t nrnk, float tol, int64_t k, + float* reig, float* imeig, float* z, + int64_t ldz, float* res, float* b, + int64_t ldb, float* v, int64_t ldv, + float* s, int64_t lds, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_dgedmdq_work_64( int matrix_layout, char jobs, char jobz, + char jobr, char jobq, char jobt, char jobf, + int64_t whtsvd, int64_t m, int64_t n, + double* f, int64_t ldf, double* x, + int64_t ldx, double* y, int64_t ldy, + int64_t nrnk, double tol, int64_t k, + double* reig, double* imeig, double* z, + int64_t ldz, double* res, double* b, + int64_t ldb, double* v, int64_t ldv, + double* s, int64_t lds, double* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_cgedmdq_work_64( int matrix_layout, char jobs, char jobz, + char jobr, char jobq, char jobt, char jobf, + int64_t whtsvd, int64_t m, int64_t n, + lapack_complex_float* f, int64_t ldf, + lapack_complex_float* x, int64_t ldx, + lapack_complex_float* y, int64_t ldy, + int64_t nrnk, float tol, int64_t k, + lapack_complex_float* reig, + lapack_complex_float* imeig, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* res, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* s, int64_t lds, + lapack_complex_float* work, int64_t lwork, + int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_zgedmdq_work_64( int matrix_layout, char jobs, char jobz, + char jobr, char jobq, char jobt, char jobf, + int64_t whtsvd, int64_t m, int64_t n, + lapack_complex_double* f, int64_t ldf, + lapack_complex_double* x, int64_t ldx, + lapack_complex_double* y, int64_t ldy, + int64_t nrnk, double tol, int64_t k, + lapack_complex_double* reig, + lapack_complex_double* imeig, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* res, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* s, int64_t lds, + lapack_complex_double* work, int64_t lwork, + int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_sgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + float* a, int64_t lda, int64_t* ipiv, + float* b, int64_t ldb ); +int64_t LAPACKE_dgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + double* a, int64_t lda, int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); +int64_t LAPACKE_dsgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + double* a, int64_t lda, int64_t* ipiv, + double* b, int64_t ldb, double* x, + int64_t ldx, double* work, float* swork, + int64_t* iter ); +int64_t LAPACKE_zcgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, lapack_complex_double* work, + lapack_complex_float* swork, double* rwork, + int64_t* iter ); + +int64_t LAPACKE_sgesvd_work_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, float* a, + int64_t lda, float* s, float* u, + int64_t ldu, float* vt, int64_t ldvt, + float* work, int64_t lwork ); +int64_t LAPACKE_dgesvd_work_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, double* a, + int64_t lda, double* s, double* u, + int64_t ldu, double* vt, int64_t ldvt, + double* work, int64_t lwork ); +int64_t LAPACKE_cgesvd_work_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + float* s, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* vt, + int64_t ldvt, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zgesvd_work_64( int matrix_layout, char jobu, char jobvt, + int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + double* s, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* vt, + int64_t ldvt, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +int64_t LAPACKE_sgesvdx_work_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, float* u, int64_t ldu, + float* vt, int64_t ldvt, + float* work, int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_dgesvdx_work_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, double* u, int64_t ldu, + double* vt, int64_t ldvt, + double* work, int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_cgesvdx_work_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, int64_t* ns, + float* s, lapack_complex_float* u, int64_t ldu, + lapack_complex_float* vt, int64_t ldvt, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t* iwork ); +int64_t LAPACKE_zgesvdx_work_64( int matrix_layout, char jobu, char jobvt, char range, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, int64_t* ns, + double* s, lapack_complex_double* u, int64_t ldu, + lapack_complex_double* vt, int64_t ldvt, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t* iwork ); + +int64_t LAPACKE_sgesvdq_work_64( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + int64_t m, int64_t n, float* a, + int64_t lda, float* s, float* u, + int64_t ldu, float* v, int64_t ldv, + int64_t* numrank, + int64_t* iwork, int64_t liwork, + float* work, int64_t lwork, + float* rwork, int64_t lrwork); +int64_t LAPACKE_dgesvdq_work_64( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + int64_t m, int64_t n, double* a, + int64_t lda, double* s, double* u, + int64_t ldu, double* v, int64_t ldv, + int64_t* numrank, + int64_t* iwork, int64_t liwork, + double* work, int64_t lwork, + double* rwork, int64_t lrwork); +int64_t LAPACKE_cgesvdq_work_64( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + float* s, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, + int64_t ldv, int64_t* numrank, + int64_t* iwork, int64_t liwork, + lapack_complex_float* cwork, int64_t lcwork, + float* rwork, int64_t lrwork); +int64_t LAPACKE_zgesvdq_work_64( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + double* s, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, + int64_t ldv, int64_t* numrank, + int64_t* iwork, int64_t liwork, + lapack_complex_double* cwork, int64_t lcwork, + double* rwork, int64_t lrwork); + +int64_t LAPACKE_sgesvj_work_64( int matrix_layout, char joba, char jobu, + char jobv, int64_t m, int64_t n, float* a, + int64_t lda, float* sva, int64_t mv, + float* v, int64_t ldv, float* work, + int64_t lwork ); +int64_t LAPACKE_dgesvj_work_64( int matrix_layout, char joba, char jobu, + char jobv, int64_t m, int64_t n, + double* a, int64_t lda, double* sva, + int64_t mv, double* v, int64_t ldv, + double* work, int64_t lwork ); +int64_t LAPACKE_cgesvj_work_64( int matrix_layout, char joba, char jobu, + char jobv, int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda, float* sva, int64_t mv, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* cwork, int64_t lwork, + float* rwork,int64_t lrwork ); +int64_t LAPACKE_zgesvj_work_64( int matrix_layout, char joba, char jobu, + char jobv, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, double* sva, + int64_t mv, lapack_complex_double* v, int64_t ldv, + lapack_complex_double* cwork, int64_t lwork, + double* rwork, int64_t lrwork ); + +int64_t LAPACKE_sgesvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, + float* c, float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, float* work, int64_t* iwork ); +int64_t LAPACKE_dgesvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, + double* c, double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, double* work, int64_t* iwork ); +int64_t LAPACKE_cgesvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, + float* c, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zgesvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, + double* c, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sgesvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, + float* c, float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgesvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, + double* c, double* b, int64_t ldb, + double* x, int64_t ldx, double* rcond, + double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgesvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* r, + float* c, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgesvxx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* r, + double* c, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* rpvgrw, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgetf2_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetf2_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetf2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetf2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetrf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetrf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetrf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetrf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetrf2_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dgetrf2_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_cgetrf2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zgetrf2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_sgetri_work_64( int matrix_layout, int64_t n, float* a, + int64_t lda, const int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dgetri_work_64( int matrix_layout, int64_t n, double* a, + int64_t lda, const int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_cgetri_work_64( int matrix_layout, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgetri_work_64( int matrix_layout, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgetrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dgetrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cgetrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zgetrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sggbak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const float* lscale, const float* rscale, + int64_t m, float* v, int64_t ldv ); +int64_t LAPACKE_dggbak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const double* lscale, const double* rscale, + int64_t m, double* v, int64_t ldv ); +int64_t LAPACKE_cggbak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const float* lscale, const float* rscale, + int64_t m, lapack_complex_float* v, + int64_t ldv ); +int64_t LAPACKE_zggbak_work_64( int matrix_layout, char job, char side, + int64_t n, int64_t ilo, int64_t ihi, + const double* lscale, const double* rscale, + int64_t m, lapack_complex_double* v, + int64_t ldv ); + +int64_t LAPACKE_sggbal_work_64( int matrix_layout, char job, int64_t n, + float* a, int64_t lda, float* b, + int64_t ldb, int64_t* ilo, + int64_t* ihi, float* lscale, float* rscale, + float* work ); +int64_t LAPACKE_dggbal_work_64( int matrix_layout, char job, int64_t n, + double* a, int64_t lda, double* b, + int64_t ldb, int64_t* ilo, + int64_t* ihi, double* lscale, double* rscale, + double* work ); +int64_t LAPACKE_cggbal_work_64( int matrix_layout, char job, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, float* lscale, + float* rscale, float* work ); +int64_t LAPACKE_zggbal_work_64( int matrix_layout, char job, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* ilo, int64_t* ihi, + double* lscale, double* rscale, double* work ); + +int64_t LAPACKE_sgges_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_S_SELECT3 selctg, int64_t n, + float* a, int64_t lda, float* b, + int64_t ldb, int64_t* sdim, float* alphar, + float* alphai, float* beta, float* vsl, + int64_t ldvsl, float* vsr, int64_t ldvsr, + float* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_dgges_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_D_SELECT3 selctg, int64_t n, + double* a, int64_t lda, double* b, + int64_t ldb, int64_t* sdim, double* alphar, + double* alphai, double* beta, double* vsl, + int64_t ldvsl, double* vsr, int64_t ldvsr, + double* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_cgges_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_C_SELECT2 selctg, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* sdim, lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vsl, int64_t ldvsl, + lapack_complex_float* vsr, int64_t ldvsr, + lapack_complex_float* work, int64_t lwork, + float* rwork, lapack_logical* bwork ); +int64_t LAPACKE_zgges_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_Z_SELECT2 selctg, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* sdim, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr, + lapack_complex_double* work, int64_t lwork, + double* rwork, lapack_logical* bwork ); + +int64_t LAPACKE_sgges3_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_S_SELECT3 selctg, + int64_t n, + float* a, int64_t lda, + float* b, int64_t ldb, int64_t* sdim, + float* alphar, float* alphai, float* beta, + float* vsl, int64_t ldvsl, + float* vsr, int64_t ldvsr, + float* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_dgges3_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_D_SELECT3 selctg, + int64_t n, + double* a, int64_t lda, + double* b, int64_t ldb, int64_t* sdim, + double* alphar, double* alphai, double* beta, + double* vsl, int64_t ldvsl, + double* vsr, int64_t ldvsr, + double* work, int64_t lwork, + lapack_logical* bwork ); +int64_t LAPACKE_cgges3_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_C_SELECT2 selctg, + int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + int64_t* sdim, lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vsl, int64_t ldvsl, + lapack_complex_float* vsr, int64_t ldvsr, + lapack_complex_float* work, int64_t lwork, + float* rwork, lapack_logical* bwork ); +int64_t LAPACKE_zgges3_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_Z_SELECT2 selctg, + int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + int64_t* sdim, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr, + lapack_complex_double* work, int64_t lwork, + double* rwork, lapack_logical* bwork ); + +int64_t LAPACKE_sggesx_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_S_SELECT3 selctg, char sense, + int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, int64_t* sdim, + float* alphar, float* alphai, float* beta, + float* vsl, int64_t ldvsl, float* vsr, + int64_t ldvsr, float* rconde, float* rcondv, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork, + lapack_logical* bwork ); +int64_t LAPACKE_dggesx_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_D_SELECT3 selctg, char sense, + int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, int64_t* sdim, + double* alphar, double* alphai, double* beta, + double* vsl, int64_t ldvsl, double* vsr, + int64_t ldvsr, double* rconde, + double* rcondv, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork, + lapack_logical* bwork ); +int64_t LAPACKE_cggesx_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_C_SELECT2 selctg, char sense, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, int64_t* sdim, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vsl, int64_t ldvsl, + lapack_complex_float* vsr, int64_t ldvsr, + float* rconde, float* rcondv, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t* iwork, + int64_t liwork, lapack_logical* bwork ); +int64_t LAPACKE_zggesx_work_64( int matrix_layout, char jobvsl, char jobvsr, + char sort, LAPACK_Z_SELECT2 selctg, char sense, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, int64_t* sdim, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vsl, int64_t ldvsl, + lapack_complex_double* vsr, int64_t ldvsr, + double* rconde, double* rcondv, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t* iwork, + int64_t liwork, lapack_logical* bwork ); + +int64_t LAPACKE_sggev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, float* a, int64_t lda, float* b, + int64_t ldb, float* alphar, float* alphai, + float* beta, float* vl, int64_t ldvl, + float* vr, int64_t ldvr, float* work, + int64_t lwork ); +int64_t LAPACKE_dggev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double* alphar, + double* alphai, double* beta, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + double* work, int64_t lwork ); +int64_t LAPACKE_cggev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zggev_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_sggev3_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + float* a, int64_t lda, + float* b, int64_t ldb, + float* alphar, float* alphai, float* beta, + float* vl, int64_t ldvl, + float* vr, int64_t ldvr, + float* work, int64_t lwork ); +int64_t LAPACKE_dggev3_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + double* a, int64_t lda, + double* b, int64_t ldb, + double* alphar, double* alphai, double* beta, + double* vl, int64_t ldvl, + double* vr, int64_t ldvr, + double* work, int64_t lwork ); +int64_t LAPACKE_cggev3_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zggev3_work_64( int matrix_layout, char jobvl, char jobvr, + int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_sggevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* alphar, float* alphai, float* beta, + float* vl, int64_t ldvl, float* vr, + int64_t ldvr, int64_t* ilo, + int64_t* ihi, float* lscale, float* rscale, + float* abnrm, float* bbnrm, float* rconde, + float* rcondv, float* work, int64_t lwork, + int64_t* iwork, lapack_logical* bwork ); +int64_t LAPACKE_dggevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* alphar, double* alphai, double* beta, + double* vl, int64_t ldvl, double* vr, + int64_t ldvr, int64_t* ilo, + int64_t* ihi, double* lscale, double* rscale, + double* abnrm, double* bbnrm, double* rconde, + double* rcondv, double* work, int64_t lwork, + int64_t* iwork, lapack_logical* bwork ); +int64_t LAPACKE_cggevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, float* lscale, + float* rscale, float* abnrm, float* bbnrm, + float* rconde, float* rcondv, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t* iwork, + lapack_logical* bwork ); +int64_t LAPACKE_zggevx_work_64( int matrix_layout, char balanc, char jobvl, + char jobvr, char sense, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t* ilo, int64_t* ihi, + double* lscale, double* rscale, double* abnrm, + double* bbnrm, double* rconde, double* rcondv, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t* iwork, + lapack_logical* bwork ); + +int64_t LAPACKE_sggglm_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, float* a, int64_t lda, + float* b, int64_t ldb, float* d, float* x, + float* y, float* work, int64_t lwork ); +int64_t LAPACKE_dggglm_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, double* a, int64_t lda, + double* b, int64_t ldb, double* d, double* x, + double* y, double* work, int64_t lwork ); +int64_t LAPACKE_cggglm_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* d, + lapack_complex_float* x, + lapack_complex_float* y, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zggglm_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* d, + lapack_complex_double* x, + lapack_complex_double* y, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgghrd_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* a, int64_t lda, float* b, + int64_t ldb, float* q, int64_t ldq, + float* z, int64_t ldz ); +int64_t LAPACKE_dgghrd_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* a, int64_t lda, double* b, + int64_t ldb, double* q, int64_t ldq, + double* z, int64_t ldz ); +int64_t LAPACKE_cgghrd_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz ); +int64_t LAPACKE_zgghrd_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz ); + +int64_t LAPACKE_sgghd3_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* a, int64_t lda, + float* b, int64_t ldb, + float* q, int64_t ldq, + float* z, int64_t ldz, + float* work, int64_t lwork ); +int64_t LAPACKE_dgghd3_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* a, int64_t lda, + double* b, int64_t ldb, + double* q, int64_t ldq, + double* z, int64_t ldz, + double* work, int64_t lwork ); +int64_t LAPACKE_cgghd3_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgghd3_work_64( int matrix_layout, char compq, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_sgglse_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, float* a, int64_t lda, + float* b, int64_t ldb, float* c, float* d, + float* x, float* work, int64_t lwork ); +int64_t LAPACKE_dgglse_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, double* a, int64_t lda, + double* b, int64_t ldb, double* c, double* d, + double* x, double* work, int64_t lwork ); +int64_t LAPACKE_cgglse_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* c, + lapack_complex_float* d, + lapack_complex_float* x, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgglse_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* c, + lapack_complex_double* d, + lapack_complex_double* x, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sggqrf_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, float* a, int64_t lda, + float* taua, float* b, int64_t ldb, + float* taub, float* work, int64_t lwork ); +int64_t LAPACKE_dggqrf_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, double* a, int64_t lda, + double* taua, double* b, int64_t ldb, + double* taub, double* work, int64_t lwork ); +int64_t LAPACKE_cggqrf_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_float* a, + int64_t lda, lapack_complex_float* taua, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* taub, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zggqrf_work_64( int matrix_layout, int64_t n, int64_t m, + int64_t p, lapack_complex_double* a, + int64_t lda, lapack_complex_double* taua, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* taub, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sggrqf_work_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, float* a, int64_t lda, + float* taua, float* b, int64_t ldb, + float* taub, float* work, int64_t lwork ); +int64_t LAPACKE_dggrqf_work_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, double* a, int64_t lda, + double* taua, double* b, int64_t ldb, + double* taub, double* work, int64_t lwork ); +int64_t LAPACKE_cggrqf_work_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* taua, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* taub, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zggrqf_work_64( int matrix_layout, int64_t m, int64_t p, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* taua, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* taub, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sggsvd_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + float* a, int64_t lda, float* b, + int64_t ldb, float* alpha, float* beta, + float* u, int64_t ldu, float* v, + int64_t ldv, float* q, int64_t ldq, + float* work, int64_t* iwork ); +int64_t LAPACKE_dggsvd_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + double* a, int64_t lda, double* b, + int64_t ldb, double* alpha, double* beta, + double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq, + double* work, int64_t* iwork ); +int64_t LAPACKE_cggsvd_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float* alpha, float* beta, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* work, float* rwork, + int64_t* iwork ); +int64_t LAPACKE_zggsvd_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* alpha, double* beta, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* work, double* rwork, + int64_t* iwork ); + +int64_t LAPACKE_sggsvd3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + float* a, int64_t lda, float* b, + int64_t ldb, float* alpha, float* beta, + float* u, int64_t ldu, float* v, + int64_t ldv, float* q, int64_t ldq, + float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dggsvd3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + double* a, int64_t lda, double* b, + int64_t ldb, double* alpha, double* beta, + double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq, + double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_cggsvd3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float* alpha, float* beta, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t* iwork ); +int64_t LAPACKE_zggsvd3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t n, + int64_t p, int64_t* k, int64_t* l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* alpha, double* beta, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t* iwork ); + +int64_t LAPACKE_sggsvp_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, + float* u, int64_t ldu, float* v, + int64_t ldv, float* q, int64_t ldq, + int64_t* iwork, float* tau, float* work ); +int64_t LAPACKE_dggsvp_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double tola, + double tolb, int64_t* k, int64_t* l, + double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq, + int64_t* iwork, double* tau, double* work ); +int64_t LAPACKE_cggsvp_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float tola, float tolb, + int64_t* k, int64_t* l, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq, + int64_t* iwork, float* rwork, + lapack_complex_float* tau, + lapack_complex_float* work ); +int64_t LAPACKE_zggsvp_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double tola, double tolb, + int64_t* k, int64_t* l, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + int64_t* iwork, double* rwork, + lapack_complex_double* tau, + lapack_complex_double* work ); + +int64_t LAPACKE_sggsvp3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, float tola, + float tolb, int64_t* k, int64_t* l, + float* u, int64_t ldu, float* v, + int64_t ldv, float* q, int64_t ldq, + int64_t* iwork, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dggsvp3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double tola, + double tolb, int64_t* k, int64_t* l, + double* u, int64_t ldu, double* v, + int64_t ldv, double* q, int64_t ldq, + int64_t* iwork, double* tau, double* work, + int64_t lwork ); +int64_t LAPACKE_cggsvp3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float tola, float tolb, + int64_t* k, int64_t* l, + lapack_complex_float* u, int64_t ldu, + lapack_complex_float* v, int64_t ldv, + lapack_complex_float* q, int64_t ldq, + int64_t* iwork, float* rwork, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zggsvp3_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double tola, double tolb, + int64_t* k, int64_t* l, + lapack_complex_double* u, int64_t ldu, + lapack_complex_double* v, int64_t ldv, + lapack_complex_double* q, int64_t ldq, + int64_t* iwork, double* rwork, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgtcon_work_64( char norm, int64_t n, const float* dl, + const float* d, const float* du, + const float* du2, const int64_t* ipiv, + float anorm, float* rcond, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgtcon_work_64( char norm, int64_t n, const double* dl, + const double* d, const double* du, + const double* du2, const int64_t* ipiv, + double anorm, double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgtcon_work_64( char norm, int64_t n, + const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* du2, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zgtcon_work_64( char norm, int64_t n, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* du2, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_sgtrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* dl, + const float* d, const float* du, + const float* dlf, const float* df, + const float* duf, const float* du2, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dgtrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* dl, + const double* d, const double* du, + const double* dlf, const double* df, + const double* duf, const double* du2, + const int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_cgtrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* dlf, + const lapack_complex_float* df, + const lapack_complex_float* duf, + const lapack_complex_float* du2, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgtrfs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* dlf, + const lapack_complex_double* df, + const lapack_complex_double* duf, + const lapack_complex_double* du2, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgtsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + float* dl, float* d, float* du, float* b, + int64_t ldb ); +int64_t LAPACKE_dgtsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + double* dl, double* d, double* du, double* b, + int64_t ldb ); +int64_t LAPACKE_cgtsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_float* dl, + lapack_complex_float* d, + lapack_complex_float* du, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zgtsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + lapack_complex_double* dl, + lapack_complex_double* d, + lapack_complex_double* du, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sgtsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, const float* dl, + const float* d, const float* du, float* dlf, + float* df, float* duf, float* du2, + int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dgtsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, const double* dl, + const double* d, const double* du, double* dlf, + double* df, double* duf, double* du2, + int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cgtsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + lapack_complex_float* dlf, + lapack_complex_float* df, + lapack_complex_float* duf, + lapack_complex_float* du2, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zgtsvx_work_64( int matrix_layout, char fact, char trans, + int64_t n, int64_t nrhs, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + lapack_complex_double* dlf, + lapack_complex_double* df, + lapack_complex_double* duf, + lapack_complex_double* du2, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sgttrf_work_64( int64_t n, float* dl, float* d, float* du, + float* du2, int64_t* ipiv ); +int64_t LAPACKE_dgttrf_work_64( int64_t n, double* dl, double* d, double* du, + double* du2, int64_t* ipiv ); +int64_t LAPACKE_cgttrf_work_64( int64_t n, lapack_complex_float* dl, + lapack_complex_float* d, + lapack_complex_float* du, + lapack_complex_float* du2, int64_t* ipiv ); +int64_t LAPACKE_zgttrf_work_64( int64_t n, lapack_complex_double* dl, + lapack_complex_double* d, + lapack_complex_double* du, + lapack_complex_double* du2, int64_t* ipiv ); + +int64_t LAPACKE_sgttrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const float* dl, + const float* d, const float* du, + const float* du2, const int64_t* ipiv, + float* b, int64_t ldb ); +int64_t LAPACKE_dgttrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const double* dl, + const double* d, const double* du, + const double* du2, const int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cgttrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, const lapack_complex_float* dl, + const lapack_complex_float* d, + const lapack_complex_float* du, + const lapack_complex_float* du2, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zgttrs_work_64( int matrix_layout, char trans, int64_t n, + int64_t nrhs, + const lapack_complex_double* dl, + const lapack_complex_double* d, + const lapack_complex_double* du, + const lapack_complex_double* du2, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chbev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zhbev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chbevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zhbevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_chbevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* q, int64_t ldq, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + float* rwork, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_zhbevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* q, int64_t ldq, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + double* rwork, int64_t* iwork, + int64_t* ifail ); + +int64_t LAPACKE_chbgst_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* bb, int64_t ldbb, + lapack_complex_float* x, int64_t ldx, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zhbgst_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + const lapack_complex_double* bb, + int64_t ldbb, lapack_complex_double* x, + int64_t ldx, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chbgv_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* bb, int64_t ldbb, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zhbgv_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* bb, int64_t ldbb, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chbgvd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* bb, int64_t ldbb, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zhbgvd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* bb, int64_t ldbb, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_chbgvx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t ka, + int64_t kb, lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* bb, + int64_t ldbb, lapack_complex_float* q, + int64_t ldq, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zhbgvx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t ka, + int64_t kb, lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* bb, + int64_t ldbb, lapack_complex_double* q, + int64_t ldq, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_chbtrd_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + float* d, float* e, lapack_complex_float* q, + int64_t ldq, lapack_complex_float* work ); +int64_t LAPACKE_zhbtrd_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + double* d, double* e, lapack_complex_double* q, + int64_t ldq, lapack_complex_double* work ); + +int64_t LAPACKE_checon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zhecon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_cheequb_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax, + lapack_complex_float* work ); +int64_t LAPACKE_zheequb_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax, + lapack_complex_double* work ); + +int64_t LAPACKE_cheev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zheev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double* w, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_cheevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_zheevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double* w, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_cheevr_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, int64_t* isuppz, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_zheevr_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, int64_t* isuppz, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_cheevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zheevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_chegst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhegst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, const lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_chegv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zhegv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* w, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +int64_t LAPACKE_chegvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float* w, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zhegvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* w, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_chegvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zhegvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_cherfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zherfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_cherfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const float* s, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zherfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const double* s, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chesv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhesv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_chesvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zhesvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_chesvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zhesvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chetrd_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + float* d, float* e, lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhetrd_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double* d, double* e, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_chetrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zhetrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_chetri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work ); +int64_t LAPACKE_zhetri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work ); + +int64_t LAPACKE_chetrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chfrk_work_64( int matrix_layout, char transr, char uplo, + char trans, int64_t n, int64_t k, + float alpha, const lapack_complex_float* a, + int64_t lda, float beta, + lapack_complex_float* c ); +int64_t LAPACKE_zhfrk_work_64( int matrix_layout, char transr, char uplo, + char trans, int64_t n, int64_t k, + double alpha, const lapack_complex_double* a, + int64_t lda, double beta, + lapack_complex_double* c ); + +int64_t LAPACKE_shgeqz_work_64( int matrix_layout, char job, char compq, + char compz, int64_t n, int64_t ilo, + int64_t ihi, float* h, int64_t ldh, + float* t, int64_t ldt, float* alphar, + float* alphai, float* beta, float* q, + int64_t ldq, float* z, int64_t ldz, + float* work, int64_t lwork ); +int64_t LAPACKE_dhgeqz_work_64( int matrix_layout, char job, char compq, + char compz, int64_t n, int64_t ilo, + int64_t ihi, double* h, int64_t ldh, + double* t, int64_t ldt, double* alphar, + double* alphai, double* beta, double* q, + int64_t ldq, double* z, int64_t ldz, + double* work, int64_t lwork ); +int64_t LAPACKE_chgeqz_work_64( int matrix_layout, char job, char compq, + char compz, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_float* h, + int64_t ldh, lapack_complex_float* t, + int64_t ldt, lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zhgeqz_work_64( int matrix_layout, char job, char compq, + char compz, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_double* h, + int64_t ldh, lapack_complex_double* t, + int64_t ldt, lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_chpcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zhpcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_chpev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* ap, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zhpev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* ap, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_chpevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* ap, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zhpevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* ap, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_chpevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_float* ap, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zhpevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_double* ap, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_chpgst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_float* ap, + const lapack_complex_float* bp ); +int64_t LAPACKE_zhpgst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, lapack_complex_double* ap, + const lapack_complex_double* bp ); + +int64_t LAPACKE_chpgv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_float* ap, + lapack_complex_float* bp, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zhpgv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_double* ap, + lapack_complex_double* bp, double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_chpgvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_float* ap, + lapack_complex_float* bp, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_zhpgvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_double* ap, + lapack_complex_double* bp, double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_chpgvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_float* ap, + lapack_complex_float* bp, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zhpgvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, + lapack_complex_double* ap, + lapack_complex_double* bp, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_chprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zhprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + const lapack_complex_double* afp, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_chpsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhpsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_chpsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + lapack_complex_float* afp, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zhpsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + lapack_complex_double* afp, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_chptrd_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, float* d, float* e, + lapack_complex_float* tau ); +int64_t LAPACKE_zhptrd_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, double* d, double* e, + lapack_complex_double* tau ); + +int64_t LAPACKE_chptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, int64_t* ipiv ); +int64_t LAPACKE_zhptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, int64_t* ipiv ); + +int64_t LAPACKE_chptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, + const int64_t* ipiv, + lapack_complex_float* work ); +int64_t LAPACKE_zhptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, + const int64_t* ipiv, + lapack_complex_double* work ); + +int64_t LAPACKE_chptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zhptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_shsein_work_64( int matrix_layout, char job, char eigsrc, + char initv, lapack_logical* select, + int64_t n, const float* h, int64_t ldh, + float* wr, const float* wi, float* vl, + int64_t ldvl, float* vr, int64_t ldvr, + int64_t mm, int64_t* m, float* work, + int64_t* ifaill, int64_t* ifailr ); +int64_t LAPACKE_dhsein_work_64( int matrix_layout, char job, char eigsrc, + char initv, lapack_logical* select, + int64_t n, const double* h, int64_t ldh, + double* wr, const double* wi, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + int64_t mm, int64_t* m, double* work, + int64_t* ifaill, int64_t* ifailr ); +int64_t LAPACKE_chsein_work_64( int matrix_layout, char job, char eigsrc, + char initv, const lapack_logical* select, + int64_t n, const lapack_complex_float* h, + int64_t ldh, lapack_complex_float* w, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_float* work, float* rwork, + int64_t* ifaill, int64_t* ifailr ); +int64_t LAPACKE_zhsein_work_64( int matrix_layout, char job, char eigsrc, + char initv, const lapack_logical* select, + int64_t n, const lapack_complex_double* h, + int64_t ldh, lapack_complex_double* w, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_double* work, double* rwork, + int64_t* ifaill, int64_t* ifailr ); + +int64_t LAPACKE_shseqr_work_64( int matrix_layout, char job, char compz, + int64_t n, int64_t ilo, int64_t ihi, + float* h, int64_t ldh, float* wr, float* wi, + float* z, int64_t ldz, float* work, + int64_t lwork ); +int64_t LAPACKE_dhseqr_work_64( int matrix_layout, char job, char compz, + int64_t n, int64_t ilo, int64_t ihi, + double* h, int64_t ldh, double* wr, + double* wi, double* z, int64_t ldz, + double* work, int64_t lwork ); +int64_t LAPACKE_chseqr_work_64( int matrix_layout, char job, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_float* h, int64_t ldh, + lapack_complex_float* w, + lapack_complex_float* z, int64_t ldz, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhseqr_work_64( int matrix_layout, char job, char compz, + int64_t n, int64_t ilo, int64_t ihi, + lapack_complex_double* h, int64_t ldh, + lapack_complex_double* w, + lapack_complex_double* z, int64_t ldz, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_clacgv_work_64( int64_t n, lapack_complex_float* x, + int64_t incx ); +int64_t LAPACKE_zlacgv_work_64( int64_t n, lapack_complex_double* x, + int64_t incx ); + +int64_t LAPACKE_slacn2_work_64( int64_t n, float* v, float* x, + int64_t* isgn, float* est, int64_t* kase, + int64_t* isave ); +int64_t LAPACKE_dlacn2_work_64( int64_t n, double* v, double* x, + int64_t* isgn, double* est, int64_t* kase, + int64_t* isave ); +int64_t LAPACKE_clacn2_work_64( int64_t n, lapack_complex_float* v, + lapack_complex_float* x, + float* est, int64_t* kase, + int64_t* isave ); +int64_t LAPACKE_zlacn2_work_64( int64_t n, lapack_complex_double* v, + lapack_complex_double* x, + double* est, int64_t* kase, + int64_t* isave ); + +int64_t LAPACKE_slacpy_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const float* a, int64_t lda, + float* b, int64_t ldb ); +int64_t LAPACKE_dlacpy_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const double* a, int64_t lda, + double* b, int64_t ldb ); +int64_t LAPACKE_clacpy_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zlacpy_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_clacp2_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zlacp2_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, const double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_zlag2c_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + lapack_complex_float* sa, int64_t ldsa ); + +int64_t LAPACKE_slag2d_work_64( int matrix_layout, int64_t m, int64_t n, + const float* sa, int64_t ldsa, double* a, + int64_t lda ); + +int64_t LAPACKE_dlag2s_work_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, float* sa, + int64_t ldsa ); + +int64_t LAPACKE_clag2z_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* sa, int64_t ldsa, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_slagge_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* d, + float* a, int64_t lda, int64_t* iseed, + float* work ); +int64_t LAPACKE_dlagge_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* d, + double* a, int64_t lda, int64_t* iseed, + double* work ); +int64_t LAPACKE_clagge_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const float* d, + lapack_complex_float* a, int64_t lda, + int64_t* iseed, lapack_complex_float* work ); +int64_t LAPACKE_zlagge_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t kl, int64_t ku, const double* d, + lapack_complex_double* a, int64_t lda, + int64_t* iseed, + lapack_complex_double* work ); + +int64_t LAPACKE_claghe_work_64( int matrix_layout, int64_t n, int64_t k, + const float* d, lapack_complex_float* a, + int64_t lda, int64_t* iseed, + lapack_complex_float* work ); +int64_t LAPACKE_zlaghe_work_64( int matrix_layout, int64_t n, int64_t k, + const double* d, lapack_complex_double* a, + int64_t lda, int64_t* iseed, + lapack_complex_double* work ); + +int64_t LAPACKE_slagsy_work_64( int matrix_layout, int64_t n, int64_t k, + const float* d, float* a, int64_t lda, + int64_t* iseed, float* work ); +int64_t LAPACKE_dlagsy_work_64( int matrix_layout, int64_t n, int64_t k, + const double* d, double* a, int64_t lda, + int64_t* iseed, double* work ); +int64_t LAPACKE_clagsy_work_64( int matrix_layout, int64_t n, int64_t k, + const float* d, lapack_complex_float* a, + int64_t lda, int64_t* iseed, + lapack_complex_float* work ); +int64_t LAPACKE_zlagsy_work_64( int matrix_layout, int64_t n, int64_t k, + const double* d, lapack_complex_double* a, + int64_t lda, int64_t* iseed, + lapack_complex_double* work ); + +int64_t LAPACKE_slapmr_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, float* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_dlapmr_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, double* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_clapmr_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, + lapack_complex_float* x, int64_t ldx, + int64_t* k ); +int64_t LAPACKE_zlapmr_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, + lapack_complex_double* x, int64_t ldx, + int64_t* k ); + +int64_t LAPACKE_slapmt_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, float* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_dlapmt_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, double* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_clapmt_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, + lapack_complex_float* x, int64_t ldx, + int64_t* k ); +int64_t LAPACKE_zlapmt_work_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, + lapack_complex_double* x, int64_t ldx, + int64_t* k ); + +int64_t LAPACKE_slartgp_work_64( float f, float g, float* cs, float* sn, + float* r ); +int64_t LAPACKE_dlartgp_work_64( double f, double g, double* cs, double* sn, + double* r ); + +int64_t LAPACKE_slartgs_work_64( float x, float y, float sigma, float* cs, + float* sn ); +int64_t LAPACKE_dlartgs_work_64( double x, double y, double sigma, double* cs, + double* sn ); + +float LAPACKE_slapy2_work_64( float x, float y ); +double LAPACKE_dlapy2_work_64( double x, double y ); + +float LAPACKE_slapy3_work_64( float x, float y, float z ); +double LAPACKE_dlapy3_work_64( double x, double y, double z ); + +float LAPACKE_slamch_work_64( char cmach ); +double LAPACKE_dlamch_work_64( char cmach ); + +float LAPACKE_slangb_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const float* ab, + int64_t ldab, float* work ); +double LAPACKE_dlangb_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, const double* ab, + int64_t ldab, double* work ); +float LAPACKE_clangb_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_float* ab, int64_t ldab, + float* work ); +double LAPACKE_zlangb_work_64( int matrix_layout, char norm, int64_t n, + int64_t kl, int64_t ku, + const lapack_complex_double* ab, int64_t ldab, + double* work ); + +float LAPACKE_slange_work_64( int matrix_layout, char norm, int64_t m, + int64_t n, const float* a, int64_t lda, + float* work ); +double LAPACKE_dlange_work_64( int matrix_layout, char norm, int64_t m, + int64_t n, const double* a, int64_t lda, + double* work ); +float LAPACKE_clange_work_64( int matrix_layout, char norm, int64_t m, + int64_t n, const lapack_complex_float* a, + int64_t lda, float* work ); +double LAPACKE_zlange_work_64( int matrix_layout, char norm, int64_t m, + int64_t n, const lapack_complex_double* a, + int64_t lda, double* work ); + +float LAPACKE_clanhe_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const lapack_complex_float* a, + int64_t lda, float* work ); +double LAPACKE_zlanhe_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const lapack_complex_double* a, + int64_t lda, double* work ); + +int64_t LAPACKE_clacrm_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_float* a, + int64_t lda, const float* b, + int64_t ldb, lapack_complex_float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_zlacrm_work_64( int matrix_layout, int64_t m, int64_t n, + const lapack_complex_double* a, + int64_t lda, const double* b, + int64_t ldb, lapack_complex_double* c, + int64_t ldc, double* work ); + +int64_t LAPACKE_clarcm_work_64( int matrix_layout, int64_t m, int64_t n, + const float* a, int64_t lda, + const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_zlarcm_work_64( int matrix_layout, int64_t m, int64_t n, + const double* a, int64_t lda, + const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* c, + int64_t ldc, double* work ); + +float LAPACKE_slansy_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const float* a, int64_t lda, + float* work ); +double LAPACKE_dlansy_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const double* a, int64_t lda, + double* work ); +float LAPACKE_clansy_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const lapack_complex_float* a, + int64_t lda, float* work ); +double LAPACKE_zlansy_work_64( int matrix_layout, char norm, char uplo, + int64_t n, const lapack_complex_double* a, + int64_t lda, double* work ); + +float LAPACKE_slantr_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t m, int64_t n, const float* a, + int64_t lda, float* work ); +double LAPACKE_dlantr_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t m, int64_t n, + const double* a, int64_t lda, double* work ); +float LAPACKE_clantr_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* work ); +double LAPACKE_zlantr_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* work ); + +int64_t LAPACKE_slarfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, const float* v, + int64_t ldv, const float* t, int64_t ldt, + float* c, int64_t ldc, float* work, + int64_t ldwork ); +int64_t LAPACKE_dlarfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, const double* v, + int64_t ldv, const double* t, int64_t ldt, + double* c, int64_t ldc, double* work, + int64_t ldwork ); +int64_t LAPACKE_clarfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t ldwork ); +int64_t LAPACKE_zlarfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, + int64_t ldwork ); + +int64_t LAPACKE_slarfg_work_64( int64_t n, float* alpha, float* x, + int64_t incx, float* tau ); +int64_t LAPACKE_dlarfg_work_64( int64_t n, double* alpha, double* x, + int64_t incx, double* tau ); +int64_t LAPACKE_clarfg_work_64( int64_t n, lapack_complex_float* alpha, + lapack_complex_float* x, int64_t incx, + lapack_complex_float* tau ); +int64_t LAPACKE_zlarfg_work_64( int64_t n, lapack_complex_double* alpha, + lapack_complex_double* x, int64_t incx, + lapack_complex_double* tau ); + +int64_t LAPACKE_slarft_work_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, const float* v, + int64_t ldv, const float* tau, float* t, + int64_t ldt ); +int64_t LAPACKE_dlarft_work_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, const double* v, + int64_t ldv, const double* tau, double* t, + int64_t ldt ); +int64_t LAPACKE_clarft_work_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* tau, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zlarft_work_64( int matrix_layout, char direct, char storev, + int64_t n, int64_t k, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* tau, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_slarfx_work_64( int matrix_layout, char side, int64_t m, + int64_t n, const float* v, float tau, + float* c, int64_t ldc, float* work ); +int64_t LAPACKE_dlarfx_work_64( int matrix_layout, char side, int64_t m, + int64_t n, const double* v, double tau, + double* c, int64_t ldc, double* work ); +int64_t LAPACKE_clarfx_work_64( int matrix_layout, char side, int64_t m, + int64_t n, const lapack_complex_float* v, + lapack_complex_float tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work ); +int64_t LAPACKE_zlarfx_work_64( int matrix_layout, char side, int64_t m, + int64_t n, const lapack_complex_double* v, + lapack_complex_double tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work ); + +int64_t LAPACKE_slarnv_work_64( int64_t idist, int64_t* iseed, + int64_t n, float* x ); +int64_t LAPACKE_dlarnv_work_64( int64_t idist, int64_t* iseed, + int64_t n, double* x ); +int64_t LAPACKE_clarnv_work_64( int64_t idist, int64_t* iseed, + int64_t n, lapack_complex_float* x ); +int64_t LAPACKE_zlarnv_work_64( int64_t idist, int64_t* iseed, + int64_t n, lapack_complex_double* x ); + + +int64_t LAPACKE_slascl_work_64( int matrix_layout, char type, int64_t kl, + int64_t ku, float cfrom, float cto, + int64_t m, int64_t n, float* a, + int64_t lda ); +int64_t LAPACKE_dlascl_work_64( int matrix_layout, char type, int64_t kl, + int64_t ku, double cfrom, double cto, + int64_t m, int64_t n, double* a, + int64_t lda ); +int64_t LAPACKE_clascl_work_64( int matrix_layout, char type, int64_t kl, + int64_t ku, float cfrom, float cto, + int64_t m, int64_t n, lapack_complex_float* a, + int64_t lda ); +int64_t LAPACKE_zlascl_work_64( int matrix_layout, char type, int64_t kl, + int64_t ku, double cfrom, double cto, + int64_t m, int64_t n, lapack_complex_double* a, + int64_t lda ); + +int64_t LAPACKE_slaset_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, float alpha, float beta, float* a, + int64_t lda ); +int64_t LAPACKE_dlaset_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, double alpha, double beta, + double* a, int64_t lda ); +int64_t LAPACKE_claset_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, lapack_complex_float alpha, + lapack_complex_float beta, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zlaset_work_64( int matrix_layout, char uplo, int64_t m, + int64_t n, lapack_complex_double alpha, + lapack_complex_double beta, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_slasrt_work_64( char id, int64_t n, float* d ); +int64_t LAPACKE_dlasrt_work_64( char id, int64_t n, double* d ); + +int64_t LAPACKE_slassq_work_64( int64_t n, float* x, int64_t incx, float* scale, float* sumsq ); +int64_t LAPACKE_dlassq_work_64( int64_t n, double* x, int64_t incx, double* scale, double* sumsq ); +int64_t LAPACKE_classq_work_64( int64_t n, lapack_complex_float* x, int64_t incx, float* scale, float* sumsq ); +int64_t LAPACKE_zlassq_work_64( int64_t n, lapack_complex_double* x, int64_t incx, double* scale, double* sumsq ); + +int64_t LAPACKE_slaswp_work_64( int matrix_layout, int64_t n, float* a, + int64_t lda, int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); +int64_t LAPACKE_dlaswp_work_64( int matrix_layout, int64_t n, double* a, + int64_t lda, int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); +int64_t LAPACKE_claswp_work_64( int matrix_layout, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); +int64_t LAPACKE_zlaswp_work_64( int matrix_layout, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t k1, int64_t k2, + const int64_t* ipiv, int64_t incx ); + +int64_t LAPACKE_slatms_work_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, + float* d, int64_t mode, float cond, + float dmax, int64_t kl, int64_t ku, + char pack, float* a, int64_t lda, + float* work ); +int64_t LAPACKE_dlatms_work_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, + double* d, int64_t mode, double cond, + double dmax, int64_t kl, int64_t ku, + char pack, double* a, int64_t lda, + double* work ); +int64_t LAPACKE_clatms_work_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, + float* d, int64_t mode, float cond, + float dmax, int64_t kl, int64_t ku, + char pack, lapack_complex_float* a, + int64_t lda, lapack_complex_float* work ); +int64_t LAPACKE_zlatms_work_64( int matrix_layout, int64_t m, int64_t n, + char dist, int64_t* iseed, char sym, + double* d, int64_t mode, double cond, + double dmax, int64_t kl, int64_t ku, + char pack, lapack_complex_double* a, + int64_t lda, lapack_complex_double* work ); + +int64_t LAPACKE_slauum_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda ); +int64_t LAPACKE_dlauum_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda ); +int64_t LAPACKE_clauum_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zlauum_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_sopgtr_work_64( int matrix_layout, char uplo, int64_t n, + const float* ap, const float* tau, float* q, + int64_t ldq, float* work ); +int64_t LAPACKE_dopgtr_work_64( int matrix_layout, char uplo, int64_t n, + const double* ap, const double* tau, double* q, + int64_t ldq, double* work ); + +int64_t LAPACKE_sopmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const float* ap, const float* tau, float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_dopmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const double* ap, const double* tau, double* c, + int64_t ldc, double* work ); + +int64_t LAPACKE_sorgbr_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, float* a, + int64_t lda, const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorgbr_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, double* a, + int64_t lda, const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorghr_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, float* a, int64_t lda, + const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorghr_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, double* a, int64_t lda, + const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorglq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorglq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorgql_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorgql_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorgqr_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorgqr_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorgrq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, float* a, int64_t lda, + const float* tau, float* work, + int64_t lwork ); +int64_t LAPACKE_dorgrq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, double* a, int64_t lda, + const double* tau, double* work, + int64_t lwork ); + +int64_t LAPACKE_sorgtr_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, const float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dorgtr_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, const double* tau, + double* work, int64_t lwork ); + +int64_t LAPACKE_sorgtsqr_row_work_64( int matrix_layout, + int64_t m, int64_t n, + int64_t mb, int64_t nb, + float* a, int64_t lda, + const float* t, int64_t ldt, + float* work, int64_t lwork ); +int64_t LAPACKE_dorgtsqr_row_work_64( int matrix_layout, + int64_t m, int64_t n, + int64_t mb, int64_t nb, + double* a, int64_t lda, + const double* t, int64_t ldt, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormbr_work_64( int matrix_layout, char vect, char side, + char trans, int64_t m, int64_t n, + int64_t k, const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormbr_work_64( int matrix_layout, char vect, char side, + char trans, int64_t m, int64_t n, + int64_t k, const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormhr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormhr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormql_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormql_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormrq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormrq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormrz_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormrz_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_sormtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const float* a, int64_t lda, + const float* tau, float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dormtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const double* a, int64_t lda, + const double* tau, double* c, int64_t ldc, + double* work, int64_t lwork ); + +int64_t LAPACKE_spbcon_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const float* ab, int64_t ldab, + float anorm, float* rcond, float* work, + int64_t* iwork ); +int64_t LAPACKE_dpbcon_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const double* ab, + int64_t ldab, double anorm, double* rcond, + double* work, int64_t* iwork ); +int64_t LAPACKE_cpbcon_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_float* ab, + int64_t ldab, float anorm, float* rcond, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zpbcon_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_double* ab, + int64_t ldab, double anorm, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_spbequ_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const float* ab, int64_t ldab, + float* s, float* scond, float* amax ); +int64_t LAPACKE_dpbequ_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const double* ab, + int64_t ldab, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cpbequ_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_float* ab, + int64_t ldab, float* s, float* scond, + float* amax ); +int64_t LAPACKE_zpbequ_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, const lapack_complex_double* ab, + int64_t ldab, double* s, double* scond, + double* amax ); + +int64_t LAPACKE_spbrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const float* ab, + int64_t ldab, const float* afb, + int64_t ldafb, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dpbrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const double* ab, int64_t ldab, + const double* afb, int64_t ldafb, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cpbrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + const lapack_complex_float* afb, + int64_t ldafb, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zpbrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, + const lapack_complex_double* afb, + int64_t ldafb, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_spbstf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, float* bb, int64_t ldbb ); +int64_t LAPACKE_dpbstf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, double* bb, int64_t ldbb ); +int64_t LAPACKE_cpbstf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, lapack_complex_float* bb, + int64_t ldbb ); +int64_t LAPACKE_zpbstf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kb, lapack_complex_double* bb, + int64_t ldbb ); + +int64_t LAPACKE_spbsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, float* ab, + int64_t ldab, float* b, int64_t ldb ); +int64_t LAPACKE_dpbsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, double* ab, + int64_t ldab, double* b, int64_t ldb ); +int64_t LAPACKE_cpbsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpbsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spbsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t kd, int64_t nrhs, + float* ab, int64_t ldab, float* afb, + int64_t ldafb, char* equed, float* s, + float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, float* work, int64_t* iwork ); +int64_t LAPACKE_dpbsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t kd, int64_t nrhs, + double* ab, int64_t ldab, double* afb, + int64_t ldafb, char* equed, double* s, + double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, double* work, int64_t* iwork ); +int64_t LAPACKE_cpbsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t kd, int64_t nrhs, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* afb, int64_t ldafb, + char* equed, float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zpbsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t kd, int64_t nrhs, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* afb, int64_t ldafb, + char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_spbtrf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab ); +int64_t LAPACKE_dpbtrf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab ); +int64_t LAPACKE_cpbtrf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab ); +int64_t LAPACKE_zpbtrf_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab ); + +int64_t LAPACKE_spbtrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, const float* ab, + int64_t ldab, float* b, int64_t ldb ); +int64_t LAPACKE_dpbtrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const double* ab, int64_t ldab, double* b, + int64_t ldb ); +int64_t LAPACKE_cpbtrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpbtrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t kd, int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_spftrf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, float* a ); +int64_t LAPACKE_dpftrf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, double* a ); +int64_t LAPACKE_cpftrf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_float* a ); +int64_t LAPACKE_zpftrf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_double* a ); + +int64_t LAPACKE_spftri_work_64( int matrix_layout, char transr, char uplo, + int64_t n, float* a ); +int64_t LAPACKE_dpftri_work_64( int matrix_layout, char transr, char uplo, + int64_t n, double* a ); +int64_t LAPACKE_cpftri_work_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_float* a ); +int64_t LAPACKE_zpftri_work_64( int matrix_layout, char transr, char uplo, + int64_t n, lapack_complex_double* a ); + +int64_t LAPACKE_spftrs_work_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, const float* a, + float* b, int64_t ldb ); +int64_t LAPACKE_dpftrs_work_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, const double* a, + double* b, int64_t ldb ); +int64_t LAPACKE_cpftrs_work_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpftrs_work_64( int matrix_layout, char transr, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spocon_work_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float anorm, + float* rcond, float* work, int64_t* iwork ); +int64_t LAPACKE_dpocon_work_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double anorm, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_cpocon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float anorm, float* rcond, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zpocon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double anorm, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_spoequ_work_64( int matrix_layout, int64_t n, const float* a, + int64_t lda, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dpoequ_work_64( int matrix_layout, int64_t n, const double* a, + int64_t lda, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cpoequ_work_64( int matrix_layout, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zpoequ_work_64( int matrix_layout, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_spoequb_work_64( int matrix_layout, int64_t n, const float* a, + int64_t lda, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dpoequb_work_64( int matrix_layout, int64_t n, + const double* a, int64_t lda, double* s, + double* scond, double* amax ); +int64_t LAPACKE_cpoequb_work_64( int matrix_layout, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax ); +int64_t LAPACKE_zpoequb_work_64( int matrix_layout, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax ); + +int64_t LAPACKE_sporfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dporfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_cporfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zporfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sporfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, + int64_t ldaf, const float* s, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dporfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const double* s, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cporfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, + int64_t ldaf, const float* s, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zporfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, + int64_t ldaf, const double* s, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* b, int64_t ldb ); +int64_t LAPACKE_dposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb ); +int64_t LAPACKE_cposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); +int64_t LAPACKE_dsposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* b, int64_t ldb, double* x, + int64_t ldx, double* work, float* swork, + int64_t* iter ); +int64_t LAPACKE_zcposv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, lapack_complex_double* work, + lapack_complex_float* swork, double* rwork, + int64_t* iter ); + +int64_t LAPACKE_sposvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + char* equed, float* s, float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dposvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + char* equed, double* s, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cposvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + char* equed, float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zposvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sposvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + char* equed, float* s, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dposvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + char* equed, double* s, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_cposvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + char* equed, float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zposvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_spotrf2_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda ); +int64_t LAPACKE_dpotrf2_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda ); +int64_t LAPACKE_cpotrf2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotrf2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotrf_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda ); +int64_t LAPACKE_dpotrf_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda ); +int64_t LAPACKE_cpotrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotri_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda ); +int64_t LAPACKE_dpotri_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda ); +int64_t LAPACKE_cpotri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zpotri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_spotrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + float* b, int64_t ldb ); +int64_t LAPACKE_dpotrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, double* b, int64_t ldb ); +int64_t LAPACKE_cpotrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zpotrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sppcon_work_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float anorm, float* rcond, + float* work, int64_t* iwork ); +int64_t LAPACKE_dppcon_work_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double anorm, double* rcond, + double* work, int64_t* iwork ); +int64_t LAPACKE_cppcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, float anorm, + float* rcond, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zppcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, double anorm, + double* rcond, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_sppequ_work_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float* s, float* scond, + float* amax ); +int64_t LAPACKE_dppequ_work_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double* s, double* scond, + double* amax ); +int64_t LAPACKE_cppequ_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, float* s, + float* scond, float* amax ); +int64_t LAPACKE_zppequ_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, double* s, + double* scond, double* amax ); + +int64_t LAPACKE_spprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, + const float* afp, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dpprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, + const double* afp, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_cpprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zpprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + const lapack_complex_double* afp, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sppsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* ap, float* b, + int64_t ldb ); +int64_t LAPACKE_dppsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* ap, double* b, + int64_t ldb ); +int64_t LAPACKE_cppsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zppsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sppsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* ap, + float* afp, char* equed, float* s, float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dppsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* ap, + double* afp, char* equed, double* s, double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cppsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* ap, + lapack_complex_float* afp, char* equed, + float* s, lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zppsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* ap, + lapack_complex_double* afp, char* equed, + double* s, lapack_complex_double* b, + int64_t ldb, lapack_complex_double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_spptrf_work_64( int matrix_layout, char uplo, int64_t n, + float* ap ); +int64_t LAPACKE_dpptrf_work_64( int matrix_layout, char uplo, int64_t n, + double* ap ); +int64_t LAPACKE_cpptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap ); +int64_t LAPACKE_zpptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap ); + +int64_t LAPACKE_spptri_work_64( int matrix_layout, char uplo, int64_t n, + float* ap ); +int64_t LAPACKE_dpptri_work_64( int matrix_layout, char uplo, int64_t n, + double* ap ); +int64_t LAPACKE_cpptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap ); +int64_t LAPACKE_zpptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap ); + +int64_t LAPACKE_spptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, float* b, + int64_t ldb ); +int64_t LAPACKE_dpptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, double* b, + int64_t ldb ); +int64_t LAPACKE_cpptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_spstrf_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t* piv, + int64_t* rank, float tol, float* work ); +int64_t LAPACKE_dpstrf_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t* piv, + int64_t* rank, double tol, double* work ); +int64_t LAPACKE_cpstrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* piv, int64_t* rank, float tol, + float* work ); +int64_t LAPACKE_zpstrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* piv, int64_t* rank, double tol, + double* work ); + +int64_t LAPACKE_sptcon_work_64( int64_t n, const float* d, const float* e, + float anorm, float* rcond, float* work ); +int64_t LAPACKE_dptcon_work_64( int64_t n, const double* d, const double* e, + double anorm, double* rcond, double* work ); +int64_t LAPACKE_cptcon_work_64( int64_t n, const float* d, + const lapack_complex_float* e, float anorm, + float* rcond, float* work ); +int64_t LAPACKE_zptcon_work_64( int64_t n, const double* d, + const lapack_complex_double* e, double anorm, + double* rcond, double* work ); + +int64_t LAPACKE_spteqr_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, float* z, int64_t ldz, + float* work ); +int64_t LAPACKE_dpteqr_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz, + double* work ); +int64_t LAPACKE_cpteqr_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, lapack_complex_float* z, + int64_t ldz, float* work ); +int64_t LAPACKE_zpteqr_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz, double* work ); + +int64_t LAPACKE_sptrfs_work_64( int matrix_layout, int64_t n, int64_t nrhs, + const float* d, const float* e, const float* df, + const float* ef, const float* b, int64_t ldb, + float* x, int64_t ldx, float* ferr, + float* berr, float* work ); +int64_t LAPACKE_dptrfs_work_64( int matrix_layout, int64_t n, int64_t nrhs, + const double* d, const double* e, + const double* df, const double* ef, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr, + double* work ); +int64_t LAPACKE_cptrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, const float* df, + const lapack_complex_float* ef, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zptrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, + const double* df, + const lapack_complex_double* ef, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sptsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + float* d, float* e, float* b, int64_t ldb ); +int64_t LAPACKE_dptsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + double* d, double* e, double* b, + int64_t ldb ); +int64_t LAPACKE_cptsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + float* d, lapack_complex_float* e, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zptsv_work_64( int matrix_layout, int64_t n, int64_t nrhs, + double* d, lapack_complex_double* e, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sptsvx_work_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const float* d, const float* e, + float* df, float* ef, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work ); +int64_t LAPACKE_dptsvx_work_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const double* d, + const double* e, double* df, double* ef, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* ferr, + double* berr, double* work ); +int64_t LAPACKE_cptsvx_work_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, float* df, + lapack_complex_float* ef, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zptsvx_work_64( int matrix_layout, char fact, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, double* df, + lapack_complex_double* ef, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_spttrf_work_64( int64_t n, float* d, float* e ); +int64_t LAPACKE_dpttrf_work_64( int64_t n, double* d, double* e ); +int64_t LAPACKE_cpttrf_work_64( int64_t n, float* d, + lapack_complex_float* e ); +int64_t LAPACKE_zpttrf_work_64( int64_t n, double* d, + lapack_complex_double* e ); + +int64_t LAPACKE_spttrs_work_64( int matrix_layout, int64_t n, int64_t nrhs, + const float* d, const float* e, float* b, + int64_t ldb ); +int64_t LAPACKE_dpttrs_work_64( int matrix_layout, int64_t n, int64_t nrhs, + const double* d, const double* e, double* b, + int64_t ldb ); +int64_t LAPACKE_cpttrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* d, + const lapack_complex_float* e, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zpttrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* d, + const lapack_complex_double* e, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_ssbev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* w, float* z, + int64_t ldz, float* work ); +int64_t LAPACKE_dsbev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* w, double* z, + int64_t ldz, double* work ); + +int64_t LAPACKE_ssbevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsbevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssbevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + float* ab, int64_t ldab, float* q, + int64_t ldq, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, float* work, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_dsbevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + double* ab, int64_t ldab, double* q, + int64_t ldq, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, double* work, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_ssbgst_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t ka, int64_t kb, + float* ab, int64_t ldab, const float* bb, + int64_t ldbb, float* x, int64_t ldx, + float* work ); +int64_t LAPACKE_dsbgst_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t ka, int64_t kb, + double* ab, int64_t ldab, const double* bb, + int64_t ldbb, double* x, int64_t ldx, + double* work ); + +int64_t LAPACKE_ssbgv_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + float* ab, int64_t ldab, float* bb, + int64_t ldbb, float* w, float* z, + int64_t ldz, float* work ); +int64_t LAPACKE_dsbgv_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + double* ab, int64_t ldab, double* bb, + int64_t ldbb, double* w, double* z, + int64_t ldz, double* work ); + +int64_t LAPACKE_ssbgvd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + float* ab, int64_t ldab, float* bb, + int64_t ldbb, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsbgvd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t ka, int64_t kb, + double* ab, int64_t ldab, double* bb, + int64_t ldbb, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssbgvx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t ka, + int64_t kb, float* ab, int64_t ldab, + float* bb, int64_t ldbb, float* q, + int64_t ldq, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_dsbgvx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t ka, + int64_t kb, double* ab, int64_t ldab, + double* bb, int64_t ldbb, double* q, + int64_t ldq, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, double* work, int64_t* iwork, + int64_t* ifail ); + +int64_t LAPACKE_ssbtrd_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* d, float* e, float* q, + int64_t ldq, float* work ); +int64_t LAPACKE_dsbtrd_work_64( int matrix_layout, char vect, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* d, double* e, + double* q, int64_t ldq, double* work ); + +int64_t LAPACKE_ssfrk_work_64( int matrix_layout, char transr, char uplo, + char trans, int64_t n, int64_t k, + float alpha, const float* a, int64_t lda, + float beta, float* c ); +int64_t LAPACKE_dsfrk_work_64( int matrix_layout, char transr, char uplo, + char trans, int64_t n, int64_t k, + double alpha, const double* a, int64_t lda, + double beta, double* c ); + +int64_t LAPACKE_sspcon_work_64( int matrix_layout, char uplo, int64_t n, + const float* ap, const int64_t* ipiv, + float anorm, float* rcond, float* work, + int64_t* iwork ); +int64_t LAPACKE_dspcon_work_64( int matrix_layout, char uplo, int64_t n, + const double* ap, const int64_t* ipiv, + double anorm, double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_cspcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zspcon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_sspev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* ap, float* w, float* z, + int64_t ldz, float* work ); +int64_t LAPACKE_dspev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* ap, double* w, double* z, + int64_t ldz, double* work ); + +int64_t LAPACKE_sspevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* ap, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dspevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* ap, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_sspevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, float* ap, float vl, + float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_dspevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, double* ap, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + double* z, int64_t ldz, double* work, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_sspgst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, float* ap, const float* bp ); +int64_t LAPACKE_dspgst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, double* ap, const double* bp ); + +int64_t LAPACKE_sspgv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* ap, float* bp, + float* w, float* z, int64_t ldz, + float* work ); +int64_t LAPACKE_dspgv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* ap, double* bp, + double* w, double* z, int64_t ldz, + double* work ); + +int64_t LAPACKE_sspgvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* ap, float* bp, + float* w, float* z, int64_t ldz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dspgvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* ap, double* bp, + double* w, double* z, int64_t ldz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_sspgvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, float* ap, + float* bp, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, float* z, int64_t ldz, float* work, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_dspgvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, double* ap, + double* bp, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, double* z, int64_t ldz, + double* work, int64_t* iwork, + int64_t* ifail ); + +int64_t LAPACKE_ssprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, + const float* afp, const int64_t* ipiv, + const float* b, int64_t ldb, float* x, + int64_t ldx, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dsprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, + const double* afp, const int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_csprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const lapack_complex_float* afp, + const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zsprfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + const lapack_complex_double* afp, + const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_sspsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* ap, int64_t* ipiv, + float* b, int64_t ldb ); +int64_t LAPACKE_dspsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* ap, int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_cspsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* ap, + int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zspsv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* ap, + int64_t* ipiv, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_sspsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, const float* ap, + float* afp, int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work, int64_t* iwork ); +int64_t LAPACKE_dspsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, const double* ap, + double* afp, int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_cspsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + lapack_complex_float* afp, int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zspsvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + lapack_complex_double* afp, int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_ssptrd_work_64( int matrix_layout, char uplo, int64_t n, + float* ap, float* d, float* e, float* tau ); +int64_t LAPACKE_dsptrd_work_64( int matrix_layout, char uplo, int64_t n, + double* ap, double* d, double* e, double* tau ); + +int64_t LAPACKE_ssptrf_work_64( int matrix_layout, char uplo, int64_t n, + float* ap, int64_t* ipiv ); +int64_t LAPACKE_dsptrf_work_64( int matrix_layout, char uplo, int64_t n, + double* ap, int64_t* ipiv ); +int64_t LAPACKE_csptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, int64_t* ipiv ); +int64_t LAPACKE_zsptrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, int64_t* ipiv ); + +int64_t LAPACKE_ssptri_work_64( int matrix_layout, char uplo, int64_t n, + float* ap, const int64_t* ipiv, + float* work ); +int64_t LAPACKE_dsptri_work_64( int matrix_layout, char uplo, int64_t n, + double* ap, const int64_t* ipiv, + double* work ); +int64_t LAPACKE_csptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* ap, + const int64_t* ipiv, + lapack_complex_float* work ); +int64_t LAPACKE_zsptri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* ap, + const int64_t* ipiv, + lapack_complex_double* work ); + +int64_t LAPACKE_ssptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* ap, + const int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dsptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* ap, + const int64_t* ipiv, double* b, + int64_t ldb ); +int64_t LAPACKE_csptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* ap, + const int64_t* ipiv, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_zsptrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, + const lapack_complex_double* ap, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sstebz_work_64( char range, char order, int64_t n, float vl, + float vu, int64_t il, int64_t iu, + float abstol, const float* d, const float* e, + int64_t* m, int64_t* nsplit, float* w, + int64_t* iblock, int64_t* isplit, + float* work, int64_t* iwork ); +int64_t LAPACKE_dstebz_work_64( char range, char order, int64_t n, double vl, + double vu, int64_t il, int64_t iu, + double abstol, const double* d, const double* e, + int64_t* m, int64_t* nsplit, double* w, + int64_t* iblock, int64_t* isplit, + double* work, int64_t* iwork ); + +int64_t LAPACKE_sstedc_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, float* z, int64_t ldz, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dstedc_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_cstedc_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zstedc_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_sstegr_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, float* z, + int64_t ldz, int64_t* isuppz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dstegr_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + double* z, int64_t ldz, int64_t* isuppz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_cstegr_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* isuppz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zstegr_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* isuppz, double* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_sstein_work_64( int matrix_layout, int64_t n, const float* d, + const float* e, int64_t m, const float* w, + const int64_t* iblock, + const int64_t* isplit, float* z, + int64_t ldz, float* work, int64_t* iwork, + int64_t* ifailv ); +int64_t LAPACKE_dstein_work_64( int matrix_layout, int64_t n, const double* d, + const double* e, int64_t m, const double* w, + const int64_t* iblock, + const int64_t* isplit, double* z, + int64_t ldz, double* work, int64_t* iwork, + int64_t* ifailv ); +int64_t LAPACKE_cstein_work_64( int matrix_layout, int64_t n, const float* d, + const float* e, int64_t m, const float* w, + const int64_t* iblock, + const int64_t* isplit, + lapack_complex_float* z, int64_t ldz, + float* work, int64_t* iwork, + int64_t* ifailv ); +int64_t LAPACKE_zstein_work_64( int matrix_layout, int64_t n, const double* d, + const double* e, int64_t m, const double* w, + const int64_t* iblock, + const int64_t* isplit, + lapack_complex_double* z, int64_t ldz, + double* work, int64_t* iwork, + int64_t* ifailv ); + +int64_t LAPACKE_sstemr_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + int64_t* m, float* w, float* z, + int64_t ldz, int64_t nzc, + int64_t* isuppz, lapack_logical* tryrac, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dstemr_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + int64_t* m, double* w, double* z, + int64_t ldz, int64_t nzc, + int64_t* isuppz, lapack_logical* tryrac, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_cstemr_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t nzc, int64_t* isuppz, + lapack_logical* tryrac, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zstemr_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t nzc, int64_t* isuppz, + lapack_logical* tryrac, double* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_ssteqr_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, float* z, int64_t ldz, + float* work ); +int64_t LAPACKE_dsteqr_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, double* z, int64_t ldz, + double* work ); +int64_t LAPACKE_csteqr_work_64( int matrix_layout, char compz, int64_t n, + float* d, float* e, lapack_complex_float* z, + int64_t ldz, float* work ); +int64_t LAPACKE_zsteqr_work_64( int matrix_layout, char compz, int64_t n, + double* d, double* e, lapack_complex_double* z, + int64_t ldz, double* work ); + +int64_t LAPACKE_ssterf_work_64( int64_t n, float* d, float* e ); +int64_t LAPACKE_dsterf_work_64( int64_t n, double* d, double* e ); + +int64_t LAPACKE_sstev_work_64( int matrix_layout, char jobz, int64_t n, + float* d, float* e, float* z, int64_t ldz, + float* work ); +int64_t LAPACKE_dstev_work_64( int matrix_layout, char jobz, int64_t n, + double* d, double* e, double* z, int64_t ldz, + double* work ); + +int64_t LAPACKE_sstevd_work_64( int matrix_layout, char jobz, int64_t n, + float* d, float* e, float* z, int64_t ldz, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dstevd_work_64( int matrix_layout, char jobz, int64_t n, + double* d, double* e, double* z, int64_t ldz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_sstevr_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, float* z, + int64_t ldz, int64_t* isuppz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dstevr_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + double* z, int64_t ldz, int64_t* isuppz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_sstevx_work_64( int matrix_layout, char jobz, char range, + int64_t n, float* d, float* e, float vl, + float vu, int64_t il, int64_t iu, + float abstol, int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_dstevx_work_64( int matrix_layout, char jobz, char range, + int64_t n, double* d, double* e, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + double* z, int64_t ldz, double* work, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_ssycon_work_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, + const int64_t* ipiv, float anorm, + float* rcond, float* work, int64_t* iwork ); +int64_t LAPACKE_dsycon_work_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_csycon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zsycon_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_ssyequb_work_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float* s, + float* scond, float* amax, float* work ); +int64_t LAPACKE_dsyequb_work_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double* s, + double* scond, double* amax, double* work ); +int64_t LAPACKE_csyequb_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* s, float* scond, float* amax, + lapack_complex_float* work ); +int64_t LAPACKE_zsyequb_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* s, double* scond, double* amax, + lapack_complex_double* work ); + +int64_t LAPACKE_ssyev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* a, int64_t lda, float* w, + float* work, int64_t lwork ); +int64_t LAPACKE_dsyev_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* a, int64_t lda, + double* w, double* work, int64_t lwork ); + +int64_t LAPACKE_ssyevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* a, int64_t lda, + float* w, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsyevd_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* a, int64_t lda, + double* w, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssyevr_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, int64_t* isuppz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dsyevr_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssyevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_dsyevx_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_ssygst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, float* a, int64_t lda, + const float* b, int64_t ldb ); +int64_t LAPACKE_dsygst_work_64( int matrix_layout, int64_t itype, char uplo, + int64_t n, double* a, int64_t lda, + const double* b, int64_t ldb ); + +int64_t LAPACKE_ssygv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* w, float* work, int64_t lwork ); +int64_t LAPACKE_dsygv_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* w, double* work, int64_t lwork ); + +int64_t LAPACKE_ssygvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* w, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsygvd_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* w, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssygvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, float* z, int64_t ldz, float* work, + int64_t lwork, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_dsygvx_work_64( int matrix_layout, int64_t itype, char jobz, + char range, char uplo, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, double* z, int64_t ldz, + double* work, int64_t lwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_ssyrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* af, int64_t ldaf, + const int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dsyrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const int64_t* ipiv, + const double* b, int64_t ldb, double* x, + int64_t ldx, double* ferr, double* berr, + double* work, int64_t* iwork ); +int64_t LAPACKE_csyrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_zsyrfs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_ssyrfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, const float* af, + int64_t ldaf, const int64_t* ipiv, + const float* s, const float* b, int64_t ldb, + float* x, int64_t ldx, float* rcond, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dsyrfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, const double* af, + int64_t ldaf, const int64_t* ipiv, + const double* s, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, double* work, + int64_t* iwork ); +int64_t LAPACKE_csyrfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* af, + int64_t ldaf, const int64_t* ipiv, + const float* s, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zsyrfsx_work_64( int matrix_layout, char uplo, char equed, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* af, + int64_t ldaf, const int64_t* ipiv, + const double* s, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_ssysv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dsysv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_csysv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsysv_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssysvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, const float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, const float* b, + int64_t ldb, float* x, int64_t ldx, + float* rcond, float* ferr, float* berr, + float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dsysvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, const double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, const double* b, + int64_t ldb, double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_csysvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, const lapack_complex_float* b, + int64_t ldb, lapack_complex_float* x, + int64_t ldx, float* rcond, float* ferr, + float* berr, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zsysvx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* ferr, double* berr, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_ssysvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, + float* b, int64_t ldb, float* x, + int64_t ldx, float* rcond, float* rpvgrw, + float* berr, int64_t n_err_bnds, + float* err_bnds_norm, float* err_bnds_comp, + int64_t nparams, float* params, float* work, + int64_t* iwork ); +int64_t LAPACKE_dsysvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, + double* b, int64_t ldb, double* x, + int64_t ldx, double* rcond, double* rpvgrw, + double* berr, int64_t n_err_bnds, + double* err_bnds_norm, double* err_bnds_comp, + int64_t nparams, double* params, + double* work, int64_t* iwork ); +int64_t LAPACKE_csysvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* af, int64_t ldaf, + int64_t* ipiv, char* equed, float* s, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* x, int64_t ldx, + float* rcond, float* rpvgrw, float* berr, + int64_t n_err_bnds, float* err_bnds_norm, + float* err_bnds_comp, int64_t nparams, + float* params, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_zsysvxx_work_64( int matrix_layout, char fact, char uplo, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* af, int64_t ldaf, + int64_t* ipiv, char* equed, double* s, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* x, int64_t ldx, + double* rcond, double* rpvgrw, double* berr, + int64_t n_err_bnds, double* err_bnds_norm, + double* err_bnds_comp, int64_t nparams, + double* params, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_ssytrd_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, float* d, float* e, + float* tau, float* work, int64_t lwork ); +int64_t LAPACKE_dsytrd_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, double* d, double* e, + double* tau, double* work, int64_t lwork ); + +int64_t LAPACKE_ssytrf_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytrf_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_csytrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zsytrf_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_ssytri_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, + const int64_t* ipiv, float* work ); +int64_t LAPACKE_dsytri_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, + const int64_t* ipiv, double* work ); +int64_t LAPACKE_csytri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work ); +int64_t LAPACKE_zsytri_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work ); + +int64_t LAPACKE_ssytrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dsytrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_csytrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stbcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, int64_t kd, + const float* ab, int64_t ldab, float* rcond, + float* work, int64_t* iwork ); +int64_t LAPACKE_dtbcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, int64_t kd, + const double* ab, int64_t ldab, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_ctbcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, int64_t kd, + const lapack_complex_float* ab, int64_t ldab, + float* rcond, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_ztbcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, int64_t kd, + const lapack_complex_double* ab, + int64_t ldab, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_stbrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const float* ab, + int64_t ldab, const float* b, int64_t ldb, + const float* x, int64_t ldx, float* ferr, + float* berr, float* work, int64_t* iwork ); +int64_t LAPACKE_dtbrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const double* ab, + int64_t ldab, const double* b, + int64_t ldb, const double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_ctbrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const lapack_complex_float* ab, + int64_t ldab, const lapack_complex_float* b, + int64_t ldb, const lapack_complex_float* x, + int64_t ldx, float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztbrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, const lapack_complex_double* b, + int64_t ldb, const lapack_complex_double* x, + int64_t ldx, double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_stbtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const float* ab, + int64_t ldab, float* b, int64_t ldb ); +int64_t LAPACKE_dtbtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const double* ab, + int64_t ldab, double* b, int64_t ldb ); +int64_t LAPACKE_ctbtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, const lapack_complex_float* ab, + int64_t ldab, lapack_complex_float* b, + int64_t ldb ); +int64_t LAPACKE_ztbtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t kd, + int64_t nrhs, + const lapack_complex_double* ab, + int64_t ldab, lapack_complex_double* b, + int64_t ldb ); + +int64_t LAPACKE_stfsm_work_64( int matrix_layout, char transr, char side, + char uplo, char trans, char diag, int64_t m, + int64_t n, float alpha, const float* a, + float* b, int64_t ldb ); +int64_t LAPACKE_dtfsm_work_64( int matrix_layout, char transr, char side, + char uplo, char trans, char diag, int64_t m, + int64_t n, double alpha, const double* a, + double* b, int64_t ldb ); +int64_t LAPACKE_ctfsm_work_64( int matrix_layout, char transr, char side, + char uplo, char trans, char diag, int64_t m, + int64_t n, lapack_complex_float alpha, + const lapack_complex_float* a, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztfsm_work_64( int matrix_layout, char transr, char side, + char uplo, char trans, char diag, int64_t m, + int64_t n, lapack_complex_double alpha, + const lapack_complex_double* a, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stftri_work_64( int matrix_layout, char transr, char uplo, + char diag, int64_t n, float* a ); +int64_t LAPACKE_dtftri_work_64( int matrix_layout, char transr, char uplo, + char diag, int64_t n, double* a ); +int64_t LAPACKE_ctftri_work_64( int matrix_layout, char transr, char uplo, + char diag, int64_t n, + lapack_complex_float* a ); +int64_t LAPACKE_ztftri_work_64( int matrix_layout, char transr, char uplo, + char diag, int64_t n, + lapack_complex_double* a ); + +int64_t LAPACKE_stfttp_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* arf, float* ap ); +int64_t LAPACKE_dtfttp_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* arf, double* ap ); +int64_t LAPACKE_ctfttp_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* arf, + lapack_complex_float* ap ); +int64_t LAPACKE_ztfttp_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* arf, + lapack_complex_double* ap ); + +int64_t LAPACKE_stfttr_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* arf, float* a, + int64_t lda ); +int64_t LAPACKE_dtfttr_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* arf, double* a, + int64_t lda ); +int64_t LAPACKE_ctfttr_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* arf, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_ztfttr_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* arf, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_stgevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const float* s, int64_t lds, const float* p, + int64_t ldp, float* vl, int64_t ldvl, + float* vr, int64_t ldvr, int64_t mm, + int64_t* m, float* work ); +int64_t LAPACKE_dtgevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const double* s, int64_t lds, + const double* p, int64_t ldp, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + int64_t mm, int64_t* m, double* work ); +int64_t LAPACKE_ctgevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* s, int64_t lds, + const lapack_complex_float* p, int64_t ldp, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztgevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* s, int64_t lds, + const lapack_complex_double* p, int64_t ldp, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_stgexc_work_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* q, int64_t ldq, float* z, + int64_t ldz, int64_t* ifst, + int64_t* ilst, float* work, + int64_t lwork ); +int64_t LAPACKE_dtgexc_work_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* q, int64_t ldq, double* z, + int64_t ldz, int64_t* ifst, + int64_t* ilst, double* work, + int64_t lwork ); +int64_t LAPACKE_ctgexc_work_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz, + int64_t ifst, int64_t ilst ); +int64_t LAPACKE_ztgexc_work_64( int matrix_layout, lapack_logical wantq, + lapack_logical wantz, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + int64_t ifst, int64_t ilst ); + +int64_t LAPACKE_stgsen_work_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + float* a, int64_t lda, float* b, + int64_t ldb, float* alphar, float* alphai, + float* beta, float* q, int64_t ldq, float* z, + int64_t ldz, int64_t* m, float* pl, + float* pr, float* dif, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dtgsen_work_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + double* a, int64_t lda, double* b, + int64_t ldb, double* alphar, double* alphai, + double* beta, double* q, int64_t ldq, + double* z, int64_t ldz, int64_t* m, + double* pl, double* pr, double* dif, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_ctgsen_work_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* z, int64_t ldz, + int64_t* m, float* pl, float* pr, float* dif, + lapack_complex_float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_ztgsen_work_64( int matrix_layout, int64_t ijob, + lapack_logical wantq, lapack_logical wantz, + const lapack_logical* select, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* z, int64_t ldz, + int64_t* m, double* pl, double* pr, + double* dif, lapack_complex_double* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_stgsja_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, int64_t k, int64_t l, + float* a, int64_t lda, float* b, + int64_t ldb, float tola, float tolb, + float* alpha, float* beta, float* u, + int64_t ldu, float* v, int64_t ldv, + float* q, int64_t ldq, float* work, + int64_t* ncycle ); +int64_t LAPACKE_dtgsja_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, int64_t k, int64_t l, + double* a, int64_t lda, double* b, + int64_t ldb, double tola, double tolb, + double* alpha, double* beta, double* u, + int64_t ldu, double* v, int64_t ldv, + double* q, int64_t ldq, double* work, + int64_t* ncycle ); +int64_t LAPACKE_ctgsja_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, int64_t k, int64_t l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + float tola, float tolb, float* alpha, + float* beta, lapack_complex_float* u, + int64_t ldu, lapack_complex_float* v, + int64_t ldv, lapack_complex_float* q, + int64_t ldq, lapack_complex_float* work, + int64_t* ncycle ); +int64_t LAPACKE_ztgsja_work_64( int matrix_layout, char jobu, char jobv, + char jobq, int64_t m, int64_t p, + int64_t n, int64_t k, int64_t l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double tola, double tolb, double* alpha, + double* beta, lapack_complex_double* u, + int64_t ldu, lapack_complex_double* v, + int64_t ldv, lapack_complex_double* q, + int64_t ldq, lapack_complex_double* work, + int64_t* ncycle ); + +int64_t LAPACKE_stgsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const float* a, int64_t lda, const float* b, + int64_t ldb, const float* vl, + int64_t ldvl, const float* vr, + int64_t ldvr, float* s, float* dif, + int64_t mm, int64_t* m, float* work, + int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_dtgsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const double* a, int64_t lda, + const double* b, int64_t ldb, + const double* vl, int64_t ldvl, + const double* vr, int64_t ldvr, double* s, + double* dif, int64_t mm, int64_t* m, + double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_ctgsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* vl, int64_t ldvl, + const lapack_complex_float* vr, int64_t ldvr, + float* s, float* dif, int64_t mm, + int64_t* m, lapack_complex_float* work, + int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_ztgsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* vl, + int64_t ldvl, + const lapack_complex_double* vr, + int64_t ldvr, double* s, double* dif, + int64_t mm, int64_t* m, + lapack_complex_double* work, int64_t lwork, + int64_t* iwork ); + +int64_t LAPACKE_stgsyl_work_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, const float* a, + int64_t lda, const float* b, int64_t ldb, + float* c, int64_t ldc, const float* d, + int64_t ldd, const float* e, int64_t lde, + float* f, int64_t ldf, float* scale, + float* dif, float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dtgsyl_work_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, const double* a, + int64_t lda, const double* b, int64_t ldb, + double* c, int64_t ldc, const double* d, + int64_t ldd, const double* e, int64_t lde, + double* f, int64_t ldf, double* scale, + double* dif, double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_ctgsyl_work_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* c, int64_t ldc, + const lapack_complex_float* d, int64_t ldd, + const lapack_complex_float* e, int64_t lde, + lapack_complex_float* f, int64_t ldf, + float* scale, float* dif, + lapack_complex_float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_ztgsyl_work_64( int matrix_layout, char trans, int64_t ijob, + int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + const lapack_complex_double* d, int64_t ldd, + const lapack_complex_double* e, int64_t lde, + lapack_complex_double* f, int64_t ldf, + double* scale, double* dif, + lapack_complex_double* work, int64_t lwork, + int64_t* iwork ); + +int64_t LAPACKE_stpcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, const float* ap, + float* rcond, float* work, int64_t* iwork ); +int64_t LAPACKE_dtpcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, const double* ap, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_ctpcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, + const lapack_complex_float* ap, float* rcond, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztpcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, + const lapack_complex_double* ap, double* rcond, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_stprfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const float* ap, const float* b, int64_t ldb, + const float* x, int64_t ldx, float* ferr, + float* berr, float* work, int64_t* iwork ); +int64_t LAPACKE_dtprfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const double* ap, const double* b, + int64_t ldb, const double* x, int64_t ldx, + double* ferr, double* berr, double* work, + int64_t* iwork ); +int64_t LAPACKE_ctprfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztprfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_stptri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, float* ap ); +int64_t LAPACKE_dtptri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, double* ap ); +int64_t LAPACKE_ctptri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, lapack_complex_float* ap ); +int64_t LAPACKE_ztptri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, lapack_complex_double* ap ); + +int64_t LAPACKE_stptrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const float* ap, float* b, int64_t ldb ); +int64_t LAPACKE_dtptrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const double* ap, double* b, int64_t ldb ); +int64_t LAPACKE_ctptrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_float* ap, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztptrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_double* ap, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stpttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* ap, float* arf ); +int64_t LAPACKE_dtpttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* ap, double* arf ); +int64_t LAPACKE_ctpttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* ap, + lapack_complex_float* arf ); +int64_t LAPACKE_ztpttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* ap, + lapack_complex_double* arf ); + +int64_t LAPACKE_stpttr_work_64( int matrix_layout, char uplo, int64_t n, + const float* ap, float* a, int64_t lda ); +int64_t LAPACKE_dtpttr_work_64( int matrix_layout, char uplo, int64_t n, + const double* ap, double* a, int64_t lda ); +int64_t LAPACKE_ctpttr_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_ztpttr_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_strcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, const float* a, + int64_t lda, float* rcond, float* work, + int64_t* iwork ); +int64_t LAPACKE_dtrcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, const double* a, + int64_t lda, double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_ctrcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, + const lapack_complex_float* a, int64_t lda, + float* rcond, lapack_complex_float* work, + float* rwork ); +int64_t LAPACKE_ztrcon_work_64( int matrix_layout, char norm, char uplo, + char diag, int64_t n, + const lapack_complex_double* a, int64_t lda, + double* rcond, lapack_complex_double* work, + double* rwork ); + +int64_t LAPACKE_strevc_work_64( int matrix_layout, char side, char howmny, + lapack_logical* select, int64_t n, + const float* t, int64_t ldt, float* vl, + int64_t ldvl, float* vr, int64_t ldvr, + int64_t mm, int64_t* m, float* work ); +int64_t LAPACKE_dtrevc_work_64( int matrix_layout, char side, char howmny, + lapack_logical* select, int64_t n, + const double* t, int64_t ldt, double* vl, + int64_t ldvl, double* vr, int64_t ldvr, + int64_t mm, int64_t* m, double* work ); +int64_t LAPACKE_ctrevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* vl, int64_t ldvl, + lapack_complex_float* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztrevc_work_64( int matrix_layout, char side, char howmny, + const lapack_logical* select, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* vl, int64_t ldvl, + lapack_complex_double* vr, int64_t ldvr, + int64_t mm, int64_t* m, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_strexc_work_64( int matrix_layout, char compq, int64_t n, + float* t, int64_t ldt, float* q, + int64_t ldq, int64_t* ifst, + int64_t* ilst, float* work ); +int64_t LAPACKE_dtrexc_work_64( int matrix_layout, char compq, int64_t n, + double* t, int64_t ldt, double* q, + int64_t ldq, int64_t* ifst, + int64_t* ilst, double* work ); +int64_t LAPACKE_ctrexc_work_64( int matrix_layout, char compq, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* q, int64_t ldq, + int64_t ifst, int64_t ilst ); +int64_t LAPACKE_ztrexc_work_64( int matrix_layout, char compq, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* q, int64_t ldq, + int64_t ifst, int64_t ilst ); + +int64_t LAPACKE_strrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const float* a, int64_t lda, const float* b, + int64_t ldb, const float* x, int64_t ldx, + float* ferr, float* berr, float* work, + int64_t* iwork ); +int64_t LAPACKE_dtrrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const double* a, int64_t lda, + const double* b, int64_t ldb, + const double* x, int64_t ldx, double* ferr, + double* berr, double* work, int64_t* iwork ); +int64_t LAPACKE_ctrrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + const lapack_complex_float* x, int64_t ldx, + float* ferr, float* berr, + lapack_complex_float* work, float* rwork ); +int64_t LAPACKE_ztrrfs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + const lapack_complex_double* x, int64_t ldx, + double* ferr, double* berr, + lapack_complex_double* work, double* rwork ); + +int64_t LAPACKE_strsen_work_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + float* t, int64_t ldt, float* q, + int64_t ldq, float* wr, float* wi, + int64_t* m, float* s, float* sep, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dtrsen_work_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + double* t, int64_t ldt, double* q, + int64_t ldq, double* wr, double* wi, + int64_t* m, double* s, double* sep, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_ctrsen_work_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* w, int64_t* m, + float* s, float* sep, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_ztrsen_work_64( int matrix_layout, char job, char compq, + const lapack_logical* select, int64_t n, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* w, int64_t* m, + double* s, double* sep, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_strsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const float* t, int64_t ldt, const float* vl, + int64_t ldvl, const float* vr, + int64_t ldvr, float* s, float* sep, + int64_t mm, int64_t* m, float* work, + int64_t ldwork, int64_t* iwork ); +int64_t LAPACKE_dtrsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const double* t, int64_t ldt, + const double* vl, int64_t ldvl, + const double* vr, int64_t ldvr, double* s, + double* sep, int64_t mm, int64_t* m, + double* work, int64_t ldwork, + int64_t* iwork ); +int64_t LAPACKE_ctrsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_float* t, int64_t ldt, + const lapack_complex_float* vl, int64_t ldvl, + const lapack_complex_float* vr, int64_t ldvr, + float* s, float* sep, int64_t mm, + int64_t* m, lapack_complex_float* work, + int64_t ldwork, float* rwork ); +int64_t LAPACKE_ztrsna_work_64( int matrix_layout, char job, char howmny, + const lapack_logical* select, int64_t n, + const lapack_complex_double* t, int64_t ldt, + const lapack_complex_double* vl, + int64_t ldvl, + const lapack_complex_double* vr, + int64_t ldvr, double* s, double* sep, + int64_t mm, int64_t* m, + lapack_complex_double* work, int64_t ldwork, + double* rwork ); + +int64_t LAPACKE_strsyl_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const float* a, int64_t lda, const float* b, + int64_t ldb, float* c, int64_t ldc, + float* scale ); +int64_t LAPACKE_dtrsyl_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const double* a, int64_t lda, + const double* b, int64_t ldb, double* c, + int64_t ldc, double* scale ); +int64_t LAPACKE_ctrsyl_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* c, int64_t ldc, + float* scale ); +int64_t LAPACKE_ztrsyl_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + double* scale ); + +int64_t LAPACKE_strsyl3_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const float* a, int64_t lda, + const float* b, int64_t ldb, + float* c, int64_t ldc, float* scale, + int64_t* iwork, int64_t liwork, + float* swork, int64_t ldswork ); +int64_t LAPACKE_dtrsyl3_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const double* a, int64_t lda, + const double* b, int64_t ldb, + double* c, int64_t ldc, double* scale, + int64_t* iwork, int64_t liwork, + double* swork, int64_t ldswork ); +int64_t LAPACKE_ctrsyl3_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* b, int64_t ldb, + lapack_complex_float* c, int64_t ldc, + float* scale, float* swork, + int64_t ldswork ); +int64_t LAPACKE_ztrsyl3_work_64( int matrix_layout, char trana, char tranb, + int64_t isgn, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* b, int64_t ldb, + lapack_complex_double* c, int64_t ldc, + double* scale, double* swork, + int64_t ldswork ); + +int64_t LAPACKE_strtri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, float* a, int64_t lda ); +int64_t LAPACKE_dtrtri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, double* a, int64_t lda ); +int64_t LAPACKE_ctrtri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, lapack_complex_float* a, + int64_t lda ); +int64_t LAPACKE_ztrtri_work_64( int matrix_layout, char uplo, char diag, + int64_t n, lapack_complex_double* a, + int64_t lda ); + +int64_t LAPACKE_strtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const float* a, int64_t lda, float* b, + int64_t ldb ); +int64_t LAPACKE_dtrtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const double* a, int64_t lda, double* b, + int64_t ldb ); +int64_t LAPACKE_ctrtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztrtrs_work_64( int matrix_layout, char uplo, char trans, + char diag, int64_t n, int64_t nrhs, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_strttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const float* a, int64_t lda, + float* arf ); +int64_t LAPACKE_dtrttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const double* a, int64_t lda, + double* arf ); +int64_t LAPACKE_ctrttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_float* a, + int64_t lda, lapack_complex_float* arf ); +int64_t LAPACKE_ztrttf_work_64( int matrix_layout, char transr, char uplo, + int64_t n, const lapack_complex_double* a, + int64_t lda, lapack_complex_double* arf ); + +int64_t LAPACKE_strttp_work_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, float* ap ); +int64_t LAPACKE_dtrttp_work_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, double* ap ); +int64_t LAPACKE_ctrttp_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + lapack_complex_float* ap ); +int64_t LAPACKE_ztrttp_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + lapack_complex_double* ap ); + +int64_t LAPACKE_stzrzf_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* tau, + float* work, int64_t lwork ); +int64_t LAPACKE_dtzrzf_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* tau, + double* work, int64_t lwork ); +int64_t LAPACKE_ctzrzf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_ztzrzf_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungbr_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungbr_work_64( int matrix_layout, char vect, int64_t m, + int64_t n, int64_t k, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunghr_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunghr_work_64( int matrix_layout, int64_t n, int64_t ilo, + int64_t ihi, lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunglq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunglq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungql_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungql_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungqr_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungqr_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungrq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungrq_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t k, lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungtr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungtr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cungtsqr_row_work_64( int matrix_layout, + int64_t m, int64_t n, + int64_t mb, int64_t nb, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zungtsqr_row_work_64( int matrix_layout, + int64_t m, int64_t n, + int64_t mb, int64_t nb, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmbr_work_64( int matrix_layout, char vect, char side, + char trans, int64_t m, int64_t n, + int64_t k, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmbr_work_64( int matrix_layout, char vect, char side, + char trans, int64_t m, int64_t n, + int64_t k, const lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmhr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmhr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t ilo, + int64_t ihi, const lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmql_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmql_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmrq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmrq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmrz_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmrz_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, const lapack_complex_double* a, + int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cunmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zunmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_cupgtr_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* ap, + const lapack_complex_float* tau, + lapack_complex_float* q, int64_t ldq, + lapack_complex_float* work ); +int64_t LAPACKE_zupgtr_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* ap, + const lapack_complex_double* tau, + lapack_complex_double* q, int64_t ldq, + lapack_complex_double* work ); + +int64_t LAPACKE_cupmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const lapack_complex_float* ap, + const lapack_complex_float* tau, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work ); +int64_t LAPACKE_zupmtr_work_64( int matrix_layout, char side, char uplo, + char trans, int64_t m, int64_t n, + const lapack_complex_double* ap, + const lapack_complex_double* tau, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work ); + +int64_t LAPACKE_claghe_64( int matrix_layout, int64_t n, int64_t k, + const float* d, lapack_complex_float* a, + int64_t lda, int64_t* iseed ); +int64_t LAPACKE_zlaghe_64( int matrix_layout, int64_t n, int64_t k, + const double* d, lapack_complex_double* a, + int64_t lda, int64_t* iseed ); + +int64_t LAPACKE_slagsy_64( int matrix_layout, int64_t n, int64_t k, + const float* d, float* a, int64_t lda, + int64_t* iseed ); +int64_t LAPACKE_dlagsy_64( int matrix_layout, int64_t n, int64_t k, + const double* d, double* a, int64_t lda, + int64_t* iseed ); +int64_t LAPACKE_clagsy_64( int matrix_layout, int64_t n, int64_t k, + const float* d, lapack_complex_float* a, + int64_t lda, int64_t* iseed ); +int64_t LAPACKE_zlagsy_64( int matrix_layout, int64_t n, int64_t k, + const double* d, lapack_complex_double* a, + int64_t lda, int64_t* iseed ); + +int64_t LAPACKE_slapmr_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, float* x, int64_t ldx, + int64_t* k ); +int64_t LAPACKE_dlapmr_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, double* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_clapmr_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, lapack_complex_float* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_zlapmr_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, lapack_complex_double* x, + int64_t ldx, int64_t* k ); + +int64_t LAPACKE_slapmt_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, float* x, int64_t ldx, + int64_t* k ); +int64_t LAPACKE_dlapmt_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, double* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_clapmt_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, lapack_complex_float* x, + int64_t ldx, int64_t* k ); +int64_t LAPACKE_zlapmt_64( int matrix_layout, lapack_logical forwrd, + int64_t m, int64_t n, lapack_complex_double* x, + int64_t ldx, int64_t* k ); + +float LAPACKE_slapy2_64( float x, float y ); +double LAPACKE_dlapy2_64( double x, double y ); + +float LAPACKE_slapy3_64( float x, float y, float z ); +double LAPACKE_dlapy3_64( double x, double y, double z ); + +int64_t LAPACKE_slartgp_64( float f, float g, float* cs, float* sn, float* r ); +int64_t LAPACKE_dlartgp_64( double f, double g, double* cs, double* sn, + double* r ); + +int64_t LAPACKE_slartgs_64( float x, float y, float sigma, float* cs, + float* sn ); +int64_t LAPACKE_dlartgs_64( double x, double y, double sigma, double* cs, + double* sn ); + + +//LAPACK 3.3.0 +int64_t LAPACKE_cbbcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, int64_t m, + int64_t p, int64_t q, float* theta, float* phi, + lapack_complex_float* u1, int64_t ldu1, + lapack_complex_float* u2, int64_t ldu2, + lapack_complex_float* v1t, int64_t ldv1t, + lapack_complex_float* v2t, int64_t ldv2t, + float* b11d, float* b11e, float* b12d, float* b12e, + float* b21d, float* b21e, float* b22d, float* b22e ); +int64_t LAPACKE_cbbcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + int64_t m, int64_t p, int64_t q, + float* theta, float* phi, + lapack_complex_float* u1, int64_t ldu1, + lapack_complex_float* u2, int64_t ldu2, + lapack_complex_float* v1t, int64_t ldv1t, + lapack_complex_float* v2t, int64_t ldv2t, + float* b11d, float* b11e, float* b12d, + float* b12e, float* b21d, float* b21e, + float* b22d, float* b22e, float* rwork, + int64_t lrwork ); +int64_t LAPACKE_cheswapr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_cheswapr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_chetri2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_chetri2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_chetri2x_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, int64_t nb ); +int64_t LAPACKE_chetri2x_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work, int64_t nb ); +int64_t LAPACKE_chetrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chetrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work ); +int64_t LAPACKE_csyconv_64( int matrix_layout, char uplo, char way, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, lapack_complex_float* e ); +int64_t LAPACKE_csyconv_work_64( int matrix_layout, char uplo, char way, + int64_t n, lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* e ); +int64_t LAPACKE_csyswapr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_csyswapr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_csytri2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_csytri2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_csytri2x_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, int64_t nb ); +int64_t LAPACKE_csytri2x_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_float* work, int64_t nb ); +int64_t LAPACKE_csytrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csytrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work ); +int64_t LAPACKE_cunbdb_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_float* x11, int64_t ldx11, + lapack_complex_float* x12, int64_t ldx12, + lapack_complex_float* x21, int64_t ldx21, + lapack_complex_float* x22, int64_t ldx22, + float* theta, float* phi, + lapack_complex_float* taup1, + lapack_complex_float* taup2, + lapack_complex_float* tauq1, + lapack_complex_float* tauq2 ); +int64_t LAPACKE_cunbdb_work_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_float* x11, int64_t ldx11, + lapack_complex_float* x12, int64_t ldx12, + lapack_complex_float* x21, int64_t ldx21, + lapack_complex_float* x22, int64_t ldx22, + float* theta, float* phi, + lapack_complex_float* taup1, + lapack_complex_float* taup2, + lapack_complex_float* tauq1, + lapack_complex_float* tauq2, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_cuncsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_float* x11, int64_t ldx11, + lapack_complex_float* x12, int64_t ldx12, + lapack_complex_float* x21, int64_t ldx21, + lapack_complex_float* x22, int64_t ldx22, + float* theta, lapack_complex_float* u1, + int64_t ldu1, lapack_complex_float* u2, + int64_t ldu2, lapack_complex_float* v1t, + int64_t ldv1t, lapack_complex_float* v2t, + int64_t ldv2t ); +int64_t LAPACKE_cuncsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + char signs, int64_t m, int64_t p, + int64_t q, lapack_complex_float* x11, + int64_t ldx11, lapack_complex_float* x12, + int64_t ldx12, lapack_complex_float* x21, + int64_t ldx21, lapack_complex_float* x22, + int64_t ldx22, float* theta, + lapack_complex_float* u1, int64_t ldu1, + lapack_complex_float* u2, int64_t ldu2, + lapack_complex_float* v1t, int64_t ldv1t, + lapack_complex_float* v2t, int64_t ldv2t, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork ); +int64_t LAPACKE_cuncsd2by1_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + lapack_complex_float* x11, int64_t ldx11, + lapack_complex_float* x21, int64_t ldx21, + float* theta, lapack_complex_float* u1, + int64_t ldu1, lapack_complex_float* u2, + int64_t ldu2, lapack_complex_float* v1t, int64_t ldv1t ); +int64_t LAPACKE_cuncsd2by1_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, + int64_t q, lapack_complex_float* x11, int64_t ldx11, + lapack_complex_float* x21, int64_t ldx21, + float* theta, lapack_complex_float* u1, + int64_t ldu1, lapack_complex_float* u2, + int64_t ldu2, lapack_complex_float* v1t, + int64_t ldv1t, lapack_complex_float* work, + int64_t lwork, float* rwork, int64_t lrwork, + int64_t* iwork ); +int64_t LAPACKE_dbbcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, int64_t m, + int64_t p, int64_t q, double* theta, + double* phi, double* u1, int64_t ldu1, double* u2, + int64_t ldu2, double* v1t, int64_t ldv1t, + double* v2t, int64_t ldv2t, double* b11d, + double* b11e, double* b12d, double* b12e, + double* b21d, double* b21e, double* b22d, + double* b22e ); +int64_t LAPACKE_dbbcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + int64_t m, int64_t p, int64_t q, + double* theta, double* phi, double* u1, + int64_t ldu1, double* u2, int64_t ldu2, + double* v1t, int64_t ldv1t, double* v2t, + int64_t ldv2t, double* b11d, double* b11e, + double* b12d, double* b12e, double* b21d, + double* b21e, double* b22d, double* b22e, + double* work, int64_t lwork ); +int64_t LAPACKE_dorbdb_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + double* x11, int64_t ldx11, double* x12, + int64_t ldx12, double* x21, int64_t ldx21, + double* x22, int64_t ldx22, double* theta, + double* phi, double* taup1, double* taup2, + double* tauq1, double* tauq2 ); +int64_t LAPACKE_dorbdb_work_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + double* x11, int64_t ldx11, double* x12, + int64_t ldx12, double* x21, int64_t ldx21, + double* x22, int64_t ldx22, double* theta, + double* phi, double* taup1, double* taup2, + double* tauq1, double* tauq2, double* work, + int64_t lwork ); +int64_t LAPACKE_dorcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, char signs, + int64_t m, int64_t p, int64_t q, + double* x11, int64_t ldx11, double* x12, + int64_t ldx12, double* x21, int64_t ldx21, + double* x22, int64_t ldx22, double* theta, + double* u1, int64_t ldu1, double* u2, + int64_t ldu2, double* v1t, int64_t ldv1t, + double* v2t, int64_t ldv2t ); +int64_t LAPACKE_dorcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + char signs, int64_t m, int64_t p, + int64_t q, double* x11, int64_t ldx11, + double* x12, int64_t ldx12, double* x21, + int64_t ldx21, double* x22, int64_t ldx22, + double* theta, double* u1, int64_t ldu1, + double* u2, int64_t ldu2, double* v1t, + int64_t ldv1t, double* v2t, int64_t ldv2t, + double* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_dorcsd2by1_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + double* x11, int64_t ldx11, double* x21, int64_t ldx21, + double* theta, double* u1, int64_t ldu1, double* u2, + int64_t ldu2, double* v1t, int64_t ldv1t); +int64_t LAPACKE_dorcsd2by1_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + double* x11, int64_t ldx11, double* x21, int64_t ldx21, + double* theta, double* u1, int64_t ldu1, double* u2, + int64_t ldu2, double* v1t, int64_t ldv1t, + double* work, int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_dsyconv_64( int matrix_layout, char uplo, char way, int64_t n, + double* a, int64_t lda, const int64_t* ipiv, double* e); +int64_t LAPACKE_dsyconv_work_64( int matrix_layout, char uplo, char way, + int64_t n, double* a, int64_t lda, + const int64_t* ipiv, double* e ); +int64_t LAPACKE_dsyswapr_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t i1, + int64_t i2 ); +int64_t LAPACKE_dsyswapr_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t i1, + int64_t i2 ); +int64_t LAPACKE_dsytri2_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_dsytri2_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, + const int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_dsytri2x_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, const int64_t* ipiv, + int64_t nb ); +int64_t LAPACKE_dsytri2x_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, + const int64_t* ipiv, double* work, + int64_t nb ); +int64_t LAPACKE_dsytrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_dsytrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const int64_t* ipiv, + double* b, int64_t ldb, double* work ); +int64_t LAPACKE_sbbcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, int64_t m, + int64_t p, int64_t q, float* theta, float* phi, + float* u1, int64_t ldu1, float* u2, + int64_t ldu2, float* v1t, int64_t ldv1t, + float* v2t, int64_t ldv2t, float* b11d, + float* b11e, float* b12d, float* b12e, float* b21d, + float* b21e, float* b22d, float* b22e ); +int64_t LAPACKE_sbbcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + int64_t m, int64_t p, int64_t q, + float* theta, float* phi, float* u1, + int64_t ldu1, float* u2, int64_t ldu2, + float* v1t, int64_t ldv1t, float* v2t, + int64_t ldv2t, float* b11d, float* b11e, + float* b12d, float* b12e, float* b21d, + float* b21e, float* b22d, float* b22e, + float* work, int64_t lwork ); +int64_t LAPACKE_sorbdb_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, float* x11, + int64_t ldx11, float* x12, int64_t ldx12, + float* x21, int64_t ldx21, float* x22, + int64_t ldx22, float* theta, float* phi, + float* taup1, float* taup2, float* tauq1, + float* tauq2 ); +int64_t LAPACKE_sorbdb_work_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + float* x11, int64_t ldx11, float* x12, + int64_t ldx12, float* x21, int64_t ldx21, + float* x22, int64_t ldx22, float* theta, + float* phi, float* taup1, float* taup2, + float* tauq1, float* tauq2, float* work, + int64_t lwork ); +int64_t LAPACKE_sorcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, char signs, + int64_t m, int64_t p, int64_t q, float* x11, + int64_t ldx11, float* x12, int64_t ldx12, + float* x21, int64_t ldx21, float* x22, + int64_t ldx22, float* theta, float* u1, + int64_t ldu1, float* u2, int64_t ldu2, + float* v1t, int64_t ldv1t, float* v2t, + int64_t ldv2t ); +int64_t LAPACKE_sorcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + char signs, int64_t m, int64_t p, + int64_t q, float* x11, int64_t ldx11, + float* x12, int64_t ldx12, float* x21, + int64_t ldx21, float* x22, int64_t ldx22, + float* theta, float* u1, int64_t ldu1, + float* u2, int64_t ldu2, float* v1t, + int64_t ldv1t, float* v2t, int64_t ldv2t, + float* work, int64_t lwork, + int64_t* iwork ); +int64_t LAPACKE_sorcsd2by1_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + float* x11, int64_t ldx11, float* x21, int64_t ldx21, + float* theta, float* u1, int64_t ldu1, float* u2, + int64_t ldu2, float* v1t, int64_t ldv1t); +int64_t LAPACKE_sorcsd2by1_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + float* x11, int64_t ldx11, float* x21, int64_t ldx21, + float* theta, float* u1, int64_t ldu1, float* u2, + int64_t ldu2, float* v1t, int64_t ldv1t, + float* work, int64_t lwork, int64_t* iwork ); +int64_t LAPACKE_ssyconv_64( int matrix_layout, char uplo, char way, int64_t n, + float* a, int64_t lda, const int64_t* ipiv, float* e ); +int64_t LAPACKE_ssyconv_work_64( int matrix_layout, char uplo, char way, + int64_t n, float* a, int64_t lda, + const int64_t* ipiv, float* e ); +int64_t LAPACKE_ssyswapr_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t i1, + int64_t i2 ); +int64_t LAPACKE_ssyswapr_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t i1, + int64_t i2 ); +int64_t LAPACKE_ssytri2_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, const int64_t* ipiv ); +int64_t LAPACKE_ssytri2_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, + const int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_ssytri2x_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, const int64_t* ipiv, + int64_t nb ); +int64_t LAPACKE_ssytri2x_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, + const int64_t* ipiv, float* work, + int64_t nb ); +int64_t LAPACKE_ssytrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_ssytrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, + int64_t lda, const int64_t* ipiv, + float* b, int64_t ldb, float* work ); +int64_t LAPACKE_zbbcsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, int64_t m, + int64_t p, int64_t q, double* theta, + double* phi, lapack_complex_double* u1, + int64_t ldu1, lapack_complex_double* u2, + int64_t ldu2, lapack_complex_double* v1t, + int64_t ldv1t, lapack_complex_double* v2t, + int64_t ldv2t, double* b11d, double* b11e, + double* b12d, double* b12e, double* b21d, + double* b21e, double* b22d, double* b22e ); +int64_t LAPACKE_zbbcsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + int64_t m, int64_t p, int64_t q, + double* theta, double* phi, + lapack_complex_double* u1, int64_t ldu1, + lapack_complex_double* u2, int64_t ldu2, + lapack_complex_double* v1t, int64_t ldv1t, + lapack_complex_double* v2t, int64_t ldv2t, + double* b11d, double* b11e, double* b12d, + double* b12e, double* b21d, double* b21e, + double* b22d, double* b22e, double* rwork, + int64_t lrwork ); +int64_t LAPACKE_zheswapr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_zheswapr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_zhetri2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_zhetri2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_zhetri2x_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, int64_t nb ); +int64_t LAPACKE_zhetri2x_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work, int64_t nb ); +int64_t LAPACKE_zhetrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhetrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work ); +int64_t LAPACKE_zsyconv_64( int matrix_layout, char uplo, char way, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, lapack_complex_double* e ); +int64_t LAPACKE_zsyconv_work_64( int matrix_layout, char uplo, char way, + int64_t n, lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* e ); +int64_t LAPACKE_zsyswapr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_zsyswapr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t i1, int64_t i2 ); +int64_t LAPACKE_zsytri2_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv ); +int64_t LAPACKE_zsytri2_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_zsytri2x_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, int64_t nb ); +int64_t LAPACKE_zsytri2x_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const int64_t* ipiv, + lapack_complex_double* work, int64_t nb ); +int64_t LAPACKE_zsytrs2_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsytrs2_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work ); +int64_t LAPACKE_zunbdb_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_double* x11, int64_t ldx11, + lapack_complex_double* x12, int64_t ldx12, + lapack_complex_double* x21, int64_t ldx21, + lapack_complex_double* x22, int64_t ldx22, + double* theta, double* phi, + lapack_complex_double* taup1, + lapack_complex_double* taup2, + lapack_complex_double* tauq1, + lapack_complex_double* tauq2 ); +int64_t LAPACKE_zunbdb_work_64( int matrix_layout, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_double* x11, int64_t ldx11, + lapack_complex_double* x12, int64_t ldx12, + lapack_complex_double* x21, int64_t ldx21, + lapack_complex_double* x22, int64_t ldx22, + double* theta, double* phi, + lapack_complex_double* taup1, + lapack_complex_double* taup2, + lapack_complex_double* tauq1, + lapack_complex_double* tauq2, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_zuncsd_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, char signs, + int64_t m, int64_t p, int64_t q, + lapack_complex_double* x11, int64_t ldx11, + lapack_complex_double* x12, int64_t ldx12, + lapack_complex_double* x21, int64_t ldx21, + lapack_complex_double* x22, int64_t ldx22, + double* theta, lapack_complex_double* u1, + int64_t ldu1, lapack_complex_double* u2, + int64_t ldu2, lapack_complex_double* v1t, + int64_t ldv1t, lapack_complex_double* v2t, + int64_t ldv2t ); +int64_t LAPACKE_zuncsd_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, char jobv2t, char trans, + char signs, int64_t m, int64_t p, + int64_t q, lapack_complex_double* x11, + int64_t ldx11, lapack_complex_double* x12, + int64_t ldx12, lapack_complex_double* x21, + int64_t ldx21, lapack_complex_double* x22, + int64_t ldx22, double* theta, + lapack_complex_double* u1, int64_t ldu1, + lapack_complex_double* u2, int64_t ldu2, + lapack_complex_double* v1t, int64_t ldv1t, + lapack_complex_double* v2t, int64_t ldv2t, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork ); +int64_t LAPACKE_zuncsd2by1_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, int64_t q, + lapack_complex_double* x11, int64_t ldx11, + lapack_complex_double* x21, int64_t ldx21, + double* theta, lapack_complex_double* u1, + int64_t ldu1, lapack_complex_double* u2, + int64_t ldu2, lapack_complex_double* v1t, int64_t ldv1t ); +int64_t LAPACKE_zuncsd2by1_work_64( int matrix_layout, char jobu1, char jobu2, + char jobv1t, int64_t m, int64_t p, + int64_t q, lapack_complex_double* x11, int64_t ldx11, + lapack_complex_double* x21, int64_t ldx21, + double* theta, lapack_complex_double* u1, + int64_t ldu1, lapack_complex_double* u2, + int64_t ldu2, lapack_complex_double* v1t, + int64_t ldv1t, lapack_complex_double* work, + int64_t lwork, double* rwork, int64_t lrwork, + int64_t* iwork ); + +//LAPACK 3.4.0 +int64_t LAPACKE_sgemqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const float* v, int64_t ldv, + const float* t, int64_t ldt, float* c, + int64_t ldc ); +int64_t LAPACKE_dgemqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const double* v, int64_t ldv, + const double* t, int64_t ldt, double* c, + int64_t ldc ); +int64_t LAPACKE_cgemqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const lapack_complex_float* v, + int64_t ldv, const lapack_complex_float* t, + int64_t ldt, lapack_complex_float* c, + int64_t ldc ); +int64_t LAPACKE_zgemqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const lapack_complex_double* v, + int64_t ldv, const lapack_complex_double* t, + int64_t ldt, lapack_complex_double* c, + int64_t ldc ); + +int64_t LAPACKE_sgeqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, float* a, int64_t lda, float* t, + int64_t ldt ); +int64_t LAPACKE_dgeqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, double* a, int64_t lda, double* t, + int64_t ldt ); +int64_t LAPACKE_cgeqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_float* a, + int64_t lda, lapack_complex_float* t, + int64_t ldt ); +int64_t LAPACKE_zgeqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_double* a, + int64_t lda, lapack_complex_double* t, + int64_t ldt ); + +int64_t LAPACKE_sgeqrt2_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* t, + int64_t ldt ); +int64_t LAPACKE_dgeqrt2_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* t, + int64_t ldt ); +int64_t LAPACKE_cgeqrt2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zgeqrt2_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_sgeqrt3_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* t, + int64_t ldt ); +int64_t LAPACKE_dgeqrt3_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* t, + int64_t ldt ); +int64_t LAPACKE_cgeqrt3_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zgeqrt3_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_stpmqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, const float* v, + int64_t ldv, const float* t, int64_t ldt, + float* a, int64_t lda, float* b, + int64_t ldb ); +int64_t LAPACKE_dtpmqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, const double* v, + int64_t ldv, const double* t, int64_t ldt, + double* a, int64_t lda, double* b, + int64_t ldb ); +int64_t LAPACKE_ctpmqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztpmqrt_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_stpqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, float* a, + int64_t lda, float* b, int64_t ldb, float* t, + int64_t ldt ); + +int64_t LAPACKE_dtpqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, double* a, + int64_t lda, double* b, int64_t ldb, double* t, + int64_t ldt ); +int64_t LAPACKE_ctpqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_ztpqrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_stpqrt2_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + float* a, int64_t lda, + float* b, int64_t ldb, + float* t, int64_t ldt ); +int64_t LAPACKE_dtpqrt2_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + double* a, int64_t lda, + double* b, int64_t ldb, + double* t, int64_t ldt ); +int64_t LAPACKE_ctpqrt2_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_ztpqrt2_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_stprfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, int64_t l, const float* v, + int64_t ldv, const float* t, int64_t ldt, + float* a, int64_t lda, float* b, int64_t ldb ); +int64_t LAPACKE_dtprfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, int64_t l, const double* v, + int64_t ldv, const double* t, int64_t ldt, + double* a, int64_t lda, double* b, int64_t ldb ); +int64_t LAPACKE_ctprfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, int64_t l, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_ztprfb_64( int matrix_layout, char side, char trans, char direct, + char storev, int64_t m, int64_t n, + int64_t k, int64_t l, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sgemqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const float* v, int64_t ldv, + const float* t, int64_t ldt, float* c, + int64_t ldc, float* work ); +int64_t LAPACKE_dgemqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const double* v, int64_t ldv, + const double* t, int64_t ldt, double* c, + int64_t ldc, double* work ); +int64_t LAPACKE_cgemqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const lapack_complex_float* v, + int64_t ldv, const lapack_complex_float* t, + int64_t ldt, lapack_complex_float* c, + int64_t ldc, lapack_complex_float* work ); +int64_t LAPACKE_zgemqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t nb, const lapack_complex_double* v, + int64_t ldv, const lapack_complex_double* t, + int64_t ldt, lapack_complex_double* c, + int64_t ldc, lapack_complex_double* work ); + +int64_t LAPACKE_sgeqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, float* a, int64_t lda, + float* t, int64_t ldt, float* work ); +int64_t LAPACKE_dgeqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, double* a, int64_t lda, + double* t, int64_t ldt, double* work ); +int64_t LAPACKE_cgeqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_float* a, + int64_t lda, lapack_complex_float* t, + int64_t ldt, lapack_complex_float* work ); +int64_t LAPACKE_zgeqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_double* a, + int64_t lda, lapack_complex_double* t, + int64_t ldt, lapack_complex_double* work ); + +int64_t LAPACKE_sgeqrt2_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* t, + int64_t ldt ); +int64_t LAPACKE_dgeqrt2_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* t, + int64_t ldt ); +int64_t LAPACKE_cgeqrt2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zgeqrt2_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_sgeqrt3_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, float* t, + int64_t ldt ); +int64_t LAPACKE_dgeqrt3_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, double* t, + int64_t ldt ); +int64_t LAPACKE_cgeqrt3_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zgeqrt3_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_stpmqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, const float* v, + int64_t ldv, const float* t, int64_t ldt, + float* a, int64_t lda, float* b, + int64_t ldb, float* work ); +int64_t LAPACKE_dtpmqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, const double* v, + int64_t ldv, const double* t, + int64_t ldt, double* a, int64_t lda, + double* b, int64_t ldb, double* work ); +int64_t LAPACKE_ctpmqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work ); +int64_t LAPACKE_ztpmqrt_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + int64_t l, int64_t nb, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work ); + +int64_t LAPACKE_stpqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, float* a, + int64_t lda, float* b, int64_t ldb, + float* t, int64_t ldt, float* work ); +int64_t LAPACKE_dtpqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, double* a, + int64_t lda, double* b, int64_t ldb, + double* t, int64_t ldt, double* work ); +int64_t LAPACKE_ctpqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* work ); +int64_t LAPACKE_ztpqrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t l, int64_t nb, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* work ); + +int64_t LAPACKE_stpqrt2_work_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + float* a, int64_t lda, + float* b, int64_t ldb, + float* t, int64_t ldt ); +int64_t LAPACKE_dtpqrt2_work_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + double* a, int64_t lda, + double* b, int64_t ldb, + double* t, int64_t ldt ); +int64_t LAPACKE_ctpqrt2_work_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_ztpqrt2_work_64( int matrix_layout, + int64_t m, int64_t n, int64_t l, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_stprfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, int64_t l, + const float* v, int64_t ldv, const float* t, + int64_t ldt, float* a, int64_t lda, + float* b, int64_t ldb, float* work, + int64_t ldwork ); +int64_t LAPACKE_dtprfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, int64_t l, + const double* v, int64_t ldv, + const double* t, int64_t ldt, double* a, + int64_t lda, double* b, int64_t ldb, + double* work, int64_t ldwork ); +int64_t LAPACKE_ctprfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, int64_t l, + const lapack_complex_float* v, int64_t ldv, + const lapack_complex_float* t, int64_t ldt, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t ldwork ); +int64_t LAPACKE_ztprfb_work_64( int matrix_layout, char side, char trans, + char direct, char storev, int64_t m, + int64_t n, int64_t k, int64_t l, + const lapack_complex_double* v, int64_t ldv, + const lapack_complex_double* t, int64_t ldt, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t ldwork ); +//LAPACK 3.X.X +int64_t LAPACKE_ssysv_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dsysv_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_csysv_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsysv_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_ssytrf_rook_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dsytrf_rook_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_csytrf_rook_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zsytrf_rook_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_ssytrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_csytrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chetrf_rook_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zhetrf_rook_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_chetrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_rook_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_csyr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float alpha, + const lapack_complex_float* x, int64_t incx, + lapack_complex_float* a, int64_t lda ); +int64_t LAPACKE_zsyr_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double alpha, + const lapack_complex_double* x, int64_t incx, + lapack_complex_double* a, int64_t lda ); + +int64_t LAPACKE_ssysv_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dsysv_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_csysv_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zsysv_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_ssytrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_csytrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zsytrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_ssytrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, + int64_t ldb ); +int64_t LAPACKE_dsytrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const int64_t* ipiv, + double* b, int64_t ldb ); +int64_t LAPACKE_csytrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_chetrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zhetrf_rook_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_chetrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_rook_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); + + +int64_t LAPACKE_csyr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float alpha, + const lapack_complex_float* x, + int64_t incx, lapack_complex_float* a, + int64_t lda ); +int64_t LAPACKE_zsyr_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double alpha, + const lapack_complex_double* x, + int64_t incx, lapack_complex_double* a, + int64_t lda ); +void LAPACKE_ilaver_64( int64_t* vers_major, + int64_t* vers_minor, + int64_t* vers_patch ); +// LAPACK 3.7.0 +int64_t LAPACKE_ssysv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_ssysv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + int64_t* ipiv, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dsysv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_dsysv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + int64_t* ipiv, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_csysv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csysv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsysv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsysv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_chesv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chesv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhesv_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhesv_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssytrf_aa_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_dsytrf_aa_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, int64_t* ipiv ); +int64_t LAPACKE_csytrf_aa_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zsytrf_aa_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_chetrf_aa_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv ); +int64_t LAPACKE_zhetrf_aa_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv ); + +int64_t LAPACKE_ssytrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_csytrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zsytrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); +int64_t LAPACKE_chetrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zhetrf_aa_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + + +int64_t LAPACKE_csytrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csytrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_chetrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chetrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_dsytrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const int64_t* ipiv, + double* b, int64_t ldb, double* work, int64_t lwork ); +int64_t LAPACKE_ssytrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_ssytrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const int64_t* ipiv, float* b, + int64_t ldb, float* work, int64_t lwork ); +int64_t LAPACKE_zsytrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork); +int64_t LAPACKE_zhetrs_aa_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_aa_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork); + + +int64_t LAPACKE_ssysv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* e, int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_ssysv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* e, int64_t* ipiv, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dsysv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* e, int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_dsysv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* e, int64_t* ipiv, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_csysv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* e, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csysv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* e, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsysv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* e, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsysv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* e, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_chesv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* e, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chesv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* e, int64_t* ipiv, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhesv_rk_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* e, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhesv_rk_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* e, int64_t* ipiv, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssytrf_rk_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, float* e, int64_t* ipiv ); +int64_t LAPACKE_dsytrf_rk_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, double* e, int64_t* ipiv ); +int64_t LAPACKE_csytrf_rk_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* e, int64_t* ipiv ); +int64_t LAPACKE_zsytrf_rk_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* e, int64_t* ipiv ); +int64_t LAPACKE_chetrf_rk_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* e, int64_t* ipiv ); +int64_t LAPACKE_zhetrf_rk_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* e, int64_t* ipiv ); +int64_t LAPACKE_ssytrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, float* e, int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, double* e, int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_csytrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* e, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zsytrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* e, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); +int64_t LAPACKE_chetrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* e, + int64_t* ipiv, lapack_complex_float* work, + int64_t lwork ); +int64_t LAPACKE_zhetrf_rk_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* e, + int64_t* ipiv, lapack_complex_double* work, + int64_t lwork ); + +int64_t LAPACKE_csytrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* e, + const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csytrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* e, + const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb); +int64_t LAPACKE_chetrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* e, + const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chetrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_float* a, + int64_t lda, const lapack_complex_float* e, + const int64_t* ipiv, + lapack_complex_float* b, int64_t ldb); +int64_t LAPACKE_dsytrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, int64_t lda, + const double* e, + const int64_t* ipiv, double* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const double* a, + int64_t lda, const double* e, + const int64_t* ipiv, + double* b, int64_t ldb); +int64_t LAPACKE_ssytrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* e, + const int64_t* ipiv, float* b, int64_t ldb ); +int64_t LAPACKE_ssytrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const float* a, int64_t lda, + const float* e, const int64_t* ipiv, float* b, + int64_t ldb); +int64_t LAPACKE_zsytrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* e, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* e, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb); +int64_t LAPACKE_zhetrs_3_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* e, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_3_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, const lapack_complex_double* a, + int64_t lda, const lapack_complex_double* e, + const int64_t* ipiv, + lapack_complex_double* b, int64_t ldb); + +int64_t LAPACKE_ssytri_3_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, const float* e, const int64_t* ipiv ); +int64_t LAPACKE_dsytri_3_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, const double* e, const int64_t* ipiv ); +int64_t LAPACKE_csytri_3_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, const int64_t* ipiv ); +int64_t LAPACKE_zsytri_3_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, const int64_t* ipiv ); +int64_t LAPACKE_chetri_3_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, const int64_t* ipiv ); +int64_t LAPACKE_zhetri_3_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, const int64_t* ipiv ); +int64_t LAPACKE_ssytri_3_work_64( int matrix_layout, char uplo, int64_t n, float* a, + int64_t lda, const float* e, const int64_t* ipiv, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytri_3_work_64( int matrix_layout, char uplo, int64_t n, double* a, + int64_t lda, const double* e, const int64_t* ipiv, + double* work, int64_t lwork ); +int64_t LAPACKE_csytri_3_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, const int64_t* ipiv, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsytri_3_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, const int64_t* ipiv, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_chetri_3_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, const int64_t* ipiv, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhetri_3_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, const int64_t* ipiv, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssycon_3_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, const float* e, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_dsycon_3_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, const double* e, + const int64_t* ipiv, double anorm, + double* rcond ); +int64_t LAPACKE_csycon_3_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zsycon_3_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, + const int64_t* ipiv, double anorm, + double* rcond ); +int64_t LAPACKE_checon_3_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, + const int64_t* ipiv, float anorm, float* rcond ); +int64_t LAPACKE_zhecon_3_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, + const int64_t* ipiv, double anorm, + double* rcond ); +int64_t LAPACKE_ssycon_3_work_64( int matrix_layout, char uplo, int64_t n, + const float* a, int64_t lda, const float* e, + const int64_t* ipiv, float anorm, + float* rcond, float* work, int64_t* iwork ); +int64_t LAPACKE_dsycon_3_work_64( int matrix_layout, char uplo, int64_t n, + const double* a, int64_t lda, const double* e, + const int64_t* ipiv, double anorm, + double* rcond, double* work, + int64_t* iwork ); +int64_t LAPACKE_csycon_3_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zsycon_3_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); +int64_t LAPACKE_checon_3_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* e, + const int64_t* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +int64_t LAPACKE_zhecon_3_work_64( int matrix_layout, char uplo, int64_t n, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* e, + const int64_t* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +int64_t LAPACKE_sgelq_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, + float* t, int64_t tsize ); +int64_t LAPACKE_dgelq_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, + double* t, int64_t tsize ); +int64_t LAPACKE_cgelq_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t tsize ); +int64_t LAPACKE_zgelq_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t tsize ); + +int64_t LAPACKE_sgelq_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, + float* t, int64_t tsize, + float* work, int64_t lwork ); +int64_t LAPACKE_dgelq_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, + double* t, int64_t tsize, + double* work, int64_t lwork ); +int64_t LAPACKE_cgelq_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t tsize, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgelq_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t tsize, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgemlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* t, int64_t tsize, + float* c, int64_t ldc ); +int64_t LAPACKE_dgemlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* t, int64_t tsize, + double* c, int64_t ldc ); +int64_t LAPACKE_cgemlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t tsize, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zgemlq_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t tsize, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_sgemlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* t, int64_t tsize, + float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dgemlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* t, int64_t tsize, + double* c, int64_t ldc, + double* work, int64_t lwork ); +int64_t LAPACKE_cgemlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t tsize, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgemlq_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t tsize, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgeqr_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, + float* t, int64_t tsize ); +int64_t LAPACKE_dgeqr_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, + double* t, int64_t tsize ); +int64_t LAPACKE_cgeqr_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t tsize ); +int64_t LAPACKE_zgeqr_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t tsize ); + +int64_t LAPACKE_sgeqr_work_64( int matrix_layout, int64_t m, int64_t n, + float* a, int64_t lda, + float* t, int64_t tsize, + float* work, int64_t lwork ); +int64_t LAPACKE_dgeqr_work_64( int matrix_layout, int64_t m, int64_t n, + double* a, int64_t lda, + double* t, int64_t tsize, + double* work, int64_t lwork ); +int64_t LAPACKE_cgeqr_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t tsize, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgeqr_work_64( int matrix_layout, int64_t m, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t tsize, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgemqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* t, int64_t tsize, + float* c, int64_t ldc ); +int64_t LAPACKE_dgemqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* t, int64_t tsize, + double* c, int64_t ldc ); +int64_t LAPACKE_cgemqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t tsize, + lapack_complex_float* c, int64_t ldc ); +int64_t LAPACKE_zgemqr_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t tsize, + lapack_complex_double* c, int64_t ldc ); + +int64_t LAPACKE_sgemqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const float* a, int64_t lda, + const float* t, int64_t tsize, + float* c, int64_t ldc, + float* work, int64_t lwork ); +int64_t LAPACKE_dgemqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const double* a, int64_t lda, + const double* t, int64_t tsize, + double* c, int64_t ldc, + double* work, int64_t lwork ); +int64_t LAPACKE_cgemqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_float* a, int64_t lda, + const lapack_complex_float* t, int64_t tsize, + lapack_complex_float* c, int64_t ldc, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgemqr_work_64( int matrix_layout, char side, char trans, + int64_t m, int64_t n, int64_t k, + const lapack_complex_double* a, int64_t lda, + const lapack_complex_double* t, int64_t tsize, + lapack_complex_double* c, int64_t ldc, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgetsls_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* b, int64_t ldb ); +int64_t LAPACKE_dgetsls_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* b, int64_t ldb ); +int64_t LAPACKE_cgetsls_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zgetsls_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb ); + +int64_t LAPACKE_sgetsls_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, float* a, + int64_t lda, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dgetsls_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, double* a, + int64_t lda, double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_cgetsls_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgetsls_work_64( int matrix_layout, char trans, int64_t m, + int64_t n, int64_t nrhs, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_sgetsqrhrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + float* a, int64_t lda, + float* t, int64_t ldt ); +int64_t LAPACKE_dgetsqrhrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + double* a, int64_t lda, + double* t, int64_t ldt ); +int64_t LAPACKE_cgetsqrhrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt ); +int64_t LAPACKE_zgetsqrhrt_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt ); + +int64_t LAPACKE_sgetsqrhrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + float* a, int64_t lda, + float* t, int64_t ldt, + float* work, int64_t lwork ); +int64_t LAPACKE_dgetsqrhrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + double* a, int64_t lda, + double* t, int64_t ldt, + double* work, int64_t lwork ); +int64_t LAPACKE_cgetsqrhrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + lapack_complex_float* a, int64_t lda, + lapack_complex_float* t, int64_t ldt, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zgetsqrhrt_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t mb1, int64_t nb1, int64_t nb2, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* t, int64_t ldt, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssyev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* a, int64_t lda, float* w ); +int64_t LAPACKE_dsyev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* a, int64_t lda, double* w ); + +int64_t LAPACKE_ssyevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + float* a, int64_t lda, float* w ); +int64_t LAPACKE_dsyevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + double* a, int64_t lda, double* w ); + +int64_t LAPACKE_ssyevr_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, float* a, int64_t lda, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_dsyevr_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, double* a, int64_t lda, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz ); + +int64_t LAPACKE_ssyevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, float* a, int64_t lda, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsyevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, double* a, int64_t lda, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssyev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* a, int64_t lda, float* w, + float* work, int64_t lwork ); +int64_t LAPACKE_dsyev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* a, int64_t lda, + double* w, double* work, int64_t lwork ); + +int64_t LAPACKE_ssyevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, float* a, int64_t lda, + float* w, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsyevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, double* a, int64_t lda, + double* w, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssyevr_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, int64_t* isuppz, float* work, + int64_t lwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_dsyevr_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, int64_t* isuppz, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssyevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, float* a, + int64_t lda, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_dsyevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, double* a, + int64_t lda, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_cheev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, float* w ); +int64_t LAPACKE_zheev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, double* w ); + +int64_t LAPACKE_cheevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, float* w ); +int64_t LAPACKE_zheevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double* w ); + +int64_t LAPACKE_cheevr_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* isuppz ); +int64_t LAPACKE_zheevr_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, int64_t ldz, + int64_t* isuppz ); + +int64_t LAPACKE_cheevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, float* w, + lapack_complex_float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_zheevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_cheev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zheev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double* w, + lapack_complex_double* work, int64_t lwork, + double* rwork ); + +int64_t LAPACKE_cheevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_float* a, + int64_t lda, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_zheevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, lapack_complex_double* a, + int64_t lda, double* w, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_cheevr_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, int64_t* isuppz, + lapack_complex_float* work, int64_t lwork, + float* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_zheevr_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, int64_t* isuppz, + lapack_complex_double* work, int64_t lwork, + double* rwork, int64_t lrwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_cheevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_float* a, int64_t lda, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t* iwork, int64_t* ifail ); +int64_t LAPACKE_zheevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t* iwork, int64_t* ifail ); + +int64_t LAPACKE_ssbev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab, float* w, + float* z, int64_t ldz ); +int64_t LAPACKE_dsbev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab, double* w, + double* z, int64_t ldz ); + +int64_t LAPACKE_ssbevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, float* ab, int64_t ldab, float* w, + float* z, int64_t ldz ); +int64_t LAPACKE_dsbevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, double* ab, int64_t ldab, + double* w, double* z, int64_t ldz ); + +int64_t LAPACKE_ssbevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, int64_t ldz, + int64_t* ifail ); +int64_t LAPACKE_dsbevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* q, int64_t ldq, + double vl, double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, double* z, + int64_t ldz, int64_t* ifail ); + +int64_t LAPACKE_ssbev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* w, float* z, + int64_t ldz, float* work, int64_t lwork ); +int64_t LAPACKE_dsbev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* w, double* z, + int64_t ldz, double* work, int64_t lwork ); + +int64_t LAPACKE_ssbevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, float* ab, + int64_t ldab, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); +int64_t LAPACKE_dsbevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, double* ab, + int64_t ldab, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); + +int64_t LAPACKE_ssbevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + float* ab, int64_t ldab, float* q, + int64_t ldq, float vl, float vu, + int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, float* z, + int64_t ldz, float* work, int64_t lwork, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_dsbevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + double* ab, int64_t ldab, double* q, + int64_t ldq, double vl, double vu, + int64_t il, int64_t iu, double abstol, + int64_t* m, double* w, double* z, + int64_t ldz, double* work, int64_t lwork, int64_t* iwork, + int64_t* ifail ); + +int64_t LAPACKE_chbev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab, float* w, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhbev_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab, double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_chbevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_float* ab, + int64_t ldab, float* w, lapack_complex_float* z, + int64_t ldz ); +int64_t LAPACKE_zhbevd_2stage_64( int matrix_layout, char jobz, char uplo, int64_t n, + int64_t kd, lapack_complex_double* ab, + int64_t ldab, double* w, lapack_complex_double* z, + int64_t ldz ); + +int64_t LAPACKE_chbevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* q, int64_t ldq, float vl, + float vu, int64_t il, int64_t iu, float abstol, + int64_t* m, float* w, lapack_complex_float* z, + int64_t ldz, int64_t* ifail ); +int64_t LAPACKE_zhbevx_2stage_64( int matrix_layout, char jobz, char range, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* q, int64_t ldq, double vl, + double vu, int64_t il, int64_t iu, + double abstol, int64_t* m, double* w, + lapack_complex_double* z, int64_t ldz, + int64_t* ifail ); + +int64_t LAPACKE_chbev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork ); +int64_t LAPACKE_zhbev_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +int64_t LAPACKE_chbevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); +int64_t LAPACKE_zhbevd_2stage_work_64( int matrix_layout, char jobz, char uplo, + int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, + int64_t lrwork, int64_t* iwork, + int64_t liwork ); + +int64_t LAPACKE_chbevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + lapack_complex_float* ab, int64_t ldab, + lapack_complex_float* q, int64_t ldq, + float vl, float vu, int64_t il, + int64_t iu, float abstol, int64_t* m, + float* w, lapack_complex_float* z, + int64_t ldz, lapack_complex_float* work, + int64_t lwork, float* rwork, int64_t* iwork, + int64_t* ifail ); +int64_t LAPACKE_zhbevx_2stage_work_64( int matrix_layout, char jobz, char range, + char uplo, int64_t n, int64_t kd, + lapack_complex_double* ab, int64_t ldab, + lapack_complex_double* q, int64_t ldq, + double vl, double vu, int64_t il, + int64_t iu, double abstol, int64_t* m, + double* w, lapack_complex_double* z, + int64_t ldz, lapack_complex_double* work, + int64_t lwork, double* rwork, int64_t* iwork, + int64_t* ifail ); + +int64_t LAPACKE_ssygv_2stage_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, int64_t lda, + float* b, int64_t ldb, float* w ); +int64_t LAPACKE_dsygv_2stage_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, int64_t lda, + double* b, int64_t ldb, double* w ); +int64_t LAPACKE_ssygv_2stage_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, float* a, + int64_t lda, float* b, int64_t ldb, + float* w, float* work, int64_t lwork ); +int64_t LAPACKE_dsygv_2stage_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, double* a, + int64_t lda, double* b, int64_t ldb, + double* w, double* work, int64_t lwork ); + +int64_t LAPACKE_chegv_2stage_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* w ); +int64_t LAPACKE_zhegv_2stage_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_double* a, + int64_t lda, lapack_complex_double* b, + int64_t ldb, double* w ); +int64_t LAPACKE_chegv_2stage_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, lapack_complex_float* a, + int64_t lda, lapack_complex_float* b, + int64_t ldb, float* w, + lapack_complex_float* work, int64_t lwork, + float* rwork ); +int64_t LAPACKE_zhegv_2stage_work_64( int matrix_layout, int64_t itype, char jobz, + char uplo, int64_t n, + lapack_complex_double* a, int64_t lda, + lapack_complex_double* b, int64_t ldb, + double* w, lapack_complex_double* work, + int64_t lwork, double* rwork ); + +//LAPACK 3.8.0 +int64_t LAPACKE_ssysv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2, float* b, int64_t ldb ); +int64_t LAPACKE_ssysv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2, float* b, int64_t ldb, + float* work, int64_t lwork ); +int64_t LAPACKE_dsysv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2, + double* b, int64_t ldb ); +int64_t LAPACKE_dsysv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2, + double* b, int64_t ldb, + double* work, int64_t lwork ); +int64_t LAPACKE_csysv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csysv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsysv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsysv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_chesv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chesv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhesv_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhesv_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb, + lapack_complex_double* work, int64_t lwork ); + +int64_t LAPACKE_ssytrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2 ); +int64_t LAPACKE_ssytrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2, + float* work, int64_t lwork ); +int64_t LAPACKE_dsytrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2 ); +int64_t LAPACKE_dsytrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2, + double* work, int64_t lwork ); +int64_t LAPACKE_csytrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2 ); +int64_t LAPACKE_csytrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zsytrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2 ); +int64_t LAPACKE_zsytrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* work, int64_t lwork ); +int64_t LAPACKE_chetrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2 ); +int64_t LAPACKE_chetrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* work, int64_t lwork ); +int64_t LAPACKE_zhetrf_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2 ); +int64_t LAPACKE_zhetrf_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* work, int64_t lwork ); + + +int64_t LAPACKE_ssytrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2, float* b, int64_t ldb ); +int64_t LAPACKE_ssytrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, float* a, int64_t lda, + float* tb, int64_t ltb, int64_t* ipiv, + int64_t* ipiv2, float* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2, + double* b, int64_t ldb ); +int64_t LAPACKE_dsytrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, double* a, int64_t lda, + double* tb, int64_t ltb, + int64_t* ipiv, int64_t* ipiv2, + double* b, int64_t ldb ); +int64_t LAPACKE_csytrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_csytrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zsytrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_chetrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_chetrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_float* a, + int64_t lda, lapack_complex_float* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_float* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_aa_2stage_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +int64_t LAPACKE_zhetrs_aa_2stage_work_64( int matrix_layout, char uplo, int64_t n, + int64_t nrhs, lapack_complex_double* a, + int64_t lda, lapack_complex_double* tb, + int64_t ltb, int64_t* ipiv, int64_t* ipiv2, + lapack_complex_double* b, int64_t ldb ); +//LAPACK 3.10.0 +int64_t LAPACKE_sorhr_col_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, float* a, + int64_t lda, float* t, + int64_t ldt, float* d ); +int64_t LAPACKE_sorhr_col_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, float* a, + int64_t lda, float* t, + int64_t ldt, float* d ); +int64_t LAPACKE_dorhr_col_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, double* a, + int64_t lda, double* t, + int64_t ldt, double* d ); +int64_t LAPACKE_dorhr_col_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, double* a, + int64_t lda, double* t, + int64_t ldt, double* d ); +int64_t LAPACKE_cunhr_col_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_float* a, + int64_t lda, lapack_complex_float* t, + int64_t ldt, lapack_complex_float* d ); +int64_t LAPACKE_cunhr_col_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_float* a, + int64_t lda, lapack_complex_float* t, + int64_t ldt, lapack_complex_float* d ); +int64_t LAPACKE_zunhr_col_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_double* a, + int64_t lda, lapack_complex_double* t, + int64_t ldt, lapack_complex_double* d ); +int64_t LAPACKE_zunhr_col_work_64( int matrix_layout, int64_t m, int64_t n, + int64_t nb, lapack_complex_double* a, + int64_t lda, lapack_complex_double* t, + int64_t ldt, lapack_complex_double* d ); + +#ifdef __cplusplus +} +#endif /* __cplusplus */ + +#endif /* _LAPACKE_64_H_ */ From 907725572a8ca92d4f438fe4e39e7deea1768461 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Fri, 28 Jul 2023 09:55:19 -0700 Subject: [PATCH 037/206] Wrap all functions to macro for Index-64 API in LAPACKE --- LAPACKE/include/lapacke_utils.h | 308 ++++++++++---------- LAPACKE/src/lapacke_cbbcsd.c | 32 +- LAPACKE/src/lapacke_cbbcsd_work.c | 6 +- LAPACKE/src/lapacke_cbdsqr.c | 18 +- LAPACKE/src/lapacke_cbdsqr_work.c | 24 +- LAPACKE/src/lapacke_cgbbrd.c | 12 +- LAPACKE/src/lapacke_cgbbrd_work.c | 38 +-- LAPACKE/src/lapacke_cgbcon.c | 12 +- LAPACKE/src/lapacke_cgbcon_work.c | 10 +- LAPACKE/src/lapacke_cgbequ.c | 8 +- LAPACKE/src/lapacke_cgbequ_work.c | 10 +- LAPACKE/src/lapacke_cgbequb.c | 8 +- LAPACKE/src/lapacke_cgbequb_work.c | 10 +- LAPACKE/src/lapacke_cgbrfs.c | 16 +- LAPACKE/src/lapacke_cgbrfs_work.c | 24 +- LAPACKE/src/lapacke_cgbrfsx.c | 26 +- LAPACKE/src/lapacke_cgbrfsx_work.c | 28 +- LAPACKE/src/lapacke_cgbsv.c | 10 +- LAPACKE/src/lapacke_cgbsv_work.c | 18 +- LAPACKE/src/lapacke_cgbsvx.c | 28 +- LAPACKE/src/lapacke_cgbsvx_work.c | 40 +-- LAPACKE/src/lapacke_cgbsvxx.c | 30 +- LAPACKE/src/lapacke_cgbsvxx_work.c | 44 +-- LAPACKE/src/lapacke_cgbtrf.c | 8 +- LAPACKE/src/lapacke_cgbtrf_work.c | 12 +- LAPACKE/src/lapacke_cgbtrs.c | 10 +- LAPACKE/src/lapacke_cgbtrs_work.c | 16 +- LAPACKE/src/lapacke_cgebak.c | 10 +- LAPACKE/src/lapacke_cgebak_work.c | 12 +- LAPACKE/src/lapacke_cgebal.c | 12 +- LAPACKE/src/lapacke_cgebal_work.c | 28 +- LAPACKE/src/lapacke_cgebrd.c | 12 +- LAPACKE/src/lapacke_cgebrd_work.c | 12 +- LAPACKE/src/lapacke_cgecon.c | 12 +- LAPACKE/src/lapacke_cgecon_work.c | 10 +- LAPACKE/src/lapacke_cgedmd.c | 30 +- LAPACKE/src/lapacke_cgedmd_work.c | 42 +-- LAPACKE/src/lapacke_cgedmdq.c | 24 +- LAPACKE/src/lapacke_cgedmdq_work.c | 48 +-- LAPACKE/src/lapacke_cgeequ.c | 8 +- LAPACKE/src/lapacke_cgeequ_work.c | 10 +- LAPACKE/src/lapacke_cgeequb.c | 8 +- LAPACKE/src/lapacke_cgeequb_work.c | 10 +- LAPACKE/src/lapacke_cgees.c | 16 +- LAPACKE/src/lapacke_cgees_work.c | 22 +- LAPACKE/src/lapacke_cgeesx.c | 16 +- LAPACKE/src/lapacke_cgeesx_work.c | 22 +- LAPACKE/src/lapacke_cgeev.c | 12 +- LAPACKE/src/lapacke_cgeev_work.c | 36 +-- LAPACKE/src/lapacke_cgeevx.c | 12 +- LAPACKE/src/lapacke_cgeevx_work.c | 36 +-- LAPACKE/src/lapacke_cgehrd.c | 12 +- LAPACKE/src/lapacke_cgehrd_work.c | 12 +- LAPACKE/src/lapacke_cgejsv.c | 108 +++---- LAPACKE/src/lapacke_cgejsv_work.c | 50 ++-- LAPACKE/src/lapacke_cgelq.c | 12 +- LAPACKE/src/lapacke_cgelq2.c | 10 +- LAPACKE/src/lapacke_cgelq2_work.c | 12 +- LAPACKE/src/lapacke_cgelq_work.c | 12 +- LAPACKE/src/lapacke_cgelqf.c | 12 +- LAPACKE/src/lapacke_cgelqf_work.c | 12 +- LAPACKE/src/lapacke_cgels.c | 14 +- LAPACKE/src/lapacke_cgels_work.c | 18 +- LAPACKE/src/lapacke_cgelsd.c | 16 +- LAPACKE/src/lapacke_cgelsd_work.c | 18 +- LAPACKE/src/lapacke_cgelss.c | 16 +- LAPACKE/src/lapacke_cgelss_work.c | 18 +- LAPACKE/src/lapacke_cgelsy.c | 16 +- LAPACKE/src/lapacke_cgelsy_work.c | 18 +- LAPACKE/src/lapacke_cgemlq.c | 16 +- LAPACKE/src/lapacke_cgemlq_work.c | 20 +- LAPACKE/src/lapacke_cgemqr.c | 18 +- LAPACKE/src/lapacke_cgemqr_work.c | 18 +- LAPACKE/src/lapacke_cgemqrt.c | 18 +- LAPACKE/src/lapacke_cgemqrt_work.c | 20 +- LAPACKE/src/lapacke_cgeqlf.c | 12 +- LAPACKE/src/lapacke_cgeqlf_work.c | 12 +- LAPACKE/src/lapacke_cgeqp3.c | 12 +- LAPACKE/src/lapacke_cgeqp3_work.c | 12 +- LAPACKE/src/lapacke_cgeqpf.c | 10 +- LAPACKE/src/lapacke_cgeqpf_work.c | 12 +- LAPACKE/src/lapacke_cgeqr.c | 12 +- LAPACKE/src/lapacke_cgeqr2.c | 10 +- LAPACKE/src/lapacke_cgeqr2_work.c | 12 +- LAPACKE/src/lapacke_cgeqr_work.c | 12 +- LAPACKE/src/lapacke_cgeqrf.c | 12 +- LAPACKE/src/lapacke_cgeqrf_work.c | 12 +- LAPACKE/src/lapacke_cgeqrfp.c | 12 +- LAPACKE/src/lapacke_cgeqrfp_work.c | 12 +- LAPACKE/src/lapacke_cgeqrt.c | 10 +- LAPACKE/src/lapacke_cgeqrt2.c | 8 +- LAPACKE/src/lapacke_cgeqrt2_work.c | 16 +- LAPACKE/src/lapacke_cgeqrt3.c | 8 +- LAPACKE/src/lapacke_cgeqrt3_work.c | 16 +- LAPACKE/src/lapacke_cgeqrt_work.c | 16 +- LAPACKE/src/lapacke_cgerfs.c | 16 +- LAPACKE/src/lapacke_cgerfs_work.c | 24 +- LAPACKE/src/lapacke_cgerfsx.c | 26 +- LAPACKE/src/lapacke_cgerfsx_work.c | 28 +- LAPACKE/src/lapacke_cgerqf.c | 12 +- LAPACKE/src/lapacke_cgerqf_work.c | 12 +- LAPACKE/src/lapacke_cgesdd.c | 14 +- LAPACKE/src/lapacke_cgesdd_work.c | 62 ++-- LAPACKE/src/lapacke_cgesv.c | 10 +- LAPACKE/src/lapacke_cgesv_work.c | 18 +- LAPACKE/src/lapacke_cgesvd.c | 12 +- LAPACKE/src/lapacke_cgesvd_work.c | 48 +-- LAPACKE/src/lapacke_cgesvdq.c | 12 +- LAPACKE/src/lapacke_cgesvdq_work.c | 44 +-- LAPACKE/src/lapacke_cgesvdx.c | 12 +- LAPACKE/src/lapacke_cgesvdx_work.c | 44 +-- LAPACKE/src/lapacke_cgesvj.c | 18 +- LAPACKE/src/lapacke_cgesvj_work.c | 30 +- LAPACKE/src/lapacke_cgesvx.c | 28 +- LAPACKE/src/lapacke_cgesvx_work.c | 40 +-- LAPACKE/src/lapacke_cgesvxx.c | 30 +- LAPACKE/src/lapacke_cgesvxx_work.c | 44 +-- LAPACKE/src/lapacke_cgetf2.c | 8 +- LAPACKE/src/lapacke_cgetf2_work.c | 12 +- LAPACKE/src/lapacke_cgetrf.c | 8 +- LAPACKE/src/lapacke_cgetrf2.c | 8 +- LAPACKE/src/lapacke_cgetrf2_work.c | 12 +- LAPACKE/src/lapacke_cgetrf_work.c | 12 +- LAPACKE/src/lapacke_cgetri.c | 12 +- LAPACKE/src/lapacke_cgetri_work.c | 12 +- LAPACKE/src/lapacke_cgetrs.c | 10 +- LAPACKE/src/lapacke_cgetrs_work.c | 16 +- LAPACKE/src/lapacke_cgetsls.c | 14 +- LAPACKE/src/lapacke_cgetsls_work.c | 18 +- LAPACKE/src/lapacke_cgetsqrhrt.c | 12 +- LAPACKE/src/lapacke_cgetsqrhrt_work.c | 16 +- LAPACKE/src/lapacke_cggbak.c | 12 +- LAPACKE/src/lapacke_cggbak_work.c | 12 +- LAPACKE/src/lapacke_cggbal.c | 22 +- LAPACKE/src/lapacke_cggbal_work.c | 50 ++-- LAPACKE/src/lapacke_cgges.c | 18 +- LAPACKE/src/lapacke_cgges3.c | 18 +- LAPACKE/src/lapacke_cgges3_work.c | 38 +-- LAPACKE/src/lapacke_cgges_work.c | 42 +-- LAPACKE/src/lapacke_cggesx.c | 18 +- LAPACKE/src/lapacke_cggesx_work.c | 42 +-- LAPACKE/src/lapacke_cggev.c | 14 +- LAPACKE/src/lapacke_cggev3.c | 14 +- LAPACKE/src/lapacke_cggev3_work.c | 46 +-- LAPACKE/src/lapacke_cggev_work.c | 46 +-- LAPACKE/src/lapacke_cggevx.c | 32 +- LAPACKE/src/lapacke_cggevx_work.c | 38 +-- LAPACKE/src/lapacke_cggglm.c | 16 +- LAPACKE/src/lapacke_cggglm_work.c | 18 +- LAPACKE/src/lapacke_cgghd3.c | 22 +- LAPACKE/src/lapacke_cgghd3_work.c | 46 +-- LAPACKE/src/lapacke_cgghrd.c | 18 +- LAPACKE/src/lapacke_cgghrd_work.c | 46 +-- LAPACKE/src/lapacke_cgglse.c | 18 +- LAPACKE/src/lapacke_cgglse_work.c | 18 +- LAPACKE/src/lapacke_cggqrf.c | 14 +- LAPACKE/src/lapacke_cggqrf_work.c | 18 +- LAPACKE/src/lapacke_cggrqf.c | 14 +- LAPACKE/src/lapacke_cggrqf_work.c | 18 +- LAPACKE/src/lapacke_cggsvd.c | 12 +- LAPACKE/src/lapacke_cggsvd3.c | 14 +- LAPACKE/src/lapacke_cggsvd3_work.c | 48 +-- LAPACKE/src/lapacke_cggsvd_work.c | 48 +-- LAPACKE/src/lapacke_cggsvp.c | 16 +- LAPACKE/src/lapacke_cggsvp3.c | 18 +- LAPACKE/src/lapacke_cggsvp3_work.c | 48 +-- LAPACKE/src/lapacke_cggsvp_work.c | 48 +-- LAPACKE/src/lapacke_cgtcon.c | 16 +- LAPACKE/src/lapacke_cgtcon_work.c | 2 +- LAPACKE/src/lapacke_cgtrfs.c | 26 +- LAPACKE/src/lapacke_cgtrfs_work.c | 16 +- LAPACKE/src/lapacke_cgtsv.c | 14 +- LAPACKE/src/lapacke_cgtsv_work.c | 12 +- LAPACKE/src/lapacke_cgtsvx.c | 32 +- LAPACKE/src/lapacke_cgtsvx_work.c | 14 +- LAPACKE/src/lapacke_cgttrf.c | 10 +- LAPACKE/src/lapacke_cgttrf_work.c | 2 +- LAPACKE/src/lapacke_cgttrs.c | 16 +- LAPACKE/src/lapacke_cgttrs_work.c | 12 +- LAPACKE/src/lapacke_chbev.c | 10 +- LAPACKE/src/lapacke_chbev_2stage.c | 12 +- LAPACKE/src/lapacke_chbev_2stage_work.c | 22 +- LAPACKE/src/lapacke_chbev_work.c | 22 +- LAPACKE/src/lapacke_chbevd.c | 12 +- LAPACKE/src/lapacke_chbevd_2stage.c | 12 +- LAPACKE/src/lapacke_chbevd_2stage_work.c | 22 +- LAPACKE/src/lapacke_chbevd_work.c | 22 +- LAPACKE/src/lapacke_chbevx.c | 20 +- LAPACKE/src/lapacke_chbevx_2stage.c | 22 +- LAPACKE/src/lapacke_chbevx_2stage_work.c | 38 +-- LAPACKE/src/lapacke_chbevx_work.c | 38 +-- LAPACKE/src/lapacke_chbgst.c | 12 +- LAPACKE/src/lapacke_chbgst_work.c | 26 +- LAPACKE/src/lapacke_chbgv.c | 12 +- LAPACKE/src/lapacke_chbgv_work.c | 28 +- LAPACKE/src/lapacke_chbgvd.c | 14 +- LAPACKE/src/lapacke_chbgvd_work.c | 28 +- LAPACKE/src/lapacke_chbgvx.c | 22 +- LAPACKE/src/lapacke_chbgvx_work.c | 38 +-- LAPACKE/src/lapacke_chbtrd.c | 14 +- LAPACKE/src/lapacke_chbtrd_work.c | 26 +- LAPACKE/src/lapacke_checon.c | 12 +- LAPACKE/src/lapacke_checon_3.c | 16 +- LAPACKE/src/lapacke_checon_3_work.c | 10 +- LAPACKE/src/lapacke_checon_work.c | 10 +- LAPACKE/src/lapacke_cheequb.c | 10 +- LAPACKE/src/lapacke_cheequb_work.c | 10 +- LAPACKE/src/lapacke_cheev.c | 12 +- LAPACKE/src/lapacke_cheev_2stage.c | 12 +- LAPACKE/src/lapacke_cheev_2stage_work.c | 12 +- LAPACKE/src/lapacke_cheev_work.c | 14 +- LAPACKE/src/lapacke_cheevd.c | 12 +- LAPACKE/src/lapacke_cheevd_2stage.c | 12 +- LAPACKE/src/lapacke_cheevd_2stage_work.c | 14 +- LAPACKE/src/lapacke_cheevd_work.c | 14 +- LAPACKE/src/lapacke_cheevr.c | 22 +- LAPACKE/src/lapacke_cheevr_2stage.c | 22 +- LAPACKE/src/lapacke_cheevr_2stage_work.c | 28 +- LAPACKE/src/lapacke_cheevr_work.c | 30 +- LAPACKE/src/lapacke_cheevx.c | 22 +- LAPACKE/src/lapacke_cheevx_2stage.c | 22 +- LAPACKE/src/lapacke_cheevx_2stage_work.c | 28 +- LAPACKE/src/lapacke_cheevx_work.c | 30 +- LAPACKE/src/lapacke_chegst.c | 10 +- LAPACKE/src/lapacke_chegst_work.c | 16 +- LAPACKE/src/lapacke_chegv.c | 14 +- LAPACKE/src/lapacke_chegv_2stage.c | 14 +- LAPACKE/src/lapacke_chegv_2stage_work.c | 18 +- LAPACKE/src/lapacke_chegv_work.c | 18 +- LAPACKE/src/lapacke_chegvd.c | 14 +- LAPACKE/src/lapacke_chegvd_work.c | 18 +- LAPACKE/src/lapacke_chegvx.c | 24 +- LAPACKE/src/lapacke_chegvx_work.c | 34 +-- LAPACKE/src/lapacke_cherfs.c | 16 +- LAPACKE/src/lapacke_cherfs_work.c | 24 +- LAPACKE/src/lapacke_cherfsx.c | 22 +- LAPACKE/src/lapacke_cherfsx_work.c | 28 +- LAPACKE/src/lapacke_chesv.c | 14 +- LAPACKE/src/lapacke_chesv_aa.c | 14 +- LAPACKE/src/lapacke_chesv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_chesv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_chesv_aa_work.c | 18 +- LAPACKE/src/lapacke_chesv_rk.c | 14 +- LAPACKE/src/lapacke_chesv_rk_work.c | 18 +- LAPACKE/src/lapacke_chesv_work.c | 18 +- LAPACKE/src/lapacke_chesvx.c | 18 +- LAPACKE/src/lapacke_chesvx_work.c | 28 +- LAPACKE/src/lapacke_chesvxx.c | 22 +- LAPACKE/src/lapacke_chesvxx_work.c | 40 +-- LAPACKE/src/lapacke_cheswapr.c | 8 +- LAPACKE/src/lapacke_cheswapr_work.c | 10 +- LAPACKE/src/lapacke_chetrd.c | 12 +- LAPACKE/src/lapacke_chetrd_work.c | 12 +- LAPACKE/src/lapacke_chetrf.c | 12 +- LAPACKE/src/lapacke_chetrf_aa.c | 12 +- LAPACKE/src/lapacke_chetrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_chetrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_chetrf_aa_work.c | 12 +- LAPACKE/src/lapacke_chetrf_rk.c | 12 +- LAPACKE/src/lapacke_chetrf_rk_work.c | 12 +- LAPACKE/src/lapacke_chetrf_rook.c | 12 +- LAPACKE/src/lapacke_chetrf_rook_work.c | 12 +- LAPACKE/src/lapacke_chetrf_work.c | 12 +- LAPACKE/src/lapacke_chetri.c | 10 +- LAPACKE/src/lapacke_chetri2.c | 12 +- LAPACKE/src/lapacke_chetri2_work.c | 12 +- LAPACKE/src/lapacke_chetri2x.c | 10 +- LAPACKE/src/lapacke_chetri2x_work.c | 12 +- LAPACKE/src/lapacke_chetri_3.c | 16 +- LAPACKE/src/lapacke_chetri_3_work.c | 12 +- LAPACKE/src/lapacke_chetri_work.c | 12 +- LAPACKE/src/lapacke_chetrs.c | 10 +- LAPACKE/src/lapacke_chetrs2.c | 12 +- LAPACKE/src/lapacke_chetrs2_work.c | 16 +- LAPACKE/src/lapacke_chetrs_3.c | 12 +- LAPACKE/src/lapacke_chetrs_3_work.c | 16 +- LAPACKE/src/lapacke_chetrs_aa.c | 14 +- LAPACKE/src/lapacke_chetrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_chetrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_chetrs_aa_work.c | 16 +- LAPACKE/src/lapacke_chetrs_rook.c | 10 +- LAPACKE/src/lapacke_chetrs_rook_work.c | 16 +- LAPACKE/src/lapacke_chetrs_work.c | 16 +- LAPACKE/src/lapacke_chfrk.c | 18 +- LAPACKE/src/lapacke_chfrk_work.c | 18 +- LAPACKE/src/lapacke_chgeqz.c | 22 +- LAPACKE/src/lapacke_chgeqz_work.c | 46 +-- LAPACKE/src/lapacke_chpcon.c | 12 +- LAPACKE/src/lapacke_chpcon_work.c | 8 +- LAPACKE/src/lapacke_chpev.c | 10 +- LAPACKE/src/lapacke_chpev_work.c | 20 +- LAPACKE/src/lapacke_chpevd.c | 12 +- LAPACKE/src/lapacke_chpevd_work.c | 20 +- LAPACKE/src/lapacke_chpevx.c | 20 +- LAPACKE/src/lapacke_chpevx_work.c | 26 +- LAPACKE/src/lapacke_chpgst.c | 10 +- LAPACKE/src/lapacke_chpgst_work.c | 12 +- LAPACKE/src/lapacke_chpgv.c | 12 +- LAPACKE/src/lapacke_chpgv_work.c | 24 +- LAPACKE/src/lapacke_chpgvd.c | 14 +- LAPACKE/src/lapacke_chpgvd_work.c | 24 +- LAPACKE/src/lapacke_chpgvx.c | 22 +- LAPACKE/src/lapacke_chpgvx_work.c | 30 +- LAPACKE/src/lapacke_chprfs.c | 16 +- LAPACKE/src/lapacke_chprfs_work.c | 20 +- LAPACKE/src/lapacke_chpsv.c | 10 +- LAPACKE/src/lapacke_chpsv_work.c | 16 +- LAPACKE/src/lapacke_chpsvx.c | 16 +- LAPACKE/src/lapacke_chpsvx_work.c | 24 +- LAPACKE/src/lapacke_chptrd.c | 8 +- LAPACKE/src/lapacke_chptrd_work.c | 10 +- LAPACKE/src/lapacke_chptrf.c | 8 +- LAPACKE/src/lapacke_chptrf_work.c | 10 +- LAPACKE/src/lapacke_chptri.c | 10 +- LAPACKE/src/lapacke_chptri_work.c | 10 +- LAPACKE/src/lapacke_chptrs.c | 10 +- LAPACKE/src/lapacke_chptrs_work.c | 14 +- LAPACKE/src/lapacke_chsein.c | 20 +- LAPACKE/src/lapacke_chsein_work.c | 42 +-- LAPACKE/src/lapacke_chseqr.c | 16 +- LAPACKE/src/lapacke_chseqr_work.c | 26 +- LAPACKE/src/lapacke_clacgv.c | 6 +- LAPACKE/src/lapacke_clacgv_work.c | 2 +- LAPACKE/src/lapacke_clacn2.c | 8 +- LAPACKE/src/lapacke_clacn2_work.c | 2 +- LAPACKE/src/lapacke_clacp2.c | 8 +- LAPACKE/src/lapacke_clacp2_work.c | 14 +- LAPACKE/src/lapacke_clacpy.c | 8 +- LAPACKE/src/lapacke_clacpy_work.c | 14 +- LAPACKE/src/lapacke_clacrm.c | 12 +- LAPACKE/src/lapacke_clacrm_work.c | 18 +- LAPACKE/src/lapacke_clag2z.c | 8 +- LAPACKE/src/lapacke_clag2z_work.c | 14 +- LAPACKE/src/lapacke_clagge.c | 10 +- LAPACKE/src/lapacke_clagge_work.c | 10 +- LAPACKE/src/lapacke_claghe.c | 10 +- LAPACKE/src/lapacke_claghe_work.c | 10 +- LAPACKE/src/lapacke_clagsy.c | 10 +- LAPACKE/src/lapacke_clagsy_work.c | 10 +- LAPACKE/src/lapacke_clangb.c | 14 +- LAPACKE/src/lapacke_clangb_work.c | 14 +- LAPACKE/src/lapacke_clange.c | 14 +- LAPACKE/src/lapacke_clange_work.c | 14 +- LAPACKE/src/lapacke_clanhe.c | 18 +- LAPACKE/src/lapacke_clanhe_work.c | 10 +- LAPACKE/src/lapacke_clansy.c | 18 +- LAPACKE/src/lapacke_clansy_work.c | 10 +- LAPACKE/src/lapacke_clantr.c | 14 +- LAPACKE/src/lapacke_clantr_work.c | 16 +- LAPACKE/src/lapacke_clapmr.c | 8 +- LAPACKE/src/lapacke_clapmr_work.c | 12 +- LAPACKE/src/lapacke_clapmt.c | 8 +- LAPACKE/src/lapacke_clapmt_work.c | 12 +- LAPACKE/src/lapacke_clarcm.c | 12 +- LAPACKE/src/lapacke_clarcm_work.c | 18 +- LAPACKE/src/lapacke_clarfb.c | 26 +- LAPACKE/src/lapacke_clarfb_work.c | 28 +- LAPACKE/src/lapacke_clarfg.c | 8 +- LAPACKE/src/lapacke_clarfg_work.c | 2 +- LAPACKE/src/lapacke_clarft.c | 18 +- LAPACKE/src/lapacke_clarft_work.c | 22 +- LAPACKE/src/lapacke_clarfx.c | 14 +- LAPACKE/src/lapacke_clarfx_work.c | 12 +- LAPACKE/src/lapacke_clarnv.c | 4 +- LAPACKE/src/lapacke_clarnv_work.c | 2 +- LAPACKE/src/lapacke_clascl.c | 28 +- LAPACKE/src/lapacke_clascl_work.c | 18 +- LAPACKE/src/lapacke_claset.c | 10 +- LAPACKE/src/lapacke_claset_work.c | 12 +- LAPACKE/src/lapacke_classq.c | 10 +- LAPACKE/src/lapacke_classq_work.c | 2 +- LAPACKE/src/lapacke_claswp.c | 10 +- LAPACKE/src/lapacke_claswp_work.c | 12 +- LAPACKE/src/lapacke_clatms.c | 16 +- LAPACKE/src/lapacke_clatms_work.c | 12 +- LAPACKE/src/lapacke_clauum.c | 8 +- LAPACKE/src/lapacke_clauum_work.c | 12 +- LAPACKE/src/lapacke_cpbcon.c | 12 +- LAPACKE/src/lapacke_cpbcon_work.c | 10 +- LAPACKE/src/lapacke_cpbequ.c | 8 +- LAPACKE/src/lapacke_cpbequ_work.c | 10 +- LAPACKE/src/lapacke_cpbrfs.c | 16 +- LAPACKE/src/lapacke_cpbrfs_work.c | 24 +- LAPACKE/src/lapacke_cpbstf.c | 8 +- LAPACKE/src/lapacke_cpbstf_work.c | 12 +- LAPACKE/src/lapacke_cpbsv.c | 10 +- LAPACKE/src/lapacke_cpbsv_work.c | 18 +- LAPACKE/src/lapacke_cpbsvx.c | 20 +- LAPACKE/src/lapacke_cpbsvx_work.c | 34 +-- LAPACKE/src/lapacke_cpbtrf.c | 8 +- LAPACKE/src/lapacke_cpbtrf_work.c | 12 +- LAPACKE/src/lapacke_cpbtrs.c | 10 +- LAPACKE/src/lapacke_cpbtrs_work.c | 16 +- LAPACKE/src/lapacke_cpftrf.c | 8 +- LAPACKE/src/lapacke_cpftrf_work.c | 10 +- LAPACKE/src/lapacke_cpftri.c | 8 +- LAPACKE/src/lapacke_cpftri_work.c | 10 +- LAPACKE/src/lapacke_cpftrs.c | 10 +- LAPACKE/src/lapacke_cpftrs_work.c | 14 +- LAPACKE/src/lapacke_cpocon.c | 12 +- LAPACKE/src/lapacke_cpocon_work.c | 10 +- LAPACKE/src/lapacke_cpoequ.c | 8 +- LAPACKE/src/lapacke_cpoequ_work.c | 10 +- LAPACKE/src/lapacke_cpoequb.c | 8 +- LAPACKE/src/lapacke_cpoequb_work.c | 10 +- LAPACKE/src/lapacke_cporfs.c | 16 +- LAPACKE/src/lapacke_cporfs_work.c | 24 +- LAPACKE/src/lapacke_cporfsx.c | 22 +- LAPACKE/src/lapacke_cporfsx_work.c | 28 +- LAPACKE/src/lapacke_cposv.c | 10 +- LAPACKE/src/lapacke_cposv_work.c | 18 +- LAPACKE/src/lapacke_cposvx.c | 20 +- LAPACKE/src/lapacke_cposvx_work.c | 34 +-- LAPACKE/src/lapacke_cposvxx.c | 22 +- LAPACKE/src/lapacke_cposvxx_work.c | 38 +-- LAPACKE/src/lapacke_cpotrf.c | 8 +- LAPACKE/src/lapacke_cpotrf2.c | 8 +- LAPACKE/src/lapacke_cpotrf2_work.c | 12 +- LAPACKE/src/lapacke_cpotrf_work.c | 12 +- LAPACKE/src/lapacke_cpotri.c | 8 +- LAPACKE/src/lapacke_cpotri_work.c | 12 +- LAPACKE/src/lapacke_cpotrs.c | 10 +- LAPACKE/src/lapacke_cpotrs_work.c | 16 +- LAPACKE/src/lapacke_cppcon.c | 12 +- LAPACKE/src/lapacke_cppcon_work.c | 8 +- LAPACKE/src/lapacke_cppequ.c | 8 +- LAPACKE/src/lapacke_cppequ_work.c | 8 +- LAPACKE/src/lapacke_cpprfs.c | 16 +- LAPACKE/src/lapacke_cpprfs_work.c | 20 +- LAPACKE/src/lapacke_cppsv.c | 10 +- LAPACKE/src/lapacke_cppsv_work.c | 16 +- LAPACKE/src/lapacke_cppsvx.c | 20 +- LAPACKE/src/lapacke_cppsvx_work.c | 30 +- LAPACKE/src/lapacke_cpptrf.c | 8 +- LAPACKE/src/lapacke_cpptrf_work.c | 10 +- LAPACKE/src/lapacke_cpptri.c | 8 +- LAPACKE/src/lapacke_cpptri_work.c | 10 +- LAPACKE/src/lapacke_cpptrs.c | 10 +- LAPACKE/src/lapacke_cpptrs_work.c | 14 +- LAPACKE/src/lapacke_cpstrf.c | 12 +- LAPACKE/src/lapacke_cpstrf_work.c | 12 +- LAPACKE/src/lapacke_cptcon.c | 12 +- LAPACKE/src/lapacke_cptcon_work.c | 2 +- LAPACKE/src/lapacke_cpteqr.c | 18 +- LAPACKE/src/lapacke_cpteqr_work.c | 14 +- LAPACKE/src/lapacke_cptrfs.c | 20 +- LAPACKE/src/lapacke_cptrfs_work.c | 16 +- LAPACKE/src/lapacke_cptsv.c | 12 +- LAPACKE/src/lapacke_cptsv_work.c | 12 +- LAPACKE/src/lapacke_cptsvx.c | 22 +- LAPACKE/src/lapacke_cptsvx_work.c | 14 +- LAPACKE/src/lapacke_cpttrf.c | 8 +- LAPACKE/src/lapacke_cpttrf_work.c | 2 +- LAPACKE/src/lapacke_cpttrs.c | 12 +- LAPACKE/src/lapacke_cpttrs_work.c | 12 +- LAPACKE/src/lapacke_cspcon.c | 12 +- LAPACKE/src/lapacke_cspcon_work.c | 8 +- LAPACKE/src/lapacke_csprfs.c | 16 +- LAPACKE/src/lapacke_csprfs_work.c | 20 +- LAPACKE/src/lapacke_cspsv.c | 10 +- LAPACKE/src/lapacke_cspsv_work.c | 16 +- LAPACKE/src/lapacke_cspsvx.c | 16 +- LAPACKE/src/lapacke_cspsvx_work.c | 24 +- LAPACKE/src/lapacke_csptrf.c | 8 +- LAPACKE/src/lapacke_csptrf_work.c | 10 +- LAPACKE/src/lapacke_csptri.c | 10 +- LAPACKE/src/lapacke_csptri_work.c | 10 +- LAPACKE/src/lapacke_csptrs.c | 10 +- LAPACKE/src/lapacke_csptrs_work.c | 14 +- LAPACKE/src/lapacke_cstedc.c | 18 +- LAPACKE/src/lapacke_cstedc_work.c | 20 +- LAPACKE/src/lapacke_cstegr.c | 24 +- LAPACKE/src/lapacke_cstegr_work.c | 18 +- LAPACKE/src/lapacke_cstein.c | 14 +- LAPACKE/src/lapacke_cstein_work.c | 10 +- LAPACKE/src/lapacke_cstemr.c | 18 +- LAPACKE/src/lapacke_cstemr_work.c | 18 +- LAPACKE/src/lapacke_csteqr.c | 18 +- LAPACKE/src/lapacke_csteqr_work.c | 20 +- LAPACKE/src/lapacke_csycon.c | 12 +- LAPACKE/src/lapacke_csycon_3.c | 16 +- LAPACKE/src/lapacke_csycon_3_work.c | 10 +- LAPACKE/src/lapacke_csycon_work.c | 10 +- LAPACKE/src/lapacke_csyconv.c | 8 +- LAPACKE/src/lapacke_csyconv_work.c | 12 +- LAPACKE/src/lapacke_csyequb.c | 10 +- LAPACKE/src/lapacke_csyequb_work.c | 10 +- LAPACKE/src/lapacke_csyr.c | 12 +- LAPACKE/src/lapacke_csyr_work.c | 12 +- LAPACKE/src/lapacke_csyrfs.c | 16 +- LAPACKE/src/lapacke_csyrfs_work.c | 24 +- LAPACKE/src/lapacke_csyrfsx.c | 22 +- LAPACKE/src/lapacke_csyrfsx_work.c | 28 +- LAPACKE/src/lapacke_csysv.c | 14 +- LAPACKE/src/lapacke_csysv_aa.c | 14 +- LAPACKE/src/lapacke_csysv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_csysv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_csysv_aa_work.c | 18 +- LAPACKE/src/lapacke_csysv_rk.c | 14 +- LAPACKE/src/lapacke_csysv_rk_work.c | 18 +- LAPACKE/src/lapacke_csysv_rook.c | 14 +- LAPACKE/src/lapacke_csysv_rook_work.c | 18 +- LAPACKE/src/lapacke_csysv_work.c | 18 +- LAPACKE/src/lapacke_csysvx.c | 18 +- LAPACKE/src/lapacke_csysvx_work.c | 28 +- LAPACKE/src/lapacke_csysvxx.c | 22 +- LAPACKE/src/lapacke_csysvxx_work.c | 40 +-- LAPACKE/src/lapacke_csyswapr.c | 8 +- LAPACKE/src/lapacke_csyswapr_work.c | 10 +- LAPACKE/src/lapacke_csytrf.c | 12 +- LAPACKE/src/lapacke_csytrf_aa.c | 12 +- LAPACKE/src/lapacke_csytrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_csytrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_csytrf_aa_work.c | 12 +- LAPACKE/src/lapacke_csytrf_rk.c | 12 +- LAPACKE/src/lapacke_csytrf_rk_work.c | 12 +- LAPACKE/src/lapacke_csytrf_rook.c | 12 +- LAPACKE/src/lapacke_csytrf_rook_work.c | 12 +- LAPACKE/src/lapacke_csytrf_work.c | 12 +- LAPACKE/src/lapacke_csytri.c | 10 +- LAPACKE/src/lapacke_csytri2.c | 12 +- LAPACKE/src/lapacke_csytri2_work.c | 12 +- LAPACKE/src/lapacke_csytri2x.c | 10 +- LAPACKE/src/lapacke_csytri2x_work.c | 12 +- LAPACKE/src/lapacke_csytri_3.c | 16 +- LAPACKE/src/lapacke_csytri_3_work.c | 12 +- LAPACKE/src/lapacke_csytri_work.c | 12 +- LAPACKE/src/lapacke_csytrs.c | 10 +- LAPACKE/src/lapacke_csytrs2.c | 12 +- LAPACKE/src/lapacke_csytrs2_work.c | 16 +- LAPACKE/src/lapacke_csytrs_3.c | 12 +- LAPACKE/src/lapacke_csytrs_3_work.c | 16 +- LAPACKE/src/lapacke_csytrs_aa.c | 14 +- LAPACKE/src/lapacke_csytrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_csytrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_csytrs_aa_work.c | 16 +- LAPACKE/src/lapacke_csytrs_rook.c | 10 +- LAPACKE/src/lapacke_csytrs_rook_work.c | 16 +- LAPACKE/src/lapacke_csytrs_work.c | 16 +- LAPACKE/src/lapacke_ctbcon.c | 10 +- LAPACKE/src/lapacke_ctbcon_work.c | 10 +- LAPACKE/src/lapacke_ctbrfs.c | 14 +- LAPACKE/src/lapacke_ctbrfs_work.c | 18 +- LAPACKE/src/lapacke_ctbtrs.c | 10 +- LAPACKE/src/lapacke_ctbtrs_work.c | 16 +- LAPACKE/src/lapacke_ctfsm.c | 12 +- LAPACKE/src/lapacke_ctfsm_work.c | 14 +- LAPACKE/src/lapacke_ctftri.c | 8 +- LAPACKE/src/lapacke_ctftri_work.c | 10 +- LAPACKE/src/lapacke_ctfttp.c | 8 +- LAPACKE/src/lapacke_ctfttp_work.c | 10 +- LAPACKE/src/lapacke_ctfttr.c | 8 +- LAPACKE/src/lapacke_ctfttr_work.c | 12 +- LAPACKE/src/lapacke_ctgevc.c | 20 +- LAPACKE/src/lapacke_ctgevc_work.c | 46 +-- LAPACKE/src/lapacke_ctgexc.c | 14 +- LAPACKE/src/lapacke_ctgexc_work.c | 30 +- LAPACKE/src/lapacke_ctgsen.c | 18 +- LAPACKE/src/lapacke_ctgsen_work.c | 30 +- LAPACKE/src/lapacke_ctgsja.c | 28 +- LAPACKE/src/lapacke_ctgsja_work.c | 60 ++-- LAPACKE/src/lapacke_ctgsna.c | 30 +- LAPACKE/src/lapacke_ctgsna_work.c | 34 +-- LAPACKE/src/lapacke_ctgsyl.c | 22 +- LAPACKE/src/lapacke_ctgsyl_work.c | 34 +-- LAPACKE/src/lapacke_ctpcon.c | 10 +- LAPACKE/src/lapacke_ctpcon_work.c | 8 +- LAPACKE/src/lapacke_ctpmqrt.c | 32 +- LAPACKE/src/lapacke_ctpmqrt_work.c | 32 +- LAPACKE/src/lapacke_ctpqrt.c | 12 +- LAPACKE/src/lapacke_ctpqrt2.c | 10 +- LAPACKE/src/lapacke_ctpqrt2_work.c | 22 +- LAPACKE/src/lapacke_ctpqrt_work.c | 22 +- LAPACKE/src/lapacke_ctprfb.c | 36 +-- LAPACKE/src/lapacke_ctprfb_work.c | 26 +- LAPACKE/src/lapacke_ctprfs.c | 14 +- LAPACKE/src/lapacke_ctprfs_work.c | 16 +- LAPACKE/src/lapacke_ctptri.c | 8 +- LAPACKE/src/lapacke_ctptri_work.c | 10 +- LAPACKE/src/lapacke_ctptrs.c | 10 +- LAPACKE/src/lapacke_ctptrs_work.c | 14 +- LAPACKE/src/lapacke_ctpttf.c | 8 +- LAPACKE/src/lapacke_ctpttf_work.c | 10 +- LAPACKE/src/lapacke_ctpttr.c | 8 +- LAPACKE/src/lapacke_ctpttr_work.c | 12 +- LAPACKE/src/lapacke_ctrcon.c | 10 +- LAPACKE/src/lapacke_ctrcon_work.c | 10 +- LAPACKE/src/lapacke_ctrevc.c | 18 +- LAPACKE/src/lapacke_ctrevc_work.c | 44 +-- LAPACKE/src/lapacke_ctrexc.c | 12 +- LAPACKE/src/lapacke_ctrexc_work.c | 28 +- LAPACKE/src/lapacke_ctrrfs.c | 14 +- LAPACKE/src/lapacke_ctrrfs_work.c | 18 +- LAPACKE/src/lapacke_ctrsen.c | 16 +- LAPACKE/src/lapacke_ctrsen_work.c | 26 +- LAPACKE/src/lapacke_ctrsna.c | 28 +- LAPACKE/src/lapacke_ctrsna_work.c | 30 +- LAPACKE/src/lapacke_ctrsyl.c | 12 +- LAPACKE/src/lapacke_ctrsyl3.c | 16 +- LAPACKE/src/lapacke_ctrsyl3_work.c | 20 +- LAPACKE/src/lapacke_ctrsyl_work.c | 20 +- LAPACKE/src/lapacke_ctrtri.c | 8 +- LAPACKE/src/lapacke_ctrtri_work.c | 12 +- LAPACKE/src/lapacke_ctrtrs.c | 10 +- LAPACKE/src/lapacke_ctrtrs_work.c | 16 +- LAPACKE/src/lapacke_ctrttf.c | 8 +- LAPACKE/src/lapacke_ctrttf_work.c | 12 +- LAPACKE/src/lapacke_ctrttp.c | 8 +- LAPACKE/src/lapacke_ctrttp_work.c | 12 +- LAPACKE/src/lapacke_ctzrzf.c | 12 +- LAPACKE/src/lapacke_ctzrzf_work.c | 12 +- LAPACKE/src/lapacke_cunbdb.c | 20 +- LAPACKE/src/lapacke_cunbdb_work.c | 6 +- LAPACKE/src/lapacke_cuncsd.c | 20 +- LAPACKE/src/lapacke_cuncsd2by1.c | 14 +- LAPACKE/src/lapacke_cuncsd2by1_work.c | 54 ++-- LAPACKE/src/lapacke_cuncsd_work.c | 6 +- LAPACKE/src/lapacke_cungbr.c | 14 +- LAPACKE/src/lapacke_cungbr_work.c | 12 +- LAPACKE/src/lapacke_cunghr.c | 14 +- LAPACKE/src/lapacke_cunghr_work.c | 12 +- LAPACKE/src/lapacke_cunglq.c | 14 +- LAPACKE/src/lapacke_cunglq_work.c | 12 +- LAPACKE/src/lapacke_cungql.c | 14 +- LAPACKE/src/lapacke_cungql_work.c | 12 +- LAPACKE/src/lapacke_cungqr.c | 14 +- LAPACKE/src/lapacke_cungqr_work.c | 12 +- LAPACKE/src/lapacke_cungrq.c | 14 +- LAPACKE/src/lapacke_cungrq_work.c | 12 +- LAPACKE/src/lapacke_cungtr.c | 14 +- LAPACKE/src/lapacke_cungtr_work.c | 12 +- LAPACKE/src/lapacke_cungtsqr_row.c | 14 +- LAPACKE/src/lapacke_cungtsqr_row_work.c | 16 +- LAPACKE/src/lapacke_cunhr_col.c | 8 +- LAPACKE/src/lapacke_cunhr_col_work.c | 16 +- LAPACKE/src/lapacke_cunmbr.c | 20 +- LAPACKE/src/lapacke_cunmbr_work.c | 22 +- LAPACKE/src/lapacke_cunmhr.c | 18 +- LAPACKE/src/lapacke_cunmhr_work.c | 18 +- LAPACKE/src/lapacke_cunmlq.c | 16 +- LAPACKE/src/lapacke_cunmlq_work.c | 20 +- LAPACKE/src/lapacke_cunmql.c | 18 +- LAPACKE/src/lapacke_cunmql_work.c | 18 +- LAPACKE/src/lapacke_cunmqr.c | 18 +- LAPACKE/src/lapacke_cunmqr_work.c | 18 +- LAPACKE/src/lapacke_cunmrq.c | 16 +- LAPACKE/src/lapacke_cunmrq_work.c | 16 +- LAPACKE/src/lapacke_cunmrz.c | 16 +- LAPACKE/src/lapacke_cunmrz_work.c | 16 +- LAPACKE/src/lapacke_cunmtr.c | 18 +- LAPACKE/src/lapacke_cunmtr_work.c | 18 +- LAPACKE/src/lapacke_cupgtr.c | 12 +- LAPACKE/src/lapacke_cupgtr_work.c | 12 +- LAPACKE/src/lapacke_cupmtr.c | 20 +- LAPACKE/src/lapacke_cupmtr_work.c | 16 +- LAPACKE/src/lapacke_dbbcsd.c | 32 +- LAPACKE/src/lapacke_dbbcsd_work.c | 6 +- LAPACKE/src/lapacke_dbdsdc.c | 18 +- LAPACKE/src/lapacke_dbdsdc_work.c | 26 +- LAPACKE/src/lapacke_dbdsqr.c | 18 +- LAPACKE/src/lapacke_dbdsqr_work.c | 24 +- LAPACKE/src/lapacke_dbdsvdx.c | 12 +- LAPACKE/src/lapacke_dbdsvdx_work.c | 22 +- LAPACKE/src/lapacke_ddisna.c | 6 +- LAPACKE/src/lapacke_ddisna_work.c | 2 +- LAPACKE/src/lapacke_dgbbrd.c | 12 +- LAPACKE/src/lapacke_dgbbrd_work.c | 38 +-- LAPACKE/src/lapacke_dgbcon.c | 12 +- LAPACKE/src/lapacke_dgbcon_work.c | 10 +- LAPACKE/src/lapacke_dgbequ.c | 8 +- LAPACKE/src/lapacke_dgbequ_work.c | 10 +- LAPACKE/src/lapacke_dgbequb.c | 8 +- LAPACKE/src/lapacke_dgbequb_work.c | 10 +- LAPACKE/src/lapacke_dgbrfs.c | 16 +- LAPACKE/src/lapacke_dgbrfs_work.c | 24 +- LAPACKE/src/lapacke_dgbrfsx.c | 26 +- LAPACKE/src/lapacke_dgbrfsx_work.c | 28 +- LAPACKE/src/lapacke_dgbsv.c | 10 +- LAPACKE/src/lapacke_dgbsv_work.c | 18 +- LAPACKE/src/lapacke_dgbsvx.c | 28 +- LAPACKE/src/lapacke_dgbsvx_work.c | 40 +-- LAPACKE/src/lapacke_dgbsvxx.c | 30 +- LAPACKE/src/lapacke_dgbsvxx_work.c | 44 +-- LAPACKE/src/lapacke_dgbtrf.c | 8 +- LAPACKE/src/lapacke_dgbtrf_work.c | 12 +- LAPACKE/src/lapacke_dgbtrs.c | 10 +- LAPACKE/src/lapacke_dgbtrs_work.c | 16 +- LAPACKE/src/lapacke_dgebak.c | 10 +- LAPACKE/src/lapacke_dgebak_work.c | 12 +- LAPACKE/src/lapacke_dgebal.c | 12 +- LAPACKE/src/lapacke_dgebal_work.c | 28 +- LAPACKE/src/lapacke_dgebrd.c | 12 +- LAPACKE/src/lapacke_dgebrd_work.c | 12 +- LAPACKE/src/lapacke_dgecon.c | 12 +- LAPACKE/src/lapacke_dgecon_work.c | 10 +- LAPACKE/src/lapacke_dgedmd.c | 24 +- LAPACKE/src/lapacke_dgedmd_work.c | 42 +-- LAPACKE/src/lapacke_dgedmdq.c | 24 +- LAPACKE/src/lapacke_dgedmdq_work.c | 48 +-- LAPACKE/src/lapacke_dgeequ.c | 8 +- LAPACKE/src/lapacke_dgeequ_work.c | 10 +- LAPACKE/src/lapacke_dgeequb.c | 8 +- LAPACKE/src/lapacke_dgeequb_work.c | 10 +- LAPACKE/src/lapacke_dgees.c | 16 +- LAPACKE/src/lapacke_dgees_work.c | 22 +- LAPACKE/src/lapacke_dgeesx.c | 18 +- LAPACKE/src/lapacke_dgeesx_work.c | 22 +- LAPACKE/src/lapacke_dgeev.c | 12 +- LAPACKE/src/lapacke_dgeev_work.c | 36 +-- LAPACKE/src/lapacke_dgeevx.c | 16 +- LAPACKE/src/lapacke_dgeevx_work.c | 36 +-- LAPACKE/src/lapacke_dgehrd.c | 12 +- LAPACKE/src/lapacke_dgehrd_work.c | 12 +- LAPACKE/src/lapacke_dgejsv.c | 80 ++--- LAPACKE/src/lapacke_dgejsv_work.c | 50 ++-- LAPACKE/src/lapacke_dgelq.c | 12 +- LAPACKE/src/lapacke_dgelq2.c | 10 +- LAPACKE/src/lapacke_dgelq2_work.c | 12 +- LAPACKE/src/lapacke_dgelq_work.c | 12 +- LAPACKE/src/lapacke_dgelqf.c | 12 +- LAPACKE/src/lapacke_dgelqf_work.c | 12 +- LAPACKE/src/lapacke_dgels.c | 14 +- LAPACKE/src/lapacke_dgels_work.c | 18 +- LAPACKE/src/lapacke_dgelsd.c | 16 +- LAPACKE/src/lapacke_dgelsd_work.c | 18 +- LAPACKE/src/lapacke_dgelss.c | 16 +- LAPACKE/src/lapacke_dgelss_work.c | 18 +- LAPACKE/src/lapacke_dgelsy.c | 16 +- LAPACKE/src/lapacke_dgelsy_work.c | 18 +- LAPACKE/src/lapacke_dgemlq.c | 16 +- LAPACKE/src/lapacke_dgemlq_work.c | 20 +- LAPACKE/src/lapacke_dgemqr.c | 18 +- LAPACKE/src/lapacke_dgemqr_work.c | 18 +- LAPACKE/src/lapacke_dgemqrt.c | 18 +- LAPACKE/src/lapacke_dgemqrt_work.c | 20 +- LAPACKE/src/lapacke_dgeqlf.c | 12 +- LAPACKE/src/lapacke_dgeqlf_work.c | 12 +- LAPACKE/src/lapacke_dgeqp3.c | 12 +- LAPACKE/src/lapacke_dgeqp3_work.c | 12 +- LAPACKE/src/lapacke_dgeqpf.c | 10 +- LAPACKE/src/lapacke_dgeqpf_work.c | 12 +- LAPACKE/src/lapacke_dgeqr.c | 12 +- LAPACKE/src/lapacke_dgeqr2.c | 10 +- LAPACKE/src/lapacke_dgeqr2_work.c | 12 +- LAPACKE/src/lapacke_dgeqr_work.c | 12 +- LAPACKE/src/lapacke_dgeqrf.c | 12 +- LAPACKE/src/lapacke_dgeqrf_work.c | 12 +- LAPACKE/src/lapacke_dgeqrfp.c | 12 +- LAPACKE/src/lapacke_dgeqrfp_work.c | 12 +- LAPACKE/src/lapacke_dgeqrt.c | 10 +- LAPACKE/src/lapacke_dgeqrt2.c | 8 +- LAPACKE/src/lapacke_dgeqrt2_work.c | 16 +- LAPACKE/src/lapacke_dgeqrt3.c | 8 +- LAPACKE/src/lapacke_dgeqrt3_work.c | 16 +- LAPACKE/src/lapacke_dgeqrt_work.c | 16 +- LAPACKE/src/lapacke_dgerfs.c | 16 +- LAPACKE/src/lapacke_dgerfs_work.c | 24 +- LAPACKE/src/lapacke_dgerfsx.c | 26 +- LAPACKE/src/lapacke_dgerfsx_work.c | 28 +- LAPACKE/src/lapacke_dgerqf.c | 12 +- LAPACKE/src/lapacke_dgerqf_work.c | 12 +- LAPACKE/src/lapacke_dgesdd.c | 12 +- LAPACKE/src/lapacke_dgesdd_work.c | 62 ++-- LAPACKE/src/lapacke_dgesv.c | 10 +- LAPACKE/src/lapacke_dgesv_work.c | 18 +- LAPACKE/src/lapacke_dgesvd.c | 12 +- LAPACKE/src/lapacke_dgesvd_work.c | 48 +-- LAPACKE/src/lapacke_dgesvdq.c | 12 +- LAPACKE/src/lapacke_dgesvdq_work.c | 44 +-- LAPACKE/src/lapacke_dgesvdx.c | 12 +- LAPACKE/src/lapacke_dgesvdx_work.c | 44 +-- LAPACKE/src/lapacke_dgesvj.c | 18 +- LAPACKE/src/lapacke_dgesvj_work.c | 30 +- LAPACKE/src/lapacke_dgesvx.c | 28 +- LAPACKE/src/lapacke_dgesvx_work.c | 40 +-- LAPACKE/src/lapacke_dgesvxx.c | 30 +- LAPACKE/src/lapacke_dgesvxx_work.c | 44 +-- LAPACKE/src/lapacke_dgetf2.c | 8 +- LAPACKE/src/lapacke_dgetf2_work.c | 12 +- LAPACKE/src/lapacke_dgetrf.c | 8 +- LAPACKE/src/lapacke_dgetrf2.c | 8 +- LAPACKE/src/lapacke_dgetrf2_work.c | 12 +- LAPACKE/src/lapacke_dgetrf_work.c | 12 +- LAPACKE/src/lapacke_dgetri.c | 12 +- LAPACKE/src/lapacke_dgetri_work.c | 12 +- LAPACKE/src/lapacke_dgetrs.c | 10 +- LAPACKE/src/lapacke_dgetrs_work.c | 16 +- LAPACKE/src/lapacke_dgetsls.c | 14 +- LAPACKE/src/lapacke_dgetsls_work.c | 18 +- LAPACKE/src/lapacke_dgetsqrhrt.c | 12 +- LAPACKE/src/lapacke_dgetsqrhrt_work.c | 16 +- LAPACKE/src/lapacke_dggbak.c | 12 +- LAPACKE/src/lapacke_dggbak_work.c | 12 +- LAPACKE/src/lapacke_dggbal.c | 22 +- LAPACKE/src/lapacke_dggbal_work.c | 50 ++-- LAPACKE/src/lapacke_dgges.c | 18 +- LAPACKE/src/lapacke_dgges3.c | 18 +- LAPACKE/src/lapacke_dgges3_work.c | 38 +-- LAPACKE/src/lapacke_dgges_work.c | 42 +-- LAPACKE/src/lapacke_dggesx.c | 18 +- LAPACKE/src/lapacke_dggesx_work.c | 42 +-- LAPACKE/src/lapacke_dggev.c | 14 +- LAPACKE/src/lapacke_dggev3.c | 14 +- LAPACKE/src/lapacke_dggev3_work.c | 46 +-- LAPACKE/src/lapacke_dggev_work.c | 46 +-- LAPACKE/src/lapacke_dggevx.c | 30 +- LAPACKE/src/lapacke_dggevx_work.c | 38 +-- LAPACKE/src/lapacke_dggglm.c | 16 +- LAPACKE/src/lapacke_dggglm_work.c | 18 +- LAPACKE/src/lapacke_dgghd3.c | 22 +- LAPACKE/src/lapacke_dgghd3_work.c | 46 +-- LAPACKE/src/lapacke_dgghrd.c | 18 +- LAPACKE/src/lapacke_dgghrd_work.c | 46 +-- LAPACKE/src/lapacke_dgglse.c | 18 +- LAPACKE/src/lapacke_dgglse_work.c | 18 +- LAPACKE/src/lapacke_dggqrf.c | 14 +- LAPACKE/src/lapacke_dggqrf_work.c | 18 +- LAPACKE/src/lapacke_dggrqf.c | 14 +- LAPACKE/src/lapacke_dggrqf_work.c | 18 +- LAPACKE/src/lapacke_dggsvd.c | 12 +- LAPACKE/src/lapacke_dggsvd3.c | 14 +- LAPACKE/src/lapacke_dggsvd3_work.c | 48 +-- LAPACKE/src/lapacke_dggsvd_work.c | 48 +-- LAPACKE/src/lapacke_dggsvp.c | 16 +- LAPACKE/src/lapacke_dggsvp3.c | 18 +- LAPACKE/src/lapacke_dggsvp3_work.c | 48 +-- LAPACKE/src/lapacke_dggsvp_work.c | 48 +-- LAPACKE/src/lapacke_dgtcon.c | 16 +- LAPACKE/src/lapacke_dgtcon_work.c | 2 +- LAPACKE/src/lapacke_dgtrfs.c | 26 +- LAPACKE/src/lapacke_dgtrfs_work.c | 16 +- LAPACKE/src/lapacke_dgtsv.c | 14 +- LAPACKE/src/lapacke_dgtsv_work.c | 12 +- LAPACKE/src/lapacke_dgtsvx.c | 32 +- LAPACKE/src/lapacke_dgtsvx_work.c | 14 +- LAPACKE/src/lapacke_dgttrf.c | 10 +- LAPACKE/src/lapacke_dgttrf_work.c | 2 +- LAPACKE/src/lapacke_dgttrs.c | 16 +- LAPACKE/src/lapacke_dgttrs_work.c | 12 +- LAPACKE/src/lapacke_dhgeqz.c | 22 +- LAPACKE/src/lapacke_dhgeqz_work.c | 46 +-- LAPACKE/src/lapacke_dhsein.c | 22 +- LAPACKE/src/lapacke_dhsein_work.c | 42 +-- LAPACKE/src/lapacke_dhseqr.c | 16 +- LAPACKE/src/lapacke_dhseqr_work.c | 26 +- LAPACKE/src/lapacke_dlacn2.c | 8 +- LAPACKE/src/lapacke_dlacn2_work.c | 2 +- LAPACKE/src/lapacke_dlacpy.c | 8 +- LAPACKE/src/lapacke_dlacpy_work.c | 14 +- LAPACKE/src/lapacke_dlag2s.c | 8 +- LAPACKE/src/lapacke_dlag2s_work.c | 14 +- LAPACKE/src/lapacke_dlagge.c | 10 +- LAPACKE/src/lapacke_dlagge_work.c | 10 +- LAPACKE/src/lapacke_dlagsy.c | 10 +- LAPACKE/src/lapacke_dlagsy_work.c | 10 +- LAPACKE/src/lapacke_dlamch.c | 4 +- LAPACKE/src/lapacke_dlamch_work.c | 2 +- LAPACKE/src/lapacke_dlangb.c | 14 +- LAPACKE/src/lapacke_dlangb_work.c | 14 +- LAPACKE/src/lapacke_dlange.c | 14 +- LAPACKE/src/lapacke_dlange_work.c | 14 +- LAPACKE/src/lapacke_dlansy.c | 18 +- LAPACKE/src/lapacke_dlansy_work.c | 10 +- LAPACKE/src/lapacke_dlantr.c | 14 +- LAPACKE/src/lapacke_dlantr_work.c | 16 +- LAPACKE/src/lapacke_dlapmr.c | 8 +- LAPACKE/src/lapacke_dlapmr_work.c | 12 +- LAPACKE/src/lapacke_dlapmt.c | 8 +- LAPACKE/src/lapacke_dlapmt_work.c | 12 +- LAPACKE/src/lapacke_dlapy2.c | 8 +- LAPACKE/src/lapacke_dlapy2_work.c | 2 +- LAPACKE/src/lapacke_dlapy3.c | 10 +- LAPACKE/src/lapacke_dlapy3_work.c | 2 +- LAPACKE/src/lapacke_dlarfb.c | 26 +- LAPACKE/src/lapacke_dlarfb_work.c | 28 +- LAPACKE/src/lapacke_dlarfg.c | 8 +- LAPACKE/src/lapacke_dlarfg_work.c | 2 +- LAPACKE/src/lapacke_dlarft.c | 18 +- LAPACKE/src/lapacke_dlarft_work.c | 22 +- LAPACKE/src/lapacke_dlarfx.c | 14 +- LAPACKE/src/lapacke_dlarfx_work.c | 12 +- LAPACKE/src/lapacke_dlarnv.c | 4 +- LAPACKE/src/lapacke_dlarnv_work.c | 2 +- LAPACKE/src/lapacke_dlartgp.c | 8 +- LAPACKE/src/lapacke_dlartgp_work.c | 2 +- LAPACKE/src/lapacke_dlartgs.c | 10 +- LAPACKE/src/lapacke_dlartgs_work.c | 2 +- LAPACKE/src/lapacke_dlascl.c | 28 +- LAPACKE/src/lapacke_dlascl_work.c | 18 +- LAPACKE/src/lapacke_dlaset.c | 10 +- LAPACKE/src/lapacke_dlaset_work.c | 12 +- LAPACKE/src/lapacke_dlasrt.c | 6 +- LAPACKE/src/lapacke_dlasrt_work.c | 2 +- LAPACKE/src/lapacke_dlassq.c | 10 +- LAPACKE/src/lapacke_dlassq_work.c | 2 +- LAPACKE/src/lapacke_dlaswp.c | 10 +- LAPACKE/src/lapacke_dlaswp_work.c | 12 +- LAPACKE/src/lapacke_dlatms.c | 16 +- LAPACKE/src/lapacke_dlatms_work.c | 12 +- LAPACKE/src/lapacke_dlauum.c | 8 +- LAPACKE/src/lapacke_dlauum_work.c | 12 +- LAPACKE/src/lapacke_dopgtr.c | 12 +- LAPACKE/src/lapacke_dopgtr_work.c | 12 +- LAPACKE/src/lapacke_dopmtr.c | 20 +- LAPACKE/src/lapacke_dopmtr_work.c | 16 +- LAPACKE/src/lapacke_dorbdb.c | 20 +- LAPACKE/src/lapacke_dorbdb_work.c | 6 +- LAPACKE/src/lapacke_dorcsd.c | 20 +- LAPACKE/src/lapacke_dorcsd2by1.c | 14 +- LAPACKE/src/lapacke_dorcsd2by1_work.c | 54 ++-- LAPACKE/src/lapacke_dorcsd_work.c | 6 +- LAPACKE/src/lapacke_dorgbr.c | 14 +- LAPACKE/src/lapacke_dorgbr_work.c | 12 +- LAPACKE/src/lapacke_dorghr.c | 14 +- LAPACKE/src/lapacke_dorghr_work.c | 12 +- LAPACKE/src/lapacke_dorglq.c | 14 +- LAPACKE/src/lapacke_dorglq_work.c | 12 +- LAPACKE/src/lapacke_dorgql.c | 14 +- LAPACKE/src/lapacke_dorgql_work.c | 12 +- LAPACKE/src/lapacke_dorgqr.c | 14 +- LAPACKE/src/lapacke_dorgqr_work.c | 12 +- LAPACKE/src/lapacke_dorgrq.c | 14 +- LAPACKE/src/lapacke_dorgrq_work.c | 12 +- LAPACKE/src/lapacke_dorgtr.c | 14 +- LAPACKE/src/lapacke_dorgtr_work.c | 12 +- LAPACKE/src/lapacke_dorgtsqr_row.c | 14 +- LAPACKE/src/lapacke_dorgtsqr_row_work.c | 16 +- LAPACKE/src/lapacke_dorhr_col.c | 8 +- LAPACKE/src/lapacke_dorhr_col_work.c | 16 +- LAPACKE/src/lapacke_dormbr.c | 22 +- LAPACKE/src/lapacke_dormbr_work.c | 22 +- LAPACKE/src/lapacke_dormhr.c | 18 +- LAPACKE/src/lapacke_dormhr_work.c | 18 +- LAPACKE/src/lapacke_dormlq.c | 18 +- LAPACKE/src/lapacke_dormlq_work.c | 18 +- LAPACKE/src/lapacke_dormql.c | 18 +- LAPACKE/src/lapacke_dormql_work.c | 18 +- LAPACKE/src/lapacke_dormqr.c | 18 +- LAPACKE/src/lapacke_dormqr_work.c | 18 +- LAPACKE/src/lapacke_dormrq.c | 16 +- LAPACKE/src/lapacke_dormrq_work.c | 16 +- LAPACKE/src/lapacke_dormrz.c | 16 +- LAPACKE/src/lapacke_dormrz_work.c | 16 +- LAPACKE/src/lapacke_dormtr.c | 18 +- LAPACKE/src/lapacke_dormtr_work.c | 18 +- LAPACKE/src/lapacke_dpbcon.c | 12 +- LAPACKE/src/lapacke_dpbcon_work.c | 10 +- LAPACKE/src/lapacke_dpbequ.c | 8 +- LAPACKE/src/lapacke_dpbequ_work.c | 10 +- LAPACKE/src/lapacke_dpbrfs.c | 16 +- LAPACKE/src/lapacke_dpbrfs_work.c | 24 +- LAPACKE/src/lapacke_dpbstf.c | 8 +- LAPACKE/src/lapacke_dpbstf_work.c | 12 +- LAPACKE/src/lapacke_dpbsv.c | 10 +- LAPACKE/src/lapacke_dpbsv_work.c | 18 +- LAPACKE/src/lapacke_dpbsvx.c | 20 +- LAPACKE/src/lapacke_dpbsvx_work.c | 34 +-- LAPACKE/src/lapacke_dpbtrf.c | 8 +- LAPACKE/src/lapacke_dpbtrf_work.c | 12 +- LAPACKE/src/lapacke_dpbtrs.c | 10 +- LAPACKE/src/lapacke_dpbtrs_work.c | 16 +- LAPACKE/src/lapacke_dpftrf.c | 8 +- LAPACKE/src/lapacke_dpftrf_work.c | 10 +- LAPACKE/src/lapacke_dpftri.c | 8 +- LAPACKE/src/lapacke_dpftri_work.c | 10 +- LAPACKE/src/lapacke_dpftrs.c | 10 +- LAPACKE/src/lapacke_dpftrs_work.c | 14 +- LAPACKE/src/lapacke_dpocon.c | 12 +- LAPACKE/src/lapacke_dpocon_work.c | 10 +- LAPACKE/src/lapacke_dpoequ.c | 8 +- LAPACKE/src/lapacke_dpoequ_work.c | 10 +- LAPACKE/src/lapacke_dpoequb.c | 8 +- LAPACKE/src/lapacke_dpoequb_work.c | 10 +- LAPACKE/src/lapacke_dporfs.c | 16 +- LAPACKE/src/lapacke_dporfs_work.c | 24 +- LAPACKE/src/lapacke_dporfsx.c | 22 +- LAPACKE/src/lapacke_dporfsx_work.c | 28 +- LAPACKE/src/lapacke_dposv.c | 10 +- LAPACKE/src/lapacke_dposv_work.c | 18 +- LAPACKE/src/lapacke_dposvx.c | 20 +- LAPACKE/src/lapacke_dposvx_work.c | 34 +-- LAPACKE/src/lapacke_dposvxx.c | 22 +- LAPACKE/src/lapacke_dposvxx_work.c | 38 +-- LAPACKE/src/lapacke_dpotrf.c | 8 +- LAPACKE/src/lapacke_dpotrf2.c | 8 +- LAPACKE/src/lapacke_dpotrf2_work.c | 12 +- LAPACKE/src/lapacke_dpotrf_work.c | 12 +- LAPACKE/src/lapacke_dpotri.c | 8 +- LAPACKE/src/lapacke_dpotri_work.c | 12 +- LAPACKE/src/lapacke_dpotrs.c | 10 +- LAPACKE/src/lapacke_dpotrs_work.c | 16 +- LAPACKE/src/lapacke_dppcon.c | 12 +- LAPACKE/src/lapacke_dppcon_work.c | 8 +- LAPACKE/src/lapacke_dppequ.c | 8 +- LAPACKE/src/lapacke_dppequ_work.c | 8 +- LAPACKE/src/lapacke_dpprfs.c | 16 +- LAPACKE/src/lapacke_dpprfs_work.c | 20 +- LAPACKE/src/lapacke_dppsv.c | 10 +- LAPACKE/src/lapacke_dppsv_work.c | 16 +- LAPACKE/src/lapacke_dppsvx.c | 20 +- LAPACKE/src/lapacke_dppsvx_work.c | 30 +- LAPACKE/src/lapacke_dpptrf.c | 8 +- LAPACKE/src/lapacke_dpptrf_work.c | 10 +- LAPACKE/src/lapacke_dpptri.c | 8 +- LAPACKE/src/lapacke_dpptri_work.c | 10 +- LAPACKE/src/lapacke_dpptrs.c | 10 +- LAPACKE/src/lapacke_dpptrs_work.c | 14 +- LAPACKE/src/lapacke_dpstrf.c | 12 +- LAPACKE/src/lapacke_dpstrf_work.c | 12 +- LAPACKE/src/lapacke_dptcon.c | 12 +- LAPACKE/src/lapacke_dptcon_work.c | 2 +- LAPACKE/src/lapacke_dpteqr.c | 18 +- LAPACKE/src/lapacke_dpteqr_work.c | 14 +- LAPACKE/src/lapacke_dptrfs.c | 20 +- LAPACKE/src/lapacke_dptrfs_work.c | 16 +- LAPACKE/src/lapacke_dptsv.c | 12 +- LAPACKE/src/lapacke_dptsv_work.c | 12 +- LAPACKE/src/lapacke_dptsvx.c | 22 +- LAPACKE/src/lapacke_dptsvx_work.c | 14 +- LAPACKE/src/lapacke_dpttrf.c | 8 +- LAPACKE/src/lapacke_dpttrf_work.c | 2 +- LAPACKE/src/lapacke_dpttrs.c | 12 +- LAPACKE/src/lapacke_dpttrs_work.c | 12 +- LAPACKE/src/lapacke_dsbev.c | 10 +- LAPACKE/src/lapacke_dsbev_2stage.c | 12 +- LAPACKE/src/lapacke_dsbev_2stage_work.c | 22 +- LAPACKE/src/lapacke_dsbev_work.c | 22 +- LAPACKE/src/lapacke_dsbevd.c | 12 +- LAPACKE/src/lapacke_dsbevd_2stage.c | 12 +- LAPACKE/src/lapacke_dsbevd_2stage_work.c | 22 +- LAPACKE/src/lapacke_dsbevd_work.c | 22 +- LAPACKE/src/lapacke_dsbevx.c | 20 +- LAPACKE/src/lapacke_dsbevx_2stage.c | 22 +- LAPACKE/src/lapacke_dsbevx_2stage_work.c | 38 +-- LAPACKE/src/lapacke_dsbevx_work.c | 38 +-- LAPACKE/src/lapacke_dsbgst.c | 12 +- LAPACKE/src/lapacke_dsbgst_work.c | 26 +- LAPACKE/src/lapacke_dsbgv.c | 12 +- LAPACKE/src/lapacke_dsbgv_work.c | 28 +- LAPACKE/src/lapacke_dsbgvd.c | 14 +- LAPACKE/src/lapacke_dsbgvd_work.c | 28 +- LAPACKE/src/lapacke_dsbgvx.c | 22 +- LAPACKE/src/lapacke_dsbgvx_work.c | 38 +-- LAPACKE/src/lapacke_dsbtrd.c | 14 +- LAPACKE/src/lapacke_dsbtrd_work.c | 26 +- LAPACKE/src/lapacke_dsfrk.c | 18 +- LAPACKE/src/lapacke_dsfrk_work.c | 18 +- LAPACKE/src/lapacke_dsgesv.c | 12 +- LAPACKE/src/lapacke_dsgesv_work.c | 22 +- LAPACKE/src/lapacke_dspcon.c | 12 +- LAPACKE/src/lapacke_dspcon_work.c | 8 +- LAPACKE/src/lapacke_dspev.c | 10 +- LAPACKE/src/lapacke_dspev_work.c | 20 +- LAPACKE/src/lapacke_dspevd.c | 12 +- LAPACKE/src/lapacke_dspevd_work.c | 20 +- LAPACKE/src/lapacke_dspevx.c | 20 +- LAPACKE/src/lapacke_dspevx_work.c | 26 +- LAPACKE/src/lapacke_dspgst.c | 10 +- LAPACKE/src/lapacke_dspgst_work.c | 12 +- LAPACKE/src/lapacke_dspgv.c | 12 +- LAPACKE/src/lapacke_dspgv_work.c | 24 +- LAPACKE/src/lapacke_dspgvd.c | 14 +- LAPACKE/src/lapacke_dspgvd_work.c | 24 +- LAPACKE/src/lapacke_dspgvx.c | 22 +- LAPACKE/src/lapacke_dspgvx_work.c | 30 +- LAPACKE/src/lapacke_dsposv.c | 12 +- LAPACKE/src/lapacke_dsposv_work.c | 22 +- LAPACKE/src/lapacke_dsprfs.c | 16 +- LAPACKE/src/lapacke_dsprfs_work.c | 20 +- LAPACKE/src/lapacke_dspsv.c | 10 +- LAPACKE/src/lapacke_dspsv_work.c | 16 +- LAPACKE/src/lapacke_dspsvx.c | 16 +- LAPACKE/src/lapacke_dspsvx_work.c | 24 +- LAPACKE/src/lapacke_dsptrd.c | 8 +- LAPACKE/src/lapacke_dsptrd_work.c | 10 +- LAPACKE/src/lapacke_dsptrf.c | 8 +- LAPACKE/src/lapacke_dsptrf_work.c | 10 +- LAPACKE/src/lapacke_dsptri.c | 10 +- LAPACKE/src/lapacke_dsptri_work.c | 10 +- LAPACKE/src/lapacke_dsptrs.c | 10 +- LAPACKE/src/lapacke_dsptrs_work.c | 14 +- LAPACKE/src/lapacke_dstebz.c | 20 +- LAPACKE/src/lapacke_dstebz_work.c | 2 +- LAPACKE/src/lapacke_dstedc.c | 18 +- LAPACKE/src/lapacke_dstedc_work.c | 20 +- LAPACKE/src/lapacke_dstegr.c | 24 +- LAPACKE/src/lapacke_dstegr_work.c | 18 +- LAPACKE/src/lapacke_dstein.c | 14 +- LAPACKE/src/lapacke_dstein_work.c | 10 +- LAPACKE/src/lapacke_dstemr.c | 18 +- LAPACKE/src/lapacke_dstemr_work.c | 18 +- LAPACKE/src/lapacke_dsteqr.c | 18 +- LAPACKE/src/lapacke_dsteqr_work.c | 20 +- LAPACKE/src/lapacke_dsterf.c | 8 +- LAPACKE/src/lapacke_dsterf_work.c | 2 +- LAPACKE/src/lapacke_dstev.c | 16 +- LAPACKE/src/lapacke_dstev_work.c | 16 +- LAPACKE/src/lapacke_dstevd.c | 14 +- LAPACKE/src/lapacke_dstevd_work.c | 16 +- LAPACKE/src/lapacke_dstevr.c | 24 +- LAPACKE/src/lapacke_dstevr_work.c | 22 +- LAPACKE/src/lapacke_dstevx.c | 22 +- LAPACKE/src/lapacke_dstevx_work.c | 22 +- LAPACKE/src/lapacke_dsycon.c | 12 +- LAPACKE/src/lapacke_dsycon_3.c | 16 +- LAPACKE/src/lapacke_dsycon_3_work.c | 10 +- LAPACKE/src/lapacke_dsycon_work.c | 10 +- LAPACKE/src/lapacke_dsyconv.c | 8 +- LAPACKE/src/lapacke_dsyconv_work.c | 12 +- LAPACKE/src/lapacke_dsyequb.c | 10 +- LAPACKE/src/lapacke_dsyequb_work.c | 10 +- LAPACKE/src/lapacke_dsyev.c | 12 +- LAPACKE/src/lapacke_dsyev_2stage.c | 12 +- LAPACKE/src/lapacke_dsyev_2stage_work.c | 12 +- LAPACKE/src/lapacke_dsyev_work.c | 14 +- LAPACKE/src/lapacke_dsyevd.c | 12 +- LAPACKE/src/lapacke_dsyevd_2stage.c | 12 +- LAPACKE/src/lapacke_dsyevd_2stage_work.c | 14 +- LAPACKE/src/lapacke_dsyevd_work.c | 14 +- LAPACKE/src/lapacke_dsyevr.c | 22 +- LAPACKE/src/lapacke_dsyevr_2stage.c | 22 +- LAPACKE/src/lapacke_dsyevr_2stage_work.c | 28 +- LAPACKE/src/lapacke_dsyevr_work.c | 30 +- LAPACKE/src/lapacke_dsyevx.c | 22 +- LAPACKE/src/lapacke_dsyevx_2stage.c | 22 +- LAPACKE/src/lapacke_dsyevx_2stage_work.c | 28 +- LAPACKE/src/lapacke_dsyevx_work.c | 30 +- LAPACKE/src/lapacke_dsygst.c | 10 +- LAPACKE/src/lapacke_dsygst_work.c | 16 +- LAPACKE/src/lapacke_dsygv.c | 14 +- LAPACKE/src/lapacke_dsygv_2stage.c | 14 +- LAPACKE/src/lapacke_dsygv_2stage_work.c | 18 +- LAPACKE/src/lapacke_dsygv_work.c | 18 +- LAPACKE/src/lapacke_dsygvd.c | 14 +- LAPACKE/src/lapacke_dsygvd_work.c | 18 +- LAPACKE/src/lapacke_dsygvx.c | 24 +- LAPACKE/src/lapacke_dsygvx_work.c | 34 +-- LAPACKE/src/lapacke_dsyrfs.c | 16 +- LAPACKE/src/lapacke_dsyrfs_work.c | 24 +- LAPACKE/src/lapacke_dsyrfsx.c | 22 +- LAPACKE/src/lapacke_dsyrfsx_work.c | 28 +- LAPACKE/src/lapacke_dsysv.c | 14 +- LAPACKE/src/lapacke_dsysv_aa.c | 14 +- LAPACKE/src/lapacke_dsysv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_dsysv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_dsysv_aa_work.c | 18 +- LAPACKE/src/lapacke_dsysv_rk.c | 14 +- LAPACKE/src/lapacke_dsysv_rk_work.c | 18 +- LAPACKE/src/lapacke_dsysv_rook.c | 14 +- LAPACKE/src/lapacke_dsysv_rook_work.c | 18 +- LAPACKE/src/lapacke_dsysv_work.c | 18 +- LAPACKE/src/lapacke_dsysvx.c | 18 +- LAPACKE/src/lapacke_dsysvx_work.c | 28 +- LAPACKE/src/lapacke_dsysvxx.c | 22 +- LAPACKE/src/lapacke_dsysvxx_work.c | 40 +-- LAPACKE/src/lapacke_dsyswapr.c | 8 +- LAPACKE/src/lapacke_dsyswapr_work.c | 10 +- LAPACKE/src/lapacke_dsytrd.c | 12 +- LAPACKE/src/lapacke_dsytrd_work.c | 12 +- LAPACKE/src/lapacke_dsytrf.c | 12 +- LAPACKE/src/lapacke_dsytrf_aa.c | 12 +- LAPACKE/src/lapacke_dsytrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_dsytrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_dsytrf_aa_work.c | 12 +- LAPACKE/src/lapacke_dsytrf_rk.c | 12 +- LAPACKE/src/lapacke_dsytrf_rk_work.c | 12 +- LAPACKE/src/lapacke_dsytrf_rook.c | 12 +- LAPACKE/src/lapacke_dsytrf_rook_work.c | 12 +- LAPACKE/src/lapacke_dsytrf_work.c | 12 +- LAPACKE/src/lapacke_dsytri.c | 10 +- LAPACKE/src/lapacke_dsytri2.c | 12 +- LAPACKE/src/lapacke_dsytri2_work.c | 12 +- LAPACKE/src/lapacke_dsytri2x.c | 10 +- LAPACKE/src/lapacke_dsytri2x_work.c | 12 +- LAPACKE/src/lapacke_dsytri_3.c | 16 +- LAPACKE/src/lapacke_dsytri_3_work.c | 12 +- LAPACKE/src/lapacke_dsytri_work.c | 12 +- LAPACKE/src/lapacke_dsytrs.c | 10 +- LAPACKE/src/lapacke_dsytrs2.c | 12 +- LAPACKE/src/lapacke_dsytrs2_work.c | 16 +- LAPACKE/src/lapacke_dsytrs_3.c | 12 +- LAPACKE/src/lapacke_dsytrs_3_work.c | 16 +- LAPACKE/src/lapacke_dsytrs_aa.c | 14 +- LAPACKE/src/lapacke_dsytrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_dsytrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_dsytrs_aa_work.c | 16 +- LAPACKE/src/lapacke_dsytrs_rook.c | 10 +- LAPACKE/src/lapacke_dsytrs_rook_work.c | 16 +- LAPACKE/src/lapacke_dsytrs_work.c | 16 +- LAPACKE/src/lapacke_dtbcon.c | 10 +- LAPACKE/src/lapacke_dtbcon_work.c | 10 +- LAPACKE/src/lapacke_dtbrfs.c | 14 +- LAPACKE/src/lapacke_dtbrfs_work.c | 18 +- LAPACKE/src/lapacke_dtbtrs.c | 10 +- LAPACKE/src/lapacke_dtbtrs_work.c | 16 +- LAPACKE/src/lapacke_dtfsm.c | 12 +- LAPACKE/src/lapacke_dtfsm_work.c | 14 +- LAPACKE/src/lapacke_dtftri.c | 8 +- LAPACKE/src/lapacke_dtftri_work.c | 10 +- LAPACKE/src/lapacke_dtfttp.c | 8 +- LAPACKE/src/lapacke_dtfttp_work.c | 10 +- LAPACKE/src/lapacke_dtfttr.c | 8 +- LAPACKE/src/lapacke_dtfttr_work.c | 12 +- LAPACKE/src/lapacke_dtgevc.c | 20 +- LAPACKE/src/lapacke_dtgevc_work.c | 46 +-- LAPACKE/src/lapacke_dtgexc.c | 18 +- LAPACKE/src/lapacke_dtgexc_work.c | 30 +- LAPACKE/src/lapacke_dtgsen.c | 18 +- LAPACKE/src/lapacke_dtgsen_work.c | 30 +- LAPACKE/src/lapacke_dtgsja.c | 28 +- LAPACKE/src/lapacke_dtgsja_work.c | 60 ++-- LAPACKE/src/lapacke_dtgsna.c | 30 +- LAPACKE/src/lapacke_dtgsna_work.c | 34 +-- LAPACKE/src/lapacke_dtgsyl.c | 22 +- LAPACKE/src/lapacke_dtgsyl_work.c | 34 +-- LAPACKE/src/lapacke_dtpcon.c | 10 +- LAPACKE/src/lapacke_dtpcon_work.c | 8 +- LAPACKE/src/lapacke_dtpmqrt.c | 32 +- LAPACKE/src/lapacke_dtpmqrt_work.c | 32 +- LAPACKE/src/lapacke_dtpqrt.c | 12 +- LAPACKE/src/lapacke_dtpqrt2.c | 10 +- LAPACKE/src/lapacke_dtpqrt2_work.c | 22 +- LAPACKE/src/lapacke_dtpqrt_work.c | 22 +- LAPACKE/src/lapacke_dtprfb.c | 36 +-- LAPACKE/src/lapacke_dtprfb_work.c | 26 +- LAPACKE/src/lapacke_dtprfs.c | 14 +- LAPACKE/src/lapacke_dtprfs_work.c | 16 +- LAPACKE/src/lapacke_dtptri.c | 8 +- LAPACKE/src/lapacke_dtptri_work.c | 10 +- LAPACKE/src/lapacke_dtptrs.c | 10 +- LAPACKE/src/lapacke_dtptrs_work.c | 14 +- LAPACKE/src/lapacke_dtpttf.c | 8 +- LAPACKE/src/lapacke_dtpttf_work.c | 10 +- LAPACKE/src/lapacke_dtpttr.c | 8 +- LAPACKE/src/lapacke_dtpttr_work.c | 12 +- LAPACKE/src/lapacke_dtrcon.c | 10 +- LAPACKE/src/lapacke_dtrcon_work.c | 10 +- LAPACKE/src/lapacke_dtrevc.c | 18 +- LAPACKE/src/lapacke_dtrevc_work.c | 42 +-- LAPACKE/src/lapacke_dtrexc.c | 14 +- LAPACKE/src/lapacke_dtrexc_work.c | 28 +- LAPACKE/src/lapacke_dtrrfs.c | 14 +- LAPACKE/src/lapacke_dtrrfs_work.c | 18 +- LAPACKE/src/lapacke_dtrsen.c | 20 +- LAPACKE/src/lapacke_dtrsen_work.c | 26 +- LAPACKE/src/lapacke_dtrsna.c | 28 +- LAPACKE/src/lapacke_dtrsna_work.c | 30 +- LAPACKE/src/lapacke_dtrsyl.c | 12 +- LAPACKE/src/lapacke_dtrsyl3.c | 16 +- LAPACKE/src/lapacke_dtrsyl3_work.c | 20 +- LAPACKE/src/lapacke_dtrsyl_work.c | 20 +- LAPACKE/src/lapacke_dtrtri.c | 8 +- LAPACKE/src/lapacke_dtrtri_work.c | 12 +- LAPACKE/src/lapacke_dtrtrs.c | 10 +- LAPACKE/src/lapacke_dtrtrs_work.c | 16 +- LAPACKE/src/lapacke_dtrttf.c | 8 +- LAPACKE/src/lapacke_dtrttf_work.c | 12 +- LAPACKE/src/lapacke_dtrttp.c | 8 +- LAPACKE/src/lapacke_dtrttp_work.c | 12 +- LAPACKE/src/lapacke_dtzrzf.c | 12 +- LAPACKE/src/lapacke_dtzrzf_work.c | 12 +- LAPACKE/src/lapacke_ilaver.c | 2 +- LAPACKE/src/lapacke_nancheck.c | 2 +- LAPACKE/src/lapacke_sbbcsd.c | 32 +- LAPACKE/src/lapacke_sbbcsd_work.c | 6 +- LAPACKE/src/lapacke_sbdsdc.c | 18 +- LAPACKE/src/lapacke_sbdsdc_work.c | 26 +- LAPACKE/src/lapacke_sbdsqr.c | 18 +- LAPACKE/src/lapacke_sbdsqr_work.c | 24 +- LAPACKE/src/lapacke_sbdsvdx.c | 12 +- LAPACKE/src/lapacke_sbdsvdx_work.c | 22 +- LAPACKE/src/lapacke_sdisna.c | 6 +- LAPACKE/src/lapacke_sdisna_work.c | 2 +- LAPACKE/src/lapacke_sgbbrd.c | 12 +- LAPACKE/src/lapacke_sgbbrd_work.c | 38 +-- LAPACKE/src/lapacke_sgbcon.c | 12 +- LAPACKE/src/lapacke_sgbcon_work.c | 10 +- LAPACKE/src/lapacke_sgbequ.c | 8 +- LAPACKE/src/lapacke_sgbequ_work.c | 10 +- LAPACKE/src/lapacke_sgbequb.c | 8 +- LAPACKE/src/lapacke_sgbequb_work.c | 10 +- LAPACKE/src/lapacke_sgbrfs.c | 16 +- LAPACKE/src/lapacke_sgbrfs_work.c | 24 +- LAPACKE/src/lapacke_sgbrfsx.c | 26 +- LAPACKE/src/lapacke_sgbrfsx_work.c | 28 +- LAPACKE/src/lapacke_sgbsv.c | 10 +- LAPACKE/src/lapacke_sgbsv_work.c | 18 +- LAPACKE/src/lapacke_sgbsvx.c | 28 +- LAPACKE/src/lapacke_sgbsvx_work.c | 40 +-- LAPACKE/src/lapacke_sgbsvxx.c | 30 +- LAPACKE/src/lapacke_sgbsvxx_work.c | 44 +-- LAPACKE/src/lapacke_sgbtrf.c | 8 +- LAPACKE/src/lapacke_sgbtrf_work.c | 12 +- LAPACKE/src/lapacke_sgbtrs.c | 10 +- LAPACKE/src/lapacke_sgbtrs_work.c | 16 +- LAPACKE/src/lapacke_sgebak.c | 10 +- LAPACKE/src/lapacke_sgebak_work.c | 12 +- LAPACKE/src/lapacke_sgebal.c | 12 +- LAPACKE/src/lapacke_sgebal_work.c | 28 +- LAPACKE/src/lapacke_sgebrd.c | 12 +- LAPACKE/src/lapacke_sgebrd_work.c | 12 +- LAPACKE/src/lapacke_sgecon.c | 12 +- LAPACKE/src/lapacke_sgecon_work.c | 10 +- LAPACKE/src/lapacke_sgedmd.c | 22 +- LAPACKE/src/lapacke_sgedmd_work.c | 42 +-- LAPACKE/src/lapacke_sgedmdq.c | 24 +- LAPACKE/src/lapacke_sgedmdq_work.c | 48 +-- LAPACKE/src/lapacke_sgeequ.c | 8 +- LAPACKE/src/lapacke_sgeequ_work.c | 10 +- LAPACKE/src/lapacke_sgeequb.c | 8 +- LAPACKE/src/lapacke_sgeequb_work.c | 10 +- LAPACKE/src/lapacke_sgees.c | 16 +- LAPACKE/src/lapacke_sgees_work.c | 22 +- LAPACKE/src/lapacke_sgeesx.c | 18 +- LAPACKE/src/lapacke_sgeesx_work.c | 22 +- LAPACKE/src/lapacke_sgeev.c | 12 +- LAPACKE/src/lapacke_sgeev_work.c | 36 +-- LAPACKE/src/lapacke_sgeevx.c | 16 +- LAPACKE/src/lapacke_sgeevx_work.c | 36 +-- LAPACKE/src/lapacke_sgehrd.c | 12 +- LAPACKE/src/lapacke_sgehrd_work.c | 12 +- LAPACKE/src/lapacke_sgejsv.c | 80 ++--- LAPACKE/src/lapacke_sgejsv_work.c | 50 ++-- LAPACKE/src/lapacke_sgelq.c | 12 +- LAPACKE/src/lapacke_sgelq2.c | 10 +- LAPACKE/src/lapacke_sgelq2_work.c | 12 +- LAPACKE/src/lapacke_sgelq_work.c | 12 +- LAPACKE/src/lapacke_sgelqf.c | 12 +- LAPACKE/src/lapacke_sgelqf_work.c | 12 +- LAPACKE/src/lapacke_sgels.c | 14 +- LAPACKE/src/lapacke_sgels_work.c | 18 +- LAPACKE/src/lapacke_sgelsd.c | 16 +- LAPACKE/src/lapacke_sgelsd_work.c | 18 +- LAPACKE/src/lapacke_sgelss.c | 16 +- LAPACKE/src/lapacke_sgelss_work.c | 18 +- LAPACKE/src/lapacke_sgelsy.c | 16 +- LAPACKE/src/lapacke_sgelsy_work.c | 18 +- LAPACKE/src/lapacke_sgemlq.c | 16 +- LAPACKE/src/lapacke_sgemlq_work.c | 20 +- LAPACKE/src/lapacke_sgemqr.c | 18 +- LAPACKE/src/lapacke_sgemqr_work.c | 18 +- LAPACKE/src/lapacke_sgemqrt.c | 18 +- LAPACKE/src/lapacke_sgemqrt_work.c | 20 +- LAPACKE/src/lapacke_sgeqlf.c | 12 +- LAPACKE/src/lapacke_sgeqlf_work.c | 12 +- LAPACKE/src/lapacke_sgeqp3.c | 12 +- LAPACKE/src/lapacke_sgeqp3_work.c | 12 +- LAPACKE/src/lapacke_sgeqpf.c | 10 +- LAPACKE/src/lapacke_sgeqpf_work.c | 12 +- LAPACKE/src/lapacke_sgeqr.c | 12 +- LAPACKE/src/lapacke_sgeqr2.c | 10 +- LAPACKE/src/lapacke_sgeqr2_work.c | 12 +- LAPACKE/src/lapacke_sgeqr_work.c | 12 +- LAPACKE/src/lapacke_sgeqrf.c | 12 +- LAPACKE/src/lapacke_sgeqrf_work.c | 12 +- LAPACKE/src/lapacke_sgeqrfp.c | 12 +- LAPACKE/src/lapacke_sgeqrfp_work.c | 12 +- LAPACKE/src/lapacke_sgeqrt.c | 10 +- LAPACKE/src/lapacke_sgeqrt2.c | 8 +- LAPACKE/src/lapacke_sgeqrt2_work.c | 16 +- LAPACKE/src/lapacke_sgeqrt3.c | 8 +- LAPACKE/src/lapacke_sgeqrt3_work.c | 16 +- LAPACKE/src/lapacke_sgeqrt_work.c | 16 +- LAPACKE/src/lapacke_sgerfs.c | 16 +- LAPACKE/src/lapacke_sgerfs_work.c | 24 +- LAPACKE/src/lapacke_sgerfsx.c | 26 +- LAPACKE/src/lapacke_sgerfsx_work.c | 28 +- LAPACKE/src/lapacke_sgerqf.c | 12 +- LAPACKE/src/lapacke_sgerqf_work.c | 12 +- LAPACKE/src/lapacke_sgesdd.c | 12 +- LAPACKE/src/lapacke_sgesdd_work.c | 62 ++-- LAPACKE/src/lapacke_sgesv.c | 10 +- LAPACKE/src/lapacke_sgesv_work.c | 18 +- LAPACKE/src/lapacke_sgesvd.c | 12 +- LAPACKE/src/lapacke_sgesvd_work.c | 48 +-- LAPACKE/src/lapacke_sgesvdq.c | 12 +- LAPACKE/src/lapacke_sgesvdq_work.c | 42 +-- LAPACKE/src/lapacke_sgesvdx.c | 12 +- LAPACKE/src/lapacke_sgesvdx_work.c | 44 +-- LAPACKE/src/lapacke_sgesvj.c | 18 +- LAPACKE/src/lapacke_sgesvj_work.c | 30 +- LAPACKE/src/lapacke_sgesvx.c | 28 +- LAPACKE/src/lapacke_sgesvx_work.c | 40 +-- LAPACKE/src/lapacke_sgesvxx.c | 30 +- LAPACKE/src/lapacke_sgesvxx_work.c | 44 +-- LAPACKE/src/lapacke_sgetf2.c | 8 +- LAPACKE/src/lapacke_sgetf2_work.c | 12 +- LAPACKE/src/lapacke_sgetrf.c | 8 +- LAPACKE/src/lapacke_sgetrf2.c | 8 +- LAPACKE/src/lapacke_sgetrf2_work.c | 12 +- LAPACKE/src/lapacke_sgetrf_work.c | 12 +- LAPACKE/src/lapacke_sgetri.c | 12 +- LAPACKE/src/lapacke_sgetri_work.c | 12 +- LAPACKE/src/lapacke_sgetrs.c | 10 +- LAPACKE/src/lapacke_sgetrs_work.c | 16 +- LAPACKE/src/lapacke_sgetsls.c | 14 +- LAPACKE/src/lapacke_sgetsls_work.c | 18 +- LAPACKE/src/lapacke_sgetsqrhrt.c | 12 +- LAPACKE/src/lapacke_sgetsqrhrt_work.c | 16 +- LAPACKE/src/lapacke_sggbak.c | 12 +- LAPACKE/src/lapacke_sggbak_work.c | 12 +- LAPACKE/src/lapacke_sggbal.c | 22 +- LAPACKE/src/lapacke_sggbal_work.c | 50 ++-- LAPACKE/src/lapacke_sgges.c | 18 +- LAPACKE/src/lapacke_sgges3.c | 18 +- LAPACKE/src/lapacke_sgges3_work.c | 38 +-- LAPACKE/src/lapacke_sgges_work.c | 42 +-- LAPACKE/src/lapacke_sggesx.c | 18 +- LAPACKE/src/lapacke_sggesx_work.c | 42 +-- LAPACKE/src/lapacke_sggev.c | 14 +- LAPACKE/src/lapacke_sggev3.c | 14 +- LAPACKE/src/lapacke_sggev3_work.c | 46 +-- LAPACKE/src/lapacke_sggev_work.c | 46 +-- LAPACKE/src/lapacke_sggevx.c | 30 +- LAPACKE/src/lapacke_sggevx_work.c | 38 +-- LAPACKE/src/lapacke_sggglm.c | 16 +- LAPACKE/src/lapacke_sggglm_work.c | 18 +- LAPACKE/src/lapacke_sgghd3.c | 22 +- LAPACKE/src/lapacke_sgghd3_work.c | 46 +-- LAPACKE/src/lapacke_sgghrd.c | 18 +- LAPACKE/src/lapacke_sgghrd_work.c | 46 +-- LAPACKE/src/lapacke_sgglse.c | 18 +- LAPACKE/src/lapacke_sgglse_work.c | 18 +- LAPACKE/src/lapacke_sggqrf.c | 14 +- LAPACKE/src/lapacke_sggqrf_work.c | 18 +- LAPACKE/src/lapacke_sggrqf.c | 14 +- LAPACKE/src/lapacke_sggrqf_work.c | 18 +- LAPACKE/src/lapacke_sggsvd.c | 12 +- LAPACKE/src/lapacke_sggsvd3.c | 14 +- LAPACKE/src/lapacke_sggsvd3_work.c | 48 +-- LAPACKE/src/lapacke_sggsvd_work.c | 48 +-- LAPACKE/src/lapacke_sggsvp.c | 16 +- LAPACKE/src/lapacke_sggsvp3.c | 18 +- LAPACKE/src/lapacke_sggsvp3_work.c | 48 +-- LAPACKE/src/lapacke_sggsvp_work.c | 48 +-- LAPACKE/src/lapacke_sgtcon.c | 16 +- LAPACKE/src/lapacke_sgtcon_work.c | 2 +- LAPACKE/src/lapacke_sgtrfs.c | 26 +- LAPACKE/src/lapacke_sgtrfs_work.c | 16 +- LAPACKE/src/lapacke_sgtsv.c | 14 +- LAPACKE/src/lapacke_sgtsv_work.c | 12 +- LAPACKE/src/lapacke_sgtsvx.c | 32 +- LAPACKE/src/lapacke_sgtsvx_work.c | 14 +- LAPACKE/src/lapacke_sgttrf.c | 10 +- LAPACKE/src/lapacke_sgttrf_work.c | 2 +- LAPACKE/src/lapacke_sgttrs.c | 16 +- LAPACKE/src/lapacke_sgttrs_work.c | 12 +- LAPACKE/src/lapacke_shgeqz.c | 22 +- LAPACKE/src/lapacke_shgeqz_work.c | 46 +-- LAPACKE/src/lapacke_shsein.c | 22 +- LAPACKE/src/lapacke_shsein_work.c | 42 +-- LAPACKE/src/lapacke_shseqr.c | 16 +- LAPACKE/src/lapacke_shseqr_work.c | 26 +- LAPACKE/src/lapacke_slacn2.c | 8 +- LAPACKE/src/lapacke_slacn2_work.c | 2 +- LAPACKE/src/lapacke_slacpy.c | 8 +- LAPACKE/src/lapacke_slacpy_work.c | 14 +- LAPACKE/src/lapacke_slag2d.c | 8 +- LAPACKE/src/lapacke_slag2d_work.c | 14 +- LAPACKE/src/lapacke_slagge.c | 10 +- LAPACKE/src/lapacke_slagge_work.c | 10 +- LAPACKE/src/lapacke_slagsy.c | 10 +- LAPACKE/src/lapacke_slagsy_work.c | 10 +- LAPACKE/src/lapacke_slamch.c | 4 +- LAPACKE/src/lapacke_slamch_work.c | 2 +- LAPACKE/src/lapacke_slangb.c | 14 +- LAPACKE/src/lapacke_slangb_work.c | 14 +- LAPACKE/src/lapacke_slange.c | 14 +- LAPACKE/src/lapacke_slange_work.c | 14 +- LAPACKE/src/lapacke_slansy.c | 18 +- LAPACKE/src/lapacke_slansy_work.c | 10 +- LAPACKE/src/lapacke_slantr.c | 14 +- LAPACKE/src/lapacke_slantr_work.c | 16 +- LAPACKE/src/lapacke_slapmr.c | 8 +- LAPACKE/src/lapacke_slapmr_work.c | 12 +- LAPACKE/src/lapacke_slapmt.c | 8 +- LAPACKE/src/lapacke_slapmt_work.c | 12 +- LAPACKE/src/lapacke_slapy2.c | 8 +- LAPACKE/src/lapacke_slapy2_work.c | 2 +- LAPACKE/src/lapacke_slapy3.c | 10 +- LAPACKE/src/lapacke_slapy3_work.c | 2 +- LAPACKE/src/lapacke_slarfb.c | 26 +- LAPACKE/src/lapacke_slarfb_work.c | 28 +- LAPACKE/src/lapacke_slarfg.c | 8 +- LAPACKE/src/lapacke_slarfg_work.c | 2 +- LAPACKE/src/lapacke_slarft.c | 18 +- LAPACKE/src/lapacke_slarft_work.c | 22 +- LAPACKE/src/lapacke_slarfx.c | 14 +- LAPACKE/src/lapacke_slarfx_work.c | 12 +- LAPACKE/src/lapacke_slarnv.c | 4 +- LAPACKE/src/lapacke_slarnv_work.c | 2 +- LAPACKE/src/lapacke_slartgp.c | 8 +- LAPACKE/src/lapacke_slartgp_work.c | 2 +- LAPACKE/src/lapacke_slartgs.c | 10 +- LAPACKE/src/lapacke_slartgs_work.c | 2 +- LAPACKE/src/lapacke_slascl.c | 28 +- LAPACKE/src/lapacke_slascl_work.c | 18 +- LAPACKE/src/lapacke_slaset.c | 10 +- LAPACKE/src/lapacke_slaset_work.c | 12 +- LAPACKE/src/lapacke_slasrt.c | 6 +- LAPACKE/src/lapacke_slasrt_work.c | 2 +- LAPACKE/src/lapacke_slassq.c | 10 +- LAPACKE/src/lapacke_slassq_work.c | 2 +- LAPACKE/src/lapacke_slaswp.c | 10 +- LAPACKE/src/lapacke_slaswp_work.c | 12 +- LAPACKE/src/lapacke_slatms.c | 16 +- LAPACKE/src/lapacke_slatms_work.c | 12 +- LAPACKE/src/lapacke_slauum.c | 8 +- LAPACKE/src/lapacke_slauum_work.c | 12 +- LAPACKE/src/lapacke_sopgtr.c | 12 +- LAPACKE/src/lapacke_sopgtr_work.c | 12 +- LAPACKE/src/lapacke_sopmtr.c | 20 +- LAPACKE/src/lapacke_sopmtr_work.c | 16 +- LAPACKE/src/lapacke_sorbdb.c | 20 +- LAPACKE/src/lapacke_sorbdb_work.c | 6 +- LAPACKE/src/lapacke_sorcsd.c | 20 +- LAPACKE/src/lapacke_sorcsd2by1.c | 14 +- LAPACKE/src/lapacke_sorcsd2by1_work.c | 54 ++-- LAPACKE/src/lapacke_sorcsd_work.c | 6 +- LAPACKE/src/lapacke_sorgbr.c | 14 +- LAPACKE/src/lapacke_sorgbr_work.c | 12 +- LAPACKE/src/lapacke_sorghr.c | 14 +- LAPACKE/src/lapacke_sorghr_work.c | 12 +- LAPACKE/src/lapacke_sorglq.c | 14 +- LAPACKE/src/lapacke_sorglq_work.c | 12 +- LAPACKE/src/lapacke_sorgql.c | 14 +- LAPACKE/src/lapacke_sorgql_work.c | 12 +- LAPACKE/src/lapacke_sorgqr.c | 14 +- LAPACKE/src/lapacke_sorgqr_work.c | 12 +- LAPACKE/src/lapacke_sorgrq.c | 14 +- LAPACKE/src/lapacke_sorgrq_work.c | 12 +- LAPACKE/src/lapacke_sorgtr.c | 14 +- LAPACKE/src/lapacke_sorgtr_work.c | 12 +- LAPACKE/src/lapacke_sorgtsqr_row.c | 14 +- LAPACKE/src/lapacke_sorgtsqr_row_work.c | 16 +- LAPACKE/src/lapacke_sorhr_col.c | 8 +- LAPACKE/src/lapacke_sorhr_col_work.c | 16 +- LAPACKE/src/lapacke_sormbr.c | 22 +- LAPACKE/src/lapacke_sormbr_work.c | 22 +- LAPACKE/src/lapacke_sormhr.c | 18 +- LAPACKE/src/lapacke_sormhr_work.c | 18 +- LAPACKE/src/lapacke_sormlq.c | 18 +- LAPACKE/src/lapacke_sormlq_work.c | 18 +- LAPACKE/src/lapacke_sormql.c | 18 +- LAPACKE/src/lapacke_sormql_work.c | 18 +- LAPACKE/src/lapacke_sormqr.c | 18 +- LAPACKE/src/lapacke_sormqr_work.c | 18 +- LAPACKE/src/lapacke_sormrq.c | 16 +- LAPACKE/src/lapacke_sormrq_work.c | 16 +- LAPACKE/src/lapacke_sormrz.c | 16 +- LAPACKE/src/lapacke_sormrz_work.c | 16 +- LAPACKE/src/lapacke_sormtr.c | 18 +- LAPACKE/src/lapacke_sormtr_work.c | 18 +- LAPACKE/src/lapacke_spbcon.c | 12 +- LAPACKE/src/lapacke_spbcon_work.c | 10 +- LAPACKE/src/lapacke_spbequ.c | 8 +- LAPACKE/src/lapacke_spbequ_work.c | 10 +- LAPACKE/src/lapacke_spbrfs.c | 16 +- LAPACKE/src/lapacke_spbrfs_work.c | 24 +- LAPACKE/src/lapacke_spbstf.c | 8 +- LAPACKE/src/lapacke_spbstf_work.c | 12 +- LAPACKE/src/lapacke_spbsv.c | 10 +- LAPACKE/src/lapacke_spbsv_work.c | 18 +- LAPACKE/src/lapacke_spbsvx.c | 20 +- LAPACKE/src/lapacke_spbsvx_work.c | 34 +-- LAPACKE/src/lapacke_spbtrf.c | 8 +- LAPACKE/src/lapacke_spbtrf_work.c | 12 +- LAPACKE/src/lapacke_spbtrs.c | 10 +- LAPACKE/src/lapacke_spbtrs_work.c | 16 +- LAPACKE/src/lapacke_spftrf.c | 8 +- LAPACKE/src/lapacke_spftrf_work.c | 10 +- LAPACKE/src/lapacke_spftri.c | 8 +- LAPACKE/src/lapacke_spftri_work.c | 10 +- LAPACKE/src/lapacke_spftrs.c | 10 +- LAPACKE/src/lapacke_spftrs_work.c | 14 +- LAPACKE/src/lapacke_spocon.c | 12 +- LAPACKE/src/lapacke_spocon_work.c | 10 +- LAPACKE/src/lapacke_spoequ.c | 8 +- LAPACKE/src/lapacke_spoequ_work.c | 10 +- LAPACKE/src/lapacke_spoequb.c | 8 +- LAPACKE/src/lapacke_spoequb_work.c | 10 +- LAPACKE/src/lapacke_sporfs.c | 16 +- LAPACKE/src/lapacke_sporfs_work.c | 24 +- LAPACKE/src/lapacke_sporfsx.c | 22 +- LAPACKE/src/lapacke_sporfsx_work.c | 28 +- LAPACKE/src/lapacke_sposv.c | 10 +- LAPACKE/src/lapacke_sposv_work.c | 18 +- LAPACKE/src/lapacke_sposvx.c | 20 +- LAPACKE/src/lapacke_sposvx_work.c | 34 +-- LAPACKE/src/lapacke_sposvxx.c | 22 +- LAPACKE/src/lapacke_sposvxx_work.c | 38 +-- LAPACKE/src/lapacke_spotrf.c | 8 +- LAPACKE/src/lapacke_spotrf2.c | 8 +- LAPACKE/src/lapacke_spotrf2_work.c | 12 +- LAPACKE/src/lapacke_spotrf_work.c | 12 +- LAPACKE/src/lapacke_spotri.c | 8 +- LAPACKE/src/lapacke_spotri_work.c | 12 +- LAPACKE/src/lapacke_spotrs.c | 10 +- LAPACKE/src/lapacke_spotrs_work.c | 16 +- LAPACKE/src/lapacke_sppcon.c | 12 +- LAPACKE/src/lapacke_sppcon_work.c | 8 +- LAPACKE/src/lapacke_sppequ.c | 8 +- LAPACKE/src/lapacke_sppequ_work.c | 8 +- LAPACKE/src/lapacke_spprfs.c | 16 +- LAPACKE/src/lapacke_spprfs_work.c | 20 +- LAPACKE/src/lapacke_sppsv.c | 10 +- LAPACKE/src/lapacke_sppsv_work.c | 16 +- LAPACKE/src/lapacke_sppsvx.c | 20 +- LAPACKE/src/lapacke_sppsvx_work.c | 30 +- LAPACKE/src/lapacke_spptrf.c | 8 +- LAPACKE/src/lapacke_spptrf_work.c | 10 +- LAPACKE/src/lapacke_spptri.c | 8 +- LAPACKE/src/lapacke_spptri_work.c | 10 +- LAPACKE/src/lapacke_spptrs.c | 10 +- LAPACKE/src/lapacke_spptrs_work.c | 14 +- LAPACKE/src/lapacke_spstrf.c | 12 +- LAPACKE/src/lapacke_spstrf_work.c | 12 +- LAPACKE/src/lapacke_sptcon.c | 12 +- LAPACKE/src/lapacke_sptcon_work.c | 2 +- LAPACKE/src/lapacke_spteqr.c | 18 +- LAPACKE/src/lapacke_spteqr_work.c | 14 +- LAPACKE/src/lapacke_sptrfs.c | 20 +- LAPACKE/src/lapacke_sptrfs_work.c | 16 +- LAPACKE/src/lapacke_sptsv.c | 12 +- LAPACKE/src/lapacke_sptsv_work.c | 12 +- LAPACKE/src/lapacke_sptsvx.c | 22 +- LAPACKE/src/lapacke_sptsvx_work.c | 14 +- LAPACKE/src/lapacke_spttrf.c | 8 +- LAPACKE/src/lapacke_spttrf_work.c | 2 +- LAPACKE/src/lapacke_spttrs.c | 12 +- LAPACKE/src/lapacke_spttrs_work.c | 12 +- LAPACKE/src/lapacke_ssbev.c | 10 +- LAPACKE/src/lapacke_ssbev_2stage.c | 12 +- LAPACKE/src/lapacke_ssbev_2stage_work.c | 22 +- LAPACKE/src/lapacke_ssbev_work.c | 22 +- LAPACKE/src/lapacke_ssbevd.c | 12 +- LAPACKE/src/lapacke_ssbevd_2stage.c | 12 +- LAPACKE/src/lapacke_ssbevd_2stage_work.c | 22 +- LAPACKE/src/lapacke_ssbevd_work.c | 22 +- LAPACKE/src/lapacke_ssbevx.c | 20 +- LAPACKE/src/lapacke_ssbevx_2stage.c | 22 +- LAPACKE/src/lapacke_ssbevx_2stage_work.c | 38 +-- LAPACKE/src/lapacke_ssbevx_work.c | 38 +-- LAPACKE/src/lapacke_ssbgst.c | 12 +- LAPACKE/src/lapacke_ssbgst_work.c | 26 +- LAPACKE/src/lapacke_ssbgv.c | 12 +- LAPACKE/src/lapacke_ssbgv_work.c | 28 +- LAPACKE/src/lapacke_ssbgvd.c | 14 +- LAPACKE/src/lapacke_ssbgvd_work.c | 28 +- LAPACKE/src/lapacke_ssbgvx.c | 22 +- LAPACKE/src/lapacke_ssbgvx_work.c | 38 +-- LAPACKE/src/lapacke_ssbtrd.c | 14 +- LAPACKE/src/lapacke_ssbtrd_work.c | 26 +- LAPACKE/src/lapacke_ssfrk.c | 18 +- LAPACKE/src/lapacke_ssfrk_work.c | 18 +- LAPACKE/src/lapacke_sspcon.c | 12 +- LAPACKE/src/lapacke_sspcon_work.c | 8 +- LAPACKE/src/lapacke_sspev.c | 10 +- LAPACKE/src/lapacke_sspev_work.c | 20 +- LAPACKE/src/lapacke_sspevd.c | 12 +- LAPACKE/src/lapacke_sspevd_work.c | 20 +- LAPACKE/src/lapacke_sspevx.c | 20 +- LAPACKE/src/lapacke_sspevx_work.c | 26 +- LAPACKE/src/lapacke_sspgst.c | 10 +- LAPACKE/src/lapacke_sspgst_work.c | 12 +- LAPACKE/src/lapacke_sspgv.c | 12 +- LAPACKE/src/lapacke_sspgv_work.c | 24 +- LAPACKE/src/lapacke_sspgvd.c | 14 +- LAPACKE/src/lapacke_sspgvd_work.c | 24 +- LAPACKE/src/lapacke_sspgvx.c | 22 +- LAPACKE/src/lapacke_sspgvx_work.c | 30 +- LAPACKE/src/lapacke_ssprfs.c | 16 +- LAPACKE/src/lapacke_ssprfs_work.c | 20 +- LAPACKE/src/lapacke_sspsv.c | 10 +- LAPACKE/src/lapacke_sspsv_work.c | 16 +- LAPACKE/src/lapacke_sspsvx.c | 16 +- LAPACKE/src/lapacke_sspsvx_work.c | 24 +- LAPACKE/src/lapacke_ssptrd.c | 8 +- LAPACKE/src/lapacke_ssptrd_work.c | 10 +- LAPACKE/src/lapacke_ssptrf.c | 8 +- LAPACKE/src/lapacke_ssptrf_work.c | 10 +- LAPACKE/src/lapacke_ssptri.c | 10 +- LAPACKE/src/lapacke_ssptri_work.c | 10 +- LAPACKE/src/lapacke_ssptrs.c | 10 +- LAPACKE/src/lapacke_ssptrs_work.c | 14 +- LAPACKE/src/lapacke_sstebz.c | 20 +- LAPACKE/src/lapacke_sstebz_work.c | 2 +- LAPACKE/src/lapacke_sstedc.c | 18 +- LAPACKE/src/lapacke_sstedc_work.c | 20 +- LAPACKE/src/lapacke_sstegr.c | 24 +- LAPACKE/src/lapacke_sstegr_work.c | 18 +- LAPACKE/src/lapacke_sstein.c | 14 +- LAPACKE/src/lapacke_sstein_work.c | 10 +- LAPACKE/src/lapacke_sstemr.c | 18 +- LAPACKE/src/lapacke_sstemr_work.c | 18 +- LAPACKE/src/lapacke_ssteqr.c | 18 +- LAPACKE/src/lapacke_ssteqr_work.c | 20 +- LAPACKE/src/lapacke_ssterf.c | 8 +- LAPACKE/src/lapacke_ssterf_work.c | 2 +- LAPACKE/src/lapacke_sstev.c | 16 +- LAPACKE/src/lapacke_sstev_work.c | 16 +- LAPACKE/src/lapacke_sstevd.c | 14 +- LAPACKE/src/lapacke_sstevd_work.c | 16 +- LAPACKE/src/lapacke_sstevr.c | 24 +- LAPACKE/src/lapacke_sstevr_work.c | 22 +- LAPACKE/src/lapacke_sstevx.c | 22 +- LAPACKE/src/lapacke_sstevx_work.c | 22 +- LAPACKE/src/lapacke_ssycon.c | 12 +- LAPACKE/src/lapacke_ssycon_3.c | 16 +- LAPACKE/src/lapacke_ssycon_3_work.c | 10 +- LAPACKE/src/lapacke_ssycon_work.c | 10 +- LAPACKE/src/lapacke_ssyconv.c | 8 +- LAPACKE/src/lapacke_ssyconv_work.c | 12 +- LAPACKE/src/lapacke_ssyequb.c | 10 +- LAPACKE/src/lapacke_ssyequb_work.c | 10 +- LAPACKE/src/lapacke_ssyev.c | 12 +- LAPACKE/src/lapacke_ssyev_2stage.c | 12 +- LAPACKE/src/lapacke_ssyev_2stage_work.c | 12 +- LAPACKE/src/lapacke_ssyev_work.c | 14 +- LAPACKE/src/lapacke_ssyevd.c | 12 +- LAPACKE/src/lapacke_ssyevd_2stage.c | 12 +- LAPACKE/src/lapacke_ssyevd_2stage_work.c | 14 +- LAPACKE/src/lapacke_ssyevd_work.c | 14 +- LAPACKE/src/lapacke_ssyevr.c | 22 +- LAPACKE/src/lapacke_ssyevr_2stage.c | 22 +- LAPACKE/src/lapacke_ssyevr_2stage_work.c | 28 +- LAPACKE/src/lapacke_ssyevr_work.c | 30 +- LAPACKE/src/lapacke_ssyevx.c | 22 +- LAPACKE/src/lapacke_ssyevx_2stage.c | 22 +- LAPACKE/src/lapacke_ssyevx_2stage_work.c | 28 +- LAPACKE/src/lapacke_ssyevx_work.c | 30 +- LAPACKE/src/lapacke_ssygst.c | 10 +- LAPACKE/src/lapacke_ssygst_work.c | 16 +- LAPACKE/src/lapacke_ssygv.c | 14 +- LAPACKE/src/lapacke_ssygv_2stage.c | 14 +- LAPACKE/src/lapacke_ssygv_2stage_work.c | 18 +- LAPACKE/src/lapacke_ssygv_work.c | 18 +- LAPACKE/src/lapacke_ssygvd.c | 14 +- LAPACKE/src/lapacke_ssygvd_work.c | 18 +- LAPACKE/src/lapacke_ssygvx.c | 24 +- LAPACKE/src/lapacke_ssygvx_work.c | 34 +-- LAPACKE/src/lapacke_ssyrfs.c | 16 +- LAPACKE/src/lapacke_ssyrfs_work.c | 24 +- LAPACKE/src/lapacke_ssyrfsx.c | 22 +- LAPACKE/src/lapacke_ssyrfsx_work.c | 28 +- LAPACKE/src/lapacke_ssysv.c | 14 +- LAPACKE/src/lapacke_ssysv_aa.c | 14 +- LAPACKE/src/lapacke_ssysv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_ssysv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_ssysv_aa_work.c | 18 +- LAPACKE/src/lapacke_ssysv_rk.c | 14 +- LAPACKE/src/lapacke_ssysv_rk_work.c | 18 +- LAPACKE/src/lapacke_ssysv_rook.c | 14 +- LAPACKE/src/lapacke_ssysv_rook_work.c | 18 +- LAPACKE/src/lapacke_ssysv_work.c | 18 +- LAPACKE/src/lapacke_ssysvx.c | 18 +- LAPACKE/src/lapacke_ssysvx_work.c | 28 +- LAPACKE/src/lapacke_ssysvxx.c | 22 +- LAPACKE/src/lapacke_ssysvxx_work.c | 40 +-- LAPACKE/src/lapacke_ssyswapr.c | 8 +- LAPACKE/src/lapacke_ssyswapr_work.c | 10 +- LAPACKE/src/lapacke_ssytrd.c | 12 +- LAPACKE/src/lapacke_ssytrd_work.c | 12 +- LAPACKE/src/lapacke_ssytrf.c | 12 +- LAPACKE/src/lapacke_ssytrf_aa.c | 12 +- LAPACKE/src/lapacke_ssytrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_ssytrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_ssytrf_aa_work.c | 12 +- LAPACKE/src/lapacke_ssytrf_rk.c | 12 +- LAPACKE/src/lapacke_ssytrf_rk_work.c | 12 +- LAPACKE/src/lapacke_ssytrf_rook.c | 12 +- LAPACKE/src/lapacke_ssytrf_rook_work.c | 12 +- LAPACKE/src/lapacke_ssytrf_work.c | 12 +- LAPACKE/src/lapacke_ssytri.c | 10 +- LAPACKE/src/lapacke_ssytri2.c | 12 +- LAPACKE/src/lapacke_ssytri2_work.c | 12 +- LAPACKE/src/lapacke_ssytri2x.c | 10 +- LAPACKE/src/lapacke_ssytri2x_work.c | 12 +- LAPACKE/src/lapacke_ssytri_3.c | 16 +- LAPACKE/src/lapacke_ssytri_3_work.c | 12 +- LAPACKE/src/lapacke_ssytri_work.c | 12 +- LAPACKE/src/lapacke_ssytrs.c | 10 +- LAPACKE/src/lapacke_ssytrs2.c | 12 +- LAPACKE/src/lapacke_ssytrs2_work.c | 16 +- LAPACKE/src/lapacke_ssytrs_3.c | 12 +- LAPACKE/src/lapacke_ssytrs_3_work.c | 16 +- LAPACKE/src/lapacke_ssytrs_aa.c | 14 +- LAPACKE/src/lapacke_ssytrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_ssytrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_ssytrs_aa_work.c | 16 +- LAPACKE/src/lapacke_ssytrs_rook.c | 10 +- LAPACKE/src/lapacke_ssytrs_rook_work.c | 16 +- LAPACKE/src/lapacke_ssytrs_work.c | 16 +- LAPACKE/src/lapacke_stbcon.c | 10 +- LAPACKE/src/lapacke_stbcon_work.c | 10 +- LAPACKE/src/lapacke_stbrfs.c | 14 +- LAPACKE/src/lapacke_stbrfs_work.c | 18 +- LAPACKE/src/lapacke_stbtrs.c | 10 +- LAPACKE/src/lapacke_stbtrs_work.c | 16 +- LAPACKE/src/lapacke_stfsm.c | 12 +- LAPACKE/src/lapacke_stfsm_work.c | 14 +- LAPACKE/src/lapacke_stftri.c | 8 +- LAPACKE/src/lapacke_stftri_work.c | 10 +- LAPACKE/src/lapacke_stfttp.c | 8 +- LAPACKE/src/lapacke_stfttp_work.c | 10 +- LAPACKE/src/lapacke_stfttr.c | 8 +- LAPACKE/src/lapacke_stfttr_work.c | 12 +- LAPACKE/src/lapacke_stgevc.c | 20 +- LAPACKE/src/lapacke_stgevc_work.c | 46 +-- LAPACKE/src/lapacke_stgexc.c | 18 +- LAPACKE/src/lapacke_stgexc_work.c | 30 +- LAPACKE/src/lapacke_stgsen.c | 18 +- LAPACKE/src/lapacke_stgsen_work.c | 30 +- LAPACKE/src/lapacke_stgsja.c | 28 +- LAPACKE/src/lapacke_stgsja_work.c | 60 ++-- LAPACKE/src/lapacke_stgsna.c | 30 +- LAPACKE/src/lapacke_stgsna_work.c | 34 +-- LAPACKE/src/lapacke_stgsyl.c | 22 +- LAPACKE/src/lapacke_stgsyl_work.c | 34 +-- LAPACKE/src/lapacke_stpcon.c | 10 +- LAPACKE/src/lapacke_stpcon_work.c | 8 +- LAPACKE/src/lapacke_stpmqrt.c | 32 +- LAPACKE/src/lapacke_stpmqrt_work.c | 32 +- LAPACKE/src/lapacke_stpqrt.c | 12 +- LAPACKE/src/lapacke_stpqrt2.c | 10 +- LAPACKE/src/lapacke_stpqrt2_work.c | 22 +- LAPACKE/src/lapacke_stpqrt_work.c | 22 +- LAPACKE/src/lapacke_stprfb.c | 36 +-- LAPACKE/src/lapacke_stprfb_work.c | 26 +- LAPACKE/src/lapacke_stprfs.c | 14 +- LAPACKE/src/lapacke_stprfs_work.c | 16 +- LAPACKE/src/lapacke_stptri.c | 8 +- LAPACKE/src/lapacke_stptri_work.c | 10 +- LAPACKE/src/lapacke_stptrs.c | 10 +- LAPACKE/src/lapacke_stptrs_work.c | 14 +- LAPACKE/src/lapacke_stpttf.c | 8 +- LAPACKE/src/lapacke_stpttf_work.c | 10 +- LAPACKE/src/lapacke_stpttr.c | 8 +- LAPACKE/src/lapacke_stpttr_work.c | 12 +- LAPACKE/src/lapacke_strcon.c | 10 +- LAPACKE/src/lapacke_strcon_work.c | 10 +- LAPACKE/src/lapacke_strevc.c | 18 +- LAPACKE/src/lapacke_strevc_work.c | 42 +-- LAPACKE/src/lapacke_strexc.c | 14 +- LAPACKE/src/lapacke_strexc_work.c | 28 +- LAPACKE/src/lapacke_strrfs.c | 14 +- LAPACKE/src/lapacke_strrfs_work.c | 18 +- LAPACKE/src/lapacke_strsen.c | 20 +- LAPACKE/src/lapacke_strsen_work.c | 26 +- LAPACKE/src/lapacke_strsna.c | 28 +- LAPACKE/src/lapacke_strsna_work.c | 30 +- LAPACKE/src/lapacke_strsyl.c | 12 +- LAPACKE/src/lapacke_strsyl3.c | 16 +- LAPACKE/src/lapacke_strsyl3_work.c | 20 +- LAPACKE/src/lapacke_strsyl_work.c | 20 +- LAPACKE/src/lapacke_strtri.c | 8 +- LAPACKE/src/lapacke_strtri_work.c | 12 +- LAPACKE/src/lapacke_strtrs.c | 10 +- LAPACKE/src/lapacke_strtrs_work.c | 16 +- LAPACKE/src/lapacke_strttf.c | 8 +- LAPACKE/src/lapacke_strttf_work.c | 12 +- LAPACKE/src/lapacke_strttp.c | 8 +- LAPACKE/src/lapacke_strttp_work.c | 12 +- LAPACKE/src/lapacke_stzrzf.c | 12 +- LAPACKE/src/lapacke_stzrzf_work.c | 12 +- LAPACKE/src/lapacke_zbbcsd.c | 32 +- LAPACKE/src/lapacke_zbbcsd_work.c | 6 +- LAPACKE/src/lapacke_zbdsqr.c | 18 +- LAPACKE/src/lapacke_zbdsqr_work.c | 24 +- LAPACKE/src/lapacke_zcgesv.c | 12 +- LAPACKE/src/lapacke_zcgesv_work.c | 22 +- LAPACKE/src/lapacke_zcposv.c | 12 +- LAPACKE/src/lapacke_zcposv_work.c | 22 +- LAPACKE/src/lapacke_zgbbrd.c | 12 +- LAPACKE/src/lapacke_zgbbrd_work.c | 38 +-- LAPACKE/src/lapacke_zgbcon.c | 12 +- LAPACKE/src/lapacke_zgbcon_work.c | 10 +- LAPACKE/src/lapacke_zgbequ.c | 8 +- LAPACKE/src/lapacke_zgbequ_work.c | 10 +- LAPACKE/src/lapacke_zgbequb.c | 8 +- LAPACKE/src/lapacke_zgbequb_work.c | 10 +- LAPACKE/src/lapacke_zgbrfs.c | 16 +- LAPACKE/src/lapacke_zgbrfs_work.c | 24 +- LAPACKE/src/lapacke_zgbrfsx.c | 26 +- LAPACKE/src/lapacke_zgbrfsx_work.c | 28 +- LAPACKE/src/lapacke_zgbsv.c | 10 +- LAPACKE/src/lapacke_zgbsv_work.c | 18 +- LAPACKE/src/lapacke_zgbsvx.c | 28 +- LAPACKE/src/lapacke_zgbsvx_work.c | 40 +-- LAPACKE/src/lapacke_zgbsvxx.c | 30 +- LAPACKE/src/lapacke_zgbsvxx_work.c | 44 +-- LAPACKE/src/lapacke_zgbtrf.c | 8 +- LAPACKE/src/lapacke_zgbtrf_work.c | 12 +- LAPACKE/src/lapacke_zgbtrs.c | 10 +- LAPACKE/src/lapacke_zgbtrs_work.c | 16 +- LAPACKE/src/lapacke_zgebak.c | 10 +- LAPACKE/src/lapacke_zgebak_work.c | 12 +- LAPACKE/src/lapacke_zgebal.c | 12 +- LAPACKE/src/lapacke_zgebal_work.c | 28 +- LAPACKE/src/lapacke_zgebrd.c | 12 +- LAPACKE/src/lapacke_zgebrd_work.c | 12 +- LAPACKE/src/lapacke_zgecon.c | 12 +- LAPACKE/src/lapacke_zgecon_work.c | 10 +- LAPACKE/src/lapacke_zgedmd.c | 34 +-- LAPACKE/src/lapacke_zgedmd_work.c | 64 ++-- LAPACKE/src/lapacke_zgedmdq.c | 24 +- LAPACKE/src/lapacke_zgedmdq_work.c | 48 +-- LAPACKE/src/lapacke_zgeequ.c | 8 +- LAPACKE/src/lapacke_zgeequ_work.c | 10 +- LAPACKE/src/lapacke_zgeequb.c | 8 +- LAPACKE/src/lapacke_zgeequb_work.c | 10 +- LAPACKE/src/lapacke_zgees.c | 16 +- LAPACKE/src/lapacke_zgees_work.c | 22 +- LAPACKE/src/lapacke_zgeesx.c | 16 +- LAPACKE/src/lapacke_zgeesx_work.c | 22 +- LAPACKE/src/lapacke_zgeev.c | 12 +- LAPACKE/src/lapacke_zgeev_work.c | 36 +-- LAPACKE/src/lapacke_zgeevx.c | 12 +- LAPACKE/src/lapacke_zgeevx_work.c | 36 +-- LAPACKE/src/lapacke_zgehrd.c | 12 +- LAPACKE/src/lapacke_zgehrd_work.c | 12 +- LAPACKE/src/lapacke_zgejsv.c | 108 +++---- LAPACKE/src/lapacke_zgejsv_work.c | 50 ++-- LAPACKE/src/lapacke_zgelq.c | 12 +- LAPACKE/src/lapacke_zgelq2.c | 10 +- LAPACKE/src/lapacke_zgelq2_work.c | 12 +- LAPACKE/src/lapacke_zgelq_work.c | 12 +- LAPACKE/src/lapacke_zgelqf.c | 12 +- LAPACKE/src/lapacke_zgelqf_work.c | 12 +- LAPACKE/src/lapacke_zgels.c | 14 +- LAPACKE/src/lapacke_zgels_work.c | 18 +- LAPACKE/src/lapacke_zgelsd.c | 16 +- LAPACKE/src/lapacke_zgelsd_work.c | 18 +- LAPACKE/src/lapacke_zgelss.c | 16 +- LAPACKE/src/lapacke_zgelss_work.c | 18 +- LAPACKE/src/lapacke_zgelsy.c | 16 +- LAPACKE/src/lapacke_zgelsy_work.c | 18 +- LAPACKE/src/lapacke_zgemlq.c | 16 +- LAPACKE/src/lapacke_zgemlq_work.c | 20 +- LAPACKE/src/lapacke_zgemqr.c | 18 +- LAPACKE/src/lapacke_zgemqr_work.c | 18 +- LAPACKE/src/lapacke_zgemqrt.c | 18 +- LAPACKE/src/lapacke_zgemqrt_work.c | 20 +- LAPACKE/src/lapacke_zgeqlf.c | 12 +- LAPACKE/src/lapacke_zgeqlf_work.c | 12 +- LAPACKE/src/lapacke_zgeqp3.c | 12 +- LAPACKE/src/lapacke_zgeqp3_work.c | 12 +- LAPACKE/src/lapacke_zgeqpf.c | 10 +- LAPACKE/src/lapacke_zgeqpf_work.c | 12 +- LAPACKE/src/lapacke_zgeqr.c | 12 +- LAPACKE/src/lapacke_zgeqr2.c | 10 +- LAPACKE/src/lapacke_zgeqr2_work.c | 12 +- LAPACKE/src/lapacke_zgeqr_work.c | 12 +- LAPACKE/src/lapacke_zgeqrf.c | 12 +- LAPACKE/src/lapacke_zgeqrf_work.c | 12 +- LAPACKE/src/lapacke_zgeqrfp.c | 12 +- LAPACKE/src/lapacke_zgeqrfp_work.c | 12 +- LAPACKE/src/lapacke_zgeqrt.c | 10 +- LAPACKE/src/lapacke_zgeqrt2.c | 8 +- LAPACKE/src/lapacke_zgeqrt2_work.c | 16 +- LAPACKE/src/lapacke_zgeqrt3.c | 8 +- LAPACKE/src/lapacke_zgeqrt3_work.c | 16 +- LAPACKE/src/lapacke_zgeqrt_work.c | 16 +- LAPACKE/src/lapacke_zgerfs.c | 16 +- LAPACKE/src/lapacke_zgerfs_work.c | 24 +- LAPACKE/src/lapacke_zgerfsx.c | 26 +- LAPACKE/src/lapacke_zgerfsx_work.c | 28 +- LAPACKE/src/lapacke_zgerqf.c | 12 +- LAPACKE/src/lapacke_zgerqf_work.c | 12 +- LAPACKE/src/lapacke_zgesdd.c | 14 +- LAPACKE/src/lapacke_zgesdd_work.c | 62 ++-- LAPACKE/src/lapacke_zgesv.c | 10 +- LAPACKE/src/lapacke_zgesv_work.c | 18 +- LAPACKE/src/lapacke_zgesvd.c | 12 +- LAPACKE/src/lapacke_zgesvd_work.c | 48 +-- LAPACKE/src/lapacke_zgesvdq.c | 12 +- LAPACKE/src/lapacke_zgesvdq_work.c | 44 +-- LAPACKE/src/lapacke_zgesvdx.c | 12 +- LAPACKE/src/lapacke_zgesvdx_work.c | 44 +-- LAPACKE/src/lapacke_zgesvj.c | 18 +- LAPACKE/src/lapacke_zgesvj_work.c | 30 +- LAPACKE/src/lapacke_zgesvx.c | 28 +- LAPACKE/src/lapacke_zgesvx_work.c | 40 +-- LAPACKE/src/lapacke_zgesvxx.c | 30 +- LAPACKE/src/lapacke_zgesvxx_work.c | 44 +-- LAPACKE/src/lapacke_zgetf2.c | 8 +- LAPACKE/src/lapacke_zgetf2_work.c | 12 +- LAPACKE/src/lapacke_zgetrf.c | 8 +- LAPACKE/src/lapacke_zgetrf2.c | 8 +- LAPACKE/src/lapacke_zgetrf2_work.c | 12 +- LAPACKE/src/lapacke_zgetrf_work.c | 12 +- LAPACKE/src/lapacke_zgetri.c | 12 +- LAPACKE/src/lapacke_zgetri_work.c | 12 +- LAPACKE/src/lapacke_zgetrs.c | 10 +- LAPACKE/src/lapacke_zgetrs_work.c | 16 +- LAPACKE/src/lapacke_zgetsls.c | 14 +- LAPACKE/src/lapacke_zgetsls_work.c | 18 +- LAPACKE/src/lapacke_zgetsqrhrt.c | 12 +- LAPACKE/src/lapacke_zgetsqrhrt_work.c | 16 +- LAPACKE/src/lapacke_zggbak.c | 12 +- LAPACKE/src/lapacke_zggbak_work.c | 12 +- LAPACKE/src/lapacke_zggbal.c | 22 +- LAPACKE/src/lapacke_zggbal_work.c | 50 ++-- LAPACKE/src/lapacke_zgges.c | 18 +- LAPACKE/src/lapacke_zgges3.c | 18 +- LAPACKE/src/lapacke_zgges3_work.c | 38 +-- LAPACKE/src/lapacke_zgges_work.c | 42 +-- LAPACKE/src/lapacke_zggesx.c | 18 +- LAPACKE/src/lapacke_zggesx_work.c | 42 +-- LAPACKE/src/lapacke_zggev.c | 14 +- LAPACKE/src/lapacke_zggev3.c | 14 +- LAPACKE/src/lapacke_zggev3_work.c | 46 +-- LAPACKE/src/lapacke_zggev_work.c | 46 +-- LAPACKE/src/lapacke_zggevx.c | 32 +- LAPACKE/src/lapacke_zggevx_work.c | 38 +-- LAPACKE/src/lapacke_zggglm.c | 16 +- LAPACKE/src/lapacke_zggglm_work.c | 18 +- LAPACKE/src/lapacke_zgghd3.c | 22 +- LAPACKE/src/lapacke_zgghd3_work.c | 46 +-- LAPACKE/src/lapacke_zgghrd.c | 18 +- LAPACKE/src/lapacke_zgghrd_work.c | 46 +-- LAPACKE/src/lapacke_zgglse.c | 18 +- LAPACKE/src/lapacke_zgglse_work.c | 18 +- LAPACKE/src/lapacke_zggqrf.c | 14 +- LAPACKE/src/lapacke_zggqrf_work.c | 18 +- LAPACKE/src/lapacke_zggrqf.c | 14 +- LAPACKE/src/lapacke_zggrqf_work.c | 18 +- LAPACKE/src/lapacke_zggsvd.c | 12 +- LAPACKE/src/lapacke_zggsvd3.c | 14 +- LAPACKE/src/lapacke_zggsvd3_work.c | 48 +-- LAPACKE/src/lapacke_zggsvd_work.c | 48 +-- LAPACKE/src/lapacke_zggsvp.c | 16 +- LAPACKE/src/lapacke_zggsvp3.c | 18 +- LAPACKE/src/lapacke_zggsvp3_work.c | 48 +-- LAPACKE/src/lapacke_zggsvp_work.c | 48 +-- LAPACKE/src/lapacke_zgtcon.c | 16 +- LAPACKE/src/lapacke_zgtcon_work.c | 2 +- LAPACKE/src/lapacke_zgtrfs.c | 26 +- LAPACKE/src/lapacke_zgtrfs_work.c | 16 +- LAPACKE/src/lapacke_zgtsv.c | 14 +- LAPACKE/src/lapacke_zgtsv_work.c | 12 +- LAPACKE/src/lapacke_zgtsvx.c | 32 +- LAPACKE/src/lapacke_zgtsvx_work.c | 14 +- LAPACKE/src/lapacke_zgttrf.c | 10 +- LAPACKE/src/lapacke_zgttrf_work.c | 2 +- LAPACKE/src/lapacke_zgttrs.c | 16 +- LAPACKE/src/lapacke_zgttrs_work.c | 12 +- LAPACKE/src/lapacke_zhbev.c | 10 +- LAPACKE/src/lapacke_zhbev_2stage.c | 12 +- LAPACKE/src/lapacke_zhbev_2stage_work.c | 22 +- LAPACKE/src/lapacke_zhbev_work.c | 22 +- LAPACKE/src/lapacke_zhbevd.c | 12 +- LAPACKE/src/lapacke_zhbevd_2stage.c | 12 +- LAPACKE/src/lapacke_zhbevd_2stage_work.c | 22 +- LAPACKE/src/lapacke_zhbevd_work.c | 22 +- LAPACKE/src/lapacke_zhbevx.c | 20 +- LAPACKE/src/lapacke_zhbevx_2stage.c | 22 +- LAPACKE/src/lapacke_zhbevx_2stage_work.c | 38 +-- LAPACKE/src/lapacke_zhbevx_work.c | 38 +-- LAPACKE/src/lapacke_zhbgst.c | 12 +- LAPACKE/src/lapacke_zhbgst_work.c | 26 +- LAPACKE/src/lapacke_zhbgv.c | 12 +- LAPACKE/src/lapacke_zhbgv_work.c | 28 +- LAPACKE/src/lapacke_zhbgvd.c | 14 +- LAPACKE/src/lapacke_zhbgvd_work.c | 28 +- LAPACKE/src/lapacke_zhbgvx.c | 22 +- LAPACKE/src/lapacke_zhbgvx_work.c | 38 +-- LAPACKE/src/lapacke_zhbtrd.c | 14 +- LAPACKE/src/lapacke_zhbtrd_work.c | 26 +- LAPACKE/src/lapacke_zhecon.c | 12 +- LAPACKE/src/lapacke_zhecon_3.c | 16 +- LAPACKE/src/lapacke_zhecon_3_work.c | 10 +- LAPACKE/src/lapacke_zhecon_work.c | 10 +- LAPACKE/src/lapacke_zheequb.c | 10 +- LAPACKE/src/lapacke_zheequb_work.c | 10 +- LAPACKE/src/lapacke_zheev.c | 12 +- LAPACKE/src/lapacke_zheev_2stage.c | 12 +- LAPACKE/src/lapacke_zheev_2stage_work.c | 12 +- LAPACKE/src/lapacke_zheev_work.c | 14 +- LAPACKE/src/lapacke_zheevd.c | 12 +- LAPACKE/src/lapacke_zheevd_2stage.c | 12 +- LAPACKE/src/lapacke_zheevd_2stage_work.c | 14 +- LAPACKE/src/lapacke_zheevd_work.c | 14 +- LAPACKE/src/lapacke_zheevr.c | 22 +- LAPACKE/src/lapacke_zheevr_2stage.c | 22 +- LAPACKE/src/lapacke_zheevr_2stage_work.c | 28 +- LAPACKE/src/lapacke_zheevr_work.c | 30 +- LAPACKE/src/lapacke_zheevx.c | 22 +- LAPACKE/src/lapacke_zheevx_2stage.c | 22 +- LAPACKE/src/lapacke_zheevx_2stage_work.c | 28 +- LAPACKE/src/lapacke_zheevx_work.c | 30 +- LAPACKE/src/lapacke_zhegst.c | 10 +- LAPACKE/src/lapacke_zhegst_work.c | 16 +- LAPACKE/src/lapacke_zhegv.c | 14 +- LAPACKE/src/lapacke_zhegv_2stage.c | 14 +- LAPACKE/src/lapacke_zhegv_2stage_work.c | 18 +- LAPACKE/src/lapacke_zhegv_work.c | 18 +- LAPACKE/src/lapacke_zhegvd.c | 14 +- LAPACKE/src/lapacke_zhegvd_work.c | 18 +- LAPACKE/src/lapacke_zhegvx.c | 24 +- LAPACKE/src/lapacke_zhegvx_work.c | 34 +-- LAPACKE/src/lapacke_zherfs.c | 16 +- LAPACKE/src/lapacke_zherfs_work.c | 24 +- LAPACKE/src/lapacke_zherfsx.c | 22 +- LAPACKE/src/lapacke_zherfsx_work.c | 28 +- LAPACKE/src/lapacke_zhesv.c | 14 +- LAPACKE/src/lapacke_zhesv_aa.c | 14 +- LAPACKE/src/lapacke_zhesv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_zhesv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_zhesv_aa_work.c | 18 +- LAPACKE/src/lapacke_zhesv_rk.c | 14 +- LAPACKE/src/lapacke_zhesv_rk_work.c | 18 +- LAPACKE/src/lapacke_zhesv_work.c | 18 +- LAPACKE/src/lapacke_zhesvx.c | 18 +- LAPACKE/src/lapacke_zhesvx_work.c | 28 +- LAPACKE/src/lapacke_zhesvxx.c | 22 +- LAPACKE/src/lapacke_zhesvxx_work.c | 40 +-- LAPACKE/src/lapacke_zheswapr.c | 8 +- LAPACKE/src/lapacke_zheswapr_work.c | 10 +- LAPACKE/src/lapacke_zhetrd.c | 12 +- LAPACKE/src/lapacke_zhetrd_work.c | 12 +- LAPACKE/src/lapacke_zhetrf.c | 12 +- LAPACKE/src/lapacke_zhetrf_aa.c | 12 +- LAPACKE/src/lapacke_zhetrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_zhetrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_zhetrf_aa_work.c | 12 +- LAPACKE/src/lapacke_zhetrf_rk.c | 12 +- LAPACKE/src/lapacke_zhetrf_rk_work.c | 12 +- LAPACKE/src/lapacke_zhetrf_rook.c | 12 +- LAPACKE/src/lapacke_zhetrf_rook_work.c | 12 +- LAPACKE/src/lapacke_zhetrf_work.c | 12 +- LAPACKE/src/lapacke_zhetri.c | 10 +- LAPACKE/src/lapacke_zhetri2.c | 12 +- LAPACKE/src/lapacke_zhetri2_work.c | 12 +- LAPACKE/src/lapacke_zhetri2x.c | 10 +- LAPACKE/src/lapacke_zhetri2x_work.c | 12 +- LAPACKE/src/lapacke_zhetri_3.c | 16 +- LAPACKE/src/lapacke_zhetri_3_work.c | 12 +- LAPACKE/src/lapacke_zhetri_work.c | 12 +- LAPACKE/src/lapacke_zhetrs.c | 10 +- LAPACKE/src/lapacke_zhetrs2.c | 12 +- LAPACKE/src/lapacke_zhetrs2_work.c | 16 +- LAPACKE/src/lapacke_zhetrs_3.c | 12 +- LAPACKE/src/lapacke_zhetrs_3_work.c | 16 +- LAPACKE/src/lapacke_zhetrs_aa.c | 14 +- LAPACKE/src/lapacke_zhetrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_zhetrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_zhetrs_aa_work.c | 16 +- LAPACKE/src/lapacke_zhetrs_rook.c | 10 +- LAPACKE/src/lapacke_zhetrs_rook_work.c | 16 +- LAPACKE/src/lapacke_zhetrs_work.c | 16 +- LAPACKE/src/lapacke_zhfrk.c | 18 +- LAPACKE/src/lapacke_zhfrk_work.c | 18 +- LAPACKE/src/lapacke_zhgeqz.c | 22 +- LAPACKE/src/lapacke_zhgeqz_work.c | 46 +-- LAPACKE/src/lapacke_zhpcon.c | 12 +- LAPACKE/src/lapacke_zhpcon_work.c | 8 +- LAPACKE/src/lapacke_zhpev.c | 10 +- LAPACKE/src/lapacke_zhpev_work.c | 20 +- LAPACKE/src/lapacke_zhpevd.c | 12 +- LAPACKE/src/lapacke_zhpevd_work.c | 20 +- LAPACKE/src/lapacke_zhpevx.c | 20 +- LAPACKE/src/lapacke_zhpevx_work.c | 26 +- LAPACKE/src/lapacke_zhpgst.c | 10 +- LAPACKE/src/lapacke_zhpgst_work.c | 12 +- LAPACKE/src/lapacke_zhpgv.c | 12 +- LAPACKE/src/lapacke_zhpgv_work.c | 24 +- LAPACKE/src/lapacke_zhpgvd.c | 14 +- LAPACKE/src/lapacke_zhpgvd_work.c | 24 +- LAPACKE/src/lapacke_zhpgvx.c | 22 +- LAPACKE/src/lapacke_zhpgvx_work.c | 30 +- LAPACKE/src/lapacke_zhprfs.c | 16 +- LAPACKE/src/lapacke_zhprfs_work.c | 20 +- LAPACKE/src/lapacke_zhpsv.c | 10 +- LAPACKE/src/lapacke_zhpsv_work.c | 16 +- LAPACKE/src/lapacke_zhpsvx.c | 16 +- LAPACKE/src/lapacke_zhpsvx_work.c | 24 +- LAPACKE/src/lapacke_zhptrd.c | 8 +- LAPACKE/src/lapacke_zhptrd_work.c | 10 +- LAPACKE/src/lapacke_zhptrf.c | 8 +- LAPACKE/src/lapacke_zhptrf_work.c | 10 +- LAPACKE/src/lapacke_zhptri.c | 10 +- LAPACKE/src/lapacke_zhptri_work.c | 10 +- LAPACKE/src/lapacke_zhptrs.c | 10 +- LAPACKE/src/lapacke_zhptrs_work.c | 14 +- LAPACKE/src/lapacke_zhsein.c | 20 +- LAPACKE/src/lapacke_zhsein_work.c | 42 +-- LAPACKE/src/lapacke_zhseqr.c | 16 +- LAPACKE/src/lapacke_zhseqr_work.c | 26 +- LAPACKE/src/lapacke_zlacgv.c | 6 +- LAPACKE/src/lapacke_zlacgv_work.c | 2 +- LAPACKE/src/lapacke_zlacn2.c | 8 +- LAPACKE/src/lapacke_zlacn2_work.c | 2 +- LAPACKE/src/lapacke_zlacp2.c | 8 +- LAPACKE/src/lapacke_zlacp2_work.c | 14 +- LAPACKE/src/lapacke_zlacpy.c | 8 +- LAPACKE/src/lapacke_zlacpy_work.c | 14 +- LAPACKE/src/lapacke_zlacrm.c | 12 +- LAPACKE/src/lapacke_zlacrm_work.c | 18 +- LAPACKE/src/lapacke_zlag2c.c | 8 +- LAPACKE/src/lapacke_zlag2c_work.c | 14 +- LAPACKE/src/lapacke_zlagge.c | 10 +- LAPACKE/src/lapacke_zlagge_work.c | 10 +- LAPACKE/src/lapacke_zlaghe.c | 10 +- LAPACKE/src/lapacke_zlaghe_work.c | 10 +- LAPACKE/src/lapacke_zlagsy.c | 10 +- LAPACKE/src/lapacke_zlagsy_work.c | 10 +- LAPACKE/src/lapacke_zlangb.c | 14 +- LAPACKE/src/lapacke_zlangb_work.c | 14 +- LAPACKE/src/lapacke_zlange.c | 14 +- LAPACKE/src/lapacke_zlange_work.c | 14 +- LAPACKE/src/lapacke_zlanhe.c | 18 +- LAPACKE/src/lapacke_zlanhe_work.c | 10 +- LAPACKE/src/lapacke_zlansy.c | 18 +- LAPACKE/src/lapacke_zlansy_work.c | 10 +- LAPACKE/src/lapacke_zlantr.c | 14 +- LAPACKE/src/lapacke_zlantr_work.c | 16 +- LAPACKE/src/lapacke_zlapmr.c | 8 +- LAPACKE/src/lapacke_zlapmr_work.c | 12 +- LAPACKE/src/lapacke_zlapmt.c | 8 +- LAPACKE/src/lapacke_zlapmt_work.c | 12 +- LAPACKE/src/lapacke_zlarcm.c | 12 +- LAPACKE/src/lapacke_zlarcm_work.c | 18 +- LAPACKE/src/lapacke_zlarfb.c | 26 +- LAPACKE/src/lapacke_zlarfb_work.c | 28 +- LAPACKE/src/lapacke_zlarfg.c | 8 +- LAPACKE/src/lapacke_zlarfg_work.c | 2 +- LAPACKE/src/lapacke_zlarft.c | 18 +- LAPACKE/src/lapacke_zlarft_work.c | 22 +- LAPACKE/src/lapacke_zlarfx.c | 14 +- LAPACKE/src/lapacke_zlarfx_work.c | 12 +- LAPACKE/src/lapacke_zlarnv.c | 4 +- LAPACKE/src/lapacke_zlarnv_work.c | 2 +- LAPACKE/src/lapacke_zlascl.c | 28 +- LAPACKE/src/lapacke_zlascl_work.c | 18 +- LAPACKE/src/lapacke_zlaset.c | 10 +- LAPACKE/src/lapacke_zlaset_work.c | 12 +- LAPACKE/src/lapacke_zlassq.c | 10 +- LAPACKE/src/lapacke_zlassq_work.c | 2 +- LAPACKE/src/lapacke_zlaswp.c | 10 +- LAPACKE/src/lapacke_zlaswp_work.c | 12 +- LAPACKE/src/lapacke_zlatms.c | 16 +- LAPACKE/src/lapacke_zlatms_work.c | 12 +- LAPACKE/src/lapacke_zlauum.c | 8 +- LAPACKE/src/lapacke_zlauum_work.c | 12 +- LAPACKE/src/lapacke_zpbcon.c | 12 +- LAPACKE/src/lapacke_zpbcon_work.c | 10 +- LAPACKE/src/lapacke_zpbequ.c | 8 +- LAPACKE/src/lapacke_zpbequ_work.c | 10 +- LAPACKE/src/lapacke_zpbrfs.c | 16 +- LAPACKE/src/lapacke_zpbrfs_work.c | 24 +- LAPACKE/src/lapacke_zpbstf.c | 8 +- LAPACKE/src/lapacke_zpbstf_work.c | 12 +- LAPACKE/src/lapacke_zpbsv.c | 10 +- LAPACKE/src/lapacke_zpbsv_work.c | 18 +- LAPACKE/src/lapacke_zpbsvx.c | 20 +- LAPACKE/src/lapacke_zpbsvx_work.c | 34 +-- LAPACKE/src/lapacke_zpbtrf.c | 8 +- LAPACKE/src/lapacke_zpbtrf_work.c | 12 +- LAPACKE/src/lapacke_zpbtrs.c | 10 +- LAPACKE/src/lapacke_zpbtrs_work.c | 16 +- LAPACKE/src/lapacke_zpftrf.c | 8 +- LAPACKE/src/lapacke_zpftrf_work.c | 10 +- LAPACKE/src/lapacke_zpftri.c | 8 +- LAPACKE/src/lapacke_zpftri_work.c | 10 +- LAPACKE/src/lapacke_zpftrs.c | 10 +- LAPACKE/src/lapacke_zpftrs_work.c | 14 +- LAPACKE/src/lapacke_zpocon.c | 12 +- LAPACKE/src/lapacke_zpocon_work.c | 10 +- LAPACKE/src/lapacke_zpoequ.c | 8 +- LAPACKE/src/lapacke_zpoequ_work.c | 10 +- LAPACKE/src/lapacke_zpoequb.c | 8 +- LAPACKE/src/lapacke_zpoequb_work.c | 10 +- LAPACKE/src/lapacke_zporfs.c | 16 +- LAPACKE/src/lapacke_zporfs_work.c | 24 +- LAPACKE/src/lapacke_zporfsx.c | 22 +- LAPACKE/src/lapacke_zporfsx_work.c | 28 +- LAPACKE/src/lapacke_zposv.c | 10 +- LAPACKE/src/lapacke_zposv_work.c | 18 +- LAPACKE/src/lapacke_zposvx.c | 20 +- LAPACKE/src/lapacke_zposvx_work.c | 34 +-- LAPACKE/src/lapacke_zposvxx.c | 22 +- LAPACKE/src/lapacke_zposvxx_work.c | 38 +-- LAPACKE/src/lapacke_zpotrf.c | 8 +- LAPACKE/src/lapacke_zpotrf2.c | 8 +- LAPACKE/src/lapacke_zpotrf2_work.c | 12 +- LAPACKE/src/lapacke_zpotrf_work.c | 12 +- LAPACKE/src/lapacke_zpotri.c | 8 +- LAPACKE/src/lapacke_zpotri_work.c | 12 +- LAPACKE/src/lapacke_zpotrs.c | 10 +- LAPACKE/src/lapacke_zpotrs_work.c | 16 +- LAPACKE/src/lapacke_zppcon.c | 12 +- LAPACKE/src/lapacke_zppcon_work.c | 8 +- LAPACKE/src/lapacke_zppequ.c | 8 +- LAPACKE/src/lapacke_zppequ_work.c | 8 +- LAPACKE/src/lapacke_zpprfs.c | 16 +- LAPACKE/src/lapacke_zpprfs_work.c | 20 +- LAPACKE/src/lapacke_zppsv.c | 10 +- LAPACKE/src/lapacke_zppsv_work.c | 16 +- LAPACKE/src/lapacke_zppsvx.c | 20 +- LAPACKE/src/lapacke_zppsvx_work.c | 30 +- LAPACKE/src/lapacke_zpptrf.c | 8 +- LAPACKE/src/lapacke_zpptrf_work.c | 10 +- LAPACKE/src/lapacke_zpptri.c | 8 +- LAPACKE/src/lapacke_zpptri_work.c | 10 +- LAPACKE/src/lapacke_zpptrs.c | 10 +- LAPACKE/src/lapacke_zpptrs_work.c | 14 +- LAPACKE/src/lapacke_zpstrf.c | 12 +- LAPACKE/src/lapacke_zpstrf_work.c | 12 +- LAPACKE/src/lapacke_zptcon.c | 12 +- LAPACKE/src/lapacke_zptcon_work.c | 2 +- LAPACKE/src/lapacke_zpteqr.c | 18 +- LAPACKE/src/lapacke_zpteqr_work.c | 14 +- LAPACKE/src/lapacke_zptrfs.c | 20 +- LAPACKE/src/lapacke_zptrfs_work.c | 16 +- LAPACKE/src/lapacke_zptsv.c | 12 +- LAPACKE/src/lapacke_zptsv_work.c | 12 +- LAPACKE/src/lapacke_zptsvx.c | 22 +- LAPACKE/src/lapacke_zptsvx_work.c | 14 +- LAPACKE/src/lapacke_zpttrf.c | 8 +- LAPACKE/src/lapacke_zpttrf_work.c | 2 +- LAPACKE/src/lapacke_zpttrs.c | 12 +- LAPACKE/src/lapacke_zpttrs_work.c | 12 +- LAPACKE/src/lapacke_zspcon.c | 12 +- LAPACKE/src/lapacke_zspcon_work.c | 8 +- LAPACKE/src/lapacke_zsprfs.c | 16 +- LAPACKE/src/lapacke_zsprfs_work.c | 20 +- LAPACKE/src/lapacke_zspsv.c | 10 +- LAPACKE/src/lapacke_zspsv_work.c | 16 +- LAPACKE/src/lapacke_zspsvx.c | 16 +- LAPACKE/src/lapacke_zspsvx_work.c | 24 +- LAPACKE/src/lapacke_zsptrf.c | 8 +- LAPACKE/src/lapacke_zsptrf_work.c | 10 +- LAPACKE/src/lapacke_zsptri.c | 10 +- LAPACKE/src/lapacke_zsptri_work.c | 10 +- LAPACKE/src/lapacke_zsptrs.c | 10 +- LAPACKE/src/lapacke_zsptrs_work.c | 14 +- LAPACKE/src/lapacke_zstedc.c | 18 +- LAPACKE/src/lapacke_zstedc_work.c | 20 +- LAPACKE/src/lapacke_zstegr.c | 24 +- LAPACKE/src/lapacke_zstegr_work.c | 18 +- LAPACKE/src/lapacke_zstein.c | 14 +- LAPACKE/src/lapacke_zstein_work.c | 10 +- LAPACKE/src/lapacke_zstemr.c | 18 +- LAPACKE/src/lapacke_zstemr_work.c | 18 +- LAPACKE/src/lapacke_zsteqr.c | 18 +- LAPACKE/src/lapacke_zsteqr_work.c | 20 +- LAPACKE/src/lapacke_zsycon.c | 12 +- LAPACKE/src/lapacke_zsycon_3.c | 16 +- LAPACKE/src/lapacke_zsycon_3_work.c | 10 +- LAPACKE/src/lapacke_zsycon_work.c | 10 +- LAPACKE/src/lapacke_zsyconv.c | 8 +- LAPACKE/src/lapacke_zsyconv_work.c | 12 +- LAPACKE/src/lapacke_zsyequb.c | 10 +- LAPACKE/src/lapacke_zsyequb_work.c | 10 +- LAPACKE/src/lapacke_zsyr.c | 12 +- LAPACKE/src/lapacke_zsyr_work.c | 12 +- LAPACKE/src/lapacke_zsyrfs.c | 16 +- LAPACKE/src/lapacke_zsyrfs_work.c | 24 +- LAPACKE/src/lapacke_zsyrfsx.c | 22 +- LAPACKE/src/lapacke_zsyrfsx_work.c | 28 +- LAPACKE/src/lapacke_zsysv.c | 14 +- LAPACKE/src/lapacke_zsysv_aa.c | 14 +- LAPACKE/src/lapacke_zsysv_aa_2stage.c | 16 +- LAPACKE/src/lapacke_zsysv_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_zsysv_aa_work.c | 18 +- LAPACKE/src/lapacke_zsysv_rk.c | 14 +- LAPACKE/src/lapacke_zsysv_rk_work.c | 18 +- LAPACKE/src/lapacke_zsysv_rook.c | 14 +- LAPACKE/src/lapacke_zsysv_rook_work.c | 18 +- LAPACKE/src/lapacke_zsysv_work.c | 18 +- LAPACKE/src/lapacke_zsysvx.c | 18 +- LAPACKE/src/lapacke_zsysvx_work.c | 28 +- LAPACKE/src/lapacke_zsysvxx.c | 22 +- LAPACKE/src/lapacke_zsysvxx_work.c | 40 +-- LAPACKE/src/lapacke_zsyswapr.c | 8 +- LAPACKE/src/lapacke_zsyswapr_work.c | 10 +- LAPACKE/src/lapacke_zsytrf.c | 12 +- LAPACKE/src/lapacke_zsytrf_aa.c | 12 +- LAPACKE/src/lapacke_zsytrf_aa_2stage.c | 14 +- LAPACKE/src/lapacke_zsytrf_aa_2stage_work.c | 14 +- LAPACKE/src/lapacke_zsytrf_aa_work.c | 12 +- LAPACKE/src/lapacke_zsytrf_rk.c | 12 +- LAPACKE/src/lapacke_zsytrf_rk_work.c | 12 +- LAPACKE/src/lapacke_zsytrf_rook.c | 12 +- LAPACKE/src/lapacke_zsytrf_rook_work.c | 12 +- LAPACKE/src/lapacke_zsytrf_work.c | 12 +- LAPACKE/src/lapacke_zsytri.c | 10 +- LAPACKE/src/lapacke_zsytri2.c | 12 +- LAPACKE/src/lapacke_zsytri2_work.c | 12 +- LAPACKE/src/lapacke_zsytri2x.c | 10 +- LAPACKE/src/lapacke_zsytri2x_work.c | 12 +- LAPACKE/src/lapacke_zsytri_3.c | 16 +- LAPACKE/src/lapacke_zsytri_3_work.c | 12 +- LAPACKE/src/lapacke_zsytri_work.c | 12 +- LAPACKE/src/lapacke_zsytrs.c | 10 +- LAPACKE/src/lapacke_zsytrs2.c | 12 +- LAPACKE/src/lapacke_zsytrs2_work.c | 16 +- LAPACKE/src/lapacke_zsytrs_3.c | 12 +- LAPACKE/src/lapacke_zsytrs_3_work.c | 16 +- LAPACKE/src/lapacke_zsytrs_aa.c | 14 +- LAPACKE/src/lapacke_zsytrs_aa_2stage.c | 12 +- LAPACKE/src/lapacke_zsytrs_aa_2stage_work.c | 20 +- LAPACKE/src/lapacke_zsytrs_aa_work.c | 16 +- LAPACKE/src/lapacke_zsytrs_rook.c | 10 +- LAPACKE/src/lapacke_zsytrs_rook_work.c | 16 +- LAPACKE/src/lapacke_zsytrs_work.c | 16 +- LAPACKE/src/lapacke_ztbcon.c | 10 +- LAPACKE/src/lapacke_ztbcon_work.c | 10 +- LAPACKE/src/lapacke_ztbrfs.c | 14 +- LAPACKE/src/lapacke_ztbrfs_work.c | 18 +- LAPACKE/src/lapacke_ztbtrs.c | 10 +- LAPACKE/src/lapacke_ztbtrs_work.c | 16 +- LAPACKE/src/lapacke_ztfsm.c | 12 +- LAPACKE/src/lapacke_ztfsm_work.c | 14 +- LAPACKE/src/lapacke_ztftri.c | 8 +- LAPACKE/src/lapacke_ztftri_work.c | 10 +- LAPACKE/src/lapacke_ztfttp.c | 8 +- LAPACKE/src/lapacke_ztfttp_work.c | 10 +- LAPACKE/src/lapacke_ztfttr.c | 8 +- LAPACKE/src/lapacke_ztfttr_work.c | 12 +- LAPACKE/src/lapacke_ztgevc.c | 20 +- LAPACKE/src/lapacke_ztgevc_work.c | 46 +-- LAPACKE/src/lapacke_ztgexc.c | 14 +- LAPACKE/src/lapacke_ztgexc_work.c | 30 +- LAPACKE/src/lapacke_ztgsen.c | 18 +- LAPACKE/src/lapacke_ztgsen_work.c | 30 +- LAPACKE/src/lapacke_ztgsja.c | 28 +- LAPACKE/src/lapacke_ztgsja_work.c | 60 ++-- LAPACKE/src/lapacke_ztgsna.c | 30 +- LAPACKE/src/lapacke_ztgsna_work.c | 34 +-- LAPACKE/src/lapacke_ztgsyl.c | 22 +- LAPACKE/src/lapacke_ztgsyl_work.c | 34 +-- LAPACKE/src/lapacke_ztpcon.c | 10 +- LAPACKE/src/lapacke_ztpcon_work.c | 8 +- LAPACKE/src/lapacke_ztpmqrt.c | 32 +- LAPACKE/src/lapacke_ztpmqrt_work.c | 32 +- LAPACKE/src/lapacke_ztpqrt.c | 12 +- LAPACKE/src/lapacke_ztpqrt2.c | 10 +- LAPACKE/src/lapacke_ztpqrt2_work.c | 22 +- LAPACKE/src/lapacke_ztpqrt_work.c | 22 +- LAPACKE/src/lapacke_ztprfb.c | 36 +-- LAPACKE/src/lapacke_ztprfb_work.c | 26 +- LAPACKE/src/lapacke_ztprfs.c | 14 +- LAPACKE/src/lapacke_ztprfs_work.c | 16 +- LAPACKE/src/lapacke_ztptri.c | 8 +- LAPACKE/src/lapacke_ztptri_work.c | 10 +- LAPACKE/src/lapacke_ztptrs.c | 10 +- LAPACKE/src/lapacke_ztptrs_work.c | 14 +- LAPACKE/src/lapacke_ztpttf.c | 8 +- LAPACKE/src/lapacke_ztpttf_work.c | 10 +- LAPACKE/src/lapacke_ztpttr.c | 8 +- LAPACKE/src/lapacke_ztpttr_work.c | 12 +- LAPACKE/src/lapacke_ztrcon.c | 10 +- LAPACKE/src/lapacke_ztrcon_work.c | 10 +- LAPACKE/src/lapacke_ztrevc.c | 18 +- LAPACKE/src/lapacke_ztrevc_work.c | 44 +-- LAPACKE/src/lapacke_ztrexc.c | 12 +- LAPACKE/src/lapacke_ztrexc_work.c | 28 +- LAPACKE/src/lapacke_ztrrfs.c | 14 +- LAPACKE/src/lapacke_ztrrfs_work.c | 18 +- LAPACKE/src/lapacke_ztrsen.c | 16 +- LAPACKE/src/lapacke_ztrsen_work.c | 26 +- LAPACKE/src/lapacke_ztrsna.c | 28 +- LAPACKE/src/lapacke_ztrsna_work.c | 30 +- LAPACKE/src/lapacke_ztrsyl.c | 12 +- LAPACKE/src/lapacke_ztrsyl3.c | 16 +- LAPACKE/src/lapacke_ztrsyl3_work.c | 20 +- LAPACKE/src/lapacke_ztrsyl_work.c | 20 +- LAPACKE/src/lapacke_ztrtri.c | 8 +- LAPACKE/src/lapacke_ztrtri_work.c | 12 +- LAPACKE/src/lapacke_ztrtrs.c | 10 +- LAPACKE/src/lapacke_ztrtrs_work.c | 16 +- LAPACKE/src/lapacke_ztrttf.c | 8 +- LAPACKE/src/lapacke_ztrttf_work.c | 12 +- LAPACKE/src/lapacke_ztrttp.c | 8 +- LAPACKE/src/lapacke_ztrttp_work.c | 12 +- LAPACKE/src/lapacke_ztzrzf.c | 12 +- LAPACKE/src/lapacke_ztzrzf_work.c | 12 +- LAPACKE/src/lapacke_zunbdb.c | 20 +- LAPACKE/src/lapacke_zunbdb_work.c | 6 +- LAPACKE/src/lapacke_zuncsd.c | 20 +- LAPACKE/src/lapacke_zuncsd2by1.c | 14 +- LAPACKE/src/lapacke_zuncsd2by1_work.c | 54 ++-- LAPACKE/src/lapacke_zuncsd_work.c | 6 +- LAPACKE/src/lapacke_zungbr.c | 14 +- LAPACKE/src/lapacke_zungbr_work.c | 12 +- LAPACKE/src/lapacke_zunghr.c | 14 +- LAPACKE/src/lapacke_zunghr_work.c | 12 +- LAPACKE/src/lapacke_zunglq.c | 14 +- LAPACKE/src/lapacke_zunglq_work.c | 12 +- LAPACKE/src/lapacke_zungql.c | 14 +- LAPACKE/src/lapacke_zungql_work.c | 12 +- LAPACKE/src/lapacke_zungqr.c | 14 +- LAPACKE/src/lapacke_zungqr_work.c | 12 +- LAPACKE/src/lapacke_zungrq.c | 14 +- LAPACKE/src/lapacke_zungrq_work.c | 12 +- LAPACKE/src/lapacke_zungtr.c | 14 +- LAPACKE/src/lapacke_zungtr_work.c | 12 +- LAPACKE/src/lapacke_zungtsqr_row.c | 14 +- LAPACKE/src/lapacke_zungtsqr_row_work.c | 16 +- LAPACKE/src/lapacke_zunhr_col.c | 8 +- LAPACKE/src/lapacke_zunhr_col_work.c | 16 +- LAPACKE/src/lapacke_zunmbr.c | 20 +- LAPACKE/src/lapacke_zunmbr_work.c | 22 +- LAPACKE/src/lapacke_zunmhr.c | 18 +- LAPACKE/src/lapacke_zunmhr_work.c | 18 +- LAPACKE/src/lapacke_zunmlq.c | 16 +- LAPACKE/src/lapacke_zunmlq_work.c | 20 +- LAPACKE/src/lapacke_zunmql.c | 18 +- LAPACKE/src/lapacke_zunmql_work.c | 18 +- LAPACKE/src/lapacke_zunmqr.c | 18 +- LAPACKE/src/lapacke_zunmqr_work.c | 18 +- LAPACKE/src/lapacke_zunmrq.c | 16 +- LAPACKE/src/lapacke_zunmrq_work.c | 16 +- LAPACKE/src/lapacke_zunmrz.c | 16 +- LAPACKE/src/lapacke_zunmrz_work.c | 16 +- LAPACKE/src/lapacke_zunmtr.c | 18 +- LAPACKE/src/lapacke_zunmtr_work.c | 18 +- LAPACKE/src/lapacke_zupgtr.c | 12 +- LAPACKE/src/lapacke_zupgtr_work.c | 12 +- LAPACKE/src/lapacke_zupmtr.c | 20 +- LAPACKE/src/lapacke_zupmtr_work.c | 16 +- LAPACKE/utils/lapacke_c_nancheck.c | 2 +- LAPACKE/utils/lapacke_cgb_nancheck.c | 2 +- LAPACKE/utils/lapacke_cgb_trans.c | 2 +- LAPACKE/utils/lapacke_cge_nancheck.c | 2 +- LAPACKE/utils/lapacke_cge_trans.c | 2 +- LAPACKE/utils/lapacke_cgg_nancheck.c | 4 +- LAPACKE/utils/lapacke_cgg_trans.c | 4 +- LAPACKE/utils/lapacke_cgt_nancheck.c | 8 +- LAPACKE/utils/lapacke_chb_nancheck.c | 10 +- LAPACKE/utils/lapacke_chb_trans.c | 10 +- LAPACKE/utils/lapacke_che_nancheck.c | 4 +- LAPACKE/utils/lapacke_che_trans.c | 4 +- LAPACKE/utils/lapacke_chp_nancheck.c | 4 +- LAPACKE/utils/lapacke_chp_trans.c | 4 +- LAPACKE/utils/lapacke_chs_nancheck.c | 8 +- LAPACKE/utils/lapacke_chs_trans.c | 8 +- LAPACKE/utils/lapacke_cpb_nancheck.c | 10 +- LAPACKE/utils/lapacke_cpb_trans.c | 10 +- LAPACKE/utils/lapacke_cpf_nancheck.c | 4 +- LAPACKE/utils/lapacke_cpf_trans.c | 4 +- LAPACKE/utils/lapacke_cpo_nancheck.c | 4 +- LAPACKE/utils/lapacke_cpo_trans.c | 4 +- LAPACKE/utils/lapacke_cpp_nancheck.c | 4 +- LAPACKE/utils/lapacke_cpp_trans.c | 4 +- LAPACKE/utils/lapacke_cpt_nancheck.c | 6 +- LAPACKE/utils/lapacke_csp_nancheck.c | 4 +- LAPACKE/utils/lapacke_csp_trans.c | 4 +- LAPACKE/utils/lapacke_cst_nancheck.c | 6 +- LAPACKE/utils/lapacke_csy_nancheck.c | 4 +- LAPACKE/utils/lapacke_csy_trans.c | 4 +- LAPACKE/utils/lapacke_ctb_nancheck.c | 22 +- LAPACKE/utils/lapacke_ctb_trans.c | 22 +- LAPACKE/utils/lapacke_ctf_nancheck.c | 66 ++--- LAPACKE/utils/lapacke_ctf_trans.c | 20 +- LAPACKE/utils/lapacke_ctp_nancheck.c | 16 +- LAPACKE/utils/lapacke_ctp_trans.c | 10 +- LAPACKE/utils/lapacke_ctr_nancheck.c | 10 +- LAPACKE/utils/lapacke_ctr_trans.c | 10 +- LAPACKE/utils/lapacke_ctz_nancheck.c | 18 +- LAPACKE/utils/lapacke_ctz_trans.c | 18 +- LAPACKE/utils/lapacke_d_nancheck.c | 2 +- LAPACKE/utils/lapacke_dgb_nancheck.c | 2 +- LAPACKE/utils/lapacke_dgb_trans.c | 2 +- LAPACKE/utils/lapacke_dge_nancheck.c | 2 +- LAPACKE/utils/lapacke_dge_trans.c | 2 +- LAPACKE/utils/lapacke_dgg_nancheck.c | 4 +- LAPACKE/utils/lapacke_dgg_trans.c | 4 +- LAPACKE/utils/lapacke_dgt_nancheck.c | 8 +- LAPACKE/utils/lapacke_dhs_nancheck.c | 8 +- LAPACKE/utils/lapacke_dhs_trans.c | 8 +- LAPACKE/utils/lapacke_dpb_nancheck.c | 10 +- LAPACKE/utils/lapacke_dpb_trans.c | 10 +- LAPACKE/utils/lapacke_dpf_nancheck.c | 4 +- LAPACKE/utils/lapacke_dpf_trans.c | 4 +- LAPACKE/utils/lapacke_dpo_nancheck.c | 4 +- LAPACKE/utils/lapacke_dpo_trans.c | 4 +- LAPACKE/utils/lapacke_dpp_nancheck.c | 4 +- LAPACKE/utils/lapacke_dpp_trans.c | 4 +- LAPACKE/utils/lapacke_dpt_nancheck.c | 6 +- LAPACKE/utils/lapacke_dsb_nancheck.c | 10 +- LAPACKE/utils/lapacke_dsb_trans.c | 10 +- LAPACKE/utils/lapacke_dsp_nancheck.c | 4 +- LAPACKE/utils/lapacke_dsp_trans.c | 4 +- LAPACKE/utils/lapacke_dst_nancheck.c | 6 +- LAPACKE/utils/lapacke_dsy_nancheck.c | 4 +- LAPACKE/utils/lapacke_dsy_trans.c | 4 +- LAPACKE/utils/lapacke_dtb_nancheck.c | 22 +- LAPACKE/utils/lapacke_dtb_trans.c | 22 +- LAPACKE/utils/lapacke_dtf_nancheck.c | 66 ++--- LAPACKE/utils/lapacke_dtf_trans.c | 20 +- LAPACKE/utils/lapacke_dtp_nancheck.c | 16 +- LAPACKE/utils/lapacke_dtp_trans.c | 10 +- LAPACKE/utils/lapacke_dtr_nancheck.c | 10 +- LAPACKE/utils/lapacke_dtr_trans.c | 10 +- LAPACKE/utils/lapacke_dtz_nancheck.c | 18 +- LAPACKE/utils/lapacke_dtz_trans.c | 18 +- LAPACKE/utils/lapacke_lsame.c | 2 +- LAPACKE/utils/lapacke_s_nancheck.c | 2 +- LAPACKE/utils/lapacke_sgb_nancheck.c | 2 +- LAPACKE/utils/lapacke_sgb_trans.c | 2 +- LAPACKE/utils/lapacke_sge_nancheck.c | 2 +- LAPACKE/utils/lapacke_sge_trans.c | 2 +- LAPACKE/utils/lapacke_sgg_nancheck.c | 4 +- LAPACKE/utils/lapacke_sgg_trans.c | 4 +- LAPACKE/utils/lapacke_sgt_nancheck.c | 8 +- LAPACKE/utils/lapacke_shs_nancheck.c | 8 +- LAPACKE/utils/lapacke_shs_trans.c | 8 +- LAPACKE/utils/lapacke_spb_nancheck.c | 10 +- LAPACKE/utils/lapacke_spb_trans.c | 10 +- LAPACKE/utils/lapacke_spf_nancheck.c | 4 +- LAPACKE/utils/lapacke_spf_trans.c | 4 +- LAPACKE/utils/lapacke_spo_nancheck.c | 4 +- LAPACKE/utils/lapacke_spo_trans.c | 4 +- LAPACKE/utils/lapacke_spp_nancheck.c | 4 +- LAPACKE/utils/lapacke_spp_trans.c | 4 +- LAPACKE/utils/lapacke_spt_nancheck.c | 6 +- LAPACKE/utils/lapacke_ssb_nancheck.c | 10 +- LAPACKE/utils/lapacke_ssb_trans.c | 10 +- LAPACKE/utils/lapacke_ssp_nancheck.c | 4 +- LAPACKE/utils/lapacke_ssp_trans.c | 4 +- LAPACKE/utils/lapacke_sst_nancheck.c | 6 +- LAPACKE/utils/lapacke_ssy_nancheck.c | 4 +- LAPACKE/utils/lapacke_ssy_trans.c | 4 +- LAPACKE/utils/lapacke_stb_nancheck.c | 22 +- LAPACKE/utils/lapacke_stb_trans.c | 22 +- LAPACKE/utils/lapacke_stf_nancheck.c | 66 ++--- LAPACKE/utils/lapacke_stf_trans.c | 20 +- LAPACKE/utils/lapacke_stp_nancheck.c | 16 +- LAPACKE/utils/lapacke_stp_trans.c | 10 +- LAPACKE/utils/lapacke_str_nancheck.c | 10 +- LAPACKE/utils/lapacke_str_trans.c | 10 +- LAPACKE/utils/lapacke_stz_nancheck.c | 18 +- LAPACKE/utils/lapacke_stz_trans.c | 18 +- LAPACKE/utils/lapacke_xerbla.c | 2 +- LAPACKE/utils/lapacke_z_nancheck.c | 2 +- LAPACKE/utils/lapacke_zgb_nancheck.c | 2 +- LAPACKE/utils/lapacke_zgb_trans.c | 2 +- LAPACKE/utils/lapacke_zge_nancheck.c | 2 +- LAPACKE/utils/lapacke_zge_trans.c | 2 +- LAPACKE/utils/lapacke_zgg_nancheck.c | 4 +- LAPACKE/utils/lapacke_zgg_trans.c | 4 +- LAPACKE/utils/lapacke_zgt_nancheck.c | 8 +- LAPACKE/utils/lapacke_zhb_nancheck.c | 10 +- LAPACKE/utils/lapacke_zhb_trans.c | 10 +- LAPACKE/utils/lapacke_zhe_nancheck.c | 4 +- LAPACKE/utils/lapacke_zhe_trans.c | 4 +- LAPACKE/utils/lapacke_zhp_nancheck.c | 4 +- LAPACKE/utils/lapacke_zhp_trans.c | 4 +- LAPACKE/utils/lapacke_zhs_nancheck.c | 8 +- LAPACKE/utils/lapacke_zhs_trans.c | 8 +- LAPACKE/utils/lapacke_zpb_nancheck.c | 10 +- LAPACKE/utils/lapacke_zpb_trans.c | 10 +- LAPACKE/utils/lapacke_zpf_nancheck.c | 4 +- LAPACKE/utils/lapacke_zpf_trans.c | 4 +- LAPACKE/utils/lapacke_zpo_nancheck.c | 4 +- LAPACKE/utils/lapacke_zpo_trans.c | 4 +- LAPACKE/utils/lapacke_zpp_nancheck.c | 4 +- LAPACKE/utils/lapacke_zpp_trans.c | 4 +- LAPACKE/utils/lapacke_zpt_nancheck.c | 6 +- LAPACKE/utils/lapacke_zsp_nancheck.c | 4 +- LAPACKE/utils/lapacke_zsp_trans.c | 4 +- LAPACKE/utils/lapacke_zst_nancheck.c | 6 +- LAPACKE/utils/lapacke_zsy_nancheck.c | 4 +- LAPACKE/utils/lapacke_zsy_trans.c | 4 +- LAPACKE/utils/lapacke_ztb_nancheck.c | 22 +- LAPACKE/utils/lapacke_ztb_trans.c | 22 +- LAPACKE/utils/lapacke_ztf_nancheck.c | 66 ++--- LAPACKE/utils/lapacke_ztf_trans.c | 20 +- LAPACKE/utils/lapacke_ztp_nancheck.c | 16 +- LAPACKE/utils/lapacke_ztp_trans.c | 10 +- LAPACKE/utils/lapacke_ztr_nancheck.c | 10 +- LAPACKE/utils/lapacke_ztr_trans.c | 10 +- LAPACKE/utils/lapacke_ztz_nancheck.c | 18 +- LAPACKE/utils/lapacke_ztz_trans.c | 18 +- 2677 files changed, 22141 insertions(+), 22141 deletions(-) diff --git a/LAPACKE/include/lapacke_utils.h b/LAPACKE/include/lapacke_utils.h index 332a5024fb..0b9d9a1f42 100644 --- a/LAPACKE/include/lapacke_utils.h +++ b/LAPACKE/include/lapacke_utils.h @@ -63,240 +63,240 @@ extern "C" { IS_D_NONZERO(*(((double*)&x)+1)) ) /* Error handler */ -void LAPACKE_xerbla( const char *name, lapack_int info ); +void API_SUFFIX(LAPACKE_xerbla)( const char *name, lapack_int info ); /* Compare two chars (case-insensitive) */ -lapack_logical LAPACKE_lsame( char ca, char cb ) +lapack_logical API_SUFFIX(LAPACKE_lsame)( char ca, char cb ) #if defined __GNUC__ __attribute__((const)) #endif ; /* Functions to convert column-major to row-major 2d arrays and vice versa. */ -void LAPACKE_cgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_cge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cge_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* in, lapack_int ldin, lapack_complex_float* out, lapack_int ldout ); -void LAPACKE_cgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* in, lapack_int ldin, lapack_complex_float* out, lapack_int ldout ); -void LAPACKE_chb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_chb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_che_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_che_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_chp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_chp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_chs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_chs_trans)( int matrix_layout, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_cpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_cpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_cpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_cpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpo_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_cpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_csp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_csp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_csy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_csy_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_ctb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_ctf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_ctp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ); -void LAPACKE_ctr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_ctr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_ctz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ); -void LAPACKE_dgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dge_trans)( int matrix_layout, lapack_int m, lapack_int n, const double* in, lapack_int ldin, double* out, lapack_int ldout ); -void LAPACKE_dgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const double* in, lapack_int ldin, double* out, lapack_int ldout ); -void LAPACKE_dhs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_dhs_trans)( int matrix_layout, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_dpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const double *in, double *out ); -void LAPACKE_dpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpo_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpp_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, double *out ); -void LAPACKE_dsb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dsp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsp_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, double *out ); -void LAPACKE_dsy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsy_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dtb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dtf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const double *in, double *out ); -void LAPACKE_dtp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const double *in, double *out ); -void LAPACKE_dtr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_dtr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_dtz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ); -void LAPACKE_sgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_sge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sge_trans)( int matrix_layout, lapack_int m, lapack_int n, const float* in, lapack_int ldin, float* out, lapack_int ldout ); -void LAPACKE_sgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const float* in, lapack_int ldin, float* out, lapack_int ldout ); -void LAPACKE_shs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_shs_trans)( int matrix_layout, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_spb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_spf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_spf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const float *in, float *out ); -void LAPACKE_spo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spo_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_spp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spp_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, float *out ); -void LAPACKE_ssb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_ssp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssp_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, float *out ); -void LAPACKE_ssy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssy_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_stb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_stb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_stf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_stf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const float *in, float *out ); -void LAPACKE_stp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_stp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const float *in, float *out ); -void LAPACKE_str_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_str_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_stz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ); -void LAPACKE_zgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zge_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* in, lapack_int ldin, lapack_complex_double* out, lapack_int ldout ); -void LAPACKE_zgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* in, lapack_int ldin, lapack_complex_double* out, lapack_int ldout ); -void LAPACKE_zhb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zhe_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhe_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zhp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_zhs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_zhs_trans)( int matrix_layout, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_zpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_zpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpo_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_zpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_zsp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zsp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_zsy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zsy_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_ztb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_ztf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_ztp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ); -void LAPACKE_ztr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_ztr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); -void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_ztz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ); @@ -310,297 +310,297 @@ void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo, LAPACK_DISNAN(*(((double*)&x)+1)) ) /* NaN checkers for vectors */ -lapack_logical LAPACKE_c_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_c_nancheck)( lapack_int n, const lapack_complex_float *x, lapack_int incx ); -lapack_logical LAPACKE_d_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_d_nancheck)( lapack_int n, const double *x, lapack_int incx ); -lapack_logical LAPACKE_s_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_s_nancheck)( lapack_int n, const float *x, lapack_int incx ); -lapack_logical LAPACKE_z_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_z_nancheck)( lapack_int n, const lapack_complex_double *x, lapack_int incx ); /* NaN checkers for matrices */ -lapack_logical LAPACKE_cgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float *ab, lapack_int ldab ); -lapack_logical LAPACKE_cge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_cgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_cgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cgt_nancheck)( lapack_int n, const lapack_complex_float *dl, const lapack_complex_float *d, const lapack_complex_float *du ); -lapack_logical LAPACKE_chb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_chb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ); -lapack_logical LAPACKE_che_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_che_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_chp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_chp_nancheck)( lapack_int n, const lapack_complex_float *ap ); -lapack_logical LAPACKE_chs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_chs_nancheck)( int matrix_layout, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_cpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_cpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ); -lapack_logical LAPACKE_cpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpf_nancheck)( lapack_int n, const lapack_complex_float *a ); -lapack_logical LAPACKE_cpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_cpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_cpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpp_nancheck)( lapack_int n, const lapack_complex_float *ap ); -lapack_logical LAPACKE_cpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpt_nancheck)( lapack_int n, const float *d, const lapack_complex_float *e ); -lapack_logical LAPACKE_csp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_csp_nancheck)( lapack_int n, const lapack_complex_float *ap ); -lapack_logical LAPACKE_cst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cst_nancheck)( lapack_int n, const lapack_complex_float *d, const lapack_complex_float *e ); -lapack_logical LAPACKE_csy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_csy_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_ctb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ); -lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_ctf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_float *a ); -lapack_logical LAPACKE_ctp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *ap ); -lapack_logical LAPACKE_ctr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ctz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ); -lapack_logical LAPACKE_dgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double *ab, lapack_int ldab ); -lapack_logical LAPACKE_dge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dgt_nancheck)( lapack_int n, const double *dl, const double *d, const double *du ); -lapack_logical LAPACKE_dhs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dhs_nancheck)( int matrix_layout, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ); -lapack_logical LAPACKE_dpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpf_nancheck)( lapack_int n, const double *a ); -lapack_logical LAPACKE_dpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpp_nancheck)( lapack_int n, const double *ap ); -lapack_logical LAPACKE_dpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpt_nancheck)( lapack_int n, const double *d, const double *e ); -lapack_logical LAPACKE_dsb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dsb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ); -lapack_logical LAPACKE_dsp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dsp_nancheck)( lapack_int n, const double *ap ); -lapack_logical LAPACKE_dst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dst_nancheck)( lapack_int n, const double *d, const double *e ); -lapack_logical LAPACKE_dsy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dsy_nancheck)( int matrix_layout, char uplo, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dtb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ); -lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_dtf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const double *a ); -lapack_logical LAPACKE_dtp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const double *ap ); -lapack_logical LAPACKE_dtr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dtz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const double *a, lapack_int lda ); -lapack_logical LAPACKE_sgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float *ab, lapack_int ldab ); -lapack_logical LAPACKE_sge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_sgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_sgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_sgt_nancheck)( lapack_int n, const float *dl, const float *d, const float *du ); -lapack_logical LAPACKE_shs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_shs_nancheck)( int matrix_layout, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_spb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_spb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ); -lapack_logical LAPACKE_spf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spf_nancheck)( lapack_int n, const float *a ); -lapack_logical LAPACKE_spo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_spo_nancheck)( int matrix_layout, char uplo, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_spp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spp_nancheck)( lapack_int n, const float *ap ); -lapack_logical LAPACKE_spt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spt_nancheck)( lapack_int n, const float *d, const float *e ); -lapack_logical LAPACKE_ssb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ssb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ); -lapack_logical LAPACKE_ssp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_ssp_nancheck)( lapack_int n, const float *ap ); -lapack_logical LAPACKE_sst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_sst_nancheck)( lapack_int n, const float *d, const float *e ); -lapack_logical LAPACKE_ssy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ssy_nancheck)( int matrix_layout, char uplo, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_stb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_stb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ); -lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_stf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const float *a ); -lapack_logical LAPACKE_stp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_stp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const float *ap ); -lapack_logical LAPACKE_str_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_str_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_stz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const float *a, lapack_int lda ); -lapack_logical LAPACKE_zgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double *ab, lapack_int ldab ); -lapack_logical LAPACKE_zge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_zgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_zgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zgt_nancheck)( lapack_int n, const lapack_complex_double *dl, const lapack_complex_double *d, const lapack_complex_double *du ); -lapack_logical LAPACKE_zhb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zhb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ); -lapack_logical LAPACKE_zhe_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zhe_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_zhp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zhp_nancheck)( lapack_int n, const lapack_complex_double *ap ); -lapack_logical LAPACKE_zhs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zhs_nancheck)( int matrix_layout, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_zpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ); -lapack_logical LAPACKE_zpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpf_nancheck)( lapack_int n, const lapack_complex_double *a ); -lapack_logical LAPACKE_zpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_zpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpp_nancheck)( lapack_int n, const lapack_complex_double *ap ); -lapack_logical LAPACKE_zpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpt_nancheck)( lapack_int n, const double *d, const lapack_complex_double *e ); -lapack_logical LAPACKE_zsp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zsp_nancheck)( lapack_int n, const lapack_complex_double *ap ); -lapack_logical LAPACKE_zst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zst_nancheck)( lapack_int n, const lapack_complex_double *d, const lapack_complex_double *e ); -lapack_logical LAPACKE_zsy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zsy_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_ztb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ); -lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_ztf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_double *a ); -lapack_logical LAPACKE_ztp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *ap ); -lapack_logical LAPACKE_ztr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *a, lapack_int lda ); -lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ztz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ); diff --git a/LAPACKE/src/lapacke_cbbcsd.c b/LAPACKE/src/lapacke_cbbcsd.c index cfcac5e641..8197654352 100644 --- a/LAPACKE/src/lapacke_cbbcsd.c +++ b/LAPACKE/src/lapacke_cbbcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_cbbcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, float* theta, float* phi, lapack_complex_float* u1, lapack_int ldu1, @@ -48,10 +48,10 @@ lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2, float rwork_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cbbcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbbcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -59,36 +59,36 @@ lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( q-1, phi, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( q, theta, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( q, theta, 1 ) ) { return -10; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { - if( LAPACKE_cge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, p, p, u1, ldu1 ) ) { return -12; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-p, m-p, u2, ldu2 ) ) { return -14; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - if( LAPACKE_cge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, q, q, v1t, ldv1t ) ) { return -16; } } - if( LAPACKE_lsame( jobv2t, 'y' ) ) { - if( LAPACKE_cge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv2t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { return -18; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_cbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, &rwork_query, lrwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_cbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, rwork, lrwork ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cbbcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbbcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cbbcsd_work.c b/LAPACKE/src/lapacke_cbbcsd_work.c index b7eca09762..c72de40cf7 100644 --- a/LAPACKE/src/lapacke_cbbcsd_work.c +++ b/LAPACKE/src/lapacke_cbbcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_cbbcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, float* theta, float* phi, @@ -63,7 +63,7 @@ lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -78,7 +78,7 @@ lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbbcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cbdsqr.c b/LAPACKE/src/lapacke_cbdsqr.c index fa41ebcc1f..8dc947710b 100644 --- a/LAPACKE/src/lapacke_cbdsqr.c +++ b/LAPACKE/src/lapacke_cbdsqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cbdsqr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cbdsqr)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, float* d, float* e, lapack_complex_float* vt, lapack_int ldvt, lapack_complex_float* u, @@ -42,30 +42,30 @@ lapack_int LAPACKE_cbdsqr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cbdsqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( ncc != 0 ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, ncc, c, ldc ) ) { return -13; } } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -8; } if( nru != 0 ) { - if( LAPACKE_cge_nancheck( matrix_layout, nru, n, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nru, n, u, ldu ) ) { return -11; } } if( ncvt != 0 ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, ncvt, vt, ldvt ) ) { return -9; } } @@ -78,13 +78,13 @@ lapack_int LAPACKE_cbdsqr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cbdsqr_work( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, + info = API_SUFFIX(LAPACKE_cbdsqr_work)( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cbdsqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cbdsqr_work.c b/LAPACKE/src/lapacke_cbdsqr_work.c index 2175d38c7b..cc5600e99b 100644 --- a/LAPACKE/src/lapacke_cbdsqr_work.c +++ b/LAPACKE/src/lapacke_cbdsqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cbdsqr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cbdsqr_work)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, float* d, float* e, lapack_complex_float* vt, lapack_int ldvt, lapack_complex_float* u, @@ -57,17 +57,17 @@ lapack_int LAPACKE_cbdsqr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldc < ncc ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr_work", info ); return info; } if( ldu < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr_work", info ); return info; } if( ldvt < ncvt ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,13 +100,13 @@ lapack_int LAPACKE_cbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose input matrices */ if( ncvt != 0 ) { - LAPACKE_cge_trans( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); } if( nru != 0 ) { - LAPACKE_cge_trans( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); } if( ncc != 0 ) { - LAPACKE_cge_trans( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_cbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t, @@ -116,14 +116,14 @@ lapack_int LAPACKE_cbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose output matrices */ if( ncvt != 0 ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, ldvt ); } if( nru != 0 ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); } if( ncc != 0 ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { @@ -139,11 +139,11 @@ lapack_int LAPACKE_cbdsqr_work( int matrix_layout, char uplo, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cbdsqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbbrd.c b/LAPACKE/src/lapacke_cgbbrd.c index 09947879e7..2105fc2e52 100644 --- a/LAPACKE/src/lapacke_cgbbrd.c +++ b/LAPACKE/src/lapacke_cgbbrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbbrd( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgbbrd)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, lapack_complex_float* ab, lapack_int ldab, float* d, float* e, @@ -44,17 +44,17 @@ lapack_int LAPACKE_cgbbrd( int matrix_layout, char vect, lapack_int m, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbbrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -8; } if( ncc != 0 ) { - if( LAPACKE_cge_nancheck( matrix_layout, m, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, ncc, c, ldc ) ) { return -16; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_cgbbrd( int matrix_layout, char vect, lapack_int m, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbbrd_work( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, + info = API_SUFFIX(LAPACKE_cgbbrd_work)( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, d, e, q, ldq, pt, ldpt, c, ldc, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_cgbbrd( int matrix_layout, char vect, lapack_int m, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbbrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbbrd_work.c b/LAPACKE/src/lapacke_cgbbrd_work.c index 1565e565e5..62cbac119d 100644 --- a/LAPACKE/src/lapacke_cgbbrd_work.c +++ b/LAPACKE/src/lapacke_cgbbrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgbbrd_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, lapack_complex_float* ab, lapack_int ldab, float* d, float* e, @@ -61,22 +61,22 @@ lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); return info; } if( ldc < ncc ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); return info; } if( ldpt < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); return info; } if( ldq < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,m) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, goto exit_level_1; } } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { pt_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldpt_t * MAX(1,n) ); @@ -114,9 +114,9 @@ lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); if( ncc != 0 ) { - LAPACKE_cge_trans( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_cgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t, @@ -125,38 +125,38 @@ lapack_int LAPACKE_cgbbrd_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); } if( ncc != 0 ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { LAPACKE_free( c_t ); } exit_level_3: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { LAPACKE_free( pt_t ); } exit_level_2: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbbrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbcon.c b/LAPACKE/src/lapacke_cgbcon.c index ffa953a79f..8f11d83422 100644 --- a/LAPACKE/src/lapacke_cgbcon.c +++ b/LAPACKE/src/lapacke_cgbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbcon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbcon)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, const lapack_int* ipiv, float anorm, float* rcond ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_cgbcon( int matrix_layout, char norm, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -9; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_cgbcon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbcon_work( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, + info = API_SUFFIX(LAPACKE_cgbcon_work)( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_cgbcon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbcon_work.c b/LAPACKE/src/lapacke_cgbcon_work.c index d0ba5131ba..95fa19b8b8 100644 --- a/LAPACKE/src/lapacke_cgbcon_work.c +++ b/LAPACKE/src/lapacke_cgbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbcon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbcon_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, const lapack_int* ipiv, float anorm, @@ -53,7 +53,7 @@ lapack_int LAPACKE_cgbcon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_cgbcon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond, @@ -76,11 +76,11 @@ lapack_int LAPACKE_cgbcon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbequ.c b/LAPACKE/src/lapacke_cgbequ.c index 293ee1719b..e690818187 100644 --- a/LAPACKE/src/lapacke_cgbequ.c +++ b/LAPACKE/src/lapacke_cgbequ.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbequ)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_cgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_cgbequ_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_cgbequ_work.c b/LAPACKE/src/lapacke_cgbequ_work.c index cfa1cf1d2f..84db58ec44 100644 --- a/LAPACKE/src/lapacke_cgbequ_work.c +++ b/LAPACKE/src/lapacke_cgbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbequ_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cgbequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_cgbequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_cgbequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbequb.c b/LAPACKE/src/lapacke_cgbequb.c index 5b5d399004..093dd52ec7 100644 --- a/LAPACKE/src/lapacke_cgbequb.c +++ b/LAPACKE/src/lapacke_cgbequb.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbequb)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_cgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_cgbequb_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_cgbequb_work.c b/LAPACKE/src/lapacke_cgbequb_work.c index 49f456c4f9..6fdcd9c5ef 100644 --- a/LAPACKE/src/lapacke_cgbequb_work.c +++ b/LAPACKE/src/lapacke_cgbequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbequb_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, float* r, float* c, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cgbequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_cgbequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_cgbequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbrfs.c b/LAPACKE/src/lapacke_cgbrfs.c index 1717cb840b..bba789acb7 100644 --- a/LAPACKE/src/lapacke_cgbrfs.c +++ b/LAPACKE/src/lapacke_cgbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbrfs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* afb, lapack_int ldafb, @@ -45,22 +45,22 @@ lapack_int LAPACKE_cgbrfs( int matrix_layout, char trans, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -7; } - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_cgbrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbrfs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_cgbrfs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_cgbrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbrfs_work.c b/LAPACKE/src/lapacke_cgbrfs_work.c index 5c48a7ff5c..a61d0bf112 100644 --- a/LAPACKE/src/lapacke_cgbrfs_work.c +++ b/LAPACKE/src/lapacke_cgbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* afb, @@ -62,22 +62,22 @@ lapack_int LAPACKE_cgbrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -108,11 +108,11 @@ lapack_int LAPACKE_cgbrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, @@ -121,7 +121,7 @@ lapack_int LAPACKE_cgbrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -132,11 +132,11 @@ lapack_int LAPACKE_cgbrfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbrfsx.c b/LAPACKE/src/lapacke_cgbrfsx.c index 79b202f395..02869f9809 100644 --- a/LAPACKE/src/lapacke_cgbrfsx.c +++ b/LAPACKE/src/lapacke_cgbrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbrfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_cgbrfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* afb, @@ -48,37 +48,37 @@ lapack_int LAPACKE_cgbrfsx( int matrix_layout, char trans, char equed, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -15; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -14; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -13; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -17; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_cgbrfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbrfsx_work( matrix_layout, trans, equed, n, kl, ku, nrhs, + info = API_SUFFIX(LAPACKE_cgbrfsx_work)( matrix_layout, trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -106,7 +106,7 @@ lapack_int LAPACKE_cgbrfsx( int matrix_layout, char trans, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbrfsx_work.c b/LAPACKE/src/lapacke_cgbrfsx_work.c index 1a9cef0500..11ad013cd9 100644 --- a/LAPACKE/src/lapacke_cgbrfsx_work.c +++ b/LAPACKE/src/lapacke_cgbrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbrfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_cgbrfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, @@ -72,22 +72,22 @@ lapack_int LAPACKE_cgbrfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -18; - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -130,11 +130,11 @@ lapack_int LAPACKE_cgbrfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -144,10 +144,10 @@ lapack_int LAPACKE_cgbrfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -163,11 +163,11 @@ lapack_int LAPACKE_cgbrfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbsv.c b/LAPACKE/src/lapacke_cgbsv.c index 226d71e0f6..0a2e8b5997 100644 --- a/LAPACKE/src/lapacke_cgbsv.c +++ b/LAPACKE/src/lapacke_cgbsv.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsv( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_cgbsv)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_cgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, + return API_SUFFIX(LAPACKE_cgbsv_work)( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cgbsv_work.c b/LAPACKE/src/lapacke_cgbsv_work.c index e569c10898..4fc7849502 100644 --- a/LAPACKE/src/lapacke_cgbsv_work.c +++ b/LAPACKE/src/lapacke_cgbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_cgbsv_work)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_int* ipiv, lapack_complex_float* b, @@ -53,12 +53,12 @@ lapack_int LAPACKE_cgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsv_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,9 +76,9 @@ lapack_int LAPACKE_cgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -86,20 +86,20 @@ lapack_int LAPACKE_cgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbsvx.c b/LAPACKE/src/lapacke_cgbsvx.c index 0e86868030..357887dfa6 100644 --- a/LAPACKE/src/lapacke_cgbsvx.c +++ b/LAPACKE/src/lapacke_cgbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgbsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, @@ -46,33 +46,33 @@ lapack_int LAPACKE_cgbsvx( int matrix_layout, char fact, char trans, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -15; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -14; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_cgbsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbsvx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_cgbsvx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Backup significant data from working array(s) */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_cgbsvx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbsvx_work.c b/LAPACKE/src/lapacke_cgbsvx_work.c index 5ff0ee9955..de4766e32d 100644 --- a/LAPACKE/src/lapacke_cgbsvx_work.c +++ b/LAPACKE/src/lapacke_cgbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgbsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_cgbsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,12 +110,12 @@ lapack_int LAPACKE_cgbsvx_work( int matrix_layout, char fact, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -124,20 +124,20 @@ lapack_int LAPACKE_cgbsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -148,11 +148,11 @@ lapack_int LAPACKE_cgbsvx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbsvxx.c b/LAPACKE/src/lapacke_cgbsvxx.c index 22a4dd8eda..2dcd9fe2b8 100644 --- a/LAPACKE/src/lapacke_cgbsvxx.c +++ b/LAPACKE/src/lapacke_cgbsvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsvxx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgbsvxx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, @@ -48,38 +48,38 @@ lapack_int LAPACKE_cgbsvxx( int matrix_layout, char fact, char trans, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -15; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -27; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -14; } } @@ -98,7 +98,7 @@ lapack_int LAPACKE_cgbsvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgbsvxx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_cgbsvxx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, @@ -109,7 +109,7 @@ lapack_int LAPACKE_cgbsvxx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbsvxx_work.c b/LAPACKE/src/lapacke_cgbsvxx_work.c index 84c4891987..fc1f289a69 100644 --- a/LAPACKE/src/lapacke_cgbsvxx_work.c +++ b/LAPACKE/src/lapacke_cgbsvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbsvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgbsvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, @@ -70,22 +70,22 @@ lapack_int LAPACKE_cgbsvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -128,12 +128,12 @@ lapack_int LAPACKE_cgbsvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, @@ -144,23 +144,23 @@ lapack_int LAPACKE_cgbsvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -176,11 +176,11 @@ lapack_int LAPACKE_cgbsvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbsvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbtrf.c b/LAPACKE/src/lapacke_cgbtrf.c index 137ff8edd5..0d8c23a202 100644 --- a/LAPACKE/src/lapacke_cgbtrf.c +++ b/LAPACKE/src/lapacke_cgbtrf.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbtrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbtrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, lapack_complex_float* ab, lapack_int ldab, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_cgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); + return API_SUFFIX(LAPACKE_cgbtrf_work)( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); } diff --git a/LAPACKE/src/lapacke_cgbtrf_work.c b/LAPACKE/src/lapacke_cgbtrf_work.c index f8f350c6f4..28f5c7e028 100644 --- a/LAPACKE/src/lapacke_cgbtrf_work.c +++ b/LAPACKE/src/lapacke_cgbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbtrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, lapack_complex_float* ab, lapack_int ldab, lapack_int* ipiv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info ); @@ -69,17 +69,17 @@ lapack_int LAPACKE_cgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_cgb_trans)( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgbtrs.c b/LAPACKE/src/lapacke_cgbtrs.c index 724c7db5c6..6dee90f25d 100644 --- a/LAPACKE/src/lapacke_cgbtrs.c +++ b/LAPACKE/src/lapacke_cgbtrs.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbtrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbtrs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_cgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + return API_SUFFIX(LAPACKE_cgbtrs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cgbtrs_work.c b/LAPACKE/src/lapacke_cgbtrs_work.c index ceff5fe82d..28c6832211 100644 --- a/LAPACKE/src/lapacke_cgbtrs_work.c +++ b/LAPACKE/src/lapacke_cgbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgbtrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgbtrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_int* ipiv, lapack_complex_float* b, @@ -54,12 +54,12 @@ lapack_int LAPACKE_cgbtrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,9 +77,9 @@ lapack_int LAPACKE_cgbtrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -87,18 +87,18 @@ lapack_int LAPACKE_cgbtrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgebak.c b/LAPACKE/src/lapacke_cgebak.c index 33d18b12f3..6b10e02ad7 100644 --- a/LAPACKE/src/lapacke_cgebak.c +++ b/LAPACKE/src/lapacke_cgebak.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgebak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* scale, lapack_int m, lapack_complex_float* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgebak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, scale, 1 ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -9; } } #endif - return LAPACKE_cgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m, + return API_SUFFIX(LAPACKE_cgebak_work)( matrix_layout, job, side, n, ilo, ihi, scale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_cgebak_work.c b/LAPACKE/src/lapacke_cgebak_work.c index 521b7c06a0..8f9d8e556a 100644 --- a/LAPACKE/src/lapacke_cgebak_work.c +++ b/LAPACKE/src/lapacke_cgebak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_cgebak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* scale, lapack_int m, lapack_complex_float* v, lapack_int ldv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgebak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cgebak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_cgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_cgebak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgebal.c b/LAPACKE/src/lapacke_cgebal.c index 7645e6bf84..23dbae7bd4 100644 --- a/LAPACKE/src/lapacke_cgebal.c +++ b/LAPACKE/src/lapacke_cgebal.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebal( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgebal)( int matrix_layout, char job, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, float* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgebal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } } #endif - return LAPACKE_cgebal_work( matrix_layout, job, n, a, lda, ilo, ihi, scale ); + return API_SUFFIX(LAPACKE_cgebal_work)( matrix_layout, job, n, a, lda, ilo, ihi, scale ); } diff --git a/LAPACKE/src/lapacke_cgebal_work.c b/LAPACKE/src/lapacke_cgebal_work.c index 75f5a21ad5..008bf7f8ef 100644 --- a/LAPACKE/src/lapacke_cgebal_work.c +++ b/LAPACKE/src/lapacke_cgebal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgebal_work)( int matrix_layout, char job, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, float* scale ) { @@ -49,12 +49,12 @@ lapack_int LAPACKE_cgebal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); @@ -64,9 +64,9 @@ lapack_int LAPACKE_cgebal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } /* Call LAPACK function and adjust info */ LAPACK_cgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info ); @@ -74,22 +74,22 @@ lapack_int LAPACKE_cgebal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgebrd.c b/LAPACKE/src/lapacke_cgebrd.c index 77fe29bdcd..92f9eac3f6 100644 --- a/LAPACKE/src/lapacke_cgebrd.c +++ b/LAPACKE/src/lapacke_cgebrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebrd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgebrd)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* d, float* e, lapack_complex_float* tauq, lapack_complex_float* taup ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_cgebrd( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgebrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_cgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_cgebrd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_cgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgebrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgebrd_work.c b/LAPACKE/src/lapacke_cgebrd_work.c index 1bb45d3e5a..44e8eea1f3 100644 --- a/LAPACKE/src/lapacke_cgebrd_work.c +++ b/LAPACKE/src/lapacke_cgebrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgebrd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgebrd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* d, float* e, lapack_complex_float* tauq, lapack_complex_float* taup, @@ -51,7 +51,7 @@ lapack_int LAPACKE_cgebrd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_cgebrd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork, &info ); @@ -76,16 +76,16 @@ lapack_int LAPACKE_cgebrd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgebrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgecon.c b/LAPACKE/src/lapacke_cgecon.c index c1360cc344..464eff3bc4 100644 --- a/LAPACKE/src/lapacke_cgecon.c +++ b/LAPACKE/src/lapacke_cgecon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgecon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgecon)( int matrix_layout, char norm, lapack_int n, const lapack_complex_float* a, lapack_int lda, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_cgecon( int matrix_layout, char norm, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgecon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgecon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_cgecon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgecon_work( matrix_layout, norm, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_cgecon_work)( matrix_layout, norm, n, a, lda, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_cgecon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgecon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgecon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgecon_work.c b/LAPACKE/src/lapacke_cgecon_work.c index fb1806f74c..df8dc505e2 100644 --- a/LAPACKE/src/lapacke_cgecon_work.c +++ b/LAPACKE/src/lapacke_cgecon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgecon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgecon_work)( int matrix_layout, char norm, lapack_int n, const lapack_complex_float* a, lapack_int lda, float anorm, float* rcond, lapack_complex_float* work, float* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgecon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgecon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cgecon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, rwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_cgecon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgecon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgecon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgedmd.c b/LAPACKE/src/lapacke_cgedmd.c index 6c77e199e2..76abdf8eb3 100644 --- a/LAPACKE/src/lapacke_cgedmd.c +++ b/LAPACKE/src/lapacke_cgedmd.c @@ -32,16 +32,16 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgedmd( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_cgedmd)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_complex_float* y, lapack_int ldy, lapack_int nrnk, float* tol, lapack_int k, lapack_complex_float* eigs, - lapack_complex_float* z, lapack_int ldz, - float* res, lapack_complex_float* b, - lapack_int ldb, lapack_complex_float* w, - lapack_int ldw, lapack_complex_float* s, lapack_int lds) + lapack_complex_float* z, lapack_int ldz, + float* res, lapack_complex_float* b, + lapack_int ldb, lapack_complex_float* w, + lapack_int ldw, lapack_complex_float* s, lapack_int lds) { lapack_int info = 0; lapack_int lwork = -1; @@ -54,34 +54,34 @@ lapack_int LAPACKE_cgedmd( int matrix_layout, char jobs, char jobz, char jobr, float work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgedmd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -15; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -18; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, w, ldw ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, w, ldw ) ) { return -20; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -22; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_cgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, w, ldw, s, lds, &zwork_query, lzwork, &work_query, lwork, &iwork_query, liwork ); @@ -109,7 +109,7 @@ lapack_int LAPACKE_cgedmd( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_cgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, w, ldw, s, lds, zwork, lzwork, work, lwork, iwork, liwork ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_cgedmd( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( zwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgedmd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgedmd_work.c b/LAPACKE/src/lapacke_cgedmd_work.c index 08d8b91f50..13ad304d5d 100644 --- a/LAPACKE/src/lapacke_cgedmd_work.c +++ b/LAPACKE/src/lapacke_cgedmd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_cgedmd_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_complex_float* y, lapack_int ldy, lapack_int nrnk, @@ -71,32 +71,32 @@ lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldx < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } if( ldy < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } if( ldb < n ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } if( ldw < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } if( lds < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -139,12 +139,12 @@ lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_cge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_cge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); - LAPACKE_cge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_cgedmd( &jobs, &jobz, &jobr, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, &ldy_t, &nrnk, tol, &k, eigs, z_t, &ldz_t, @@ -154,12 +154,12 @@ lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_5: @@ -174,11 +174,11 @@ lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgedmdq.c b/LAPACKE/src/lapacke_cgedmdq.c index b0b258f97b..37e1522023 100644 --- a/LAPACKE/src/lapacke_cgedmdq.c +++ b/LAPACKE/src/lapacke_cgedmdq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgedmdq( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_cgedmdq)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_float* f, lapack_int ldf, lapack_complex_float* x, @@ -55,37 +55,37 @@ lapack_int LAPACKE_cgedmdq( int matrix_layout, char jobs, char jobz, char jobr, float work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgedmdq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -11; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -13; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -15; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -22; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -25; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, v, ldv ) ) { return -27; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -29; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_cgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, v, ldv, s, lds, &zwork_query, lzwork, @@ -114,7 +114,7 @@ lapack_int LAPACKE_cgedmdq( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_cgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, v, ldv, s, lds, zwork, lzwork, @@ -127,7 +127,7 @@ lapack_int LAPACKE_cgedmdq( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( zwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgedmdq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgedmdq_work.c b/LAPACKE/src/lapacke_cgedmdq_work.c index 05287c1bc5..8eab4f27a1 100644 --- a/LAPACKE/src/lapacke_cgedmdq_work.c +++ b/LAPACKE/src/lapacke_cgedmdq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_cgedmdq_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_float* f, lapack_int ldf, @@ -78,37 +78,37 @@ lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldf < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( ldx < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( ldy < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( ldz < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( ldb < n ) { info = -26; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( ldv < n ) { info = -28; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } if( lds < n ) { info = -30; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -156,13 +156,13 @@ lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, goto exit_level_6; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); - LAPACKE_cge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_cge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_cge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, m, n, v, ldv, v_t, ldv_t ); - LAPACKE_cge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_cgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, tol, &k, eigs, @@ -172,13 +172,13 @@ lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_6: @@ -195,11 +195,11 @@ lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( f_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeequ.c b/LAPACKE/src/lapacke_cgeequ.c index fd97acfb51..87a74d1dd0 100644 --- a/LAPACKE/src/lapacke_cgeequ.c +++ b/LAPACKE/src/lapacke_cgeequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeequ)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_cgeequ_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_cgeequ_work.c b/LAPACKE/src/lapacke_cgeequ_work.c index abcaec976e..647ba0e459 100644 --- a/LAPACKE/src/lapacke_cgeequ_work.c +++ b/LAPACKE/src/lapacke_cgeequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeequ_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cgeequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_cgeequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeequb.c b/LAPACKE/src/lapacke_cgeequb.c index 13b69902c5..4f05886042 100644 --- a/LAPACKE/src/lapacke_cgeequb.c +++ b/LAPACKE/src/lapacke_cgeequb.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeequb)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_cgeequb_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_cgeequb_work.c b/LAPACKE/src/lapacke_cgeequb_work.c index a4de1edd08..f84f923b79 100644 --- a/LAPACKE/src/lapacke_cgeequb_work.c +++ b/LAPACKE/src/lapacke_cgeequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeequb_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cgeequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_cgeequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgees.c b/LAPACKE/src/lapacke_cgees.c index 2d04730cc5..530de1f4ef 100644 --- a/LAPACKE/src/lapacke_cgees.c +++ b/LAPACKE/src/lapacke_cgees.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgees( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_cgees)( int matrix_layout, char jobvs, char sort, LAPACK_C_SELECT1 select, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* sdim, lapack_complex_float* w, @@ -45,19 +45,19 @@ lapack_int LAPACKE_cgees( int matrix_layout, char jobvs, char sort, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgees", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -71,7 +71,7 @@ lapack_int LAPACKE_cgees( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_cgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, w, vs, ldvs, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -86,19 +86,19 @@ lapack_int LAPACKE_cgees( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_cgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, w, vs, ldvs, work, lwork, rwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgees", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgees_work.c b/LAPACKE/src/lapacke_cgees_work.c index 0416d70fcd..43cae37fbd 100644 --- a/LAPACKE/src/lapacke_cgees_work.c +++ b/LAPACKE/src/lapacke_cgees_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_cgees_work)( int matrix_layout, char jobvs, char sort, LAPACK_C_SELECT1 select, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* sdim, lapack_complex_float* w, @@ -56,12 +56,12 @@ lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info ); return info; } if( ldvs < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -77,7 +77,7 @@ lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvs_t * MAX(1,n) ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, w, vs_t, &ldvs_t, work, &lwork, rwork, bwork, &info ); @@ -95,23 +95,23 @@ lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeesx.c b/LAPACKE/src/lapacke_cgeesx.c index d172f8bf58..e15d6535ba 100644 --- a/LAPACKE/src/lapacke_cgeesx.c +++ b/LAPACKE/src/lapacke_cgeesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeesx( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_cgeesx)( int matrix_layout, char jobvs, char sort, LAPACK_C_SELECT1 select, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* sdim, lapack_complex_float* w, @@ -46,19 +46,19 @@ lapack_int LAPACKE_cgeesx( int matrix_layout, char jobvs, char sort, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -72,7 +72,7 @@ lapack_int LAPACKE_cgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_cgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, w, vs, ldvs, rconde, rcondv, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_cgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_cgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, w, vs, ldvs, rconde, rcondv, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -95,12 +95,12 @@ lapack_int LAPACKE_cgeesx( int matrix_layout, char jobvs, char sort, exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeesx_work.c b/LAPACKE/src/lapacke_cgeesx_work.c index 4be2ceeb62..201b7d68c6 100644 --- a/LAPACKE/src/lapacke_cgeesx_work.c +++ b/LAPACKE/src/lapacke_cgeesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeesx_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_cgeesx_work)( int matrix_layout, char jobvs, char sort, LAPACK_C_SELECT1 select, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* sdim, @@ -59,12 +59,12 @@ lapack_int LAPACKE_cgeesx_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx_work", info ); return info; } if( ldvs < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_cgeesx_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvs_t * MAX(1,n) ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_cgeesx_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, w, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, rwork, @@ -100,23 +100,23 @@ lapack_int LAPACKE_cgeesx_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeev.c b/LAPACKE/src/lapacke_cgeev.c index 5770f20115..b9a63af0f6 100644 --- a/LAPACKE/src/lapacke_cgeev.c +++ b/LAPACKE/src/lapacke_cgeev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_cgeev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* w, lapack_complex_float* vl, lapack_int ldvl, lapack_complex_float* vr, @@ -44,13 +44,13 @@ lapack_int LAPACKE_cgeev( int matrix_layout, char jobvl, char jobvr, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_cgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, + info = API_SUFFIX(LAPACKE_cgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -76,7 +76,7 @@ lapack_int LAPACKE_cgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, + info = API_SUFFIX(LAPACKE_cgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_cgeev( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeev_work.c b/LAPACKE/src/lapacke_cgeev_work.c index af6a247edd..e81409f532 100644 --- a/LAPACKE/src/lapacke_cgeev_work.c +++ b/LAPACKE/src/lapacke_cgeev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_cgeev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* w, lapack_complex_float* vl, lapack_int ldvl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,n) ); @@ -93,7 +93,7 @@ lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,n) ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeev( &jobvl, &jobvr, &n, a_t, &lda_t, w, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, rwork, &info ); @@ -111,30 +111,30 @@ lapack_int LAPACKE_cgeev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeevx.c b/LAPACKE/src/lapacke_cgeevx.c index f9eb943c58..c0a034f2d4 100644 --- a/LAPACKE/src/lapacke_cgeevx.c +++ b/LAPACKE/src/lapacke_cgeevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_cgeevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* w, lapack_complex_float* vl, @@ -47,13 +47,13 @@ lapack_int LAPACKE_cgeevx( int matrix_layout, char balanc, char jobvl, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_cgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_cgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, w, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, &work_query, lwork, rwork ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_cgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_cgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, w, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_cgeevx( int matrix_layout, char balanc, char jobvl, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeevx_work.c b/LAPACKE/src/lapacke_cgeevx_work.c index 632ddd6619..85edf59d62 100644 --- a/LAPACKE/src/lapacke_cgeevx_work.c +++ b/LAPACKE/src/lapacke_cgeevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_cgeevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* w, @@ -62,17 +62,17 @@ lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,n) ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,n) ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, w, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm, @@ -117,30 +117,30 @@ lapack_int LAPACKE_cgeevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgehrd.c b/LAPACKE/src/lapacke_cgehrd.c index 31fd49d46c..376702da95 100644 --- a/LAPACKE/src/lapacke_cgehrd.c +++ b/LAPACKE/src/lapacke_cgehrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgehrd( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_cgehrd)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgehrd( int matrix_layout, lapack_int n, lapack_int ilo, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgehrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgehrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_cgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_cgehrd( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgehrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgehrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgehrd_work.c b/LAPACKE/src/lapacke_cgehrd_work.c index e5c0295aa2..32b56b2470 100644 --- a/LAPACKE/src/lapacke_cgehrd_work.c +++ b/LAPACKE/src/lapacke_cgehrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_cgehrd_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgehrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_cgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgehrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgehrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgejsv.c b/LAPACKE/src/lapacke_cgejsv.c index f5604495ce..4c82f9bd6b 100644 --- a/LAPACKE/src/lapacke_cgejsv.c +++ b/LAPACKE/src/lapacke_cgejsv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_cgejsv)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* sva, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* v, lapack_int ldv, @@ -41,96 +41,96 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, lapack_int info = 0; lapack_int lwork = ( // 1.1 - ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? 2*n+1 : + ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? 2*n+1 : //1.2 - ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? n*n+3*n : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? n*n+3*n : //2.1 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&& - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u') || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) )&& + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //2.2 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //3.1 - ( ( ( 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' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //3.2 - ( ( ( 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' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //4.1 - ( ( ( 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' ) ))? 5*n+2*n*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 5*n+2*n*n : //4.2 - ( ( ( 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' ) ))? 4*n*n: + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 4*n*n: 1) ) ) ) ) ) ) ); lapack_int lrwork = ( // 1.1 - ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,n+2*m) : + ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? MAX(7,n+2*m) : //1.2 - ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,2*n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? MAX(7,2*n) : //2.1 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u') || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //2.2 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : //3.1 - ( ( ( 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, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //3.2 - ( ( ( 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) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : //4.1 - ( ( ( 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, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //4.2 - ( ( ( 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) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : 7) ) ) ) ) ) ) ); lapack_int* iwork = NULL; float* rwork = NULL; lapack_complex_float* cwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgejsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } } @@ -143,13 +143,13 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, } 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' ); + int want_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ); + int want_v = API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ); + int want_sce = API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || API_SUFFIX(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 + if( want_u && API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) lwork = MAX( lwork, 5*n+2*n*n ); // 4.1 + if( want_u && API_SUFFIX(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 ) { @@ -163,7 +163,7 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt, + info = API_SUFFIX(LAPACKE_cgejsv_work)( matrix_layout, joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork ); /* Backup significant data from working array(s) */ @@ -181,7 +181,7 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgejsv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgejsv_work.c b/LAPACKE/src/lapacke_cgejsv_work.c index 19ae194add..505cc4af43 100644 --- a/LAPACKE/src/lapacke_cgejsv_work.c +++ b/LAPACKE/src/lapacke_cgejsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, +lapack_int API_SUFFIX(LAPACKE_cgejsv_work)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* sva, lapack_complex_float* u, @@ -51,10 +51,10 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } } 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 nu = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : m; + lapack_int nv = API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : + API_SUFFIX(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); @@ -64,17 +64,17 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv_work", info ); return info; } if( ldu < ncols_u ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv_work", info ); return info; } if( ldv < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -93,8 +93,8 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, goto exit_level_1; } } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) ); if( v_t == NULL ) { @@ -103,7 +103,7 @@ 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 ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_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, @@ -112,33 +112,33 @@ lapack_int LAPACKE_cgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { + API_SUFFIX(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' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { LAPACKE_free( v_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { LAPACKE_free( u_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgejsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelq.c b/LAPACKE/src/lapacke_cgelq.c index 48487f1d8e..b3730f7839 100644 --- a/LAPACKE/src/lapacke_cgelq.c +++ b/LAPACKE/src/lapacke_cgelq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelq)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_cgelq_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_cgelq_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelq2.c b/LAPACKE/src/lapacke_cgelq2.c index a73205a267..2b3aabbb7e 100644 --- a/LAPACKE/src/lapacke_cgelq2.c +++ b/LAPACKE/src/lapacke_cgelq2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelq2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelq2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelq2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_cgelq2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgelq2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_cgelq2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelq2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelq2_work.c b/LAPACKE/src/lapacke_cgelq2_work.c index 66ff1eed6b..3e485cce5f 100644 --- a/LAPACKE/src/lapacke_cgelq2_work.c +++ b/LAPACKE/src/lapacke_cgelq2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelq2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelq2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgelq2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_cgelq2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelq2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelq_work.c b/LAPACKE/src/lapacke_cgelq_work.c index 3e246d3fc8..85d45d6080 100644 --- a/LAPACKE/src/lapacke_cgelq_work.c +++ b/LAPACKE/src/lapacke_cgelq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int tsize, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelqf.c b/LAPACKE/src/lapacke_cgelqf.c index a900631c8b..8c2ed4c25c 100644 --- a/LAPACKE/src/lapacke_cgelqf.c +++ b/LAPACKE/src/lapacke_cgelqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelqf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgelqf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgelqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cgelqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgelqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgelqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_cgelqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelqf_work.c b/LAPACKE/src/lapacke_cgelqf_work.c index 8bbb4a8200..3854e70e94 100644 --- a/LAPACKE/src/lapacke_cgelqf_work.c +++ b/LAPACKE/src/lapacke_cgelqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelqf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgelqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgelqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgels.c b/LAPACKE/src/lapacke_cgels.c index 14daaef180..33a466bc95 100644 --- a/LAPACKE/src/lapacke_cgels.c +++ b/LAPACKE/src/lapacke_cgels.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgels( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgels)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_cgels( int matrix_layout, char trans, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgels", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_cgels( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgels", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgels_work.c b/LAPACKE/src/lapacke_cgels_work.c index 7c7012f6e5..b3b2fd2d1f 100644 --- a/LAPACKE/src/lapacke_cgels_work.c +++ b/LAPACKE/src/lapacke_cgels_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgels_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgels_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_cgels_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cgels_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -92,8 +92,8 @@ lapack_int LAPACKE_cgels_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -101,11 +101,11 @@ lapack_int LAPACKE_cgels_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgels_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelsd.c b/LAPACKE/src/lapacke_cgelsd.c index 74197666d8..319c425a90 100644 --- a/LAPACKE/src/lapacke_cgelsd.c +++ b/LAPACKE/src/lapacke_cgelsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelsd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelsd)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* s, float rcond, @@ -50,25 +50,25 @@ lapack_int LAPACKE_cgelsd( int matrix_layout, lapack_int m, lapack_int n, float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_cgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, &rwork_query, &iwork_query ); if( info != 0 ) { @@ -95,7 +95,7 @@ lapack_int LAPACKE_cgelsd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_cgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -105,7 +105,7 @@ lapack_int LAPACKE_cgelsd( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelsd_work.c b/LAPACKE/src/lapacke_cgelsd_work.c index 2fc647be07..05d1d29f65 100644 --- a/LAPACKE/src/lapacke_cgelsd_work.c +++ b/LAPACKE/src/lapacke_cgelsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelsd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelsd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* s, float rcond, @@ -56,12 +56,12 @@ lapack_int LAPACKE_cgelsd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_cgelsd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, rwork, iwork, &info ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_cgelsd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -103,11 +103,11 @@ lapack_int LAPACKE_cgelsd_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelss.c b/LAPACKE/src/lapacke_cgelss.c index 10fcde2ef2..e0d9aeefca 100644 --- a/LAPACKE/src/lapacke_cgelss.c +++ b/LAPACKE/src/lapacke_cgelss.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelss( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelss)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* s, float rcond, @@ -44,19 +44,19 @@ lapack_int LAPACKE_cgelss( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelss", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_cgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_cgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -82,7 +82,7 @@ lapack_int LAPACKE_cgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_cgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_cgelss( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelss", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelss_work.c b/LAPACKE/src/lapacke_cgelss_work.c index ae5773c86c..f64bea1a49 100644 --- a/LAPACKE/src/lapacke_cgelss_work.c +++ b/LAPACKE/src/lapacke_cgelss_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelss_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelss_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* s, float rcond, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cgelss_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cgelss_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, rwork, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_cgelss_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -102,11 +102,11 @@ lapack_int LAPACKE_cgelss_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelss_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelsy.c b/LAPACKE/src/lapacke_cgelsy.c index 8a46e21857..c446b4d852 100644 --- a/LAPACKE/src/lapacke_cgelsy.c +++ b/LAPACKE/src/lapacke_cgelsy.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelsy( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelsy)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_int* jpvt, float rcond, @@ -44,19 +44,19 @@ lapack_int LAPACKE_cgelsy( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgelsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_cgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_cgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -82,7 +82,7 @@ lapack_int LAPACKE_cgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_cgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_cgelsy( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgelsy_work.c b/LAPACKE/src/lapacke_cgelsy_work.c index c2ac423150..322efda050 100644 --- a/LAPACKE/src/lapacke_cgelsy_work.c +++ b/LAPACKE/src/lapacke_cgelsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgelsy_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgelsy_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_int* jpvt, float rcond, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cgelsy_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cgelsy_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond, rank, work, &lwork, rwork, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_cgelsy_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -102,11 +102,11 @@ lapack_int LAPACKE_cgelsy_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgelsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemlq.c b/LAPACKE/src/lapacke_cgemlq.c index 8661b12e9f..eb18b6abef 100644 --- a/LAPACKE/src/lapacke_cgemlq.c +++ b/LAPACKE/src/lapacke_cgemlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int tsize, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgemlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_cgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_cgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemlq_work.c b/LAPACKE/src/lapacke_cgemlq_work.c index 071032033a..de9226b4aa 100644 --- a/LAPACKE/src/lapacke_cgemlq_work.c +++ b/LAPACKE/src/lapacke_cgemlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,k); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(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) ); @@ -87,8 +87,8 @@ lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -96,18 +96,18 @@ lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemqr.c b/LAPACKE/src/lapacke_cgemqr.c index 440804c09f..97c71adfd3 100644 --- a/LAPACKE/src/lapacke_cgemqr.c +++ b/LAPACKE/src/lapacke_cgemqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int tsize, @@ -44,26 +44,26 @@ lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, lapack_complex_float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgemqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_cgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_cgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemqr_work.c b/LAPACKE/src/lapacke_cgemqr_work.c index 1e421864df..17d3dcb0df 100644 --- a/LAPACKE/src/lapacke_cgemqr_work.c +++ b/LAPACKE/src/lapacke_cgemqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -94,18 +94,18 @@ lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemqrt.c b/LAPACKE/src/lapacke_cgemqrt.c index fdb5a71cc7..4debdeb15b 100644 --- a/LAPACKE/src/lapacke_cgemqrt.c +++ b/LAPACKE/src/lapacke_cgemqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, @@ -43,21 +43,21 @@ lapack_int LAPACKE_cgemqrt( int matrix_layout, char side, char trans, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgemqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* 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 ) ) { + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } } @@ -70,13 +70,13 @@ lapack_int LAPACKE_cgemqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgemqrt_work( matrix_layout, side, trans, m, n, k, nb, v, ldv, + info = API_SUFFIX(LAPACKE_cgemqrt_work)( matrix_layout, side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgemqrt_work.c b/LAPACKE/src/lapacke_cgemqrt_work.c index e2772fd78f..bad6aaa2e3 100644 --- a/LAPACKE/src/lapacke_cgemqrt_work.c +++ b/LAPACKE/src/lapacke_cgemqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgemqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cgemqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, @@ -57,17 +57,17 @@ lapack_int LAPACKE_cgemqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt_work", info ); return info; } if( ldt < nb ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt_work", info ); return info; } if( ldv < k ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,9 +90,9 @@ lapack_int LAPACKE_cgemqrt_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_cge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_cgemqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -109,11 +109,11 @@ lapack_int LAPACKE_cgemqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgemqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqlf.c b/LAPACKE/src/lapacke_cgeqlf.c index a8bcd39d6c..85b848eedc 100644 --- a/LAPACKE/src/lapacke_cgeqlf.c +++ b/LAPACKE/src/lapacke_cgeqlf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqlf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqlf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgeqlf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqlf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqlf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgeqlf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cgeqlf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgeqlf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqlf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_cgeqlf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqlf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqlf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqlf_work.c b/LAPACKE/src/lapacke_cgeqlf_work.c index 7b70fb34d8..1620ec7e5c 100644 --- a/LAPACKE/src/lapacke_cgeqlf_work.c +++ b/LAPACKE/src/lapacke_cgeqlf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqlf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqlf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqlf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqlf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqp3.c b/LAPACKE/src/lapacke_cgeqp3.c index d4b0c94cf3..583f81bdbb 100644 --- a/LAPACKE/src/lapacke_cgeqp3.c +++ b/LAPACKE/src/lapacke_cgeqp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqp3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqp3)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* jpvt, lapack_complex_float* tau ) { @@ -42,13 +42,13 @@ lapack_int LAPACKE_cgeqp3( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -60,7 +60,7 @@ lapack_int LAPACKE_cgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, + info = API_SUFFIX(LAPACKE_cgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -74,7 +74,7 @@ lapack_int LAPACKE_cgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_cgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_cgeqp3( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqp3_work.c b/LAPACKE/src/lapacke_cgeqp3_work.c index 638935b2af..053958e857 100644 --- a/LAPACKE/src/lapacke_cgeqp3_work.c +++ b/LAPACKE/src/lapacke_cgeqp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqp3_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* jpvt, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork, @@ -51,7 +51,7 @@ lapack_int LAPACKE_cgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_cgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, rwork, &info ); @@ -76,16 +76,16 @@ lapack_int LAPACKE_cgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqpf.c b/LAPACKE/src/lapacke_cgeqpf.c index 2f161493da..cdda28cb67 100644 --- a/LAPACKE/src/lapacke_cgeqpf.c +++ b/LAPACKE/src/lapacke_cgeqpf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqpf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqpf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* jpvt, lapack_complex_float* tau ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_cgeqpf( int matrix_layout, lapack_int m, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqpf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqpf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_cgeqpf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgeqpf_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_cgeqpf_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_cgeqpf( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqpf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqpf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqpf_work.c b/LAPACKE/src/lapacke_cgeqpf_work.c index da779ac3a8..1ebb563ce6 100644 --- a/LAPACKE/src/lapacke_cgeqpf_work.c +++ b/LAPACKE/src/lapacke_cgeqpf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqpf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* jpvt, lapack_complex_float* tau, lapack_complex_float* work, float* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqpf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_cgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqpf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqpf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqr.c b/LAPACKE/src/lapacke_cgeqr.c index be3e665040..d91ad2e3cf 100644 --- a/LAPACKE/src/lapacke_cgeqr.c +++ b/LAPACKE/src/lapacke_cgeqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_cgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,12 +70,12 @@ lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_cgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqr2.c b/LAPACKE/src/lapacke_cgeqr2.c index 14f8e9be95..6d94cd77de 100644 --- a/LAPACKE/src/lapacke_cgeqr2.c +++ b/LAPACKE/src/lapacke_cgeqr2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqr2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqr2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_cgeqr2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqr2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_cgeqr2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqr2_work.c b/LAPACKE/src/lapacke_cgeqr2_work.c index 8fa36b85a5..18547f1f39 100644 --- a/LAPACKE/src/lapacke_cgeqr2_work.c +++ b/LAPACKE/src/lapacke_cgeqr2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqr2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_cgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqr2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqr_work.c b/LAPACKE/src/lapacke_cgeqr_work.c index 46ece5ffdd..967c2c8e1a 100644 --- a/LAPACKE/src/lapacke_cgeqr_work.c +++ b/LAPACKE/src/lapacke_cgeqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int tsize, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgeqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrf.c b/LAPACKE/src/lapacke_cgeqrf.c index 4a80430b34..7e9a51c643 100644 --- a/LAPACKE/src/lapacke_cgeqrf.c +++ b/LAPACKE/src/lapacke_cgeqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgeqrf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgeqrf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cgeqrf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgeqrf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqrf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_cgeqrf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrf_work.c b/LAPACKE/src/lapacke_cgeqrf_work.c index 4733275554..c4c1230434 100644 --- a/LAPACKE/src/lapacke_cgeqrf_work.c +++ b/LAPACKE/src/lapacke_cgeqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrfp.c b/LAPACKE/src/lapacke_cgeqrfp.c index a8596a4d51..05e83b1226 100644 --- a/LAPACKE/src/lapacke_cgeqrfp.c +++ b/LAPACKE/src/lapacke_cgeqrfp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrfp( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrfp)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgeqrfp( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrfp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrfp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgeqrfp_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cgeqrfp_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgeqrfp( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqrfp_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_cgeqrfp_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrfp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrfp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrfp_work.c b/LAPACKE/src/lapacke_cgeqrfp_work.c index 4d63fc2f15..a12c6796d4 100644 --- a/LAPACKE/src/lapacke_cgeqrfp_work.c +++ b/LAPACKE/src/lapacke_cgeqrfp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrfp_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrfp_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrfp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrfp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrt.c b/LAPACKE/src/lapacke_cgeqrt.c index 6e3cb656e9..bcdc249299 100644 --- a/LAPACKE/src/lapacke_cgeqrt.c +++ b/LAPACKE/src/lapacke_cgeqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) @@ -40,13 +40,13 @@ lapack_int LAPACKE_cgeqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -59,12 +59,12 @@ lapack_int LAPACKE_cgeqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgeqrt_work( matrix_layout, m, n, nb, a, lda, t, ldt, work ); + info = API_SUFFIX(LAPACKE_cgeqrt_work)( matrix_layout, m, n, nb, a, lda, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrt2.c b/LAPACKE/src/lapacke_cgeqrt2.c index dc03b2d020..c570f62fe5 100644 --- a/LAPACKE/src/lapacke_cgeqrt2.c +++ b/LAPACKE/src/lapacke_cgeqrt2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_cgeqrt2_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_cgeqrt2_work.c b/LAPACKE/src/lapacke_cgeqrt2_work.c index bfaecd7ce6..015948b589 100644 --- a/LAPACKE/src/lapacke_cgeqrt2_work.c +++ b/LAPACKE/src/lapacke_cgeqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_cgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt2_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,26 +73,26 @@ lapack_int LAPACKE_cgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrt3.c b/LAPACKE/src/lapacke_cgeqrt3.c index 8cdf3d5b7d..71b886d95e 100644 --- a/LAPACKE/src/lapacke_cgeqrt3.c +++ b/LAPACKE/src/lapacke_cgeqrt3.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt3)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_cgeqrt3_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_cgeqrt3_work.c b/LAPACKE/src/lapacke_cgeqrt3_work.c index de5894e628..55d565d605 100644 --- a/LAPACKE/src/lapacke_cgeqrt3_work.c +++ b/LAPACKE/src/lapacke_cgeqrt3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt3_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_cgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt3_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,26 +73,26 @@ lapack_int LAPACKE_cgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgeqrt_work.c b/LAPACKE/src/lapacke_cgeqrt_work.c index 3f8f0cf179..ca2818e40e 100644 --- a/LAPACKE/src/lapacke_cgeqrt_work.c +++ b/LAPACKE/src/lapacke_cgeqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgeqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* work ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt_work", info ); return info; } if( ldt < MIN(m,n) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,15 +75,15 @@ lapack_int LAPACKE_cgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -91,11 +91,11 @@ lapack_int LAPACKE_cgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgeqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerfs.c b/LAPACKE/src/lapacke_cgerfs.c index fe4cfaee37..67b8ae4570 100644 --- a/LAPACKE/src/lapacke_cgerfs.c +++ b/LAPACKE/src/lapacke_cgerfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgerfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_cgerfs( int matrix_layout, char trans, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgerfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_cgerfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgerfs_work( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_cgerfs_work)( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_cgerfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerfs_work.c b/LAPACKE/src/lapacke_cgerfs_work.c index a16907e272..c724282777 100644 --- a/LAPACKE/src/lapacke_cgerfs_work.c +++ b/LAPACKE/src/lapacke_cgerfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgerfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_cgerfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_cgerfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_cgerfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_cgerfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerfsx.c b/LAPACKE/src/lapacke_cgerfsx.c index 3bb7670447..cdd6bb6ab4 100644 --- a/LAPACKE/src/lapacke_cgerfsx.c +++ b/LAPACKE/src/lapacke_cgerfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_cgerfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, @@ -48,37 +48,37 @@ lapack_int LAPACKE_cgerfsx( int matrix_layout, char trans, char equed, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgerfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -12; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -11; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_cgerfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgerfsx_work( matrix_layout, trans, equed, n, nrhs, a, lda, + info = API_SUFFIX(LAPACKE_cgerfsx_work)( matrix_layout, trans, equed, n, nrhs, a, lda, af, ldaf, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -106,7 +106,7 @@ lapack_int LAPACKE_cgerfsx( int matrix_layout, char trans, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerfsx_work.c b/LAPACKE/src/lapacke_cgerfsx_work.c index 0277d77ed7..2e905e43a4 100644 --- a/LAPACKE/src/lapacke_cgerfsx_work.c +++ b/LAPACKE/src/lapacke_cgerfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_cgerfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, @@ -70,22 +70,22 @@ lapack_int LAPACKE_cgerfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -128,10 +128,10 @@ lapack_int LAPACKE_cgerfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -141,10 +141,10 @@ lapack_int LAPACKE_cgerfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -160,11 +160,11 @@ lapack_int LAPACKE_cgerfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerqf.c b/LAPACKE/src/lapacke_cgerqf.c index 03492c96da..b1f62b3051 100644 --- a/LAPACKE/src/lapacke_cgerqf.c +++ b/LAPACKE/src/lapacke_cgerqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgerqf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgerqf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgerqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgerqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cgerqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgerqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgerqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_cgerqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgerqf_work.c b/LAPACKE/src/lapacke_cgerqf_work.c index 1f00b43a5a..f475de1793 100644 --- a/LAPACKE/src/lapacke_cgerqf_work.c +++ b/LAPACKE/src/lapacke_cgerqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgerqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgerqf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgerqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgerqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgerqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgesdd.c b/LAPACKE/src/lapacke_cgesdd.c index d28139aabc..928d75ce19 100644 --- a/LAPACKE/src/lapacke_cgesdd.c +++ b/LAPACKE/src/lapacke_cgesdd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgesdd( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgesdd)( int matrix_layout, char jobz, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, lapack_complex_float* vt, @@ -47,19 +47,19 @@ lapack_int LAPACKE_cgesdd( int matrix_layout, char jobz, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgesdd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'n' ) ) { lrwork = MAX(1,7*MIN(m,n)); } else { lrwork = (size_t)MAX(1,MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1)); @@ -77,7 +77,7 @@ lapack_int LAPACKE_cgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_cgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, &work_query, lwork, rwork, iwork ); if( info != 0 ) { goto exit_level_2; @@ -91,7 +91,7 @@ lapack_int LAPACKE_cgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_cgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -101,7 +101,7 @@ lapack_int LAPACKE_cgesdd( int matrix_layout, char jobz, lapack_int m, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgesdd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgesdd_work.c b/LAPACKE/src/lapacke_cgesdd_work.c index 70198ccdce..793e409719 100644 --- a/LAPACKE/src/lapacke_cgesdd_work.c +++ b/LAPACKE/src/lapacke_cgesdd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgesdd_work)( int matrix_layout, char jobz, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, @@ -49,15 +49,15 @@ lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) || - LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && m=n) ) ? n : - ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m=n) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1); lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); @@ -67,17 +67,17 @@ lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd_work", info ); return info; } if( ldu < ncols_u ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd_work", info ); return info; } if( ldvt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { vt_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvt_t * MAX(1,n) ); @@ -114,7 +114,7 @@ lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, rwork, iwork, &info ); @@ -122,36 +122,36 @@ lapack_int LAPACKE_cgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -12; } } @@ -97,7 +97,7 @@ lapack_int LAPACKE_cgesvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgesvxx_work( matrix_layout, fact, trans, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_cgesvxx_work)( matrix_layout, fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -107,7 +107,7 @@ lapack_int LAPACKE_cgesvxx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgesvxx_work.c b/LAPACKE/src/lapacke_cgesvxx_work.c index f192d2a526..50f4b5873b 100644 --- a/LAPACKE/src/lapacke_cgesvxx_work.c +++ b/LAPACKE/src/lapacke_cgesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgesvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgesvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_cgesvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_cgesvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgesvxx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -141,21 +141,21 @@ lapack_int LAPACKE_cgesvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -171,11 +171,11 @@ lapack_int LAPACKE_cgesvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetf2.c b/LAPACKE/src/lapacke_cgetf2.c index eba00c30d0..8b6bda87c4 100644 --- a/LAPACKE/src/lapacke_cgetf2.c +++ b/LAPACKE/src/lapacke_cgetf2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetf2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgetf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_cgetf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_cgetf2_work.c b/LAPACKE/src/lapacke_cgetf2_work.c index 1eb26d1fa2..53643cd7c3 100644 --- a/LAPACKE/src/lapacke_cgetf2_work.c +++ b/LAPACKE/src/lapacke_cgetf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetf2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cgetf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_cgetf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetrf.c b/LAPACKE/src/lapacke_cgetrf.c index 90b17b24dd..7327482dad 100644 --- a/LAPACKE/src/lapacke_cgetrf.c +++ b/LAPACKE/src/lapacke_cgetrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgetrf_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_cgetrf_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_cgetrf2.c b/LAPACKE/src/lapacke_cgetrf2.c index 7d335fac1e..0089c7f885 100644 --- a/LAPACKE/src/lapacke_cgetrf2.c +++ b/LAPACKE/src/lapacke_cgetrf2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrf2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cgetrf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_cgetrf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_cgetrf2_work.c b/LAPACKE/src/lapacke_cgetrf2_work.c index b93a4056c7..2586244a3e 100644 --- a/LAPACKE/src/lapacke_cgetrf2_work.c +++ b/LAPACKE/src/lapacke_cgetrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrf2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_cgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetrf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetrf_work.c b/LAPACKE/src/lapacke_cgetrf_work.c index cc4d90096d..32b8751acc 100644 --- a/LAPACKE/src/lapacke_cgetrf_work.c +++ b/LAPACKE/src/lapacke_cgetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cgetrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_cgetrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetrf( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetri.c b/LAPACKE/src/lapacke_cgetri.c index 2e25e863e2..67b49fd1ef 100644 --- a/LAPACKE/src/lapacke_cgetri.c +++ b/LAPACKE/src/lapacke_cgetri.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetri( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetri)( int matrix_layout, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_cgetri( int matrix_layout, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgetri_work( matrix_layout, n, a, lda, ipiv, &work_query, + info = API_SUFFIX(LAPACKE_cgetri_work)( matrix_layout, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_cgetri( int matrix_layout, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgetri_work( matrix_layout, n, a, lda, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_cgetri_work)( matrix_layout, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetri_work.c b/LAPACKE/src/lapacke_cgetri_work.c index 1a1d7b23bd..d053dfee70 100644 --- a/LAPACKE/src/lapacke_cgetri_work.c +++ b/LAPACKE/src/lapacke_cgetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetri_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetri_work)( int matrix_layout, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cgetri_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_cgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetri_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cgetri_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetrs.c b/LAPACKE/src/lapacke_cgetrs.c index 192e1497a9..f33b2dfcb1 100644 --- a/LAPACKE/src/lapacke_cgetrs.c +++ b/LAPACKE/src/lapacke_cgetrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_cgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_cgetrs_work)( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cgetrs_work.c b/LAPACKE/src/lapacke_cgetrs_work.c index 47783ed62d..a8d317d062 100644 --- a/LAPACKE/src/lapacke_cgetrs_work.c +++ b/LAPACKE/src/lapacke_cgetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cgetrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_cgetrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_cgetrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetsls.c b/LAPACKE/src/lapacke_cgetsls.c index ed6c5ad51b..82521c16de 100644 --- a/LAPACKE/src/lapacke_cgetsls.c +++ b/LAPACKE/src/lapacke_cgetsls.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgetsls)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetsls", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetsls", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetsls_work.c b/LAPACKE/src/lapacke_cgetsls_work.c index 0e68339443..83b2c6ce4a 100644 --- a/LAPACKE/src/lapacke_cgetsls_work.c +++ b/LAPACKE/src/lapacke_cgetsls_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cgetsls_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -92,8 +92,8 @@ lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -101,11 +101,11 @@ lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsls_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgetsqrhrt.c b/LAPACKE/src/lapacke_cgetsqrhrt.c index 0e67e0b831..7bd49f76fd 100644 --- a/LAPACKE/src/lapacke_cgetsqrhrt.c +++ b/LAPACKE/src/lapacke_cgetsqrhrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetsqrhrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_cgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_cgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_cgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_cgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_cgetsqrhrt_work.c b/LAPACKE/src/lapacke_cgetsqrhrt_work.c index 598f193e6f..d8fd5dbec7 100644 --- a/LAPACKE/src/lapacke_cgetsqrhrt_work.c +++ b/LAPACKE/src/lapacke_cgetsqrhrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgetsqrhrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt, @@ -54,12 +54,12 @@ lapack_int LAPACKE_cgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt_work", info ); return info; } if( ldt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_cgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgetsqrhrt( &m, &n, &mb1, &nb1, &nb2, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -90,19 +90,19 @@ lapack_int LAPACKE_cgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgetsqrhrt_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_cggbak.c b/LAPACKE/src/lapacke_cggbak.c index 3dafa4242a..8dd6dad0ce 100644 --- a/LAPACKE/src/lapacke_cggbak.c +++ b/LAPACKE/src/lapacke_cggbak.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggbak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cggbak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* lscale, const float* rscale, lapack_int m, lapack_complex_float* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggbak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, lscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, lscale, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n, rscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, rscale, 1 ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -10; } } #endif - return LAPACKE_cggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale, + return API_SUFFIX(LAPACKE_cggbak_work)( matrix_layout, job, side, n, ilo, ihi, lscale, rscale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_cggbak_work.c b/LAPACKE/src/lapacke_cggbak_work.c index 58fc3ca2d9..76481993a4 100644 --- a/LAPACKE/src/lapacke_cggbak_work.c +++ b/LAPACKE/src/lapacke_cggbak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggbak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_cggbak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* lscale, const float* rscale, lapack_int m, lapack_complex_float* v, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cggbak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_cggbak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_cggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t, &ldv_t, &info ); @@ -71,16 +71,16 @@ lapack_int LAPACKE_cggbak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggbal.c b/LAPACKE/src/lapacke_cggbal.c index 101d1a147e..29610a73e3 100644 --- a/LAPACKE/src/lapacke_cggbal.c +++ b/LAPACKE/src/lapacke_cggbal.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggbal( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cggbal)( int matrix_layout, char job, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, @@ -43,28 +43,28 @@ lapack_int LAPACKE_cggbal( int matrix_layout, char job, lapack_int n, lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggbal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 's' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { lwork = MAX(1,6*n); } else { lwork = 1; @@ -76,13 +76,13 @@ lapack_int LAPACKE_cggbal( int matrix_layout, char job, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cggbal_work( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, + info = API_SUFFIX(LAPACKE_cggbal_work)( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggbal", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggbal_work.c b/LAPACKE/src/lapacke_cggbal_work.c index 765b290c5e..3e3de7c7f5 100644 --- a/LAPACKE/src/lapacke_cggbal_work.c +++ b/LAPACKE/src/lapacke_cggbal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggbal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cggbal_work)( int matrix_layout, char job, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, @@ -54,17 +54,17 @@ lapack_int LAPACKE_cggbal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); @@ -73,8 +73,8 @@ lapack_int LAPACKE_cggbal_work( int matrix_layout, char job, lapack_int n, goto exit_level_0; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); @@ -84,13 +84,13 @@ lapack_int LAPACKE_cggbal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_cggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, @@ -99,31 +99,31 @@ lapack_int LAPACKE_cggbal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggbal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgges.c b/LAPACKE/src/lapacke_cgges.c index f521323712..8460d927ff 100644 --- a/LAPACKE/src/lapacke_cgges.c +++ b/LAPACKE/src/lapacke_cgges.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgges( int matrix_layout, char jobvsl, char jobvsr, char sort, +lapack_int API_SUFFIX(LAPACKE_cgges)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -48,22 +48,22 @@ lapack_int LAPACKE_cgges( int matrix_layout, char jobvsl, char jobvsr, char sort lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgges", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -77,7 +77,7 @@ lapack_int LAPACKE_cgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_cgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_cgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_cgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -100,12 +100,12 @@ lapack_int LAPACKE_cgges( int matrix_layout, char jobvsl, char jobvsr, char sort exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgges", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgges3.c b/LAPACKE/src/lapacke_cgges3.c index b1dcad8cc0..bf40fd65ac 100644 --- a/LAPACKE/src/lapacke_cgges3.c +++ b/LAPACKE/src/lapacke_cgges3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgges3( int matrix_layout, char jobvsl, char jobvsr, char sort, +lapack_int API_SUFFIX(LAPACKE_cgges3)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -48,22 +48,22 @@ lapack_int LAPACKE_cgges3( int matrix_layout, char jobvsl, char jobvsr, char sor lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgges3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -77,7 +77,7 @@ lapack_int LAPACKE_cgges3( int matrix_layout, char jobvsl, char jobvsr, char sor goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_cgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_cgges3( int matrix_layout, char jobvsl, char jobvsr, char sor goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_cgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -100,12 +100,12 @@ lapack_int LAPACKE_cgges3( int matrix_layout, char jobvsl, char jobvsr, char sor exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgges3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgges3_work.c b/LAPACKE/src/lapacke_cgges3_work.c index a8f06f5a13..886817adc9 100644 --- a/LAPACKE/src/lapacke_cgges3_work.c +++ b/LAPACKE/src/lapacke_cgges3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_cgges3_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); return info; } if( ldvsl < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); return info; } if( ldvsr < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsl_t * MAX(1,n) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsr_t * MAX(1,n) ); @@ -121,8 +121,8 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -131,22 +131,22 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -155,11 +155,11 @@ lapack_int LAPACKE_cgges3_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgges_work.c b/LAPACKE/src/lapacke_cgges_work.c index be0b8347f1..b45a881d9e 100644 --- a/LAPACKE/src/lapacke_cgges_work.c +++ b/LAPACKE/src/lapacke_cgges_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_cgges_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsl_t * MAX(1,n) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsr_t * MAX(1,n) ); @@ -121,8 +121,8 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -131,22 +131,22 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -155,11 +155,11 @@ lapack_int LAPACKE_cgges_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgges_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggesx.c b/LAPACKE/src/lapacke_cggesx.c index 5962dadb14..5a7999a6e4 100644 --- a/LAPACKE/src/lapacke_cggesx.c +++ b/LAPACKE/src/lapacke_cggesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_cggesx)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, @@ -53,22 +53,22 @@ lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, lapack_int iwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -10; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -82,7 +82,7 @@ lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_cggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, &work_query, lwork, rwork, &iwork_query, liwork, @@ -105,7 +105,7 @@ lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_cggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_cggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, rwork, iwork, liwork, bwork ); @@ -116,12 +116,12 @@ lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggesx_work.c b/LAPACKE/src/lapacke_cggesx_work.c index 311fe6e0a6..de49f385dd 100644 --- a/LAPACKE/src/lapacke_cggesx_work.c +++ b/LAPACKE/src/lapacke_cggesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_cggesx_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_C_SELECT2 selctg, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, @@ -68,22 +68,22 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -18; - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -107,7 +107,7 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsl_t * MAX(1,n) ); @@ -116,7 +116,7 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvsr_t * MAX(1,n) ); @@ -126,8 +126,8 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -137,22 +137,22 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -161,11 +161,11 @@ lapack_int LAPACKE_cggesx_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggev.c b/LAPACKE/src/lapacke_cggev.c index 629a53bc90..50d55bb094 100644 --- a/LAPACKE/src/lapacke_cggev.c +++ b/LAPACKE/src/lapacke_cggev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_cggev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* alpha, @@ -46,16 +46,16 @@ lapack_int LAPACKE_cggev( int matrix_layout, char jobvl, char jobvr, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_cggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -82,7 +82,7 @@ lapack_int LAPACKE_cggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_cggev( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggev3.c b/LAPACKE/src/lapacke_cggev3.c index b14ec96aac..711fb0d555 100644 --- a/LAPACKE/src/lapacke_cggev3.c +++ b/LAPACKE/src/lapacke_cggev3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggev3( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_cggev3)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -47,16 +47,16 @@ lapack_int LAPACKE_cggev3( int matrix_layout, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggev3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_cggev3( int matrix_layout, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -83,7 +83,7 @@ lapack_int LAPACKE_cggev3( int matrix_layout, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_cggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_cggev3( int matrix_layout, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggev3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggev3_work.c b/LAPACKE/src/lapacke_cggev3_work.c index 6443a84827..74fcd01c8f 100644 --- a/LAPACKE/src/lapacke_cggev3_work.c +++ b/LAPACKE/src/lapacke_cggev3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggev3_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_cggev3_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -52,10 +52,10 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -67,22 +67,22 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); return info; } if( ldvl < ncols_vl ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); return info; } if( ldvr < ncols_vr ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,ncols_vl) ); @@ -114,7 +114,7 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,ncols_vr) ); @@ -124,8 +124,8 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggev3( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, rwork, @@ -134,22 +134,22 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -158,11 +158,11 @@ lapack_int LAPACKE_cggev3_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggev_work.c b/LAPACKE/src/lapacke_cggev_work.c index ff129a8b80..fdfc90c76d 100644 --- a/LAPACKE/src/lapacke_cggev_work.c +++ b/LAPACKE/src/lapacke_cggev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_cggev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* alpha, @@ -51,10 +51,10 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -66,22 +66,22 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); return info; } if( ldvl < ncols_vl ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); return info; } if( ldvr < ncols_vr ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,ncols_vl) ); @@ -113,7 +113,7 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,ncols_vr) ); @@ -123,8 +123,8 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, rwork, @@ -133,22 +133,22 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -157,11 +157,11 @@ lapack_int LAPACKE_cggev_work( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggevx.c b/LAPACKE/src/lapacke_cggevx.c index 89785ed8ca..0f6b10ad5f 100644 --- a/LAPACKE/src/lapacke_cggevx.c +++ b/LAPACKE/src/lapacke_cggevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_cggevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -53,29 +53,29 @@ lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( balanc, 's' ) || LAPACKE_lsame( balanc, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( balanc, 's' ) || API_SUFFIX(LAPACKE_lsame)( balanc, 'b' ) ) { lrwork = MAX(1,6*n); } else { lrwork = MAX(1,2*n); } /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -83,8 +83,8 @@ lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } } - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -97,7 +97,7 @@ lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } /* Query optimal working array(s) size */ - info = LAPACKE_cggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_cggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, &work_query, lwork, rwork, iwork, @@ -114,7 +114,7 @@ lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_cggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_cggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, rwork, iwork, bwork ); @@ -123,18 +123,18 @@ lapack_int LAPACKE_cggevx( int matrix_layout, char balanc, char jobvl, exit_level_3: LAPACKE_free( rwork ); exit_level_2: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggevx_work.c b/LAPACKE/src/lapacke_cggevx_work.c index 9c3adb6b46..3632e58f1a 100644 --- a/LAPACKE/src/lapacke_cggevx_work.c +++ b/LAPACKE/src/lapacke_cggevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_cggevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -69,22 +69,22 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); return info; } if( ldvl < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); return info; } if( ldvr < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,n) ); @@ -117,7 +117,7 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,n) ); @@ -127,8 +127,8 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, @@ -138,20 +138,20 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -160,11 +160,11 @@ lapack_int LAPACKE_cggevx_work( int matrix_layout, char balanc, char jobvl, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggglm.c b/LAPACKE/src/lapacke_cggglm.c index 62740bbf62..34ad7f2b95 100644 --- a/LAPACKE/src/lapacke_cggglm.c +++ b/LAPACKE/src/lapacke_cggglm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggglm( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cggglm)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* d, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cggglm( int matrix_layout, lapack_int n, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggglm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -7; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_cggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_cggglm( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_cggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggglm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggglm_work.c b/LAPACKE/src/lapacke_cggglm_work.c index 0b3da2d7a1..aaacb360f8 100644 --- a/LAPACKE/src/lapacke_cggglm_work.c +++ b/LAPACKE/src/lapacke_cggglm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggglm_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cggglm_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* d, @@ -56,12 +56,12 @@ lapack_int LAPACKE_cggglm_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm_work", info ); return info; } if( ldb < p ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cggglm_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_cggglm_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggglm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgghd3.c b/LAPACKE/src/lapacke_cgghd3.c index dce0b2ab75..593a1453d2 100644 --- a/LAPACKE/src/lapacke_cgghd3.c +++ b/LAPACKE/src/lapacke_cgghd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgghd3( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_cgghd3)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -45,32 +45,32 @@ lapack_int LAPACKE_cgghd3( int matrix_layout, char compq, char compz, lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgghd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_cgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -85,14 +85,14 @@ lapack_int LAPACKE_cgghd3( int matrix_layout, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_cgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgghd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgghd3_work.c b/LAPACKE/src/lapacke_cgghd3_work.c index e91ee810e9..f707b8f548 100644 --- a/LAPACKE/src/lapacke_cgghd3_work.c +++ b/LAPACKE/src/lapacke_cgghd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_cgghd3_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -66,22 +66,22 @@ lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -95,14 +95,14 @@ lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -110,13 +110,13 @@ lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_cgghd3( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -125,20 +125,20 @@ lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -147,11 +147,11 @@ lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgghrd.c b/LAPACKE/src/lapacke_cgghrd.c index a3e41570cc..31a0ea7d47 100644 --- a/LAPACKE/src/lapacke_cgghrd.c +++ b/LAPACKE/src/lapacke_cgghrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgghrd( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_cgghrd)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -40,30 +40,30 @@ lapack_int LAPACKE_cgghrd( int matrix_layout, char compq, char compz, lapack_complex_float* z, lapack_int ldz ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgghrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif - return LAPACKE_cgghrd_work( matrix_layout, compq, compz, n, ilo, ihi, a, lda, + return API_SUFFIX(LAPACKE_cgghrd_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz ); } diff --git a/LAPACKE/src/lapacke_cgghrd_work.c b/LAPACKE/src/lapacke_cgghrd_work.c index 31cb555036..51bf95d77c 100644 --- a/LAPACKE/src/lapacke_cgghrd_work.c +++ b/LAPACKE/src/lapacke_cgghrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_cgghrd_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -59,22 +59,22 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -99,7 +99,7 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -109,13 +109,13 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_cgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -124,20 +124,20 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -146,11 +146,11 @@ lapack_int LAPACKE_cgghrd_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgghrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgglse.c b/LAPACKE/src/lapacke_cgglse.c index 17bcc981db..933c72d226 100644 --- a/LAPACKE/src/lapacke_cgglse.c +++ b/LAPACKE/src/lapacke_cgglse.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgglse( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgglse)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* c, @@ -43,28 +43,28 @@ lapack_int LAPACKE_cgglse( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgglse", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -7; } - if( LAPACKE_c_nancheck( m, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( m, c, 1 ) ) { return -9; } - if( LAPACKE_c_nancheck( p, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( p, d, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_cgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -78,13 +78,13 @@ lapack_int LAPACKE_cgglse( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_cgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgglse", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgglse_work.c b/LAPACKE/src/lapacke_cgglse_work.c index d352dfa096..53da78bc9b 100644 --- a/LAPACKE/src/lapacke_cgglse_work.c +++ b/LAPACKE/src/lapacke_cgglse_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgglse_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgglse_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* c, @@ -56,12 +56,12 @@ lapack_int LAPACKE_cgglse_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cgglse_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_cgglse_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgglse_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggqrf.c b/LAPACKE/src/lapacke_cggqrf.c index 247fcd06d3..fd178e9934 100644 --- a/LAPACKE/src/lapacke_cggqrf.c +++ b/LAPACKE/src/lapacke_cggqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggqrf( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cggqrf)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* taua, lapack_complex_float* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_cggqrf( int matrix_layout, lapack_int n, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_cggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_cggqrf( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_cggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggqrf_work.c b/LAPACKE/src/lapacke_cggqrf_work.c index 4e70f2b5aa..5ce130d191 100644 --- a/LAPACKE/src/lapacke_cggqrf_work.c +++ b/LAPACKE/src/lapacke_cggqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggqrf_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cggqrf_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_float* a, lapack_int lda, lapack_complex_float* taua, lapack_complex_float* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cggqrf_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf_work", info ); return info; } if( ldb < p ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cggqrf_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_cggqrf_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggrqf.c b/LAPACKE/src/lapacke_cggrqf.c index 660ce46260..6291578e5d 100644 --- a/LAPACKE/src/lapacke_cggrqf.c +++ b/LAPACKE/src/lapacke_cggrqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggrqf( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_cggrqf)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* taua, lapack_complex_float* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_cggrqf( int matrix_layout, lapack_int m, lapack_int p, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggrqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_cggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_cggrqf( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_cggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggrqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggrqf_work.c b/LAPACKE/src/lapacke_cggrqf_work.c index 9462e88fe3..fffa79b795 100644 --- a/LAPACKE/src/lapacke_cggrqf_work.c +++ b/LAPACKE/src/lapacke_cggrqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggrqf_work( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_cggrqf_work)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* taua, lapack_complex_float* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cggrqf_work( int matrix_layout, lapack_int m, lapack_int p, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cggrqf_work( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_cggrqf_work( int matrix_layout, lapack_int m, lapack_int p, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggrqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvd.c b/LAPACKE/src/lapacke_cggsvd.c index 16d622a76c..a40f693753 100644 --- a/LAPACKE/src/lapacke_cggsvd.c +++ b/LAPACKE/src/lapacke_cggsvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_cggsvd)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_float* a, lapack_int lda, @@ -46,16 +46,16 @@ lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cggsvd_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_cggsvd_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, rwork, iwork ); /* Release memory and exit */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvd3.c b/LAPACKE/src/lapacke_cggsvd3.c index e0a00c6165..6cdd88eadc 100644 --- a/LAPACKE/src/lapacke_cggsvd3.c +++ b/LAPACKE/src/lapacke_cggsvd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_cggsvd3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_float* a, lapack_int lda, @@ -48,22 +48,22 @@ lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } #endif /* Query optimal size for working array */ - info = LAPACKE_cggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_cggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, &work_query, lwork, rwork, iwork ); if( info != 0 ) @@ -82,7 +82,7 @@ lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_cggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, lwork, rwork, iwork ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvd3_work.c b/LAPACKE/src/lapacke_cggsvd3_work.c index 17b6b54b04..6cfb38e320 100644 --- a/LAPACKE/src/lapacke_cggsvd3_work.c +++ b/LAPACKE/src/lapacke_cggsvd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_cggsvd3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_float* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -111,7 +111,7 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); @@ -120,7 +120,7 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,p) ); @@ -129,7 +129,7 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -139,8 +139,8 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -149,27 +149,27 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -178,11 +178,11 @@ lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvd_work.c b/LAPACKE/src/lapacke_cggsvd_work.c index ce6d50cbeb..44cf6d09bc 100644 --- a/LAPACKE/src/lapacke_cggsvd_work.c +++ b/LAPACKE/src/lapacke_cggsvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_cggsvd_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_float* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,p) ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -131,8 +131,8 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggsvd( &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, @@ -141,27 +141,27 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -170,11 +170,11 @@ lapack_int LAPACKE_cggsvd_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvp.c b/LAPACKE/src/lapacke_cggsvp.c index 324b23197b..bcc6b5df25 100644 --- a/LAPACKE/src/lapacke_cggsvp.c +++ b/LAPACKE/src/lapacke_cggsvp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_cggsvp)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float tola, @@ -47,22 +47,22 @@ lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq, lapack_complex_float* tau = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -13; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_cggsvp_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_cggsvp_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, work ); /* Release memory and exit */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvp3.c b/LAPACKE/src/lapacke_cggsvp3.c index b82b5a0048..b1c258d33b 100644 --- a/LAPACKE/src/lapacke_cggsvp3.c +++ b/LAPACKE/src/lapacke_cggsvp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_cggsvp3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float tola, @@ -49,28 +49,28 @@ lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -13; } } #endif /* Query optimal size for working array */ - info = LAPACKE_cggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + info = API_SUFFIX(LAPACKE_cggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, &work_query, lwork ); @@ -101,7 +101,7 @@ lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_cggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_cggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, work, lwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvp3_work.c b/LAPACKE/src/lapacke_cggsvp3_work.c index 28ca7d9a95..067fde065b 100644 --- a/LAPACKE/src/lapacke_cggsvp3_work.c +++ b/LAPACKE/src/lapacke_cggsvp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_cggsvp3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, @@ -68,27 +68,27 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -111,7 +111,7 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); @@ -120,7 +120,7 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,p) ); @@ -129,7 +129,7 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -139,8 +139,8 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -149,27 +149,27 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -178,11 +178,11 @@ lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cggsvp_work.c b/LAPACKE/src/lapacke_cggsvp_work.c index fc04a92fdc..6bd3a72ed7 100644 --- a/LAPACKE/src/lapacke_cggsvp_work.c +++ b/LAPACKE/src/lapacke_cggsvp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_cggsvp_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, @@ -68,27 +68,27 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); return info; } if( ldv < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); @@ -113,7 +113,7 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,m) ); @@ -122,7 +122,7 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -132,8 +132,8 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggsvp( &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, @@ -142,27 +142,27 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, m, 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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -171,11 +171,11 @@ lapack_int LAPACKE_cggsvp_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cggsvp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtcon.c b/LAPACKE/src/lapacke_cgtcon.c index d79f95cf76..7b80382a61 100644 --- a/LAPACKE/src/lapacke_cgtcon.c +++ b/LAPACKE/src/lapacke_cgtcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtcon( char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgtcon)( char norm, lapack_int n, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, @@ -44,19 +44,19 @@ lapack_int LAPACKE_cgtcon( char norm, lapack_int n, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -8; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -3; } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-2, du2, 1 ) ) { return -6; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_cgtcon( char norm, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_cgtcon_work)( norm, n, dl, d, du, du2, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtcon_work.c b/LAPACKE/src/lapacke_cgtcon_work.c index b3f729b0de..da5660365a 100644 --- a/LAPACKE/src/lapacke_cgtcon_work.c +++ b/LAPACKE/src/lapacke_cgtcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtcon_work( char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgtcon_work)( char norm, lapack_int n, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, diff --git a/LAPACKE/src/lapacke_cgtrfs.c b/LAPACKE/src/lapacke_cgtrfs.c index 80094adcf4..1c7bbb5f64 100644 --- a/LAPACKE/src/lapacke_cgtrfs.c +++ b/LAPACKE/src/lapacke_cgtrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgtrfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, @@ -49,37 +49,37 @@ lapack_int LAPACKE_cgtrfs( int matrix_layout, char trans, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgtrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_c_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, df, 1 ) ) { return -9; } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dlf, 1 ) ) { return -8; } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-2, du2, 1 ) ) { return -11; } - if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, duf, 1 ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -97,7 +97,7 @@ lapack_int LAPACKE_cgtrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgtrfs_work( matrix_layout, trans, n, nrhs, dl, d, du, dlf, + info = API_SUFFIX(LAPACKE_cgtrfs_work)( matrix_layout, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -106,7 +106,7 @@ lapack_int LAPACKE_cgtrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtrfs_work.c b/LAPACKE/src/lapacke_cgtrfs_work.c index 83330ce126..19873838a7 100644 --- a/LAPACKE/src/lapacke_cgtrfs_work.c +++ b/LAPACKE/src/lapacke_cgtrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgtrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, @@ -62,12 +62,12 @@ lapack_int LAPACKE_cgtrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,8 +86,8 @@ lapack_int LAPACKE_cgtrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, @@ -96,18 +96,18 @@ lapack_int LAPACKE_cgtrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtsv.c b/LAPACKE/src/lapacke_cgtsv.c index 1002f6f743..d9725da1ab 100644 --- a/LAPACKE/src/lapacke_cgtsv.c +++ b/LAPACKE/src/lapacke_cgtsv.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_cgtsv)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_float* dl, lapack_complex_float* d, lapack_complex_float* du, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgtsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -6; } } #endif - return LAPACKE_cgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb ); + return API_SUFFIX(LAPACKE_cgtsv_work)( matrix_layout, n, nrhs, dl, d, du, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cgtsv_work.c b/LAPACKE/src/lapacke_cgtsv_work.c index 926b109f3e..5a61a105dd 100644 --- a/LAPACKE/src/lapacke_cgtsv_work.c +++ b/LAPACKE/src/lapacke_cgtsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_cgtsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_float* dl, lapack_complex_float* d, lapack_complex_float* du, @@ -51,7 +51,7 @@ lapack_int LAPACKE_cgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,23 +63,23 @@ lapack_int LAPACKE_cgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtsvx.c b/LAPACKE/src/lapacke_cgtsvx.c index 1cfe558579..b971e84893 100644 --- a/LAPACKE/src/lapacke_cgtsvx.c +++ b/LAPACKE/src/lapacke_cgtsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgtsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, @@ -48,41 +48,41 @@ lapack_int LAPACKE_cgtsvx( int matrix_layout, char fact, char trans, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgtsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -14; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_c_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, df, 1 ) ) { return -10; } } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_c_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dlf, 1 ) ) { return -9; } } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-2, du2, 1 ) ) { return -12; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_c_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, duf, 1 ) ) { return -11; } } @@ -101,7 +101,7 @@ lapack_int LAPACKE_cgtsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cgtsvx_work( matrix_layout, fact, trans, n, nrhs, dl, d, du, + info = API_SUFFIX(LAPACKE_cgtsvx_work)( matrix_layout, fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -110,7 +110,7 @@ lapack_int LAPACKE_cgtsvx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgtsvx_work.c b/LAPACKE/src/lapacke_cgtsvx_work.c index 2873010ed0..c2939470a8 100644 --- a/LAPACKE/src/lapacke_cgtsvx_work.c +++ b/LAPACKE/src/lapacke_cgtsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgtsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_cgtsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, @@ -63,12 +63,12 @@ lapack_int LAPACKE_cgtsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_cgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_cgtsvx_work( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -96,18 +96,18 @@ lapack_int LAPACKE_cgtsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgtsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cgttrf.c b/LAPACKE/src/lapacke_cgttrf.c index f63ec8e8b1..012d3b4e23 100644 --- a/LAPACKE/src/lapacke_cgttrf.c +++ b/LAPACKE/src/lapacke_cgttrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgttrf( lapack_int n, lapack_complex_float* dl, +lapack_int API_SUFFIX(LAPACKE_cgttrf)( lapack_int n, lapack_complex_float* dl, lapack_complex_float* d, lapack_complex_float* du, lapack_complex_float* du2, lapack_int* ipiv ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -2; } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -4; } } #endif - return LAPACKE_cgttrf_work( n, dl, d, du, du2, ipiv ); + return API_SUFFIX(LAPACKE_cgttrf_work)( n, dl, d, du, du2, ipiv ); } diff --git a/LAPACKE/src/lapacke_cgttrf_work.c b/LAPACKE/src/lapacke_cgttrf_work.c index d55ebb3f77..4c3c7a21ec 100644 --- a/LAPACKE/src/lapacke_cgttrf_work.c +++ b/LAPACKE/src/lapacke_cgttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgttrf_work( lapack_int n, lapack_complex_float* dl, +lapack_int API_SUFFIX(LAPACKE_cgttrf_work)( lapack_int n, lapack_complex_float* dl, lapack_complex_float* d, lapack_complex_float* du, lapack_complex_float* du2, lapack_int* ipiv ) diff --git a/LAPACKE/src/lapacke_cgttrs.c b/LAPACKE/src/lapacke_cgttrs.c index 696f66649a..1ccd388382 100644 --- a/LAPACKE/src/lapacke_cgttrs.c +++ b/LAPACKE/src/lapacke_cgttrs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgttrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgttrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, @@ -41,29 +41,29 @@ lapack_int LAPACKE_cgttrs( int matrix_layout, char trans, lapack_int n, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_c_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_c_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_c_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-2, du2, 1 ) ) { return -8; } } #endif - return LAPACKE_cgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2, + return API_SUFFIX(LAPACKE_cgttrs_work)( matrix_layout, trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cgttrs_work.c b/LAPACKE/src/lapacke_cgttrs_work.c index 4d17200b48..9225a2722a 100644 --- a/LAPACKE/src/lapacke_cgttrs_work.c +++ b/LAPACKE/src/lapacke_cgttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cgttrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cgttrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_float* dl, const lapack_complex_float* d, const lapack_complex_float* du, @@ -54,7 +54,7 @@ lapack_int LAPACKE_cgttrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_cgttrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t, &info ); @@ -74,16 +74,16 @@ lapack_int LAPACKE_cgttrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbev.c b/LAPACKE/src/lapacke_chbev.c index 9f0da84a8f..a0241df28d 100644 --- a/LAPACKE/src/lapacke_chbev.c +++ b/LAPACKE/src/lapacke_chbev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -41,13 +41,13 @@ lapack_int LAPACKE_chbev( int matrix_layout, char jobz, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_chbev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chbev_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbev_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_chbev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbev_2stage.c b/LAPACKE/src/lapacke_chbev_2stage.c index aeba6302cc..58122b43fe 100644 --- a/LAPACKE/src/lapacke_chbev_2stage.c +++ b/LAPACKE/src/lapacke_chbev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -43,19 +43,19 @@ lapack_int LAPACKE_chbev_2stage( int matrix_layout, char jobz, char uplo, lapack lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_chbev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_chbev_2stage( int matrix_layout, char jobz, char uplo, lapack LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbev_2stage_work.c b/LAPACKE/src/lapacke_chbev_2stage_work.c index 809ebea5f6..8c2b7828d8 100644 --- a/LAPACKE/src/lapacke_chbev_2stage_work.c +++ b/LAPACKE/src/lapacke_chbev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chbev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -76,7 +76,7 @@ lapack_int LAPACKE_chbev_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_chbev_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbev_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &info ); @@ -94,24 +94,24 @@ lapack_int LAPACKE_chbev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbev_work.c b/LAPACKE/src/lapacke_chbev_work.c index 933c5afd93..2485843a3d 100644 --- a/LAPACKE/src/lapacke_chbev_work.c +++ b/LAPACKE/src/lapacke_chbev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chbev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_chbev_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -80,7 +80,7 @@ lapack_int LAPACKE_chbev_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -88,24 +88,24 @@ lapack_int LAPACKE_chbev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevd.c b/LAPACKE/src/lapacke_chbevd.c index 0321d7baf8..f613bdcd9c 100644 --- a/LAPACKE/src/lapacke_chbevd.c +++ b/LAPACKE/src/lapacke_chbevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -48,19 +48,19 @@ lapack_int LAPACKE_chbevd( int matrix_layout, char jobz, char uplo, lapack_int n float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_chbevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_chbevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevd_2stage.c b/LAPACKE/src/lapacke_chbevd_2stage.c index 839e74b3c8..1c44ed9495 100644 --- a/LAPACKE/src/lapacke_chbevd_2stage.c +++ b/LAPACKE/src/lapacke_chbevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -48,19 +48,19 @@ lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapac float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_chbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevd_2stage_work.c b/LAPACKE/src/lapacke_chbevd_2stage_work.c index 83cdd05ee4..56e0f1a22c 100644 --- a/LAPACKE/src/lapacke_chbevd_2stage_work.c +++ b/LAPACKE/src/lapacke_chbevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, @@ -57,12 +57,12 @@ lapack_int LAPACKE_chbevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_chbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_chbevd_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbevd_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -97,24 +97,24 @@ lapack_int LAPACKE_chbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevd_work.c b/LAPACKE/src/lapacke_chbevd_work.c index ce554ad787..61be1330b7 100644 --- a/LAPACKE/src/lapacke_chbevd_work.c +++ b/LAPACKE/src/lapacke_chbevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* w, lapack_complex_float* z, @@ -57,12 +57,12 @@ lapack_int LAPACKE_chbevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_chbevd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_chbevd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -97,24 +97,24 @@ lapack_int LAPACKE_chbevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevx.c b/LAPACKE/src/lapacke_chbevx.c index fba050c365..9d829ac84d 100644 --- a/LAPACKE/src/lapacke_chbevx.c +++ b/LAPACKE/src/lapacke_chbevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* q, lapack_int ldq, float vl, @@ -45,25 +45,25 @@ lapack_int LAPACKE_chbevx( int matrix_layout, char jobz, char range, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_chbevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbevx_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_chbevx_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_chbevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevx_2stage.c b/LAPACKE/src/lapacke_chbevx_2stage.c index ea94132b6c..2545d3c0e2 100644 --- a/LAPACKE/src/lapacke_chbevx_2stage.c +++ b/LAPACKE/src/lapacke_chbevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* q, lapack_int ldq, float vl, @@ -47,32 +47,32 @@ lapack_int LAPACKE_chbevx_2stage( int matrix_layout, char jobz, char range, char lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_chbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -97,7 +97,7 @@ lapack_int LAPACKE_chbevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_chbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_chbevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevx_2stage_work.c b/LAPACKE/src/lapacke_chbevx_2stage_work.c index 9e8a26842d..2371e6d941 100644 --- a/LAPACKE/src/lapacke_chbevx_2stage_work.c +++ b/LAPACKE/src/lapacke_chbevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_chbevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* q, lapack_int ldq, @@ -53,9 +53,9 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_chbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbevx_2stage( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -120,32 +120,32 @@ lapack_int LAPACKE_chbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbevx_work.c b/LAPACKE/src/lapacke_chbevx_work.c index ddebb9e735..ffc6c177c6 100644 --- a/LAPACKE/src/lapacke_chbevx_work.c +++ b/LAPACKE/src/lapacke_chbevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_chbevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* q, lapack_int ldq, @@ -53,9 +53,9 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_chbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_chbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -113,32 +113,32 @@ lapack_int LAPACKE_chbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgst.c b/LAPACKE/src/lapacke_chbgst.c index 13d4272593..d098cdc7f6 100644 --- a/LAPACKE/src/lapacke_chbgst.c +++ b/LAPACKE/src/lapacke_chbgst.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgst( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbgst)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* bb, lapack_int ldbb, @@ -42,16 +42,16 @@ lapack_int LAPACKE_chbgst( int matrix_layout, char vect, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_chbgst( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chbgst_work( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_chbgst_work)( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x, ldx, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -77,7 +77,7 @@ lapack_int LAPACKE_chbgst( int matrix_layout, char vect, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgst", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgst_work.c b/LAPACKE/src/lapacke_chbgst_work.c index a04b04a26a..4d31dd1838 100644 --- a/LAPACKE/src/lapacke_chbgst_work.c +++ b/LAPACKE/src/lapacke_chbgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbgst_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* bb, lapack_int ldbb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst_work", info ); return info; } if( ldx < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_chbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -83,7 +83,7 @@ lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { x_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,n) ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_chb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_chbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, x_t, &ldx_t, work, rwork, &info ); @@ -102,13 +102,13 @@ lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( x_t ); } exit_level_2: @@ -117,11 +117,11 @@ lapack_int LAPACKE_chbgst_work( int matrix_layout, char vect, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgv.c b/LAPACKE/src/lapacke_chbgv.c index d28f0f1f31..6b7dda8dbb 100644 --- a/LAPACKE/src/lapacke_chbgv.c +++ b/LAPACKE/src/lapacke_chbgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgv( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbgv)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, float* w, @@ -42,16 +42,16 @@ lapack_int LAPACKE_chbgv( int matrix_layout, char jobz, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_chbgv( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chbgv_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_chbgv_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -77,7 +77,7 @@ lapack_int LAPACKE_chbgv( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgv_work.c b/LAPACKE/src/lapacke_chbgv_work.c index b977a94fa8..de2abb0168 100644 --- a/LAPACKE/src/lapacke_chbgv_work.c +++ b/LAPACKE/src/lapacke_chbgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbgv_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, @@ -58,17 +58,17 @@ lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_chbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_chb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_chbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -103,15 +103,15 @@ lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -120,11 +120,11 @@ lapack_int LAPACKE_chbgv_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgvd.c b/LAPACKE/src/lapacke_chbgvd.c index f1b037a116..42fdbf784e 100644 --- a/LAPACKE/src/lapacke_chbgvd.c +++ b/LAPACKE/src/lapacke_chbgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgvd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbgvd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, float* w, @@ -49,22 +49,22 @@ lapack_int LAPACKE_chbgvd( int matrix_layout, char jobz, char uplo, lapack_int n float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_chbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_chbgvd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_chbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_chbgvd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgvd_work.c b/LAPACKE/src/lapacke_chbgvd_work.c index f6e2ac84a2..7aff46d95c 100644 --- a/LAPACKE/src/lapacke_chbgvd_work.c +++ b/LAPACKE/src/lapacke_chbgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbgvd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, @@ -61,17 +61,17 @@ lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_chbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -104,8 +104,8 @@ lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_chb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_chbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, @@ -114,15 +114,15 @@ lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -131,11 +131,11 @@ lapack_int LAPACKE_chbgvd_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgvx.c b/LAPACKE/src/lapacke_chbgvx.c index 736c33e887..ae9260fcfd 100644 --- a/LAPACKE/src/lapacke_chbgvx.c +++ b/LAPACKE/src/lapacke_chbgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgvx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbgvx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, @@ -46,28 +46,28 @@ lapack_int LAPACKE_chbgvx( int matrix_layout, char jobz, char range, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -8; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -18; } - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -14; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -15; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_chbgvx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chbgvx_work( matrix_layout, jobz, range, uplo, n, ka, kb, ab, + info = API_SUFFIX(LAPACKE_chbgvx_work)( matrix_layout, jobz, range, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_chbgvx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbgvx_work.c b/LAPACKE/src/lapacke_chbgvx_work.c index 1fe2c9e69d..11f329ecc6 100644 --- a/LAPACKE/src/lapacke_chbgvx_work.c +++ b/LAPACKE/src/lapacke_chbgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_chbgvx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, @@ -65,22 +65,22 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); return info; } if( ldbb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); return info; } if( ldq < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); return info; } if( ldz < n ) { info = -22; - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -105,7 +105,7 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, goto exit_level_2; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -115,8 +115,8 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_chb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_chbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, @@ -125,22 +125,22 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -149,11 +149,11 @@ lapack_int LAPACKE_chbgvx_work( int matrix_layout, char jobz, char range, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbtrd.c b/LAPACKE/src/lapacke_chbtrd.c index c54dc555fe..74ad8129a3 100644 --- a/LAPACKE/src/lapacke_chbtrd.c +++ b/LAPACKE/src/lapacke_chbtrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbtrd( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chbtrd)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* d, float* e, lapack_complex_float* q, lapack_int ldq ) @@ -40,17 +40,17 @@ lapack_int LAPACKE_chbtrd( int matrix_layout, char vect, char uplo, lapack_int n lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chbtrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -10; } } @@ -64,13 +64,13 @@ lapack_int LAPACKE_chbtrd( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chbtrd_work( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, + info = API_SUFFIX(LAPACKE_chbtrd_work)( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbtrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chbtrd_work.c b/LAPACKE/src/lapacke_chbtrd_work.c index 3b58b0e2b8..d0b44c5caa 100644 --- a/LAPACKE/src/lapacke_chbtrd_work.c +++ b/LAPACKE/src/lapacke_chbtrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chbtrd_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_chbtrd_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab, float* d, float* e, lapack_complex_float* q, @@ -54,12 +54,12 @@ lapack_int LAPACKE_chbtrd_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd_work", info ); return info; } if( ldq < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_chbtrd_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -79,9 +79,9 @@ lapack_int LAPACKE_chbtrd_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_chb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_chb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_chbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t, @@ -90,24 +90,24 @@ lapack_int LAPACKE_chbtrd_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_chb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chbtrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_checon.c b/LAPACKE/src/lapacke_checon.c index af00a5366f..e4a57df6ea 100644 --- a/LAPACKE/src/lapacke_checon.c +++ b/LAPACKE/src/lapacke_checon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_checon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_checon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_checon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_checon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_checon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_checon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_checon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_checon_3.c b/LAPACKE/src/lapacke_checon_3.c index 08a2f0e130..28591a3f38 100644 --- a/LAPACKE/src/lapacke_checon_3.c +++ b/LAPACKE/src/lapacke_checon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_checon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_checon_3)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_checon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -66,13 +66,13 @@ lapack_int LAPACKE_checon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_checon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_checon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_checon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_checon_3_work.c b/LAPACKE/src/lapacke_checon_3_work.c index 30294c58b8..e23df7fa12 100644 --- a/LAPACKE/src/lapacke_checon_3_work.c +++ b/LAPACKE/src/lapacke_checon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_checon_3_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, float anorm, @@ -51,7 +51,7 @@ lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_checon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_checon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_checon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_checon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_checon_work.c b/LAPACKE/src/lapacke_checon_work.c index e0977e0b02..27ae39caa7 100644 --- a/LAPACKE/src/lapacke_checon_work.c +++ b/LAPACKE/src/lapacke_checon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_checon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_checon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_checon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_checon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_checon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_checon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_checon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_checon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_checon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_checon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheequb.c b/LAPACKE/src/lapacke_cheequb.c index 795d074f59..7f4d6351e9 100644 --- a/LAPACKE/src/lapacke_cheequb.c +++ b/LAPACKE/src/lapacke_cheequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheequb)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_cheequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cheequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_cheequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheequb_work.c b/LAPACKE/src/lapacke_cheequb_work.c index 730bcb759e..7ea7179102 100644 --- a/LAPACKE/src/lapacke_cheequb_work.c +++ b/LAPACKE/src/lapacke_cheequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheequb_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cheequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cheequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_cheequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheev.c b/LAPACKE/src/lapacke_cheev.c index 02e5df29dc..a499986fde 100644 --- a/LAPACKE/src/lapacke_cheev.c +++ b/LAPACKE/src/lapacke_cheev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -41,13 +41,13 @@ lapack_int LAPACKE_cheev( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -59,7 +59,7 @@ lapack_int LAPACKE_cheev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cheev_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_cheev_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -73,7 +73,7 @@ lapack_int LAPACKE_cheev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cheev_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_cheev_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_cheev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheev_2stage.c b/LAPACKE/src/lapacke_cheev_2stage.c index 4e18f9b380..45283d8563 100644 --- a/LAPACKE/src/lapacke_cheev_2stage.c +++ b/LAPACKE/src/lapacke_cheev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -41,13 +41,13 @@ lapack_int LAPACKE_cheev_2stage( int matrix_layout, char jobz, char uplo, lapack lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -59,7 +59,7 @@ lapack_int LAPACKE_cheev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cheev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_cheev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -73,7 +73,7 @@ lapack_int LAPACKE_cheev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cheev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_cheev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_cheev_2stage( int matrix_layout, char jobz, char uplo, lapack LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheev_2stage_work.c b/LAPACKE/src/lapacke_cheev_2stage_work.c index 4efb6c03db..3c341728d2 100644 --- a/LAPACKE/src/lapacke_cheev_2stage_work.c +++ b/LAPACKE/src/lapacke_cheev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w, lapack_complex_float* work, lapack_int lwork, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cheev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_cheev_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheev_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -77,16 +77,16 @@ lapack_int LAPACKE_cheev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheev_work.c b/LAPACKE/src/lapacke_cheev_work.c index 3cf5a963f9..a7f3a871a4 100644 --- a/LAPACKE/src/lapacke_cheev_work.c +++ b/LAPACKE/src/lapacke_cheev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w, lapack_complex_float* work, lapack_int lwork, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -78,19 +78,19 @@ lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevd.c b/LAPACKE/src/lapacke_cheevd.c index 56bfc411ce..48765be638 100644 --- a/LAPACKE/src/lapacke_cheevd.c +++ b/LAPACKE/src/lapacke_cheevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -46,19 +46,19 @@ lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cheevd_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_cheevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevd_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_cheevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevd_2stage.c b/LAPACKE/src/lapacke_cheevd_2stage.c index 4fa71d2526..a5220dc8e7 100644 --- a/LAPACKE/src/lapacke_cheevd_2stage.c +++ b/LAPACKE/src/lapacke_cheevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -46,19 +46,19 @@ lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapac float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cheevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_cheevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_cheevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevd_2stage_work.c b/LAPACKE/src/lapacke_cheevd_2stage_work.c index b2c861206b..32b58602a2 100644 --- a/LAPACKE/src/lapacke_cheevd_2stage_work.c +++ b/LAPACKE/src/lapacke_cheevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w, lapack_complex_float* work, lapack_int lwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,19 +79,19 @@ lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevd_work.c b/LAPACKE/src/lapacke_cheevd_work.c index 942c8b3eb1..15592d8fa8 100644 --- a/LAPACKE/src/lapacke_cheevd_work.c +++ b/LAPACKE/src/lapacke_cheevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* w, lapack_complex_float* work, lapack_int lwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,19 +79,19 @@ lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevr.c b/LAPACKE/src/lapacke_cheevr.c index bfa2468d70..d2f1d8238f 100644 --- a/LAPACKE/src/lapacke_cheevr.c +++ b/LAPACKE/src/lapacke_cheevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevr( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevr)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -50,32 +50,32 @@ lapack_int LAPACKE_cheevr( int matrix_layout, char jobz, char range, char uplo, float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cheevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_cheevr( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_cheevr( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevr_2stage.c b/LAPACKE/src/lapacke_cheevr_2stage.c index 788d287696..01ba48dcf8 100644 --- a/LAPACKE/src/lapacke_cheevr_2stage.c +++ b/LAPACKE/src/lapacke_cheevr_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevr_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevr_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -50,32 +50,32 @@ lapack_int LAPACKE_cheevr_2stage( int matrix_layout, char jobz, char range, char float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevr_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cheevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_cheevr_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_cheevr_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevr_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevr_2stage_work.c b/LAPACKE/src/lapacke_cheevr_2stage_work.c index 29525cbebf..7365e5410e 100644 --- a/LAPACKE/src/lapacke_cheevr_2stage_work.c +++ b/LAPACKE/src/lapacke_cheevr_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cheevr_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, @@ -53,9 +53,9 @@ lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_float* a_t = NULL; @@ -63,12 +63,12 @@ lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevr_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -104,24 +104,24 @@ lapack_int LAPACKE_cheevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevr_work.c b/LAPACKE/src/lapacke_cheevr_work.c index 3e4f75ef49..7c4a8523fd 100644 --- a/LAPACKE/src/lapacke_cheevr_work.c +++ b/LAPACKE/src/lapacke_cheevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cheevr_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, @@ -53,10 +53,10 @@ lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_float* a_t = NULL; @@ -64,12 +64,12 @@ lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -105,24 +105,24 @@ lapack_int LAPACKE_cheevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevx.c b/LAPACKE/src/lapacke_cheevx.c index 44cae07d2d..582fc77e62 100644 --- a/LAPACKE/src/lapacke_cheevx.c +++ b/LAPACKE/src/lapacke_cheevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -46,25 +46,25 @@ lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -97,7 +97,7 @@ lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevx_2stage.c b/LAPACKE/src/lapacke_cheevx_2stage.c index 22b6594ed7..d98c65c09c 100644 --- a/LAPACKE/src/lapacke_cheevx_2stage.c +++ b/LAPACKE/src/lapacke_cheevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_cheevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -46,25 +46,25 @@ lapack_int LAPACKE_cheevx_2stage( int matrix_layout, char jobz, char range, char lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cheevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_cheevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_cheevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -97,7 +97,7 @@ lapack_int LAPACKE_cheevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cheevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_cheevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_cheevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevx_2stage_work.c b/LAPACKE/src/lapacke_cheevx_2stage_work.c index 4d90468cee..088f92157c 100644 --- a/LAPACKE/src/lapacke_cheevx_2stage_work.c +++ b/LAPACKE/src/lapacke_cheevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cheevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, @@ -52,9 +52,9 @@ lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_float* a_t = NULL; @@ -62,12 +62,12 @@ lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevx_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, rwork, @@ -103,24 +103,24 @@ lapack_int LAPACKE_cheevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheevx_work.c b/LAPACKE/src/lapacke_cheevx_work.c index ca0ed9ec70..bc47dfa8b1 100644 --- a/LAPACKE/src/lapacke_cheevx_work.c +++ b/LAPACKE/src/lapacke_cheevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cheevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float vl, float vu, lapack_int il, @@ -52,10 +52,10 @@ lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_float* a_t = NULL; @@ -63,12 +63,12 @@ lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, rwork, @@ -104,24 +104,24 @@ lapack_int LAPACKE_cheevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegst.c b/LAPACKE/src/lapacke_chegst.c index d4961620d5..93405f49d6 100644 --- a/LAPACKE/src/lapacke_chegst.c +++ b/LAPACKE/src/lapacke_chegst.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_chegst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chegst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -7; } } #endif - return LAPACKE_chegst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_chegst_work)( matrix_layout, itype, uplo, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chegst_work.c b/LAPACKE/src/lapacke_chegst_work.c index 9318e02dda..048f9e5b78 100644 --- a/LAPACKE/src/lapacke_chegst_work.c +++ b/LAPACKE/src/lapacke_chegst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_chegst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_chegst_work( int matrix_layout, lapack_int itype, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegst_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,26 +74,26 @@ lapack_int LAPACKE_chegst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chegst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegv.c b/LAPACKE/src/lapacke_chegv.c index 4b676e6250..f65f426512 100644 --- a/LAPACKE/src/lapacke_chegv.c +++ b/LAPACKE/src/lapacke_chegv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* w ) @@ -43,16 +43,16 @@ lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chegv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_chegv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -78,7 +78,7 @@ lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chegv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegv_2stage.c b/LAPACKE/src/lapacke_chegv_2stage.c index 0ebcb74dc6..041c342c9f 100644 --- a/LAPACKE/src/lapacke_chegv_2stage.c +++ b/LAPACKE/src/lapacke_chegv_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegv_2stage( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegv_2stage)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* w ) @@ -43,16 +43,16 @@ lapack_int LAPACKE_chegv_2stage( int matrix_layout, lapack_int itype, char jobz, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chegv_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_chegv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_chegv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -78,7 +78,7 @@ lapack_int LAPACKE_chegv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chegv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_chegv_2stage( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegv_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegv_2stage_work.c b/LAPACKE/src/lapacke_chegv_2stage_work.c index 52a7356a5f..339f99f374 100644 --- a/LAPACKE/src/lapacke_chegv_2stage_work.c +++ b/LAPACKE/src/lapacke_chegv_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegv_2stage_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegv_2stage_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* w, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chegv_2stage_work( int matrix_layout, lapack_int itype, char /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_chegv_2stage_work( int matrix_layout, lapack_int itype, char goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chegv_2stage( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_chegv_2stage_work( int matrix_layout, lapack_int itype, char info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegv_work.c b/LAPACKE/src/lapacke_chegv_work.c index 35d69120d3..b821aacf78 100644 --- a/LAPACKE/src/lapacke_chegv_work.c +++ b/LAPACKE/src/lapacke_chegv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* w, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chegv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_chegv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chegv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_chegv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegvd.c b/LAPACKE/src/lapacke_chegvd.c index 21a33fadf6..11e91927c3 100644 --- a/LAPACKE/src/lapacke_chegvd.c +++ b/LAPACKE/src/lapacke_chegvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float* w ) @@ -48,22 +48,22 @@ lapack_int LAPACKE_chegvd( int matrix_layout, lapack_int itype, char jobz, float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chegvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chegvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_chegvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chegvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_chegvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_chegvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegvd_work.c b/LAPACKE/src/lapacke_chegvd_work.c index b9749d9352..10e7dcbde5 100644 --- a/LAPACKE/src/lapacke_chegvd_work.c +++ b/LAPACKE/src/lapacke_chegvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -57,12 +57,12 @@ lapack_int LAPACKE_chegvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,8 +86,8 @@ lapack_int LAPACKE_chegvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chegvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -95,19 +95,19 @@ lapack_int LAPACKE_chegvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegvx.c b/LAPACKE/src/lapacke_chegvx.c index 688ea34ff2..236196c8ea 100644 --- a/LAPACKE/src/lapacke_chegvx.c +++ b/LAPACKE/src/lapacke_chegvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, float vl, @@ -47,28 +47,28 @@ lapack_int LAPACKE_chegvx( int matrix_layout, lapack_int itype, char jobz, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chegvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -86,7 +86,7 @@ lapack_int LAPACKE_chegvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_chegvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_chegvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -101,7 +101,7 @@ lapack_int LAPACKE_chegvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chegvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_chegvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -112,7 +112,7 @@ lapack_int LAPACKE_chegvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chegvx_work.c b/LAPACKE/src/lapacke_chegvx_work.c index 132d0c0e10..cad37eae2a 100644 --- a/LAPACKE/src/lapacke_chegvx_work.c +++ b/LAPACKE/src/lapacke_chegvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chegvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -53,9 +53,9 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_chegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -108,8 +108,8 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, } } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_che_trans( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chegvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -118,14 +118,14 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -134,11 +134,11 @@ lapack_int LAPACKE_chegvx_work( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chegvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cherfs.c b/LAPACKE/src/lapacke_cherfs.c index dfcda32e12..f84ea8605e 100644 --- a/LAPACKE/src/lapacke_cherfs.c +++ b/LAPACKE/src/lapacke_cherfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cherfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cherfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_cherfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cherfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_cherfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cherfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_cherfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_cherfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cherfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cherfs_work.c b/LAPACKE/src/lapacke_cherfs_work.c index 88a000be0c..1d8e68a41b 100644 --- a/LAPACKE/src/lapacke_cherfs_work.c +++ b/LAPACKE/src/lapacke_cherfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cherfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cherfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_cherfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_cherfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_che_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cherfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_cherfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_cherfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cherfsx.c b/LAPACKE/src/lapacke_cherfsx.c index c2da393393..5f566c7527 100644 --- a/LAPACKE/src/lapacke_cherfsx.c +++ b/LAPACKE/src/lapacke_cherfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cherfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_cherfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_cherfsx( int matrix_layout, char uplo, char equed, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cherfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_cherfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cherfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_cherfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_cherfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cherfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cherfsx_work.c b/LAPACKE/src/lapacke_cherfsx_work.c index 438803de03..b343b103bb 100644 --- a/LAPACKE/src/lapacke_cherfsx_work.c +++ b/LAPACKE/src/lapacke_cherfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cherfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_cherfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, @@ -69,22 +69,22 @@ lapack_int LAPACKE_cherfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,10 +127,10 @@ lapack_int LAPACKE_cherfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_che_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cherfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -140,10 +140,10 @@ lapack_int LAPACKE_cherfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -159,11 +159,11 @@ lapack_int LAPACKE_cherfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cherfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv.c b/LAPACKE/src/lapacke_chesv.c index 2fc9c9dae7..bef17720ef 100644 --- a/LAPACKE/src/lapacke_chesv.c +++ b/LAPACKE/src/lapacke_chesv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_chesv( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chesv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_chesv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chesv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_aa.c b/LAPACKE/src/lapacke_chesv_aa.c index 4a72778975..2050b55792 100644 --- a/LAPACKE/src/lapacke_chesv_aa.c +++ b/LAPACKE/src/lapacke_chesv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_chesv_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chesv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_chesv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chesv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_aa_2stage.c b/LAPACKE/src/lapacke_chesv_aa_2stage.c index 4ba72aeca1..3c2da04066 100644 --- a/LAPACKE/src/lapacke_chesv_aa_2stage.c +++ b/LAPACKE/src/lapacke_chesv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -43,25 +43,25 @@ lapack_int LAPACKE_chesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chesv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_chesv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -76,14 +76,14 @@ lapack_int LAPACKE_chesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chesv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_chesv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_aa_2stage_work.c b/LAPACKE/src/lapacke_chesv_aa_2stage_work.c index 7115052326..a044c9c58b 100644 --- a/LAPACKE/src/lapacke_chesv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_chesv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_chesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_aa_work.c b/LAPACKE/src/lapacke_chesv_aa_work.c index 62ee5bc968..9203a58675 100644 --- a/LAPACKE/src/lapacke_chesv_aa_work.c +++ b/LAPACKE/src/lapacke_chesv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_chesv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_chesv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_chesv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_rk.c b/LAPACKE/src/lapacke_chesv_rk.c index c5a5caa447..6182d99e41 100644 --- a/LAPACKE/src/lapacke_chesv_rk.c +++ b/LAPACKE/src/lapacke_chesv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, @@ -43,22 +43,22 @@ lapack_int LAPACKE_chesv_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_chesv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_chesv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_rk_work.c b/LAPACKE/src/lapacke_chesv_rk_work.c index 83a5bcd420..1a7b407231 100644 --- a/LAPACKE/src/lapacke_chesv_rk_work.c +++ b/LAPACKE/src/lapacke_chesv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesv_work.c b/LAPACKE/src/lapacke_chesv_work.c index 8647396621..9013dddea5 100644 --- a/LAPACKE/src/lapacke_chesv_work.c +++ b/LAPACKE/src/lapacke_chesv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_chesv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_chesv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_chesv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesvx.c b/LAPACKE/src/lapacke_chesvx.c index 9cf0c0460c..d9f93020fd 100644 --- a/LAPACKE/src/lapacke_chesvx.c +++ b/LAPACKE/src/lapacke_chesvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chesvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, lapack_int* ipiv, @@ -46,21 +46,21 @@ lapack_int LAPACKE_chesvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -72,7 +72,7 @@ lapack_int LAPACKE_chesvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_chesvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_chesvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_chesvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chesvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_chesvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_chesvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesvx_work.c b/LAPACKE/src/lapacke_chesvx_work.c index 3e1aa96076..bbfb2cb89e 100644 --- a/LAPACKE/src/lapacke_chesvx_work.c +++ b/LAPACKE/src/lapacke_chesvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_chesvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -63,22 +63,22 @@ lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -116,11 +116,11 @@ lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_che_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -129,11 +129,11 @@ lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -144,11 +144,11 @@ lapack_int LAPACKE_chesvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesvxx.c b/LAPACKE/src/lapacke_chesvxx.c index 9ef8749298..af400f742a 100644 --- a/LAPACKE/src/lapacke_chesvxx.c +++ b/LAPACKE/src/lapacke_chesvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_chesvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -48,30 +48,30 @@ lapack_int LAPACKE_chesvxx( int matrix_layout, char fact, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chesvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -12; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_chesvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chesvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_chesvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_chesvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chesvxx_work.c b/LAPACKE/src/lapacke_chesvxx_work.c index 700ecf7a08..2ecd7fc810 100644 --- a/LAPACKE/src/lapacke_chesvxx_work.c +++ b/LAPACKE/src/lapacke_chesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chesvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_chesvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_chesvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_chesvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_che_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chesvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -141,20 +141,20 @@ lapack_int LAPACKE_chesvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -170,11 +170,11 @@ lapack_int LAPACKE_chesvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cheswapr.c b/LAPACKE/src/lapacke_cheswapr.c index 8acee82280..99f7c4f324 100644 --- a/LAPACKE/src/lapacke_cheswapr.c +++ b/LAPACKE/src/lapacke_cheswapr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_cheswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_cheswapr_work.c b/LAPACKE/src/lapacke_cheswapr_work.c index 378cd75862..0554a593ae 100644 --- a/LAPACKE/src/lapacke_cheswapr_work.c +++ b/LAPACKE/src/lapacke_cheswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cheswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cheswapr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -54,21 +54,21 @@ lapack_int LAPACKE_cheswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cheswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cheswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cheswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrd.c b/LAPACKE/src/lapacke_chetrd.c index bdfb2493f1..e87c6da9e1 100644 --- a/LAPACKE/src/lapacke_chetrd.c +++ b/LAPACKE/src/lapacke_chetrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrd( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrd)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* d, float* e, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetrd( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, + info = API_SUFFIX(LAPACKE_chetrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetrd( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, work, + info = API_SUFFIX(LAPACKE_chetrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrd_work.c b/LAPACKE/src/lapacke_chetrd_work.c index 6c950ee7a3..85a6f4d4fd 100644 --- a/LAPACKE/src/lapacke_chetrd_work.c +++ b/LAPACKE/src/lapacke_chetrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrd_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, float* d, float* e, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetrd_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_chetrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf.c b/LAPACKE/src/lapacke_chetrf.c index 3238059188..f93ce8facd 100644 --- a/LAPACKE/src/lapacke_chetrf.c +++ b/LAPACKE/src/lapacke_chetrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetrf( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_chetrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_chetrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_aa.c b/LAPACKE/src/lapacke_chetrf_aa.c index be3a442c16..bde35b62ad 100644 --- a/LAPACKE/src/lapacke_chetrf_aa.c +++ b/LAPACKE/src/lapacke_chetrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_aa)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetrf_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_chetrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetrf_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_chetrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_aa_2stage.c b/LAPACKE/src/lapacke_chetrf_aa_2stage.c index 2ecf93478a..7108696561 100644 --- a/LAPACKE/src/lapacke_chetrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_chetrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_chetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_chetrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_chetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_chetrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_aa_2stage_work.c b/LAPACKE/src/lapacke_chetrf_aa_2stage_work.c index ccb41ee623..eb22b3335a 100644 --- a/LAPACKE/src/lapacke_chetrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_chetrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -90,18 +90,18 @@ lapack_int LAPACKE_chetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_aa_work.c b/LAPACKE/src/lapacke_chetrf_aa_work.c index dcebaf2f21..487df5e3c0 100644 --- a/LAPACKE/src/lapacke_chetrf_aa_work.c +++ b/LAPACKE/src/lapacke_chetrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_chetrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_rk.c b/LAPACKE/src/lapacke_chetrf_rk.c index 7caf6f2bbb..51dff5534b 100644 --- a/LAPACKE/src/lapacke_chetrf_rk.c +++ b/LAPACKE/src/lapacke_chetrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_rk)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetrf_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_chetrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetrf_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_chetrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_rk_work.c b/LAPACKE/src/lapacke_chetrf_rk_work.c index b43d92bb9e..7b840bd25b 100644 --- a/LAPACKE/src/lapacke_chetrf_rk_work.c +++ b/LAPACKE/src/lapacke_chetrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, lapack_complex_float* work, @@ -51,7 +51,7 @@ lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_rook.c b/LAPACKE/src/lapacke_chetrf_rook.c index 73ce55ac68..8d75607e62 100644 --- a/LAPACKE/src/lapacke_chetrf_rook.c +++ b/LAPACKE/src/lapacke_chetrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_rook)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetrf_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_chetrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetrf_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_chetrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_rook_work.c b/LAPACKE/src/lapacke_chetrf_rook_work.c index a2afa602e1..ce99a97c90 100644 --- a/LAPACKE/src/lapacke_chetrf_rook_work.c +++ b/LAPACKE/src/lapacke_chetrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_chetrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrf_work.c b/LAPACKE/src/lapacke_chetrf_work.c index b043364a31..f0f5dc54e1 100644 --- a/LAPACKE/src/lapacke_chetrf_work.c +++ b/LAPACKE/src/lapacke_chetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_chetrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri.c b/LAPACKE/src/lapacke_chetri.c index 5d68dd005b..e0579a49c2 100644 --- a/LAPACKE/src/lapacke_chetri.c +++ b/LAPACKE/src/lapacke_chetri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_chetri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_chetri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri2.c b/LAPACKE/src/lapacke_chetri2.c index 3822bbae54..e7d3d7be7d 100644 --- a/LAPACKE/src/lapacke_chetri2.c +++ b/LAPACKE/src/lapacke_chetri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_chetri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_chetri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_chetri2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_chetri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri2_work.c b/LAPACKE/src/lapacke_chetri2_work.c index c87c032d25..3e98df8a63 100644 --- a/LAPACKE/src/lapacke_chetri2_work.c +++ b/LAPACKE/src/lapacke_chetri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_chetri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri2x.c b/LAPACKE/src/lapacke_chetri2x.c index 7260d9bb92..0a4bfd1abd 100644 --- a/LAPACKE/src/lapacke_chetri2x.c +++ b/LAPACKE/src/lapacke_chetri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri2x)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_chetri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_chetri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri2x_work.c b/LAPACKE/src/lapacke_chetri2x_work.c index ea36e0c70e..b65df81857 100644 --- a/LAPACKE/src/lapacke_chetri2x_work.c +++ b/LAPACKE/src/lapacke_chetri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri2x_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_chetri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri_3.c b/LAPACKE/src/lapacke_chetri_3.c index 2e0031a040..c9d4bb39f9 100644 --- a/LAPACKE/src/lapacke_chetri_3.c +++ b/LAPACKE/src/lapacke_chetri_3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri_3)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv ) { @@ -40,24 +40,24 @@ lapack_int LAPACKE_chetri_3( int matrix_layout, char uplo, lapack_int n, lapack_int lwork = -1; lapack_complex_float* work = NULL; lapack_complex_float work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_chetri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,12 +71,12 @@ lapack_int LAPACKE_chetri_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_chetri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri_3_work.c b/LAPACKE/src/lapacke_chetri_3_work.c index 5650df6e82..f38dca7b8b 100644 --- a/LAPACKE/src/lapacke_chetri_3_work.c +++ b/LAPACKE/src/lapacke_chetri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_chetri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetri_work.c b/LAPACKE/src/lapacke_chetri_work.c index a47da60284..464fff79f0 100644 --- a/LAPACKE/src/lapacke_chetri_work.c +++ b/LAPACKE/src/lapacke_chetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_chetri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_chetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_chetri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_chetri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs.c b/LAPACKE/src/lapacke_chetrs.c index f00609f795..0f05cebe81 100644 --- a/LAPACKE/src/lapacke_chetrs.c +++ b/LAPACKE/src/lapacke_chetrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_chetrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_chetrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chetrs2.c b/LAPACKE/src/lapacke_chetrs2.c index 60ab9044f6..8e53c3d3c0 100644 --- a/LAPACKE/src/lapacke_chetrs2.c +++ b/LAPACKE/src/lapacke_chetrs2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_chetrs2( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_chetrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chetrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs2_work.c b/LAPACKE/src/lapacke_chetrs2_work.c index b564a84d21..d4cc2de2e2 100644 --- a/LAPACKE/src/lapacke_chetrs2_work.c +++ b/LAPACKE/src/lapacke_chetrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -53,12 +53,12 @@ lapack_int LAPACKE_chetrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_chetrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_chetrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_3.c b/LAPACKE/src/lapacke_chetrs_3.c index ab5610a051..d97d92d8ae 100644 --- a/LAPACKE/src/lapacke_chetrs_3.c +++ b/LAPACKE/src/lapacke_chetrs_3.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_chetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_chetrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chetrs_3_work.c b/LAPACKE/src/lapacke_chetrs_3_work.c index 1d521d7202..424e8216a1 100644 --- a/LAPACKE/src/lapacke_chetrs_3_work.c +++ b/LAPACKE/src/lapacke_chetrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, @@ -53,12 +53,12 @@ lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_aa.c b/LAPACKE/src/lapacke_chetrs_aa.c index aa85d5df5c..33b3c11a45 100644 --- a/LAPACKE/src/lapacke_chetrs_aa.c +++ b/LAPACKE/src/lapacke_chetrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_chetrs_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chetrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chetrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_chetrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chetrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_chetrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_aa_2stage.c b/LAPACKE/src/lapacke_chetrs_aa_2stage.c index ca57ca9d9c..8782a10f67 100644 --- a/LAPACKE/src/lapacke_chetrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_chetrs_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -40,25 +40,25 @@ lapack_int LAPACKE_chetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_chetrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_chetrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb ); return info; diff --git a/LAPACKE/src/lapacke_chetrs_aa_2stage_work.c b/LAPACKE/src/lapacke_chetrs_aa_2stage_work.c index 6c781d6b82..cad13076a7 100644 --- a/LAPACKE/src/lapacke_chetrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_chetrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb ) @@ -55,17 +55,17 @@ lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_che_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -104,11 +104,11 @@ lapack_int LAPACKE_chetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_aa_work.c b/LAPACKE/src/lapacke_chetrs_aa_work.c index b09bea793b..03688eb8cf 100644 --- a/LAPACKE/src/lapacke_chetrs_aa_work.c +++ b/LAPACKE/src/lapacke_chetrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -53,12 +53,12 @@ lapack_int LAPACKE_chetrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_chetrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_chetrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_rook.c b/LAPACKE/src/lapacke_chetrs_rook.c index fda67007cc..2a6470e02f 100644 --- a/LAPACKE/src/lapacke_chetrs_rook.c +++ b/LAPACKE/src/lapacke_chetrs_rook.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_chetrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_chetrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chetrs_rook_work.c b/LAPACKE/src/lapacke_chetrs_rook_work.c index b3b5fd4335..4f05696864 100644 --- a/LAPACKE/src/lapacke_chetrs_rook_work.c +++ b/LAPACKE/src/lapacke_chetrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_chetrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_chetrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_chetrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chetrs_work.c b/LAPACKE/src/lapacke_chetrs_work.c index ec1a7d09e3..e8a010b084 100644 --- a/LAPACKE/src/lapacke_chetrs_work.c +++ b/LAPACKE/src/lapacke_chetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chetrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chetrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_chetrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_chetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_chetrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_chetrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_chetrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chfrk.c b/LAPACKE/src/lapacke_chfrk.c index 9a51bbecc1..b760887980 100644 --- a/LAPACKE/src/lapacke_chfrk.c +++ b/LAPACKE/src/lapacke_chfrk.c @@ -32,35 +32,35 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chfrk( int matrix_layout, char transr, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_chfrk)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, float alpha, const lapack_complex_float* a, lapack_int lda, float beta, lapack_complex_float* c ) { lapack_int ka, na; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chfrk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chfrk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - if( LAPACKE_cge_nancheck( matrix_layout, na, ka, a, lda ) ) { + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, na, ka, a, lda ) ) { return -8; } - if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &alpha, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &beta, 1 ) ) { return -10; } - if( LAPACKE_cpf_nancheck( n, c ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, c ) ) { return -11; } } #endif - return LAPACKE_chfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha, + return API_SUFFIX(LAPACKE_chfrk_work)( matrix_layout, transr, uplo, trans, n, k, alpha, a, lda, beta, c ); } diff --git a/LAPACKE/src/lapacke_chfrk_work.c b/LAPACKE/src/lapacke_chfrk_work.c index 0686916223..cfafeb35ce 100644 --- a/LAPACKE/src/lapacke_chfrk_work.c +++ b/LAPACKE/src/lapacke_chfrk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chfrk_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_chfrk_work)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, float alpha, const lapack_complex_float* a, lapack_int lda, float beta, @@ -49,13 +49,13 @@ lapack_int LAPACKE_chfrk_work( int matrix_layout, char transr, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; lda_t = MAX(1,na); /* Check leading dimension(s) */ if( lda < ka ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,25 +73,25 @@ lapack_int LAPACKE_chfrk_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, na, ka, a, lda, a_t, lda_t ); - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, c, c_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, na, ka, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_chfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); + API_SUFFIX(LAPACKE_cpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chfrk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chfrk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chgeqz.c b/LAPACKE/src/lapacke_chgeqz.c index b264791851..7557cc607f 100644 --- a/LAPACKE/src/lapacke_chgeqz.c +++ b/LAPACKE/src/lapacke_chgeqz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chgeqz( int matrix_layout, char job, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_chgeqz)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* h, lapack_int ldh, lapack_complex_float* t, lapack_int ldt, @@ -47,25 +47,25 @@ lapack_int LAPACKE_chgeqz( int matrix_layout, char job, char compq, char compz, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chgeqz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -8; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -14; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -10; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -16; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_chgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_chgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_chgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, &work_query, lwork, rwork ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_chgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_chgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work, lwork, rwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_chgeqz( int matrix_layout, char job, char compq, char compz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chgeqz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chgeqz_work.c b/LAPACKE/src/lapacke_chgeqz_work.c index eefec0b076..08aee9762c 100644 --- a/LAPACKE/src/lapacke_chgeqz_work.c +++ b/LAPACKE/src/lapacke_chgeqz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_chgeqz_work)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* h, lapack_int ldh, lapack_complex_float* t, @@ -64,22 +64,22 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldh < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); return info; } if( ldq < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); return info; } if( ldz < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -121,13 +121,13 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - LAPACKE_cge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_chgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t, @@ -137,20 +137,20 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_chgeqz_work( int matrix_layout, char job, char compq, LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chgeqz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpcon.c b/LAPACKE/src/lapacke_chpcon.c index ce312e6e10..29007badd6 100644 --- a/LAPACKE/src/lapacke_chpcon.c +++ b/LAPACKE/src/lapacke_chpcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -4; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_chpcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chpcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_chpcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpcon_work.c b/LAPACKE/src/lapacke_chpcon_work.c index 327aa03dc2..0d9ee830ff 100644 --- a/LAPACKE/src/lapacke_chpcon_work.c +++ b/LAPACKE/src/lapacke_chpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_int* ipiv, float anorm, float* rcond, lapack_complex_float* work ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_chpcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chpcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_chpcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpev.c b/LAPACKE/src/lapacke_chpev.c index 36fff84e25..0acf5889d6 100644 --- a/LAPACKE/src/lapacke_chpev.c +++ b/LAPACKE/src/lapacke_chpev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, float* w, lapack_complex_float* z, lapack_int ldz ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_chpev( int matrix_layout, char jobz, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_chpev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chpev_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, + info = API_SUFFIX(LAPACKE_chpev_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_chpev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpev_work.c b/LAPACKE/src/lapacke_chpev_work.c index deaa8dd03b..9de1f3d687 100644 --- a/LAPACKE/src/lapacke_chpev_work.c +++ b/LAPACKE/src/lapacke_chpev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, float* w, lapack_complex_float* z, lapack_int ldz, lapack_complex_float* work, float* rwork ) @@ -51,11 +51,11 @@ lapack_int LAPACKE_chpev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_chpev_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chpev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -80,23 +80,23 @@ lapack_int LAPACKE_chpev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpevd.c b/LAPACKE/src/lapacke_chpevd.c index 7fb13d0d1a..3cad9459dd 100644 --- a/LAPACKE/src/lapacke_chpevd.c +++ b/LAPACKE/src/lapacke_chpevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, float* w, lapack_complex_float* z, lapack_int ldz ) { @@ -47,19 +47,19 @@ lapack_int LAPACKE_chpevd( int matrix_layout, char jobz, char uplo, lapack_int n float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chpevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_chpevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -86,7 +86,7 @@ lapack_int LAPACKE_chpevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chpevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_chpevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_chpevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpevd_work.c b/LAPACKE/src/lapacke_chpevd_work.c index 90b89ce8aa..baca17aaed 100644 --- a/LAPACKE/src/lapacke_chpevd_work.c +++ b/LAPACKE/src/lapacke_chpevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, float* w, lapack_complex_float* z, lapack_int ldz, lapack_complex_float* work, @@ -55,7 +55,7 @@ lapack_int LAPACKE_chpevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,7 +65,7 @@ lapack_int LAPACKE_chpevd_work( int matrix_layout, char jobz, char uplo, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_chpevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chpevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -90,23 +90,23 @@ lapack_int LAPACKE_chpevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpevx.c b/LAPACKE/src/lapacke_chpevx.c index eb383edbb3..5ad1f130af 100644 --- a/LAPACKE/src/lapacke_chpevx.c +++ b/LAPACKE/src/lapacke_chpevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* ap, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, lapack_complex_float* z, @@ -43,25 +43,25 @@ lapack_int LAPACKE_chpevx( int matrix_layout, char jobz, char range, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -85,7 +85,7 @@ lapack_int LAPACKE_chpevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chpevx_work( matrix_layout, jobz, range, uplo, n, ap, vl, vu, + info = API_SUFFIX(LAPACKE_chpevx_work)( matrix_layout, jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_chpevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpevx_work.c b/LAPACKE/src/lapacke_chpevx_work.c index 2aac2227f0..61606cda1a 100644 --- a/LAPACKE/src/lapacke_chpevx_work.c +++ b/LAPACKE/src/lapacke_chpevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_chpevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* ap, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -51,20 +51,20 @@ lapack_int LAPACKE_chpevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); lapack_complex_float* z_t = NULL; lapack_complex_float* ap_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_chpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_chpevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chpevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, rwork, iwork, ifail, @@ -90,24 +90,24 @@ lapack_int LAPACKE_chpevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgst.c b/LAPACKE/src/lapacke_chpgst.c index 0672f9ba99..64b6530e5c 100644 --- a/LAPACKE/src/lapacke_chpgst.c +++ b/LAPACKE/src/lapacke_chpgst.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpgst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_complex_float* bp ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_chp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, bp ) ) { return -6; } } #endif - return LAPACKE_chpgst_work( matrix_layout, itype, uplo, n, ap, bp ); + return API_SUFFIX(LAPACKE_chpgst_work)( matrix_layout, itype, uplo, n, ap, bp ); } diff --git a/LAPACKE/src/lapacke_chpgst_work.c b/LAPACKE/src/lapacke_chpgst_work.c index 7e4509e259..ea66d9d103 100644 --- a/LAPACKE/src/lapacke_chpgst_work.c +++ b/LAPACKE/src/lapacke_chpgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpgst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_complex_float* bp ) { @@ -62,26 +62,26 @@ lapack_int LAPACKE_chpgst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_chpgst( &itype, &uplo, &n, ap_t, bp_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgv.c b/LAPACKE/src/lapacke_chpgv.c index 71499d275c..cfbded2d2c 100644 --- a/LAPACKE/src/lapacke_chpgv.c +++ b/LAPACKE/src/lapacke_chpgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_chpgv( int matrix_layout, lapack_int itype, char jobz, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_chp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, bp ) ) { return -7; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_chpgv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chpgv_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, + info = API_SUFFIX(LAPACKE_chpgv_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_chpgv( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgv_work.c b/LAPACKE/src/lapacke_chpgv_work.c index 8bbf650f6a..c75e583d2f 100644 --- a/LAPACKE/src/lapacke_chpgv_work.c +++ b/LAPACKE/src/lapacke_chpgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float* w, @@ -55,11 +55,11 @@ lapack_int LAPACKE_chpgv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -83,8 +83,8 @@ lapack_int LAPACKE_chpgv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_chpgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -92,26 +92,26 @@ lapack_int LAPACKE_chpgv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgvd.c b/LAPACKE/src/lapacke_chpgvd.c index df8989f541..ebaed8df5b 100644 --- a/LAPACKE/src/lapacke_chpgvd.c +++ b/LAPACKE/src/lapacke_chpgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float* w, lapack_complex_float* z, lapack_int ldz ) @@ -48,22 +48,22 @@ lapack_int LAPACKE_chpgvd( int matrix_layout, lapack_int itype, char jobz, float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_chp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, bp ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chpgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_chpgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_chpgvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chpgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_chpgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_chpgvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgvd_work.c b/LAPACKE/src/lapacke_chpgvd_work.c index 98b28a0741..b866877736 100644 --- a/LAPACKE/src/lapacke_chpgvd_work.c +++ b/LAPACKE/src/lapacke_chpgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float* w, @@ -57,7 +57,7 @@ lapack_int LAPACKE_chpgvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_chpgvd_work( int matrix_layout, lapack_int itype, char jobz, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -91,8 +91,8 @@ lapack_int LAPACKE_chpgvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_chpgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -100,26 +100,26 @@ lapack_int LAPACKE_chpgvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgvx.c b/LAPACKE/src/lapacke_chpgvx.c index 0e3876d224..eee12850c8 100644 --- a/LAPACKE/src/lapacke_chpgvx.c +++ b/LAPACKE/src/lapacke_chpgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float vl, float vu, lapack_int il, lapack_int iu, @@ -45,28 +45,28 @@ lapack_int LAPACKE_chpgvx( int matrix_layout, lapack_int itype, char jobz, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -13; } - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -7; } - if( LAPACKE_chp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, bp ) ) { return -8; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -9; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -10; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_chpgvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_chpgvx_work( matrix_layout, itype, jobz, range, uplo, n, ap, + info = API_SUFFIX(LAPACKE_chpgvx_work)( matrix_layout, itype, jobz, range, uplo, n, ap, bp, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_chpgvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpgvx_work.c b/LAPACKE/src/lapacke_chpgvx_work.c index 7ff379d9ed..49f5331649 100644 --- a/LAPACKE/src/lapacke_chpgvx_work.c +++ b/LAPACKE/src/lapacke_chpgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpgvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_chpgvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_float* ap, lapack_complex_float* bp, float vl, float vu, @@ -52,9 +52,9 @@ lapack_int LAPACKE_chpgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); lapack_complex_float* z_t = NULL; lapack_complex_float* ap_t = NULL; @@ -62,11 +62,11 @@ lapack_int LAPACKE_chpgvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -17; - LAPACKE_xerbla( "LAPACKE_chpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,ncols_z) ); @@ -90,8 +90,8 @@ lapack_int LAPACKE_chpgvx_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_chpgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, rwork, iwork, @@ -100,27 +100,27 @@ lapack_int LAPACKE_chpgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chprfs.c b/LAPACKE/src/lapacke_chprfs.c index 0eacaf3821..c544cbb93e 100644 --- a/LAPACKE/src/lapacke_chprfs.c +++ b/LAPACKE/src/lapacke_chprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_chprfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_chprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_chprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_chprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chprfs_work.c b/LAPACKE/src/lapacke_chprfs_work.c index d51f00c809..a0eee7e525 100644 --- a/LAPACKE/src/lapacke_chprfs_work.c +++ b/LAPACKE/src/lapacke_chprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_chprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_chprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_chprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_chprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_chprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -119,11 +119,11 @@ lapack_int LAPACKE_chprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpsv.c b/LAPACKE/src/lapacke_chpsv.c index c82716af20..6c098ee4aa 100644 --- a/LAPACKE/src/lapacke_chpsv.c +++ b/LAPACKE/src/lapacke_chpsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_chpsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_chpsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chpsv_work.c b/LAPACKE/src/lapacke_chpsv_work.c index 7260defb8d..4a54409052 100644 --- a/LAPACKE/src/lapacke_chpsv_work.c +++ b/LAPACKE/src/lapacke_chpsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_chpsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,27 +70,27 @@ lapack_int LAPACKE_chpsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chpsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpsvx.c b/LAPACKE/src/lapacke_chpsvx.c index 21dec80cbe..78866d0502 100644 --- a/LAPACKE/src/lapacke_chpsvx.c +++ b/LAPACKE/src/lapacke_chpsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chpsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* afp, lapack_int* ipiv, const lapack_complex_float* b, lapack_int ldb, @@ -43,21 +43,21 @@ lapack_int LAPACKE_chpsvx( int matrix_layout, char fact, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chpsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_chp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_chpsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chpsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_chpsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_chpsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chpsvx_work.c b/LAPACKE/src/lapacke_chpsvx_work.c index 6084db1928..9fc72eaa95 100644 --- a/LAPACKE/src/lapacke_chpsvx_work.c +++ b/LAPACKE/src/lapacke_chpsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chpsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_chpsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* afp, lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_chpsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_chpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_chpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_chpsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_chp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_chpsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -109,9 +109,9 @@ lapack_int LAPACKE_chpsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -123,11 +123,11 @@ lapack_int LAPACKE_chpsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chpsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chptrd.c b/LAPACKE/src/lapacke_chptrd.c index 7a2c7923ca..7538893508 100644 --- a/LAPACKE/src/lapacke_chptrd.c +++ b/LAPACKE/src/lapacke_chptrd.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrd( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrd)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, float* d, float* e, lapack_complex_float* tau ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chptrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_chptrd_work( matrix_layout, uplo, n, ap, d, e, tau ); + return API_SUFFIX(LAPACKE_chptrd_work)( matrix_layout, uplo, n, ap, d, e, tau ); } diff --git a/LAPACKE/src/lapacke_chptrd_work.c b/LAPACKE/src/lapacke_chptrd_work.c index dc3313f684..1c2b47c15b 100644 --- a/LAPACKE/src/lapacke_chptrd_work.c +++ b/LAPACKE/src/lapacke_chptrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrd_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, float* d, float* e, lapack_complex_float* tau ) { @@ -54,23 +54,23 @@ lapack_int LAPACKE_chptrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chptrd( &uplo, &n, ap_t, d, e, tau, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chptrf.c b/LAPACKE/src/lapacke_chptrf.c index 957f16d776..1698d3f310 100644 --- a/LAPACKE/src/lapacke_chptrf.c +++ b/LAPACKE/src/lapacke_chptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_chptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_chptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_chptrf_work.c b/LAPACKE/src/lapacke_chptrf_work.c index 43d9c89923..c80bee6fdb 100644 --- a/LAPACKE/src/lapacke_chptrf_work.c +++ b/LAPACKE/src/lapacke_chptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_chptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chptri.c b/LAPACKE/src/lapacke_chptri.c index 1d159b7e70..a5ce2036bd 100644 --- a/LAPACKE/src/lapacke_chptri.c +++ b/LAPACKE/src/lapacke_chptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_chptri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_chptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chptri_work.c b/LAPACKE/src/lapacke_chptri_work.c index 51a10195d0..869c7a3b05 100644 --- a/LAPACKE/src/lapacke_chptri_work.c +++ b/LAPACKE/src/lapacke_chptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* work ) @@ -55,23 +55,23 @@ lapack_int LAPACKE_chptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_chp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_chp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chptrs.c b/LAPACKE/src/lapacke_chptrs.c index ba3590d929..6ad4fbb036 100644 --- a/LAPACKE/src/lapacke_chptrs.c +++ b/LAPACKE/src/lapacke_chptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_chp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_chp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_chptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_chptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_chptrs_work.c b/LAPACKE/src/lapacke_chptrs_work.c index 139de1dcfe..c4d0467e26 100644 --- a/LAPACKE/src/lapacke_chptrs_work.c +++ b/LAPACKE/src/lapacke_chptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_chptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,26 +70,26 @@ lapack_int LAPACKE_chptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_chp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_chp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_chptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chsein.c b/LAPACKE/src/lapacke_chsein.c index 4e606b9481..9cb00b0205 100644 --- a/LAPACKE/src/lapacke_chsein.c +++ b/LAPACKE/src/lapacke_chsein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chsein( int matrix_layout, char job, char eigsrc, char initv, +lapack_int API_SUFFIX(LAPACKE_chsein)( int matrix_layout, char job, char eigsrc, char initv, const lapack_logical* select, lapack_int n, const lapack_complex_float* h, lapack_int ldh, lapack_complex_float* w, lapack_complex_float* vl, @@ -44,26 +44,26 @@ lapack_int LAPACKE_chsein( int matrix_layout, char job, char eigsrc, char initv, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chsein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } - if( LAPACKE_c_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, w, 1 ) ) { return -9; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_chsein( int matrix_layout, char job, char eigsrc, char initv, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_chsein_work( matrix_layout, job, eigsrc, initv, select, n, h, + info = API_SUFFIX(LAPACKE_chsein_work)( matrix_layout, job, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_chsein( int matrix_layout, char job, char eigsrc, char initv, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chsein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chsein_work.c b/LAPACKE/src/lapacke_chsein_work.c index 8c58add548..90f3654af3 100644 --- a/LAPACKE/src/lapacke_chsein_work.c +++ b/LAPACKE/src/lapacke_chsein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, +lapack_int API_SUFFIX(LAPACKE_chsein_work)( int matrix_layout, char job, char eigsrc, char initv, const lapack_logical* select, lapack_int n, const lapack_complex_float* h, lapack_int ldh, lapack_complex_float* w, @@ -60,17 +60,17 @@ lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_chsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,mm) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,mm) ); @@ -99,14 +99,14 @@ lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'l' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'r' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_chsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, w, vl_t, @@ -116,31 +116,31 @@ lapack_int LAPACKE_chsein_work( int matrix_layout, char job, char eigsrc, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chsein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chseqr.c b/LAPACKE/src/lapacke_chseqr.c index ad364f84e6..78e668ec81 100644 --- a/LAPACKE/src/lapacke_chseqr.c +++ b/LAPACKE/src/lapacke_chseqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chseqr( int matrix_layout, char job, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_chseqr)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* h, lapack_int ldh, lapack_complex_float* w, lapack_complex_float* z, @@ -43,24 +43,24 @@ lapack_int LAPACKE_chseqr( int matrix_layout, char job, char compz, lapack_int n lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_chseqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -10; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_chseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_chseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, w, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_chseqr( int matrix_layout, char job, char compz, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_chseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_chseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chseqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_chseqr_work.c b/LAPACKE/src/lapacke_chseqr_work.c index 11bac7ccb0..1161f0c64a 100644 --- a/LAPACKE/src/lapacke_chseqr_work.c +++ b/LAPACKE/src/lapacke_chseqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_chseqr_work( int matrix_layout, char job, char compz, +lapack_int API_SUFFIX(LAPACKE_chseqr_work)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* h, lapack_int ldh, lapack_complex_float* w, @@ -55,12 +55,12 @@ lapack_int LAPACKE_chseqr_work( int matrix_layout, char job, char compz, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_chseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr_work", info ); return info; } if( ldz < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_chseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -76,7 +76,7 @@ lapack_int LAPACKE_chseqr_work( int matrix_layout, char job, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -86,9 +86,9 @@ lapack_int LAPACKE_chseqr_work( int matrix_layout, char job, char compz, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_chseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, w, z_t, @@ -97,23 +97,23 @@ lapack_int LAPACKE_chseqr_work( int matrix_layout, char job, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_chseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_chseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_chseqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clacgv.c b/LAPACKE/src/lapacke_clacgv.c index 1e6ed883e8..f821a870bc 100644 --- a/LAPACKE/src/lapacke_clacgv.c +++ b/LAPACKE/src/lapacke_clacgv.c @@ -32,16 +32,16 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacgv( lapack_int n, lapack_complex_float* x, +lapack_int API_SUFFIX(LAPACKE_clacgv)( lapack_int n, lapack_complex_float* x, lapack_int incx ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_c_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, x, incx ) ) { return -2; } } #endif - return LAPACKE_clacgv_work( n, x, incx ); + return API_SUFFIX(LAPACKE_clacgv_work)( n, x, incx ); } diff --git a/LAPACKE/src/lapacke_clacgv_work.c b/LAPACKE/src/lapacke_clacgv_work.c index 11f41bed37..9cc41f4557 100644 --- a/LAPACKE/src/lapacke_clacgv_work.c +++ b/LAPACKE/src/lapacke_clacgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacgv_work( lapack_int n, lapack_complex_float* x, +lapack_int API_SUFFIX(LAPACKE_clacgv_work)( lapack_int n, lapack_complex_float* x, lapack_int incx ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_clacn2.c b/LAPACKE/src/lapacke_clacn2.c index 8cb37df7fb..bd43fb5b29 100644 --- a/LAPACKE/src/lapacke_clacn2.c +++ b/LAPACKE/src/lapacke_clacn2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacn2( lapack_int n, lapack_complex_float* v, +lapack_int API_SUFFIX(LAPACKE_clacn2)( lapack_int n, lapack_complex_float* v, lapack_complex_float* x, float* est, lapack_int* kase, lapack_int* isave ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, est, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, est, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, x, 1 ) ) { return -3; } } #endif - return LAPACKE_clacn2_work( n, v, x, est, kase, isave ); + return API_SUFFIX(LAPACKE_clacn2_work)( n, v, x, est, kase, isave ); } diff --git a/LAPACKE/src/lapacke_clacn2_work.c b/LAPACKE/src/lapacke_clacn2_work.c index 390e42068e..415ccbcff2 100644 --- a/LAPACKE/src/lapacke_clacn2_work.c +++ b/LAPACKE/src/lapacke_clacn2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacn2_work( lapack_int n, lapack_complex_float* v, +lapack_int API_SUFFIX(LAPACKE_clacn2_work)( lapack_int n, lapack_complex_float* v, lapack_complex_float* x, float* est, lapack_int* kase, lapack_int* isave ) diff --git a/LAPACKE/src/lapacke_clacp2.c b/LAPACKE/src/lapacke_clacp2.c index fc9b9f8d97..177d787d44 100644 --- a/LAPACKE/src/lapacke_clacp2.c +++ b/LAPACKE/src/lapacke_clacp2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacp2( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clacp2)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clacp2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacp2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_clacp2_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_clacp2_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_clacp2_work.c b/LAPACKE/src/lapacke_clacp2_work.c index d565e46698..008cecb083 100644 --- a/LAPACKE/src/lapacke_clacp2_work.c +++ b/LAPACKE/src/lapacke_clacp2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clacp2_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacp2_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacp2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,23 +72,23 @@ lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clacp2( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacp2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacp2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clacpy.c b/LAPACKE/src/lapacke_clacpy.c index f5f6216fa6..21b88be010 100644 --- a/LAPACKE/src/lapacke_clacpy.c +++ b/LAPACKE/src/lapacke_clacpy.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacpy( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clacpy)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clacpy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacpy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_clacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_clacpy_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_clacpy_work.c b/LAPACKE/src/lapacke_clacpy_work.c index 59cab5aa30..dfea330042 100644 --- a/LAPACKE/src/lapacke_clacpy_work.c +++ b/LAPACKE/src/lapacke_clacpy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacpy_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clacpy_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -49,12 +49,12 @@ lapack_int LAPACKE_clacpy_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacpy_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacpy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,23 +71,23 @@ lapack_int LAPACKE_clacpy_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacpy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacpy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clacrm.c b/LAPACKE/src/lapacke_clacrm.c index c14540589c..37f6592c67 100644 --- a/LAPACKE/src/lapacke_clacrm.c +++ b/LAPACKE/src/lapacke_clacrm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacrm(int matrix_layout, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clacrm)(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const float* b, lapack_int ldb, lapack_complex_float* c, lapack_int ldc) @@ -41,16 +41,16 @@ lapack_int LAPACKE_clacrm(int matrix_layout, lapack_int m, float* rwork = NULL; if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) { - LAPACKE_xerbla("LAPACKE_clacrm", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_clacrm", -1); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if ( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_clacrm(int matrix_layout, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clacrm_work(matrix_layout, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_clacrm_work)(matrix_layout, m, n, a, lda, b, ldb, c, ldc, rwork); /* Release memory and exit */ LAPACKE_free(rwork); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clacrm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacrm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clacrm_work.c b/LAPACKE/src/lapacke_clacrm_work.c index a9befaf088..4425e7a9dc 100644 --- a/LAPACKE/src/lapacke_clacrm_work.c +++ b/LAPACKE/src/lapacke_clacrm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clacrm_work(int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clacrm_work)(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const float* b, lapack_int ldb, lapack_complex_float* c, lapack_int ldc, @@ -52,17 +52,17 @@ lapack_int LAPACKE_clacrm_work(int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_clacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacrm_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_clacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacrm_work", info ); return info; } if( ldc < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_clacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacrm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,12 +85,12 @@ lapack_int LAPACKE_clacrm_work(int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans(matrix_layout, m, n, a, lda, a_t, lda_t); - LAPACKE_sge_trans(matrix_layout, n, n, b, ldb, b_t, ldb_t); + API_SUFFIX(LAPACKE_cge_trans)(matrix_layout, m, n, a, lda, a_t, lda_t); + API_SUFFIX(LAPACKE_sge_trans)(matrix_layout, n, n, b, ldb, b_t, ldb_t); /* Call LAPACK function */ LAPACK_clacrm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork); /* Transpose output matrices */ - LAPACKE_cge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); + API_SUFFIX(LAPACKE_cge_trans)(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); /* Release memory and exit */ LAPACKE_free(c_t); exit_level_2: @@ -99,11 +99,11 @@ lapack_int LAPACKE_clacrm_work(int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free(a_t); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clacrm_work", info ); } } else { info = -1; - LAPACKE_xerbla("LAPACKE_clacrm_work", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_clacrm_work", -1); } return info; } diff --git a/LAPACKE/src/lapacke_clag2z.c b/LAPACKE/src/lapacke_clag2z.c index 77af6c4da2..899b5fbbc3 100644 --- a/LAPACKE/src/lapacke_clag2z.c +++ b/LAPACKE/src/lapacke_clag2z.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clag2z( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clag2z)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* sa, lapack_int ldsa, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clag2z", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clag2z", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, sa, ldsa ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, sa, ldsa ) ) { return -4; } } #endif - return LAPACKE_clag2z_work( matrix_layout, m, n, sa, ldsa, a, lda ); + return API_SUFFIX(LAPACKE_clag2z_work)( matrix_layout, m, n, sa, ldsa, a, lda ); } diff --git a/LAPACKE/src/lapacke_clag2z_work.c b/LAPACKE/src/lapacke_clag2z_work.c index 727bd54388..a057f3e825 100644 --- a/LAPACKE/src/lapacke_clag2z_work.c +++ b/LAPACKE/src/lapacke_clag2z_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clag2z_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clag2z_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* sa, lapack_int ldsa, lapack_complex_double* a, lapack_int lda ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_clag2z_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_clag2z_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clag2z_work", info ); return info; } if( ldsa < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_clag2z_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clag2z_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,25 +73,25 @@ lapack_int LAPACKE_clag2z_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, sa, ldsa, sa_t, ldsa_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, sa, ldsa, sa_t, ldsa_t ); /* Call LAPACK function and adjust info */ LAPACK_clag2z( &m, &n, sa_t, &ldsa_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( sa_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clag2z_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clag2z_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clag2z_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clag2z_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clagge.c b/LAPACKE/src/lapacke_clagge.c index abe1a96556..5e6f562b10 100644 --- a/LAPACKE/src/lapacke_clagge.c +++ b/LAPACKE/src/lapacke_clagge.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clagge( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clagge)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed ) @@ -40,13 +40,13 @@ lapack_int LAPACKE_clagge( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clagge", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagge", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(m,n), d, 1 ) ) { return -6; } } @@ -59,13 +59,13 @@ lapack_int LAPACKE_clagge( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clagge_work( matrix_layout, m, n, kl, ku, d, a, lda, iseed, + info = API_SUFFIX(LAPACKE_clagge_work)( matrix_layout, m, n, kl, ku, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clagge", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagge", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clagge_work.c b/LAPACKE/src/lapacke_clagge_work.c index 99f14e882c..72e03560de 100644 --- a/LAPACKE/src/lapacke_clagge_work.c +++ b/LAPACKE/src/lapacke_clagge_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clagge_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clagge_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_clagge_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagge_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_clagge_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagge_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagge_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_claghe.c b/LAPACKE/src/lapacke_claghe.c index 281a12f72c..ec3447ecaa 100644 --- a/LAPACKE/src/lapacke_claghe.c +++ b/LAPACKE/src/lapacke_claghe.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claghe( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_claghe)( int matrix_layout, lapack_int n, lapack_int k, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_claghe", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claghe", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_claghe( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_claghe_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_claghe_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_claghe", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claghe", info ); } return info; } diff --git a/LAPACKE/src/lapacke_claghe_work.c b/LAPACKE/src/lapacke_claghe_work.c index a72cb152ea..d2db2a9f25 100644 --- a/LAPACKE/src/lapacke_claghe_work.c +++ b/LAPACKE/src/lapacke_claghe_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claghe_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_claghe_work)( int matrix_layout, lapack_int n, lapack_int k, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_claghe_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_claghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claghe_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_claghe_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_claghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claghe_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_claghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claghe_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clagsy.c b/LAPACKE/src/lapacke_clagsy.c index 841d41c441..6972d2b3af 100644 --- a/LAPACKE/src/lapacke_clagsy.c +++ b/LAPACKE/src/lapacke_clagsy.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clagsy( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_clagsy)( int matrix_layout, lapack_int n, lapack_int k, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clagsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_clagsy( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clagsy_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_clagsy_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clagsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clagsy_work.c b/LAPACKE/src/lapacke_clagsy_work.c index 6b1c25f66c..9ddb08552c 100644 --- a/LAPACKE/src/lapacke_clagsy_work.c +++ b/LAPACKE/src/lapacke_clagsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clagsy_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_clagsy_work)( int matrix_layout, lapack_int n, lapack_int k, const float* d, lapack_complex_float* a, lapack_int lda, lapack_int* iseed, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_clagsy_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagsy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_clagsy_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clagsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clangb.c b/LAPACKE/src/lapacke_clangb.c index 0d61575aaa..0fec1bf497 100644 --- a/LAPACKE/src/lapacke_clangb.c +++ b/LAPACKE/src/lapacke_clangb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clangb( int matrix_layout, char norm, lapack_int n, +float API_SUFFIX(LAPACKE_clangb)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab ) { @@ -40,19 +40,19 @@ float LAPACKE_clangb( int matrix_layout, char norm, lapack_int n, float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clangb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clangb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ float LAPACKE_clangb( int matrix_layout, char norm, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_clangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work ); + res = API_SUFFIX(LAPACKE_clangb_work)( matrix_layout, norm, n, kl, ku, ab, ldab, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clangb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clangb", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clangb_work.c b/LAPACKE/src/lapacke_clangb_work.c index b5b2cf8163..83c3a6a993 100644 --- a/LAPACKE/src/lapacke_clangb_work.c +++ b/LAPACKE/src/lapacke_clangb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clangb_work( int matrix_layout, char norm, lapack_int n, +float API_SUFFIX(LAPACKE_clangb_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float* ab, lapack_int ldab, float* work ) @@ -48,18 +48,18 @@ float LAPACKE_clangb_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < kl+ku+1 ) { info = -7; - LAPACKE_xerbla( "LAPACKE_clangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clangb_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -74,11 +74,11 @@ float LAPACKE_clangb_work( int matrix_layout, char norm, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clangb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clangb_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clange.c b/LAPACKE/src/lapacke_clange.c index 7bd436d4dc..fbcf159f6b 100644 --- a/LAPACKE/src/lapacke_clange.c +++ b/LAPACKE/src/lapacke_clange.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clange( int matrix_layout, char norm, lapack_int m, +float API_SUFFIX(LAPACKE_clange)( int matrix_layout, char norm, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda ) { @@ -40,19 +40,19 @@ float LAPACKE_clange( int matrix_layout, char norm, lapack_int m, float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clange", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clange", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ float LAPACKE_clange( int matrix_layout, char norm, lapack_int m, } } /* Call middle-level interface */ - res = LAPACKE_clange_work( matrix_layout, norm, m, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_clange_work)( matrix_layout, norm, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clange", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clange", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clange_work.c b/LAPACKE/src/lapacke_clange_work.c index 4875031dc6..9e41478a49 100644 --- a/LAPACKE/src/lapacke_clange_work.c +++ b/LAPACKE/src/lapacke_clange_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clange_work( int matrix_layout, char norm, lapack_int m, +float API_SUFFIX(LAPACKE_clange_work)( int matrix_layout, char norm, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* work ) { @@ -47,18 +47,18 @@ float LAPACKE_clange_work( int matrix_layout, char norm, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clange_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ float LAPACKE_clange_work( int matrix_layout, char norm, lapack_int m, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clange_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clange_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clanhe.c b/LAPACKE/src/lapacke_clanhe.c index b515348ea4..571f9009ff 100644 --- a/LAPACKE/src/lapacke_clanhe.c +++ b/LAPACKE/src/lapacke_clanhe.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -float LAPACKE_clanhe( int matrix_layout, char norm, char uplo, lapack_int n, +float API_SUFFIX(LAPACKE_clanhe)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clanhe", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clanhe", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ float LAPACKE_clanhe( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_clanhe_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_clanhe_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clanhe", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clanhe", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clanhe_work.c b/LAPACKE/src/lapacke_clanhe_work.c index 561b8fad3d..5fc67733fa 100644 --- a/LAPACKE/src/lapacke_clanhe_work.c +++ b/LAPACKE/src/lapacke_clanhe_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clanhe_work( int matrix_layout, char norm, char uplo, +float API_SUFFIX(LAPACKE_clanhe_work)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* work ) { @@ -50,7 +50,7 @@ float LAPACKE_clanhe_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clanhe_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ float LAPACKE_clanhe_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_che_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_clanhe( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -69,11 +69,11 @@ float LAPACKE_clanhe_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clanhe_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clanhe_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clansy.c b/LAPACKE/src/lapacke_clansy.c index 018f873738..3c3a477828 100644 --- a/LAPACKE/src/lapacke_clansy.c +++ b/LAPACKE/src/lapacke_clansy.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -float LAPACKE_clansy( int matrix_layout, char norm, char uplo, lapack_int n, +float API_SUFFIX(LAPACKE_clansy)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clansy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clansy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ float LAPACKE_clansy( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_clansy_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_clansy_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clansy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clansy", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clansy_work.c b/LAPACKE/src/lapacke_clansy_work.c index 6c30105f97..40dc293ad8 100644 --- a/LAPACKE/src/lapacke_clansy_work.c +++ b/LAPACKE/src/lapacke_clansy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clansy_work( int matrix_layout, char norm, char uplo, +float API_SUFFIX(LAPACKE_clansy_work)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* work ) { @@ -50,7 +50,7 @@ float LAPACKE_clansy_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clansy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ float LAPACKE_clansy_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_clansy( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -69,11 +69,11 @@ float LAPACKE_clansy_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clansy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clansy_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clantr.c b/LAPACKE/src/lapacke_clantr.c index e00b6c5788..cea035df8c 100644 --- a/LAPACKE/src/lapacke_clantr.c +++ b/LAPACKE/src/lapacke_clantr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clantr( int matrix_layout, char norm, char uplo, char diag, +float API_SUFFIX(LAPACKE_clantr)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda ) { @@ -40,19 +40,19 @@ float LAPACKE_clantr( int matrix_layout, char norm, char uplo, char diag, float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clantr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clantr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctz_nancheck)( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,MAX(m,n)) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ float LAPACKE_clantr( int matrix_layout, char norm, char uplo, char diag, } } /* Call middle-level interface */ - res = LAPACKE_clantr_work( matrix_layout, norm, uplo, diag, m, n, a, lda, + res = API_SUFFIX(LAPACKE_clantr_work)( matrix_layout, norm, uplo, diag, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clantr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clantr", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clantr_work.c b/LAPACKE/src/lapacke_clantr_work.c index 2c64600f84..b5be0b256f 100644 --- a/LAPACKE/src/lapacke_clantr_work.c +++ b/LAPACKE/src/lapacke_clantr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo, +float API_SUFFIX(LAPACKE_clantr_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* work ) @@ -49,23 +49,23 @@ float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clantr_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } - if( LAPACKE_lsame( uplo, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { uplo_lapack = 'l'; } else { uplo_lapack = 'u'; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -80,11 +80,11 @@ float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clantr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clantr_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_clapmr.c b/LAPACKE/src/lapacke_clapmr.c index 8b2a4da344..a1f8de2d93 100644 --- a/LAPACKE/src/lapacke_clapmr.c +++ b/LAPACKE/src/lapacke_clapmr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clapmr( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_clapmr)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clapmr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_clapmr_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_clapmr_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_clapmr_work.c b/LAPACKE/src/lapacke_clapmr_work.c index 2496296dba..3b42b0048a 100644 --- a/LAPACKE/src/lapacke_clapmr_work.c +++ b/LAPACKE/src/lapacke_clapmr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clapmr_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_clapmr_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_int* k ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_clapmr_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,21 +61,21 @@ lapack_int LAPACKE_clapmr_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_clapmr( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clapmt.c b/LAPACKE/src/lapacke_clapmt.c index 95ba11b052..e7a6e116fc 100644 --- a/LAPACKE/src/lapacke_clapmt.c +++ b/LAPACKE/src/lapacke_clapmt.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clapmt( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_clapmt)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clapmt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_clapmt_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_clapmt_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_clapmt_work.c b/LAPACKE/src/lapacke_clapmt_work.c index 9cbdcc3352..e17a1da1f0 100644 --- a/LAPACKE/src/lapacke_clapmt_work.c +++ b/LAPACKE/src/lapacke_clapmt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clapmt_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_clapmt_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_float* x, lapack_int ldx, lapack_int* k ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_clapmt_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_clapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,21 +61,21 @@ lapack_int LAPACKE_clapmt_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_clapmt( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clapmt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarcm.c b/LAPACKE/src/lapacke_clarcm.c index 9fb300d605..fab71e1657 100644 --- a/LAPACKE/src/lapacke_clarcm.c +++ b/LAPACKE/src/lapacke_clarcm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarcm(int matrix_layout, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clarcm)(int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, lapack_complex_float* c, lapack_int ldc) @@ -41,16 +41,16 @@ lapack_int LAPACKE_clarcm(int matrix_layout, lapack_int m, float* rwork = NULL; if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) { - LAPACKE_xerbla("LAPACKE_clarcm", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_clarcm", -1); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if ( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -4; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_clarcm(int matrix_layout, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clarcm_work(matrix_layout, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_clarcm_work)(matrix_layout, m, n, a, lda, b, ldb, c, ldc, rwork); /* Release memory and exit */ LAPACKE_free(rwork); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarcm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarcm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarcm_work.c b/LAPACKE/src/lapacke_clarcm_work.c index a2c048cf4e..103853c309 100644 --- a/LAPACKE/src/lapacke_clarcm_work.c +++ b/LAPACKE/src/lapacke_clarcm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarcm_work(int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clarcm_work)(int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, lapack_complex_float* c, lapack_int ldc, @@ -52,17 +52,17 @@ lapack_int LAPACKE_clarcm_work(int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < m ) { info = -5; - LAPACKE_xerbla( "LAPACKE_clarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarcm_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_clarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarcm_work", info ); return info; } if( ldc < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_clarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarcm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,12 +85,12 @@ lapack_int LAPACKE_clarcm_work(int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans(matrix_layout, m, m, a, lda, a_t, lda_t); - LAPACKE_cge_trans(matrix_layout, m, n, b, ldb, b_t, ldb_t); + API_SUFFIX(LAPACKE_sge_trans)(matrix_layout, m, m, a, lda, a_t, lda_t); + API_SUFFIX(LAPACKE_cge_trans)(matrix_layout, m, n, b, ldb, b_t, ldb_t); /* Call LAPACK function */ LAPACK_clarcm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork); /* Transpose output matrices */ - LAPACKE_cge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); + API_SUFFIX(LAPACKE_cge_trans)(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); /* Release memory and exit */ LAPACKE_free(c_t); exit_level_2: @@ -99,11 +99,11 @@ lapack_int LAPACKE_clarcm_work(int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free(a_t); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarcm_work", info ); } } else { info = -1; - LAPACKE_xerbla("LAPACKE_clarcm_work", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_clarcm_work", -1); } return info; } diff --git a/LAPACKE/src/lapacke_clarfb.c b/LAPACKE/src/lapacke_clarfb.c index aac7b551d6..f48c7e3831 100644 --- a/LAPACKE/src/lapacke_clarfb.c +++ b/LAPACKE/src/lapacke_clarfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_clarfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, @@ -46,39 +46,39 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct lapack_logical left, col, forward; char uplo; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clarfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); uplo = ( ( forward && col ) || !( forward || col ) ) ? 'l' : 'u'; if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { - LAPACKE_xerbla( "LAPACKE_clarfb", -8 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb", -8 ); return -8; } - if( LAPACKE_ctz_nancheck( matrix_layout, direct, uplo, 'u', + if( API_SUFFIX(LAPACKE_ctz_nancheck)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -11; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -13; } } #endif - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { ldwork = n; - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { ldwork = m; } else { ldwork = 1; @@ -91,13 +91,13 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clarfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_clarfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarfb_work.c b/LAPACKE/src/lapacke_clarfb_work.c index 67bbbd34fb..68eec0c4cb 100644 --- a/LAPACKE/src/lapacke_clarfb_work.c +++ b/LAPACKE/src/lapacke_clarfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_clarfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* v, lapack_int ldv, @@ -54,9 +54,9 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); @@ -68,22 +68,22 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); return info; } if( ldv < ncols_v ) { info = -10; - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); return info; } if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,16 +107,16 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ctz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, + API_SUFFIX(LAPACKE_ctz_trans)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv, v_t, ldv_t ); - LAPACKE_cge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_clarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -125,11 +125,11 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarfg.c b/LAPACKE/src/lapacke_clarfg.c index 238b81f27f..14ee6eb40c 100644 --- a/LAPACKE/src/lapacke_clarfg.c +++ b/LAPACKE/src/lapacke_clarfg.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfg( lapack_int n, lapack_complex_float* alpha, +lapack_int API_SUFFIX(LAPACKE_clarfg)( lapack_int n, lapack_complex_float* alpha, lapack_complex_float* x, lapack_int incx, lapack_complex_float* tau ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_c_nancheck( 1, alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, alpha, 1 ) ) { return -2; } - if( LAPACKE_c_nancheck( n-1, x, incx ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, x, incx ) ) { return -3; } } #endif - return LAPACKE_clarfg_work( n, alpha, x, incx, tau ); + return API_SUFFIX(LAPACKE_clarfg_work)( n, alpha, x, incx, tau ); } diff --git a/LAPACKE/src/lapacke_clarfg_work.c b/LAPACKE/src/lapacke_clarfg_work.c index 06a6a93ff6..cf5c253315 100644 --- a/LAPACKE/src/lapacke_clarfg_work.c +++ b/LAPACKE/src/lapacke_clarfg_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfg_work( lapack_int n, lapack_complex_float* alpha, +lapack_int API_SUFFIX(LAPACKE_clarfg_work)( lapack_int n, lapack_complex_float* alpha, lapack_complex_float* x, lapack_int incx, lapack_complex_float* tau ) { diff --git a/LAPACKE/src/lapacke_clarft.c b/LAPACKE/src/lapacke_clarft.c index 9691afb856..f6dc8f3c8f 100644 --- a/LAPACKE/src/lapacke_clarft.c +++ b/LAPACKE/src/lapacke_clarft.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarft( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_clarft)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* tau, @@ -40,24 +40,24 @@ lapack_int LAPACKE_clarft( int matrix_layout, char direct, char storev, { lapack_int ncols_v, nrows_v; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clarft", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarft", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -6; } } #endif - return LAPACKE_clarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau, + return API_SUFFIX(LAPACKE_clarft_work)( matrix_layout, direct, storev, n, k, v, ldv, tau, t, ldt ); } diff --git a/LAPACKE/src/lapacke_clarft_work.c b/LAPACKE/src/lapacke_clarft_work.c index f540bd1fbd..cd277875a0 100644 --- a/LAPACKE/src/lapacke_clarft_work.c +++ b/LAPACKE/src/lapacke_clarft_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarft_work( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_clarft_work)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* tau, @@ -49,21 +49,21 @@ lapack_int LAPACKE_clarft_work( int matrix_layout, char direct, char storev, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); ldt_t = MAX(1,k); ldv_t = MAX(1,nrows_v); /* Check leading dimension(s) */ if( ldt < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_clarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarft_work", info ); return info; } if( ldv < ncols_v ) { info = -7; - LAPACKE_xerbla( "LAPACKE_clarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarft_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,24 +81,24 @@ lapack_int LAPACKE_clarft_work( int matrix_layout, char direct, char storev, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_clarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t, &ldt_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarft_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarft_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarfx.c b/LAPACKE/src/lapacke_clarfx.c index 6ee8d09ff8..f6aff83ad8 100644 --- a/LAPACKE/src/lapacke_clarfx.c +++ b/LAPACKE/src/lapacke_clarfx.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfx( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clarfx)( int matrix_layout, char side, lapack_int m, lapack_int n, const lapack_complex_float* v, lapack_complex_float tau, lapack_complex_float* c, lapack_int ldc, lapack_complex_float* work ) { lapack_int lv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clarfx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -7; } - if( LAPACKE_c_nancheck( 1, &tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, &tau, 1 ) ) { return -6; } - lv = (LAPACKE_lsame( side, 'l' ) ? m : n); - if( LAPACKE_c_nancheck( lv, v, 1 ) ) { + lv = (API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n); + if( API_SUFFIX(LAPACKE_c_nancheck)( lv, v, 1 ) ) { return -5; } } #endif - return LAPACKE_clarfx_work( matrix_layout, side, m, n, v, tau, c, ldc, + return API_SUFFIX(LAPACKE_clarfx_work)( matrix_layout, side, m, n, v, tau, c, ldc, work ); } diff --git a/LAPACKE/src/lapacke_clarfx_work.c b/LAPACKE/src/lapacke_clarfx_work.c index f8d6f2dd5e..8566c17f2a 100644 --- a/LAPACKE/src/lapacke_clarfx_work.c +++ b/LAPACKE/src/lapacke_clarfx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarfx_work( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_clarfx_work)( int matrix_layout, char side, lapack_int m, lapack_int n, const lapack_complex_float* v, lapack_complex_float tau, lapack_complex_float* c, lapack_int ldc, @@ -51,7 +51,7 @@ lapack_int LAPACKE_clarfx_work( int matrix_layout, char side, lapack_int m, /* Check leading dimension(s) */ if( ldc < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_clarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,21 +62,21 @@ lapack_int LAPACKE_clarfx_work( int matrix_layout, char side, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_clarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clarfx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clarnv.c b/LAPACKE/src/lapacke_clarnv.c index 9cb36c3048..4f7d6b740e 100644 --- a/LAPACKE/src/lapacke_clarnv.c +++ b/LAPACKE/src/lapacke_clarnv.c @@ -32,8 +32,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarnv( lapack_int idist, lapack_int* iseed, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clarnv)( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_float* x ) { - return LAPACKE_clarnv_work( idist, iseed, n, x ); + return API_SUFFIX(LAPACKE_clarnv_work)( idist, iseed, n, x ); } diff --git a/LAPACKE/src/lapacke_clarnv_work.c b/LAPACKE/src/lapacke_clarnv_work.c index ef5061a62a..ce0f5eca96 100644 --- a/LAPACKE/src/lapacke_clarnv_work.c +++ b/LAPACKE/src/lapacke_clarnv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clarnv_work( lapack_int idist, lapack_int* iseed, +lapack_int API_SUFFIX(LAPACKE_clarnv_work)( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_float* x ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_clascl.c b/LAPACKE/src/lapacke_clascl.c index 7a10c130e5..84373d5bbc 100644 --- a/LAPACKE/src/lapacke_clascl.c +++ b/LAPACKE/src/lapacke_clascl.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_clascl)( int matrix_layout, char type, lapack_int kl, lapack_int ku, float cfrom, float cto, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clascl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clascl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -46,68 +46,68 @@ 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, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -9; } break; case 'L': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_cgb_nancheck)( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { return -9; } break; case 'U': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_cgb_nancheck)( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { return -9; } break; case 'H': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(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 ) ) { + if( API_SUFFIX(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 ) ) { + if( API_SUFFIX(LAPACKE_chb_nancheck)( matrix_layout, 'U', n, ku, a, lda ) ) { return -9; } break; case 'Z': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { return -9; } break; } } #endif - return LAPACKE_clascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); + return API_SUFFIX(LAPACKE_clascl_work)( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_clascl_work.c b/LAPACKE/src/lapacke_clascl_work.c index 2f4a781ef4..88a10eae40 100644 --- a/LAPACKE/src/lapacke_clascl_work.c +++ b/LAPACKE/src/lapacke_clascl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_clascl_work)( int matrix_layout, char type, lapack_int kl, lapack_int ku, float cfrom, float cto, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda ) @@ -45,15 +45,15 @@ 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 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 nrows_a = API_SUFFIX(LAPACKE_lsame)(type, 'b') ? kl + 1 : + API_SUFFIX(LAPACKE_lsame)(type, 'q') ? ku + 1 : + API_SUFFIX(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 ) { info = -9; - LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clascl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,23 +64,23 @@ 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, nrows_a, n, a, lda, a_t, lda_t ); + API_SUFFIX(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); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clascl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clascl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_claset.c b/LAPACKE/src/lapacke_claset.c index 3e320f5561..1f77013c3c 100644 --- a/LAPACKE/src/lapacke_claset.c +++ b/LAPACKE/src/lapacke_claset.c @@ -32,14 +32,14 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claset( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_claset)( int matrix_layout, char uplo, lapack_int m, lapack_int n, lapack_complex_float alpha, lapack_complex_float beta, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_claset", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claset", -1 ); return -1; } @@ -51,14 +51,14 @@ lapack_int LAPACKE_claset( int matrix_layout, char uplo, lapack_int m, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, &alpha, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, &beta, 1 ) ) { return -6; } } #endif - return LAPACKE_claset_work( matrix_layout, uplo, m, n, alpha, beta, a, lda ); + return API_SUFFIX(LAPACKE_claset_work)( matrix_layout, uplo, m, n, alpha, beta, a, lda ); } diff --git a/LAPACKE/src/lapacke_claset_work.c b/LAPACKE/src/lapacke_claset_work.c index af1fe23aa9..cd1882c740 100644 --- a/LAPACKE/src/lapacke_claset_work.c +++ b/LAPACKE/src/lapacke_claset_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claset_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_claset_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, lapack_complex_float alpha, lapack_complex_float beta, lapack_complex_float* a, lapack_int lda ) @@ -47,7 +47,7 @@ lapack_int LAPACKE_claset_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_claset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claset_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,21 +58,21 @@ lapack_int LAPACKE_claset_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_claset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_claset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claset_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_claset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claset_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_classq.c b/LAPACKE/src/lapacke_classq.c index f2fa6a7d4f..ff989e4e6b 100644 --- a/LAPACKE/src/lapacke_classq.c +++ b/LAPACKE/src/lapacke_classq.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_classq( lapack_int n, lapack_complex_float* x, +lapack_int API_SUFFIX(LAPACKE_classq)( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */ - if( LAPACKE_c_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, x, incx ) ) { return -2; } - if( LAPACKE_s_nancheck( 1, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, scale, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, sumsq, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, sumsq, 1 ) ) { return -5; } } #endif - return LAPACKE_classq_work( n, x, incx, scale, sumsq ); + return API_SUFFIX(LAPACKE_classq_work)( n, x, incx, scale, sumsq ); } diff --git a/LAPACKE/src/lapacke_classq_work.c b/LAPACKE/src/lapacke_classq_work.c index 79ed26a19b..b840579ecd 100644 --- a/LAPACKE/src/lapacke_classq_work.c +++ b/LAPACKE/src/lapacke_classq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_classq_work( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq ) +lapack_int API_SUFFIX(LAPACKE_classq_work)( lapack_int n, lapack_complex_float* x, lapack_int incx, float* scale, float* sumsq ) { lapack_int info = 0; LAPACK_classq( &n, x, &incx, scale, sumsq ); diff --git a/LAPACKE/src/lapacke_claswp.c b/LAPACKE/src/lapacke_claswp.c index 62d0e8918e..4f3b27bc6c 100644 --- a/LAPACKE/src/lapacke_claswp.c +++ b/LAPACKE/src/lapacke_claswp.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claswp( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_claswp)( int matrix_layout, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_claswp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claswp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -48,15 +48,15 @@ lapack_int LAPACKE_claswp( int matrix_layout, lapack_int n, * Disable the check as is below, the check below was checking for NaN * from lda to n since there is no (obvious) way to knowing m. This is not * a good idea. We could get a lower bound of m by scanning from ipiv. Or - * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable + * we could pass on the NaN check to API_SUFFIX(LAPACKE_dlaswp_work). For now disable * the buggy Nan check. * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827 *****************************************************************************/ - /* if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) { + /* if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, lda, n, a, lda ) ) { * return -3; * } */ } #endif - return LAPACKE_claswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); + return API_SUFFIX(LAPACKE_claswp_work)( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); } diff --git a/LAPACKE/src/lapacke_claswp_work.c b/LAPACKE/src/lapacke_claswp_work.c index 0b7d2cde09..76e0159695 100644 --- a/LAPACKE/src/lapacke_claswp_work.c +++ b/LAPACKE/src/lapacke_claswp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_claswp_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_claswp_work)( int matrix_layout, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) @@ -54,7 +54,7 @@ lapack_int LAPACKE_claswp_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_claswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claswp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,21 +65,21 @@ lapack_int LAPACKE_claswp_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_claswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_claswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claswp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_claswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_claswp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clatms.c b/LAPACKE/src/lapacke_clatms.c index 04847345c2..1b5a5870f0 100644 --- a/LAPACKE/src/lapacke_clatms.c +++ b/LAPACKE/src/lapacke_clatms.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clatms( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clatms)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, float* d, lapack_int mode, float cond, float dmax, lapack_int kl, lapack_int ku, char pack, @@ -41,22 +41,22 @@ lapack_int LAPACKE_clatms( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clatms", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clatms", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -14; } - if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &cond, 1 ) ) { return -9; } - if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(n,m), d, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &dmax, 1 ) ) { return -10; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_clatms( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_clatms_work( matrix_layout, m, n, dist, iseed, sym, d, mode, + info = API_SUFFIX(LAPACKE_clatms_work)( matrix_layout, m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clatms", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clatms", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clatms_work.c b/LAPACKE/src/lapacke_clatms_work.c index b96cf936a8..a1c1501a3b 100644 --- a/LAPACKE/src/lapacke_clatms_work.c +++ b/LAPACKE/src/lapacke_clatms_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clatms_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clatms_work)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, float* d, lapack_int mode, float cond, float dmax, lapack_int kl, lapack_int ku, @@ -53,7 +53,7 @@ lapack_int LAPACKE_clatms_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_clatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clatms_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_clatms_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a_t, &lda_t, work, &info ); @@ -72,16 +72,16 @@ lapack_int LAPACKE_clatms_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clatms_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clatms_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_clauum.c b/LAPACKE/src/lapacke_clauum.c index 071a956130..e223799017 100644 --- a/LAPACKE/src/lapacke_clauum.c +++ b/LAPACKE/src/lapacke_clauum.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clauum( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clauum)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_clauum", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clauum", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_clauum_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_clauum_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_clauum_work.c b/LAPACKE/src/lapacke_clauum_work.c index 8d71c3768d..67d45297b3 100644 --- a/LAPACKE/src/lapacke_clauum_work.c +++ b/LAPACKE/src/lapacke_clauum_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_clauum_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_clauum_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_clauum_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_clauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clauum_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_clauum_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clauum( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_clauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clauum_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_clauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_clauum_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbcon.c b/LAPACKE/src/lapacke_cpbcon.c index e5f81169bf..ff009e3817 100644 --- a/LAPACKE/src/lapacke_cpbcon.c +++ b/LAPACKE/src/lapacke_cpbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbcon)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_cpbcon( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_cpbcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cpbcon_work( matrix_layout, uplo, n, kd, ab, ldab, anorm, + info = API_SUFFIX(LAPACKE_cpbcon_work)( matrix_layout, uplo, n, kd, ab, ldab, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_cpbcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbcon_work.c b/LAPACKE/src/lapacke_cpbcon_work.c index 340fcd61ee..2949e1f383 100644 --- a/LAPACKE/src/lapacke_cpbcon_work.c +++ b/LAPACKE/src/lapacke_cpbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbcon_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float anorm, float* rcond, lapack_complex_float* work, float* rwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_cpbcon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_cpbcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work, rwork, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_cpbcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbequ.c b/LAPACKE/src/lapacke_cpbequ.c index ee0bba51b8..dcf0c85be5 100644 --- a/LAPACKE/src/lapacke_cpbequ.c +++ b/LAPACKE/src/lapacke_cpbequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbequ)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_cpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond, + return API_SUFFIX(LAPACKE_cpbequ_work)( matrix_layout, uplo, n, kd, ab, ldab, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_cpbequ_work.c b/LAPACKE/src/lapacke_cpbequ_work.c index f139ecaf69..a6ac444f4e 100644 --- a/LAPACKE/src/lapacke_cpbequ_work.c +++ b/LAPACKE/src/lapacke_cpbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbequ_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float* s, float* scond, float* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cpbequ_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cpbequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_cpbequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbrfs.c b/LAPACKE/src/lapacke_cpbrfs.c index 4c8faaf625..bed7d0f4a3 100644 --- a/LAPACKE/src/lapacke_cpbrfs.c +++ b/LAPACKE/src/lapacke_cpbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* afb, lapack_int ldafb, @@ -44,22 +44,22 @@ lapack_int LAPACKE_cpbrfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_cpbrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cpbrfs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, + info = API_SUFFIX(LAPACKE_cpbrfs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_cpbrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbrfs_work.c b/LAPACKE/src/lapacke_cpbrfs_work.c index 3bcc7ca4ff..5a28680530 100644 --- a/LAPACKE/src/lapacke_cpbrfs_work.c +++ b/LAPACKE/src/lapacke_cpbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* afb, @@ -61,22 +61,22 @@ lapack_int LAPACKE_cpbrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); return info; } if( ldafb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,11 +107,11 @@ lapack_int LAPACKE_cpbrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, @@ -120,7 +120,7 @@ lapack_int LAPACKE_cpbrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -131,11 +131,11 @@ lapack_int LAPACKE_cpbrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbstf.c b/LAPACKE/src/lapacke_cpbstf.c index d886421910..cffd53964b 100644 --- a/LAPACKE/src/lapacke_cpbstf.c +++ b/LAPACKE/src/lapacke_cpbstf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbstf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbstf)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, lapack_complex_float* bb, lapack_int ldbb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbstf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbstf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -5; } } #endif - return LAPACKE_cpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb ); + return API_SUFFIX(LAPACKE_cpbstf_work)( matrix_layout, uplo, n, kb, bb, ldbb ); } diff --git a/LAPACKE/src/lapacke_cpbstf_work.c b/LAPACKE/src/lapacke_cpbstf_work.c index 1e583fb3be..347e3e6f46 100644 --- a/LAPACKE/src/lapacke_cpbstf_work.c +++ b/LAPACKE/src/lapacke_cpbstf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbstf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbstf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, lapack_complex_float* bb, lapack_int ldbb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cpbstf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldbb < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbstf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_cpbstf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_cpb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); /* Release memory and exit */ LAPACKE_free( bb_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbstf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbstf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbsv.c b/LAPACKE/src/lapacke_cpbsv.c index 4c0b27d219..d53e6a433a 100644 --- a/LAPACKE/src/lapacke_cpbsv.c +++ b/LAPACKE/src/lapacke_cpbsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbsv)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_cpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_cpbsv_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpbsv_work.c b/LAPACKE/src/lapacke_cpbsv_work.c index f6f356e4f0..9d4e965677 100644 --- a/LAPACKE/src/lapacke_cpbsv_work.c +++ b/LAPACKE/src/lapacke_cpbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cpbsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_cpbsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -84,20 +84,20 @@ lapack_int LAPACKE_cpbsv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_cpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbsvx.c b/LAPACKE/src/lapacke_cpbsvx.c index 47a12dd3e2..00cf4b70cb 100644 --- a/LAPACKE/src/lapacke_cpbsvx.c +++ b/LAPACKE/src/lapacke_cpbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, lapack_int ldafb, @@ -45,25 +45,25 @@ lapack_int LAPACKE_cpbsvx( int matrix_layout, char fact, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -9; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -12; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_cpbsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cpbsvx_work( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_cpbsvx_work)( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_cpbsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbsvx_work.c b/LAPACKE/src/lapacke_cpbsvx_work.c index a63c8fddda..e95bd47d51 100644 --- a/LAPACKE/src/lapacke_cpbsvx_work.c +++ b/LAPACKE/src/lapacke_cpbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpbsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, lapack_int ldafb, @@ -63,22 +63,22 @@ lapack_int LAPACKE_cpbsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -109,12 +109,12 @@ lapack_int LAPACKE_cpbsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -123,16 +123,16 @@ lapack_int LAPACKE_cpbsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, afb, ldafb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -143,11 +143,11 @@ lapack_int LAPACKE_cpbsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbtrf.c b/LAPACKE/src/lapacke_cpbtrf.c index 9b2f160eb6..a295d8e491 100644 --- a/LAPACKE/src/lapacke_cpbtrf.c +++ b/LAPACKE/src/lapacke_cpbtrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbtrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbtrf)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_cpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_cpbtrf_work)( matrix_layout, uplo, n, kd, ab, ldab ); } diff --git a/LAPACKE/src/lapacke_cpbtrf_work.c b/LAPACKE/src/lapacke_cpbtrf_work.c index a0c1d4c0db..2ce1b3052c 100644 --- a/LAPACKE/src/lapacke_cpbtrf_work.c +++ b/LAPACKE/src/lapacke_cpbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbtrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbtrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_complex_float* ab, lapack_int ldab ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cpbtrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_cpbtrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_cpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpbtrs.c b/LAPACKE/src/lapacke_cpbtrs.c index 144c2af899..064c6af333 100644 --- a/LAPACKE/src/lapacke_cpbtrs.c +++ b/LAPACKE/src/lapacke_cpbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbtrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbtrs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_cpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_cpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_cpbtrs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpbtrs_work.c b/LAPACKE/src/lapacke_cpbtrs_work.c index af8078b84b..a7d3f39643 100644 --- a/LAPACKE/src/lapacke_cpbtrs_work.c +++ b/LAPACKE/src/lapacke_cpbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpbtrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpbtrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cpbtrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_cpbtrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_cpbtrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpftrf.c b/LAPACKE/src/lapacke_cpftrf.c index afc8343c9b..982d9a843f 100644 --- a/LAPACKE/src/lapacke_cpftrf.c +++ b/LAPACKE/src/lapacke_cpftrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftrf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftrf)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpftrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_cpftrf_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_cpftrf_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_cpftrf_work.c b/LAPACKE/src/lapacke_cpftrf_work.c index 29f939246c..bc18aabf76 100644 --- a/LAPACKE/src/lapacke_cpftrf_work.c +++ b/LAPACKE/src/lapacke_cpftrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftrf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftrf_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_float* a ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_cpftrf_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_cpftrf( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_cpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpftri.c b/LAPACKE/src/lapacke_cpftri.c index 0637acb96f..109750d5e3 100644 --- a/LAPACKE/src/lapacke_cpftri.c +++ b/LAPACKE/src/lapacke_cpftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftri( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftri)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_cpftri_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_cpftri_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_cpftri_work.c b/LAPACKE/src/lapacke_cpftri_work.c index 1120cc25f8..bcb29ba9e2 100644 --- a/LAPACKE/src/lapacke_cpftri_work.c +++ b/LAPACKE/src/lapacke_cpftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftri_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_float* a ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_cpftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_cpftri( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_cpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpftrs.c b/LAPACKE/src/lapacke_cpftrs.c index 81ecd03fdc..cdcdad2d8d 100644 --- a/LAPACKE/src/lapacke_cpftrs.c +++ b/LAPACKE/src/lapacke_cpftrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftrs( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftrs)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpftrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, a ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_cpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b, + return API_SUFFIX(LAPACKE_cpftrs_work)( matrix_layout, transr, uplo, n, nrhs, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpftrs_work.c b/LAPACKE/src/lapacke_cpftrs_work.c index 819bbdcbb3..0a3a915b89 100644 --- a/LAPACKE/src/lapacke_cpftrs_work.c +++ b/LAPACKE/src/lapacke_cpftrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpftrs_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_cpftrs_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_cpftrs_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,26 +70,26 @@ lapack_int LAPACKE_cpftrs_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_cpftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpftrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpocon.c b/LAPACKE/src/lapacke_cpocon.c index bd8fd6b97c..4f3c9871b7 100644 --- a/LAPACKE/src/lapacke_cpocon.c +++ b/LAPACKE/src/lapacke_cpocon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpocon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpocon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_cpocon( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpocon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpocon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_cpocon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cpocon_work( matrix_layout, uplo, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_cpocon_work)( matrix_layout, uplo, n, a, lda, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_cpocon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpocon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpocon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpocon_work.c b/LAPACKE/src/lapacke_cpocon_work.c index 25024a6ade..945fde6d6f 100644 --- a/LAPACKE/src/lapacke_cpocon_work.c +++ b/LAPACKE/src/lapacke_cpocon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpocon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpocon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float anorm, float* rcond, lapack_complex_float* work, float* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cpocon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpocon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_cpocon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, rwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_cpocon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpocon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpocon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpoequ.c b/LAPACKE/src/lapacke_cpoequ.c index 1945af0c7f..a7660e4940 100644 --- a/LAPACKE/src/lapacke_cpoequ.c +++ b/LAPACKE/src/lapacke_cpoequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpoequ( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpoequ)( int matrix_layout, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpoequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_cpoequ_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_cpoequ_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_cpoequ_work.c b/LAPACKE/src/lapacke_cpoequ_work.c index 39e45ea820..42d4ed2d57 100644 --- a/LAPACKE/src/lapacke_cpoequ_work.c +++ b/LAPACKE/src/lapacke_cpoequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpoequ_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpoequ_work)( int matrix_layout, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cpoequ_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_cpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_cpoequ_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpoequ( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_cpoequ_work( int matrix_layout, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpoequb.c b/LAPACKE/src/lapacke_cpoequb.c index 50bb97998e..0828ad471e 100644 --- a/LAPACKE/src/lapacke_cpoequb.c +++ b/LAPACKE/src/lapacke_cpoequb.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpoequb( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpoequb)( int matrix_layout, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpoequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_cpoequb_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_cpoequb_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_cpoequb_work.c b/LAPACKE/src/lapacke_cpoequb_work.c index 2df58a1668..b1abc4ecca 100644 --- a/LAPACKE/src/lapacke_cpoequb_work.c +++ b/LAPACKE/src/lapacke_cpoequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpoequb_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpoequb_work)( int matrix_layout, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cpoequb_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_cpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_cpoequb_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpoequb( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_cpoequb_work( int matrix_layout, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpoequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cporfs.c b/LAPACKE/src/lapacke_cporfs.c index 3063f97167..32462801b2 100644 --- a/LAPACKE/src/lapacke_cporfs.c +++ b/LAPACKE/src/lapacke_cporfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cporfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cporfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_complex_float* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_cporfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cporfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -76,7 +76,7 @@ lapack_int LAPACKE_cporfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cporfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_cporfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_cporfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cporfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cporfs_work.c b/LAPACKE/src/lapacke_cporfs_work.c index aa9421b7f0..68e644b815 100644 --- a/LAPACKE/src/lapacke_cporfs_work.c +++ b/LAPACKE/src/lapacke_cporfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cporfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cporfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_complex_float* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_cporfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -106,10 +106,10 @@ lapack_int LAPACKE_cporfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -117,7 +117,7 @@ lapack_int LAPACKE_cporfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -128,11 +128,11 @@ lapack_int LAPACKE_cporfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cporfsx.c b/LAPACKE/src/lapacke_cporfsx.c index 530d96775e..9a2108c635 100644 --- a/LAPACKE/src/lapacke_cporfsx.c +++ b/LAPACKE/src/lapacke_cporfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cporfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_cporfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_cporfsx( int matrix_layout, char uplo, char equed, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cporfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -21; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -10; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -13; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_cporfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cporfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_cporfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_cporfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cporfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cporfsx_work.c b/LAPACKE/src/lapacke_cporfsx_work.c index 4e4342eb54..39d8b47d43 100644 --- a/LAPACKE/src/lapacke_cporfsx_work.c +++ b/LAPACKE/src/lapacke_cporfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cporfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_cporfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, @@ -68,22 +68,22 @@ lapack_int LAPACKE_cporfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -126,10 +126,10 @@ lapack_int LAPACKE_cporfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_csy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cporfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, &n_err_bnds, @@ -139,10 +139,10 @@ lapack_int LAPACKE_cporfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -158,11 +158,11 @@ lapack_int LAPACKE_cporfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cporfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cposv.c b/LAPACKE/src/lapacke_cposv.c index 94296c7d72..143dd0d12a 100644 --- a/LAPACKE/src/lapacke_cposv.c +++ b/LAPACKE/src/lapacke_cposv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_cposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_cposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cposv_work.c b/LAPACKE/src/lapacke_cposv_work.c index f5903a8b41..180bf6fba6 100644 --- a/LAPACKE/src/lapacke_cposv_work.c +++ b/LAPACKE/src/lapacke_cposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,27 +75,27 @@ lapack_int LAPACKE_cposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cposvx.c b/LAPACKE/src/lapacke_cposvx.c index fa401cde17..4a43e45861 100644 --- a/LAPACKE/src/lapacke_cposvx.c +++ b/LAPACKE/src/lapacke_cposvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cposvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, char* equed, float* s, @@ -44,25 +44,25 @@ lapack_int LAPACKE_cposvx( int matrix_layout, char fact, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cposvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_cposvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cposvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_cposvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_cposvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cposvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cposvx_work.c b/LAPACKE/src/lapacke_cposvx_work.c index d732801d09..c88382622b 100644 --- a/LAPACKE/src/lapacke_cposvx_work.c +++ b/LAPACKE/src/lapacke_cposvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cposvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -62,22 +62,22 @@ lapack_int LAPACKE_cposvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -108,11 +108,11 @@ lapack_int LAPACKE_cposvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, @@ -121,15 +121,15 @@ lapack_int LAPACKE_cposvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -140,11 +140,11 @@ lapack_int LAPACKE_cposvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cposvxx.c b/LAPACKE/src/lapacke_cposvxx.c index d420171aba..2582415bb0 100644 --- a/LAPACKE/src/lapacke_cposvxx.c +++ b/LAPACKE/src/lapacke_cposvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cposvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -47,30 +47,30 @@ lapack_int LAPACKE_cposvxx( int matrix_layout, char fact, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cposvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } @@ -89,7 +89,7 @@ lapack_int LAPACKE_cposvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cposvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_cposvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -99,7 +99,7 @@ lapack_int LAPACKE_cposvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cposvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cposvxx_work.c b/LAPACKE/src/lapacke_cposvxx_work.c index a329787df5..11e4c46787 100644 --- a/LAPACKE/src/lapacke_cposvxx_work.c +++ b/LAPACKE/src/lapacke_cposvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cposvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -68,22 +68,22 @@ lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -126,11 +126,11 @@ lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr, @@ -140,18 +140,18 @@ lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -167,11 +167,11 @@ lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cposvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpotrf.c b/LAPACKE/src/lapacke_cpotrf.c index d8c7a24792..fcce319c67 100644 --- a/LAPACKE/src/lapacke_cpotrf.c +++ b/LAPACKE/src/lapacke_cpotrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpotrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cpotrf_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_cpotrf_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_cpotrf2.c b/LAPACKE/src/lapacke_cpotrf2.c index 7fd0560a7e..601a1bb662 100644 --- a/LAPACKE/src/lapacke_cpotrf2.c +++ b/LAPACKE/src/lapacke_cpotrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrf2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrf2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpotrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cpotrf2_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_cpotrf2_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_cpotrf2_work.c b/LAPACKE/src/lapacke_cpotrf2_work.c index 9d29d58427..e12e522b00 100644 --- a/LAPACKE/src/lapacke_cpotrf2_work.c +++ b/LAPACKE/src/lapacke_cpotrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrf2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrf2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_cpotrf2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_cpotrf2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpotrf2( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpotrf_work.c b/LAPACKE/src/lapacke_cpotrf_work.c index 128a1638ed..df1d1dbfd0 100644 --- a/LAPACKE/src/lapacke_cpotrf_work.c +++ b/LAPACKE/src/lapacke_cpotrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_cpotrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_cpotrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpotrf( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpotri.c b/LAPACKE/src/lapacke_cpotri.c index 3b006e6a83..71e2fd1482 100644 --- a/LAPACKE/src/lapacke_cpotri.c +++ b/LAPACKE/src/lapacke_cpotri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpotri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_cpotri_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_cpotri_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_cpotri_work.c b/LAPACKE/src/lapacke_cpotri_work.c index d4f9878190..449e9cceeb 100644 --- a/LAPACKE/src/lapacke_cpotri_work.c +++ b/LAPACKE/src/lapacke_cpotri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_cpotri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_cpotri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpotri( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpotrs.c b/LAPACKE/src/lapacke_cpotrs.c index 638b7595e1..6315bd30c7 100644 --- a/LAPACKE/src/lapacke_cpotrs.c +++ b/LAPACKE/src/lapacke_cpotrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpotrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_cpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_cpotrs_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpotrs_work.c b/LAPACKE/src/lapacke_cpotrs_work.c index dee555b635..2b9a4a1118 100644 --- a/LAPACKE/src/lapacke_cpotrs_work.c +++ b/LAPACKE/src/lapacke_cpotrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpotrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpotrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_cpotrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrs_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,26 +75,26 @@ lapack_int LAPACKE_cpotrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpotrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppcon.c b/LAPACKE/src/lapacke_cppcon.c index 0f4cb52a12..b1a9cac4ba 100644 --- a/LAPACKE/src/lapacke_cppcon.c +++ b/LAPACKE/src/lapacke_cppcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_cppcon( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cppcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -5; } - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_cppcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cppcon_work( matrix_layout, uplo, n, ap, anorm, rcond, work, + info = API_SUFFIX(LAPACKE_cppcon_work)( matrix_layout, uplo, n, ap, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_cppcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppcon_work.c b/LAPACKE/src/lapacke_cppcon_work.c index aea7edd3c2..a5f50577ea 100644 --- a/LAPACKE/src/lapacke_cppcon_work.c +++ b/LAPACKE/src/lapacke_cppcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, float anorm, float* rcond, lapack_complex_float* work, float* rwork ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_cppcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cppcon( &uplo, &n, ap_t, &anorm, rcond, work, rwork, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_cppcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppequ.c b/LAPACKE/src/lapacke_cppequ.c index 1cb51bfdf3..649d3b5aea 100644 --- a/LAPACKE/src/lapacke_cppequ.c +++ b/LAPACKE/src/lapacke_cppequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppequ)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cppequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_cppequ_work( matrix_layout, uplo, n, ap, s, scond, amax ); + return API_SUFFIX(LAPACKE_cppequ_work)( matrix_layout, uplo, n, ap, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_cppequ_work.c b/LAPACKE/src/lapacke_cppequ_work.c index 111f50c772..9d24d5ab49 100644 --- a/LAPACKE/src/lapacke_cppequ_work.c +++ b/LAPACKE/src/lapacke_cppequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppequ_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, float* s, float* scond, float* amax ) { @@ -54,7 +54,7 @@ lapack_int LAPACKE_cppequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cppequ( &uplo, &n, ap_t, s, scond, amax, &info ); if( info < 0 ) { @@ -64,11 +64,11 @@ lapack_int LAPACKE_cppequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpprfs.c b/LAPACKE/src/lapacke_cpprfs.c index 7fc34be98a..f69369aa85 100644 --- a/LAPACKE/src/lapacke_cpprfs.c +++ b/LAPACKE/src/lapacke_cpprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_complex_float* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_cpprfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -9; } } @@ -76,7 +76,7 @@ lapack_int LAPACKE_cpprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cpprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, + info = API_SUFFIX(LAPACKE_cpprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_cpprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpprfs_work.c b/LAPACKE/src/lapacke_cpprfs_work.c index 312280a58b..eec06dafa4 100644 --- a/LAPACKE/src/lapacke_cpprfs_work.c +++ b/LAPACKE/src/lapacke_cpprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_complex_float* b, lapack_int ldb, @@ -58,12 +58,12 @@ lapack_int LAPACKE_cpprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -96,10 +96,10 @@ lapack_int LAPACKE_cpprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_cpprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -107,7 +107,7 @@ lapack_int LAPACKE_cpprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -118,11 +118,11 @@ lapack_int LAPACKE_cpprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppsv.c b/LAPACKE/src/lapacke_cppsv.c index 6d6ddcc028..36ef29fd26 100644 --- a/LAPACKE/src/lapacke_cppsv.c +++ b/LAPACKE/src/lapacke_cppsv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cppsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_cppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_cppsv_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cppsv_work.c b/LAPACKE/src/lapacke_cppsv_work.c index ad9516912e..a15f6278bd 100644 --- a/LAPACKE/src/lapacke_cppsv_work.c +++ b/LAPACKE/src/lapacke_cppsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_cppsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,27 +69,27 @@ lapack_int LAPACKE_cppsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppsvx.c b/LAPACKE/src/lapacke_cppsvx.c index fbf68f9777..4f16706fe7 100644 --- a/LAPACKE/src/lapacke_cppsvx.c +++ b/LAPACKE/src/lapacke_cppsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cppsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_complex_float* afp, char* equed, float* s, lapack_complex_float* b, lapack_int ldb, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cppsvx( int matrix_layout, char fact, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cppsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_cpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -9; } } @@ -80,7 +80,7 @@ lapack_int LAPACKE_cppsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cppsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_cppsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_cppsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cppsvx_work.c b/LAPACKE/src/lapacke_cppsvx_work.c index d4a3135e67..25c8ac725b 100644 --- a/LAPACKE/src/lapacke_cppsvx_work.c +++ b/LAPACKE/src/lapacke_cppsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cppsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cppsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_complex_float* afp, char* equed, @@ -60,12 +60,12 @@ lapack_int LAPACKE_cppsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_cppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,10 +98,10 @@ lapack_int LAPACKE_cppsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_cpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_cppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t, @@ -111,13 +111,13 @@ lapack_int LAPACKE_cppsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -129,11 +129,11 @@ lapack_int LAPACKE_cppsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cppsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpptrf.c b/LAPACKE/src/lapacke_cpptrf.c index 38247619bb..a279130eab 100644 --- a/LAPACKE/src/lapacke_cpptrf.c +++ b/LAPACKE/src/lapacke_cpptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_cpptrf_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_cpptrf_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_cpptrf_work.c b/LAPACKE/src/lapacke_cpptrf_work.c index b786bd4c29..c901c178d8 100644 --- a/LAPACKE/src/lapacke_cpptrf_work.c +++ b/LAPACKE/src/lapacke_cpptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_cpptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cpptrf( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpptri.c b/LAPACKE/src/lapacke_cpptri.c index 89fba4257d..5a76b7e94c 100644 --- a/LAPACKE/src/lapacke_cpptri.c +++ b/LAPACKE/src/lapacke_cpptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_cpptri_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_cpptri_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_cpptri_work.c b/LAPACKE/src/lapacke_cpptri_work.c index 91a54af814..8ccfa7bc09 100644 --- a/LAPACKE/src/lapacke_cpptri_work.c +++ b/LAPACKE/src/lapacke_cpptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_cpptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cpptri( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpptrs.c b/LAPACKE/src/lapacke_cpptrs.c index 091c6dceb2..8d5b812bee 100644 --- a/LAPACKE/src/lapacke_cpptrs.c +++ b/LAPACKE/src/lapacke_cpptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_cpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_cpptrs_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpptrs_work.c b/LAPACKE/src/lapacke_cpptrs_work.c index b59a21fc70..2d544be656 100644 --- a/LAPACKE/src/lapacke_cpptrs_work.c +++ b/LAPACKE/src/lapacke_cpptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_cpptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,26 +69,26 @@ lapack_int LAPACKE_cpptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cpptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpstrf.c b/LAPACKE/src/lapacke_cpstrf.c index 630e154c55..f0711891e7 100644 --- a/LAPACKE/src/lapacke_cpstrf.c +++ b/LAPACKE/src/lapacke_cpstrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpstrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpstrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* piv, lapack_int* rank, float tol ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpstrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpstrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tol, 1 ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_cpstrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cpstrf_work( matrix_layout, uplo, n, a, lda, piv, rank, tol, + info = API_SUFFIX(LAPACKE_cpstrf_work)( matrix_layout, uplo, n, a, lda, piv, rank, tol, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpstrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpstrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpstrf_work.c b/LAPACKE/src/lapacke_cpstrf_work.c index d4f5e53d0f..bd09022335 100644 --- a/LAPACKE/src/lapacke_cpstrf_work.c +++ b/LAPACKE/src/lapacke_cpstrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpstrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpstrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* piv, lapack_int* rank, float tol, float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cpstrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpstrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_cpstrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cpstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpstrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpstrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptcon.c b/LAPACKE/src/lapacke_cptcon.c index eb861647fc..11e83656d9 100644 --- a/LAPACKE/src/lapacke_cptcon.c +++ b/LAPACKE/src/lapacke_cptcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptcon( lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_cptcon)( lapack_int n, const float* d, const lapack_complex_float* e, float anorm, float* rcond ) { @@ -41,13 +41,13 @@ lapack_int LAPACKE_cptcon( lapack_int n, const float* d, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -3; } } @@ -59,12 +59,12 @@ lapack_int LAPACKE_cptcon( lapack_int n, const float* d, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cptcon_work( n, d, e, anorm, rcond, work ); + info = API_SUFFIX(LAPACKE_cptcon_work)( n, d, e, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptcon_work.c b/LAPACKE/src/lapacke_cptcon_work.c index 1298bda8e8..30287d931f 100644 --- a/LAPACKE/src/lapacke_cptcon_work.c +++ b/LAPACKE/src/lapacke_cptcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptcon_work( lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_cptcon_work)( lapack_int n, const float* d, const lapack_complex_float* e, float anorm, float* rcond, float* work ) { diff --git a/LAPACKE/src/lapacke_cpteqr.c b/LAPACKE/src/lapacke_cpteqr.c index 1205a58136..dcadf0e62b 100644 --- a/LAPACKE/src/lapacke_cpteqr.c +++ b/LAPACKE/src/lapacke_cpteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpteqr( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_cpteqr)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_cpteqr( int matrix_layout, char compz, lapack_int n, float* d lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,4*n-4); @@ -72,12 +72,12 @@ lapack_int LAPACKE_cpteqr( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cpteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_cpteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpteqr_work.c b/LAPACKE/src/lapacke_cpteqr_work.c index 501e85b45a..5ab420a9bd 100644 --- a/LAPACKE/src/lapacke_cpteqr_work.c +++ b/LAPACKE/src/lapacke_cpteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpteqr_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cpteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,8 +60,8 @@ lapack_int LAPACKE_cpteqr_work( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_cpteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_cpteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptrfs.c b/LAPACKE/src/lapacke_cptrfs.c index b7c7b236b9..9c789947c6 100644 --- a/LAPACKE/src/lapacke_cptrfs.c +++ b/LAPACKE/src/lapacke_cptrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cptrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, const float* df, const lapack_complex_float* ef, @@ -44,28 +44,28 @@ lapack_int LAPACKE_cptrfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cptrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -7; } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, ef, 1 ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -83,7 +83,7 @@ lapack_int LAPACKE_cptrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cptrfs_work( matrix_layout, uplo, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_cptrfs_work)( matrix_layout, uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_cptrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptrfs_work.c b/LAPACKE/src/lapacke_cptrfs_work.c index f2128fa3e9..25000b1001 100644 --- a/LAPACKE/src/lapacke_cptrfs_work.c +++ b/LAPACKE/src/lapacke_cptrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cptrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, const float* df, const lapack_complex_float* ef, @@ -57,12 +57,12 @@ lapack_int LAPACKE_cptrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_cptrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cptrfs( &uplo, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -90,18 +90,18 @@ lapack_int LAPACKE_cptrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptsv.c b/LAPACKE/src/lapacke_cptsv.c index c617fb344d..50c954857b 100644 --- a/LAPACKE/src/lapacke_cptsv.c +++ b/LAPACKE/src/lapacke_cptsv.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_cptsv)( int matrix_layout, lapack_int n, lapack_int nrhs, float* d, lapack_complex_float* e, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cptsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_cptsv_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_cptsv_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cptsv_work.c b/LAPACKE/src/lapacke_cptsv_work.c index 262ea94708..70af7e5862 100644 --- a/LAPACKE/src/lapacke_cptsv_work.c +++ b/LAPACKE/src/lapacke_cptsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_cptsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, float* d, lapack_complex_float* e, lapack_complex_float* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_cptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_cptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptsvx.c b/LAPACKE/src/lapacke_cptsvx.c index ce4a51292c..ddf433531b 100644 --- a/LAPACKE/src/lapacke_cptsvx.c +++ b/LAPACKE/src/lapacke_cptsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptsvx( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cptsvx)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, float* df, lapack_complex_float* ef, @@ -44,28 +44,28 @@ lapack_int LAPACKE_cptsvx( int matrix_layout, char fact, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cptsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -7; } } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_c_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, ef, 1 ) ) { return -8; } } @@ -84,7 +84,7 @@ lapack_int LAPACKE_cptsvx( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cptsvx_work( matrix_layout, fact, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_cptsvx_work)( matrix_layout, fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -92,7 +92,7 @@ lapack_int LAPACKE_cptsvx( int matrix_layout, char fact, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cptsvx_work.c b/LAPACKE/src/lapacke_cptsvx_work.c index 5a16eb7e53..a0b7ce21bf 100644 --- a/LAPACKE/src/lapacke_cptsvx_work.c +++ b/LAPACKE/src/lapacke_cptsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cptsvx_work( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cptsvx_work)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, float* df, lapack_complex_float* ef, @@ -57,12 +57,12 @@ lapack_int LAPACKE_cptsvx_work( int matrix_layout, char fact, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_cptsvx_work( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, rwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_cptsvx_work( int matrix_layout, char fact, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cptsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cpttrf.c b/LAPACKE/src/lapacke_cpttrf.c index 6dd5476aa6..1d95ff7d93 100644 --- a/LAPACKE/src/lapacke_cpttrf.c +++ b/LAPACKE/src/lapacke_cpttrf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpttrf( lapack_int n, float* d, lapack_complex_float* e ) +lapack_int API_SUFFIX(LAPACKE_cpttrf)( lapack_int n, float* d, lapack_complex_float* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_cpttrf_work( n, d, e ); + return API_SUFFIX(LAPACKE_cpttrf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_cpttrf_work.c b/LAPACKE/src/lapacke_cpttrf_work.c index b49017814d..e31353969f 100644 --- a/LAPACKE/src/lapacke_cpttrf_work.c +++ b/LAPACKE/src/lapacke_cpttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpttrf_work( lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_cpttrf_work)( lapack_int n, float* d, lapack_complex_float* e ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_cpttrs.c b/LAPACKE/src/lapacke_cpttrs.c index 61d22b4962..5578443c70 100644 --- a/LAPACKE/src/lapacke_cpttrs.c +++ b/LAPACKE/src/lapacke_cpttrs.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpttrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpttrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cpttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_c_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ) ) { return -6; } } #endif - return LAPACKE_cpttrs_work( matrix_layout, uplo, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_cpttrs_work)( matrix_layout, uplo, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cpttrs_work.c b/LAPACKE/src/lapacke_cpttrs_work.c index fe9150bedf..25ade7559a 100644 --- a/LAPACKE/src/lapacke_cpttrs_work.c +++ b/LAPACKE/src/lapacke_cpttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cpttrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cpttrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* d, const lapack_complex_float* e, lapack_complex_float* b, lapack_int ldb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cpttrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,23 +62,23 @@ lapack_int LAPACKE_cpttrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cpttrs( &uplo, &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cpttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cspcon.c b/LAPACKE/src/lapacke_cspcon.c index d17277b655..ced2500d32 100644 --- a/LAPACKE/src/lapacke_cspcon.c +++ b/LAPACKE/src/lapacke_cspcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cspcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cspcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -4; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_cspcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cspcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_cspcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cspcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cspcon_work.c b/LAPACKE/src/lapacke_cspcon_work.c index 90fffaed2f..221f4b21ad 100644 --- a/LAPACKE/src/lapacke_cspcon_work.c +++ b/LAPACKE/src/lapacke_cspcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cspcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_int* ipiv, float anorm, float* rcond, lapack_complex_float* work ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_cspcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_cspcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csprfs.c b/LAPACKE/src/lapacke_csprfs.c index 6d4a52dc4a..96fd3c5b20 100644 --- a/LAPACKE/src/lapacke_csprfs.c +++ b/LAPACKE/src/lapacke_csprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_csprfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_csprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_csprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_csprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_csprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csprfs_work.c b/LAPACKE/src/lapacke_csprfs_work.c index b245cd06d7..be983eb151 100644 --- a/LAPACKE/src/lapacke_csprfs_work.c +++ b/LAPACKE/src/lapacke_csprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_csprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_csprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_csp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_csprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_csprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -119,11 +119,11 @@ lapack_int LAPACKE_csprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cspsv.c b/LAPACKE/src/lapacke_cspsv.c index 078356f57d..bb96c40286 100644 --- a/LAPACKE/src/lapacke_cspsv.c +++ b/LAPACKE/src/lapacke_cspsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cspsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cspsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_cspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_cspsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_cspsv_work.c b/LAPACKE/src/lapacke_cspsv_work.c index 794e99e12a..22a5209e5f 100644 --- a/LAPACKE/src/lapacke_cspsv_work.c +++ b/LAPACKE/src/lapacke_cspsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cspsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* ap, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_cspsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,27 +70,27 @@ lapack_int LAPACKE_cspsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_csp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cspsvx.c b/LAPACKE/src/lapacke_cspsvx.c index f75ac35b7d..b6435d76b8 100644 --- a/LAPACKE/src/lapacke_cspsvx.c +++ b/LAPACKE/src/lapacke_cspsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cspsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* afp, lapack_int* ipiv, const lapack_complex_float* b, lapack_int ldb, @@ -43,21 +43,21 @@ lapack_int LAPACKE_cspsvx( int matrix_layout, char fact, char uplo, lapack_int n float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cspsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_csp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_cspsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cspsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_cspsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_cspsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cspsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cspsvx_work.c b/LAPACKE/src/lapacke_cspsvx_work.c index b3ba12b5d7..4a0c0116be 100644 --- a/LAPACKE/src/lapacke_cspsvx_work.c +++ b/LAPACKE/src/lapacke_cspsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cspsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_cspsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* afp, lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_cspsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_cspsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_csp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_cspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -109,9 +109,9 @@ lapack_int LAPACKE_cspsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_csp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_csp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -123,11 +123,11 @@ lapack_int LAPACKE_cspsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cspsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csptrf.c b/LAPACKE/src/lapacke_csptrf.c index 6ba643e25d..4d8b728e69 100644 --- a/LAPACKE/src/lapacke_csptrf.c +++ b/LAPACKE/src/lapacke_csptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_csptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_csptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_csptrf_work.c b/LAPACKE/src/lapacke_csptrf_work.c index 6b640445d4..06d25d129f 100644 --- a/LAPACKE/src/lapacke_csptrf_work.c +++ b/LAPACKE/src/lapacke_csptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_csptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_csptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_csp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csptri.c b/LAPACKE/src/lapacke_csptri.c index 5897d74bb6..aded51773d 100644 --- a/LAPACKE/src/lapacke_csptri.c +++ b/LAPACKE/src/lapacke_csptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_csptri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_csptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csptri_work.c b/LAPACKE/src/lapacke_csptri_work.c index 185c164a57..53a86d676a 100644 --- a/LAPACKE/src/lapacke_csptri_work.c +++ b/LAPACKE/src/lapacke_csptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* work ) @@ -55,23 +55,23 @@ lapack_int LAPACKE_csptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_csptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_csp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csptrs.c b/LAPACKE/src/lapacke_csptrs.c index ca97e4d794..bd77ddf966 100644 --- a/LAPACKE/src/lapacke_csptrs.c +++ b/LAPACKE/src/lapacke_csptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_csp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_csptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_csptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_csptrs_work.c b/LAPACKE/src/lapacke_csptrs_work.c index 58f3dfae93..c1bdcd45b9 100644 --- a/LAPACKE/src/lapacke_csptrs_work.c +++ b/LAPACKE/src/lapacke_csptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_csptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,26 +70,26 @@ lapack_int LAPACKE_csptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_csp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_csptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstedc.c b/LAPACKE/src/lapacke_cstedc.c index 61cacfb148..17c172505f 100644 --- a/LAPACKE/src/lapacke_cstedc.c +++ b/LAPACKE/src/lapacke_cstedc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_cstedc)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz ) { lapack_int info = 0; @@ -46,27 +46,27 @@ lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d float rwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cstedc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstedc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cstedc_work( matrix_layout, compz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_cstedc_work)( matrix_layout, compz, n, d, e, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cstedc_work( matrix_layout, compz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_cstedc_work)( matrix_layout, compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstedc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstedc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstedc_work.c b/LAPACKE/src/lapacke_cstedc_work.c index 5574ea58df..f74759b7ac 100644 --- a/LAPACKE/src/lapacke_cstedc_work.c +++ b/LAPACKE/src/lapacke_cstedc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cstedc_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz, lapack_complex_float* work, lapack_int lwork, float* rwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstedc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -73,8 +73,8 @@ lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_cstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, rwork, @@ -83,20 +83,20 @@ lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstedc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstedc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstegr.c b/LAPACKE/src/lapacke_cstegr.c index 8d81dc1630..b11bf13c7a 100644 --- a/LAPACKE/src/lapacke_cstegr.c +++ b/LAPACKE/src/lapacke_cstegr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstegr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cstegr)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, lapack_complex_float* z, @@ -46,35 +46,35 @@ lapack_int LAPACKE_cstegr( int matrix_layout, char jobz, char range, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cstegr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstegr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_cstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_cstegr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_cstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_cstegr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstegr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstegr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstegr_work.c b/LAPACKE/src/lapacke_cstegr_work.c index 49f1b394db..5d4f3f100f 100644 --- a/LAPACKE/src/lapacke_cstegr_work.c +++ b/LAPACKE/src/lapacke_cstegr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstegr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cstegr_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -54,9 +54,9 @@ lapack_int LAPACKE_cstegr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); lapack_complex_float* z_t = NULL; /* Check leading dimension(s) */ - if( ( LAPACKE_lsame( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { + if( ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_cstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstegr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_cstegr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { /* Let be always 'n' instead of 'm' */ z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * @@ -85,20 +85,20 @@ lapack_int LAPACKE_cstegr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstegr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstegr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstein.c b/LAPACKE/src/lapacke_cstein.c index 693e84aa7f..2aea218d42 100644 --- a/LAPACKE/src/lapacke_cstein.c +++ b/LAPACKE/src/lapacke_cstein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstein( int matrix_layout, lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_cstein)( int matrix_layout, lapack_int n, const float* d, const float* e, lapack_int m, const float* w, const lapack_int* iblock, const lapack_int* isplit, lapack_complex_float* z, lapack_int ldz, @@ -42,19 +42,19 @@ lapack_int LAPACKE_cstein( int matrix_layout, lapack_int n, const float* d, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cstein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, w, 1 ) ) { return -6; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_cstein( int matrix_layout, lapack_int n, const float* d, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cstein_work( matrix_layout, n, d, e, m, w, iblock, isplit, z, + info = API_SUFFIX(LAPACKE_cstein_work)( matrix_layout, n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifailv ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_cstein( int matrix_layout, lapack_int n, const float* d, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstein_work.c b/LAPACKE/src/lapacke_cstein_work.c index 53e686b471..d0af13b07a 100644 --- a/LAPACKE/src/lapacke_cstein_work.c +++ b/LAPACKE/src/lapacke_cstein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstein_work( int matrix_layout, lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_cstein_work)( int matrix_layout, lapack_int n, const float* d, const float* e, lapack_int m, const float* w, const lapack_int* iblock, const lapack_int* isplit, @@ -54,7 +54,7 @@ lapack_int LAPACKE_cstein_work( int matrix_layout, lapack_int n, const float* d, /* Check leading dimension(s) */ if( ldz < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,16 +71,16 @@ lapack_int LAPACKE_cstein_work( int matrix_layout, lapack_int n, const float* d, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstemr.c b/LAPACKE/src/lapacke_cstemr.c index 304914526f..d3d8ff938c 100644 --- a/LAPACKE/src/lapacke_cstemr.c +++ b/LAPACKE/src/lapacke_cstemr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstemr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cstemr)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* m, float* w, lapack_complex_float* z, lapack_int ldz, @@ -47,28 +47,28 @@ lapack_int LAPACKE_cstemr( int matrix_layout, char jobz, char range, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cstemr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstemr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_cstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -88,7 +88,7 @@ lapack_int LAPACKE_cstemr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_cstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_cstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -97,7 +97,7 @@ lapack_int LAPACKE_cstemr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstemr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstemr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cstemr_work.c b/LAPACKE/src/lapacke_cstemr_work.c index 7327bfb159..0d54b540fd 100644 --- a/LAPACKE/src/lapacke_cstemr_work.c +++ b/LAPACKE/src/lapacke_cstemr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cstemr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_cstemr_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* m, float* w, @@ -55,9 +55,9 @@ lapack_int LAPACKE_cstemr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); lapack_complex_float* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) { + if( ldz < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ldz < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstemr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_cstemr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -85,20 +85,20 @@ lapack_int LAPACKE_cstemr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstemr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cstemr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csteqr.c b/LAPACKE/src/lapacke_csteqr.c index 457d70bf03..de2795981c 100644 --- a/LAPACKE/src/lapacke_csteqr.c +++ b/LAPACKE/src/lapacke_csteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csteqr( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_csteqr)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_csteqr( int matrix_layout, char compz, lapack_int n, float* d lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,2*n-2); @@ -72,12 +72,12 @@ lapack_int LAPACKE_csteqr( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_csteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csteqr_work.c b/LAPACKE/src/lapacke_csteqr_work.c index 7ccbfd7bb7..45f2000e6e 100644 --- a/LAPACKE/src/lapacke_csteqr_work.c +++ b/LAPACKE/src/lapacke_csteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csteqr_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, lapack_complex_float* z, lapack_int ldz, float* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_csteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_csteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); @@ -63,8 +63,8 @@ lapack_int LAPACKE_csteqr_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_csteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -72,20 +72,20 @@ lapack_int LAPACKE_csteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csycon.c b/LAPACKE/src/lapacke_csycon.c index 1472442ad3..39a61a321c 100644 --- a/LAPACKE/src/lapacke_csycon.c +++ b/LAPACKE/src/lapacke_csycon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csycon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csycon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csycon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_csycon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csycon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_csycon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csycon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csycon_3.c b/LAPACKE/src/lapacke_csycon_3.c index bb1ad9d10a..c72b818b0d 100644 --- a/LAPACKE/src/lapacke_csycon_3.c +++ b/LAPACKE/src/lapacke_csycon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csycon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csycon_3)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_complex_float* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csycon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -66,13 +66,13 @@ lapack_int LAPACKE_csycon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_csycon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csycon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csycon_3_work.c b/LAPACKE/src/lapacke_csycon_3_work.c index b00e8fd96f..73b5f181f9 100644 --- a/LAPACKE/src/lapacke_csycon_3_work.c +++ b/LAPACKE/src/lapacke_csycon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csycon_3_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, float anorm, @@ -51,7 +51,7 @@ lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csycon_work.c b/LAPACKE/src/lapacke_csycon_work.c index 3fa8a69399..d4edce7811 100644 --- a/LAPACKE/src/lapacke_csycon_work.c +++ b/LAPACKE/src/lapacke_csycon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csycon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csycon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csycon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_csycon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_csycon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csycon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyconv.c b/LAPACKE/src/lapacke_csyconv.c index b9df46e9e7..46e04daf42 100644 --- a/LAPACKE/src/lapacke_csyconv.c +++ b/LAPACKE/src/lapacke_csyconv.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyconv( int matrix_layout, char uplo, char way, lapack_int n, +lapack_int API_SUFFIX(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* e ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csyconv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyconv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - return LAPACKE_csyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, e ); + return API_SUFFIX(LAPACKE_csyconv_work)( matrix_layout, uplo, way, n, a, lda, ipiv, e ); } diff --git a/LAPACKE/src/lapacke_csyconv_work.c b/LAPACKE/src/lapacke_csyconv_work.c index be6da33396..c2210de409 100644 --- a/LAPACKE/src/lapacke_csyconv_work.c +++ b/LAPACKE/src/lapacke_csyconv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, +lapack_int API_SUFFIX(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* e ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyconv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_csyconv_work( int matrix_layout, char uplo, char way, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, e, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyconv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyconv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyequb.c b/LAPACKE/src/lapacke_csyequb.c index e1bb1621f6..5e4b730689 100644 --- a/LAPACKE/src/lapacke_csyequb.c +++ b/LAPACKE/src/lapacke_csyequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyequb)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csyequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_csyequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csyequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_csyequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyequb_work.c b/LAPACKE/src/lapacke_csyequb_work.c index 3469e11e00..d5055e63f1 100644 --- a/LAPACKE/src/lapacke_csyequb_work.c +++ b/LAPACKE/src/lapacke_csyequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyequb_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* s, float* scond, float* amax, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csyequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_csyequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_csyequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyr.c b/LAPACKE/src/lapacke_csyr.c index ea5da573f5..dec181b09f 100644 --- a/LAPACKE/src/lapacke_csyr.c +++ b/LAPACKE/src/lapacke_csyr.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyr)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float alpha, const lapack_complex_float* x, lapack_int incx, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csyr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, &alpha, 1 ) ) { return -4; } - if( LAPACKE_c_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, x, 1 ) ) { return -5; } } #endif - return LAPACKE_csyr_work( matrix_layout, uplo, n, alpha, x, incx, a, + return API_SUFFIX(LAPACKE_csyr_work)( matrix_layout, uplo, n, alpha, x, incx, a, lda ); } diff --git a/LAPACKE/src/lapacke_csyr_work.c b/LAPACKE/src/lapacke_csyr_work.c index 2769eaa3e7..a87fe6c79e 100644 --- a/LAPACKE/src/lapacke_csyr_work.c +++ b/LAPACKE/src/lapacke_csyr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float alpha, const lapack_complex_float* x, lapack_int incx, lapack_complex_float* a, @@ -51,7 +51,7 @@ lapack_int LAPACKE_csyr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,21 +62,21 @@ lapack_int LAPACKE_csyr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csyr( &uplo, &n, &alpha, x, &incx, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyrfs.c b/LAPACKE/src/lapacke_csyrfs.c index b8d8b8bdc5..132a1d3a36 100644 --- a/LAPACKE/src/lapacke_csyrfs.c +++ b/LAPACKE/src/lapacke_csyrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_csyrfs( int matrix_layout, char uplo, lapack_int n, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csyrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_csyrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_csyrfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_csyrfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_csyrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyrfs_work.c b/LAPACKE/src/lapacke_csyrfs_work.c index e22ce1c406..0540897a98 100644 --- a/LAPACKE/src/lapacke_csyrfs_work.c +++ b/LAPACKE/src/lapacke_csyrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_csyrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_csyrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_csy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_csyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_csyrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_csyrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyrfsx.c b/LAPACKE/src/lapacke_csyrfsx.c index 6ea79675a8..43572e9ad5 100644 --- a/LAPACKE/src/lapacke_csyrfsx.c +++ b/LAPACKE/src/lapacke_csyrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyrfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_csyrfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_csyrfsx( int matrix_layout, char uplo, char equed, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csyrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_csyrfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_csyrfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_csyrfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_csyrfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyrfsx_work.c b/LAPACKE/src/lapacke_csyrfsx_work.c index fa422849b8..068efe6b35 100644 --- a/LAPACKE/src/lapacke_csyrfsx_work.c +++ b/LAPACKE/src/lapacke_csyrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyrfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_csyrfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, @@ -69,22 +69,22 @@ lapack_int LAPACKE_csyrfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,10 +127,10 @@ lapack_int LAPACKE_csyrfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_csy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_csyrfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -140,10 +140,10 @@ lapack_int LAPACKE_csyrfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -159,11 +159,11 @@ lapack_int LAPACKE_csyrfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv.c b/LAPACKE/src/lapacke_csysv.c index 022271052a..c0930bcdcf 100644 --- a/LAPACKE/src/lapacke_csysv.c +++ b/LAPACKE/src/lapacke_csysv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_csysv( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_csysv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_aa.c b/LAPACKE/src/lapacke_csysv_aa.c index 53f0f90326..7541bf3350 100644 --- a/LAPACKE/src/lapacke_csysv_aa.c +++ b/LAPACKE/src/lapacke_csysv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_csysv_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_csysv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_aa_2stage.c b/LAPACKE/src/lapacke_csysv_aa_2stage.c index db154bd91c..ee08177ebf 100644 --- a/LAPACKE/src/lapacke_csysv_aa_2stage.c +++ b/LAPACKE/src/lapacke_csysv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_csysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_csysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -75,14 +75,14 @@ lapack_int LAPACKE_csysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_csysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_aa_2stage_work.c b/LAPACKE/src/lapacke_csysv_aa_2stage_work.c index 6180de7760..afddf1f9ac 100644 --- a/LAPACKE/src/lapacke_csysv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_csysv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_csysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_aa_work.c b/LAPACKE/src/lapacke_csysv_aa_work.c index 8abf0e0703..8a80354d14 100644 --- a/LAPACKE/src/lapacke_csysv_aa_work.c +++ b/LAPACKE/src/lapacke_csysv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_csysv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_rk.c b/LAPACKE/src/lapacke_csysv_rk.c index 9721074a15..707cb498c3 100644 --- a/LAPACKE/src/lapacke_csysv_rk.c +++ b/LAPACKE/src/lapacke_csysv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, @@ -43,22 +43,22 @@ lapack_int LAPACKE_csysv_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_csysv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_csysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_rk_work.c b/LAPACKE/src/lapacke_csysv_rk_work.c index 71facf581f..41ed262175 100644 --- a/LAPACKE/src/lapacke_csysv_rk_work.c +++ b/LAPACKE/src/lapacke_csysv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, @@ -55,12 +55,12 @@ lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_rook.c b/LAPACKE/src/lapacke_csysv_rook.c index 95dbd0d8c2..fe52fb455d 100644 --- a/LAPACKE/src/lapacke_csysv_rook.c +++ b/LAPACKE/src/lapacke_csysv_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_csysv_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_csysv_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_rook_work.c b/LAPACKE/src/lapacke_csysv_rook_work.c index b3feff5b51..99aa19b96d 100644 --- a/LAPACKE/src/lapacke_csysv_rook_work.c +++ b/LAPACKE/src/lapacke_csysv_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_csysv_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_csysv_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysv_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_csysv_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysv_work.c b/LAPACKE/src/lapacke_csysv_work.c index 291da4e712..d41435367d 100644 --- a/LAPACKE/src/lapacke_csysv_work.c +++ b/LAPACKE/src/lapacke_csysv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_csysv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_csysv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_csysv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysvx.c b/LAPACKE/src/lapacke_csysvx.c index a9e4f784d4..ada6cd4a63 100644 --- a/LAPACKE/src/lapacke_csysvx.c +++ b/LAPACKE/src/lapacke_csysvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csysvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, lapack_int* ipiv, @@ -46,21 +46,21 @@ lapack_int LAPACKE_csysvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -72,7 +72,7 @@ lapack_int LAPACKE_csysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_csysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_csysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_csysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_csysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_csysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_csysvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysvx_work.c b/LAPACKE/src/lapacke_csysvx_work.c index dfd4a16392..589673e515 100644 --- a/LAPACKE/src/lapacke_csysvx_work.c +++ b/LAPACKE/src/lapacke_csysvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_csysvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -63,22 +63,22 @@ lapack_int LAPACKE_csysvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -116,11 +116,11 @@ lapack_int LAPACKE_csysvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_csy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -129,11 +129,11 @@ lapack_int LAPACKE_csysvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -144,11 +144,11 @@ lapack_int LAPACKE_csysvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysvxx.c b/LAPACKE/src/lapacke_csysvxx.c index ae60885a4c..44ad8f3063 100644 --- a/LAPACKE/src/lapacke_csysvxx.c +++ b/LAPACKE/src/lapacke_csysvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_csysvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -48,30 +48,30 @@ lapack_int LAPACKE_csysvxx( int matrix_layout, char fact, char uplo, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csysvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -12; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_csysvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_csysvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_csysvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_csysvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csysvxx_work.c b/LAPACKE/src/lapacke_csysvxx_work.c index d2bcd301a4..6ccaf01c4b 100644 --- a/LAPACKE/src/lapacke_csysvxx_work.c +++ b/LAPACKE/src/lapacke_csysvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csysvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_csysvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_csysvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_csysvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_csy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csysvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -141,20 +141,20 @@ lapack_int LAPACKE_csysvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -170,11 +170,11 @@ lapack_int LAPACKE_csysvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csysvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csyswapr.c b/LAPACKE/src/lapacke_csyswapr.c index be412876bd..c048c2d13d 100644 --- a/LAPACKE/src/lapacke_csyswapr.c +++ b/LAPACKE/src/lapacke_csyswapr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_csyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_csyswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_csyswapr_work.c b/LAPACKE/src/lapacke_csyswapr_work.c index def8e235ac..7b95a68158 100644 --- a/LAPACKE/src/lapacke_csyswapr_work.c +++ b/LAPACKE/src/lapacke_csyswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csyswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csyswapr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -54,21 +54,21 @@ lapack_int LAPACKE_csyswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csyswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf.c b/LAPACKE/src/lapacke_csytrf.c index 9b1f6b5455..ab93ed3df3 100644 --- a/LAPACKE/src/lapacke_csytrf.c +++ b/LAPACKE/src/lapacke_csytrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_csytrf( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_csytrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_csytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_aa.c b/LAPACKE/src/lapacke_csytrf_aa.c index 7dafe090fe..e3cb5d8a98 100644 --- a/LAPACKE/src/lapacke_csytrf_aa.c +++ b/LAPACKE/src/lapacke_csytrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_aa)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_csytrf_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally csyck input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_csytrf_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_csytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_aa_2stage.c b/LAPACKE/src/lapacke_csytrf_aa_2stage.c index 8cad47aa9a..a57b6138c5 100644 --- a/LAPACKE/src/lapacke_csytrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_csytrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_csytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_csytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_csytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_csytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_aa_2stage_work.c b/LAPACKE/src/lapacke_csytrf_aa_2stage_work.c index 7139a2d156..0cdb400f8d 100644 --- a/LAPACKE/src/lapacke_csytrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_csytrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage_work", info ); return info; } @@ -82,7 +82,7 @@ lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -91,18 +91,18 @@ lapack_int LAPACKE_csytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_aa_work.c b/LAPACKE/src/lapacke_csytrf_aa_work.c index 1a25fcc482..60b1e8612c 100644 --- a/LAPACKE/src/lapacke_csytrf_aa_work.c +++ b/LAPACKE/src/lapacke_csytrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_csytrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_rk.c b/LAPACKE/src/lapacke_csytrf_rk.c index 5b21a0ad74..de844a5aad 100644 --- a/LAPACKE/src/lapacke_csytrf_rk.c +++ b/LAPACKE/src/lapacke_csytrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_rk)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_csytrf_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_csytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_csytrf_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_csytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_rk_work.c b/LAPACKE/src/lapacke_csytrf_rk_work.c index 740d917dcb..5683913308 100644 --- a/LAPACKE/src/lapacke_csytrf_rk_work.c +++ b/LAPACKE/src/lapacke_csytrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, lapack_complex_float* work, @@ -51,7 +51,7 @@ lapack_int LAPACKE_csytrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_csytrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_rook.c b/LAPACKE/src/lapacke_csytrf_rook.c index 0f76a80e9b..ef60086c82 100644 --- a/LAPACKE/src/lapacke_csytrf_rook.c +++ b/LAPACKE/src/lapacke_csytrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_rook)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_csytrf_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_csytrf_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_csytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_rook_work.c b/LAPACKE/src/lapacke_csytrf_rook_work.c index 0e927ae263..666b77e2bb 100644 --- a/LAPACKE/src/lapacke_csytrf_rook_work.c +++ b/LAPACKE/src/lapacke_csytrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_csytrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrf_work.c b/LAPACKE/src/lapacke_csytrf_work.c index 5ed9fae6cb..2590522a66 100644 --- a/LAPACKE/src/lapacke_csytrf_work.c +++ b/LAPACKE/src/lapacke_csytrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_csytrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri.c b/LAPACKE/src/lapacke_csytri.c index 14d37f6216..5a2316b3a7 100644 --- a/LAPACKE/src/lapacke_csytri.c +++ b/LAPACKE/src/lapacke_csytri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_csytri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_csytri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri2.c b/LAPACKE/src/lapacke_csytri2.c index c9fe76d5f8..77d75b0137 100644 --- a/LAPACKE/src/lapacke_csytri2.c +++ b/LAPACKE/src/lapacke_csytri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_csytri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_csytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_csytri2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_csytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri2_work.c b/LAPACKE/src/lapacke_csytri2_work.c index a1660758ff..5cb2c4f2dc 100644 --- a/LAPACKE/src/lapacke_csytri2_work.c +++ b/LAPACKE/src/lapacke_csytri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_csytri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri2x.c b/LAPACKE/src/lapacke_csytri2x.c index f47f6ca55e..646201864f 100644 --- a/LAPACKE/src/lapacke_csytri2x.c +++ b/LAPACKE/src/lapacke_csytri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri2x)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_csytri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_csytri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri2x_work.c b/LAPACKE/src/lapacke_csytri2x_work.c index 56b5e72021..42b384c994 100644 --- a/LAPACKE/src/lapacke_csytri2x_work.c +++ b/LAPACKE/src/lapacke_csytri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri2x_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_csytri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri_3.c b/LAPACKE/src/lapacke_csytri_3.c index a08dbda641..403e02c6cd 100644 --- a/LAPACKE/src/lapacke_csytri_3.c +++ b/LAPACKE/src/lapacke_csytri_3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri_3)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv ) { @@ -40,24 +40,24 @@ lapack_int LAPACKE_csytri_3( int matrix_layout, char uplo, lapack_int n, lapack_int lwork = -1; lapack_complex_float* work = NULL; lapack_complex_float work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_csytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,12 +71,12 @@ lapack_int LAPACKE_csytri_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_csytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri_3_work.c b/LAPACKE/src/lapacke_csytri_3_work.c index 5cf6448397..f5fd4073b0 100644 --- a/LAPACKE/src/lapacke_csytri_3_work.c +++ b/LAPACKE/src/lapacke_csytri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, lapack_complex_float* work, lapack_int lwork) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_csytri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytri_work.c b/LAPACKE/src/lapacke_csytri_work.c index 3fad4a5656..4ec782ae10 100644 --- a/LAPACKE/src/lapacke_csytri_work.c +++ b/LAPACKE/src/lapacke_csytri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_csytri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_csytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_csytri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_csytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs.c b/LAPACKE/src/lapacke_csytrs.c index 12356251d7..87fbd617dc 100644 --- a/LAPACKE/src/lapacke_csytrs.c +++ b/LAPACKE/src/lapacke_csytrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_csytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_csytrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_csytrs2.c b/LAPACKE/src/lapacke_csytrs2.c index b7312d0d72..e6d4c5fba4 100644 --- a/LAPACKE/src/lapacke_csytrs2.c +++ b/LAPACKE/src/lapacke_csytrs2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_csytrs2( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_csytrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csytrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs2_work.c b/LAPACKE/src/lapacke_csytrs2_work.c index e2c56fbecf..fc95fd35f9 100644 --- a/LAPACKE/src/lapacke_csytrs2_work.c +++ b/LAPACKE/src/lapacke_csytrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -53,12 +53,12 @@ lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_3.c b/LAPACKE/src/lapacke_csytrs_3.c index 628eb2617f..35a355c146 100644 --- a/LAPACKE/src/lapacke_csytrs_3.c +++ b/LAPACKE/src/lapacke_csytrs_3.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_csytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_csytrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_csytrs_3_work.c b/LAPACKE/src/lapacke_csytrs_3_work.c index 5183ea6374..7d638470fe 100644 --- a/LAPACKE/src/lapacke_csytrs_3_work.c +++ b/LAPACKE/src/lapacke_csytrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* e, const lapack_int* ipiv, @@ -53,12 +53,12 @@ lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_aa.c b/LAPACKE/src/lapacke_csytrs_aa.c index fc71b4a3bc..bedb54935d 100644 --- a/LAPACKE/src/lapacke_csytrs_aa.c +++ b/LAPACKE/src/lapacke_csytrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_csytrs_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally csyck input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_csytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_csytrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_csytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_csytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_aa_2stage.c b/LAPACKE/src/lapacke_csytrs_aa_2stage.c index 1396d0b500..97fd3a8daa 100644 --- a/LAPACKE/src/lapacke_csytrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_csytrs_aa_2stage.c @@ -32,32 +32,32 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_csytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_csytrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb ); diff --git a/LAPACKE/src/lapacke_csytrs_aa_2stage_work.c b/LAPACKE/src/lapacke_csytrs_aa_2stage_work.c index f144e470c7..8d3ba5317f 100644 --- a/LAPACKE/src/lapacke_csytrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_csytrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_float* b, lapack_int ldb ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_csy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_csytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_aa_work.c b/LAPACKE/src/lapacke_csytrs_aa_work.c index 1be7791b24..d748c9bfe1 100644 --- a/LAPACKE/src/lapacke_csytrs_aa_work.c +++ b/LAPACKE/src/lapacke_csytrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, @@ -53,12 +53,12 @@ lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_csytrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_rook.c b/LAPACKE/src/lapacke_csytrs_rook.c index a22bc29eaf..6d5f2e4210 100644 --- a/LAPACKE/src/lapacke_csytrs_rook.c +++ b/LAPACKE/src/lapacke_csytrs_rook.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_csy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_csytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_csytrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_csytrs_rook_work.c b/LAPACKE/src/lapacke_csytrs_rook_work.c index 9683fd46d2..065fb40584 100644 --- a/LAPACKE/src/lapacke_csytrs_rook_work.c +++ b/LAPACKE/src/lapacke_csytrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_csytrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_csytrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_csytrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_csytrs_work.c b/LAPACKE/src/lapacke_csytrs_work.c index c7403bb5ec..5ff07a631e 100644 --- a/LAPACKE/src/lapacke_csytrs_work.c +++ b/LAPACKE/src/lapacke_csytrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_csytrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_csytrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_csytrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_csytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_csytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_csytrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_csy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_csytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_csytrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_csytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_csytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_csytrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctbcon.c b/LAPACKE/src/lapacke_ctbcon.c index 35fc065d69..002517046e 100644 --- a/LAPACKE/src/lapacke_ctbcon.c +++ b/LAPACKE/src/lapacke_ctbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctbcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float* rcond ) @@ -41,13 +41,13 @@ lapack_int LAPACKE_ctbcon( int matrix_layout, char norm, char uplo, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ctb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -7; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_ctbcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctbcon_work( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, + info = API_SUFFIX(LAPACKE_ctbcon_work)( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_ctbcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctbcon_work.c b/LAPACKE/src/lapacke_ctbcon_work.c index 0ffc705a32..f6a1305549 100644 --- a/LAPACKE/src/lapacke_ctbcon_work.c +++ b/LAPACKE/src/lapacke_ctbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctbcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab, float* rcond, lapack_complex_float* work, @@ -52,7 +52,7 @@ lapack_int LAPACKE_ctbcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_ctbcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ctb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ctbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work, @@ -75,11 +75,11 @@ lapack_int LAPACKE_ctbcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctbrfs.c b/LAPACKE/src/lapacke_ctbrfs.c index 62228ace9d..58a9afac5d 100644 --- a/LAPACKE/src/lapacke_ctbrfs.c +++ b/LAPACKE/src/lapacke_ctbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctbrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ctbrfs( int matrix_layout, char uplo, char trans, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ctb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ctbrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctbrfs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + info = API_SUFFIX(LAPACKE_ctbrfs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_ctbrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctbrfs_work.c b/LAPACKE/src/lapacke_ctbrfs_work.c index 18ac02dc20..f92708aceb 100644 --- a/LAPACKE/src/lapacke_ctbrfs_work.c +++ b/LAPACKE/src/lapacke_ctbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctbrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, const lapack_complex_float* b, @@ -58,17 +58,17 @@ lapack_int LAPACKE_ctbrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -93,10 +93,10 @@ lapack_int LAPACKE_ctbrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ctb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ctb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ctbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -111,11 +111,11 @@ lapack_int LAPACKE_ctbrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctbtrs.c b/LAPACKE/src/lapacke_ctbtrs.c index 0b617f2931..4f509ae042 100644 --- a/LAPACKE/src/lapacke_ctbtrs.c +++ b/LAPACKE/src/lapacke_ctbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctbtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ctb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_ctbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + return API_SUFFIX(LAPACKE_ctbtrs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ctbtrs_work.c b/LAPACKE/src/lapacke_ctbtrs_work.c index a4ab5cab78..3b0e15e2b9 100644 --- a/LAPACKE/src/lapacke_ctbtrs_work.c +++ b/LAPACKE/src/lapacke_ctbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctbtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctbtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* b, @@ -54,12 +54,12 @@ lapack_int LAPACKE_ctbtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,9 +77,9 @@ lapack_int LAPACKE_ctbtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ctb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ctb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -87,18 +87,18 @@ lapack_int LAPACKE_ctbtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctfsm.c b/LAPACKE/src/lapacke_ctfsm.c index 40330fb33c..ab9d8d1b02 100644 --- a/LAPACKE/src/lapacke_ctfsm.c +++ b/LAPACKE/src/lapacke_ctfsm.c @@ -32,34 +32,34 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfsm( int matrix_layout, char transr, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, lapack_complex_float alpha, const lapack_complex_float* a, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctfsm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( IS_C_NONZERO(alpha) ) { - if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -10; } } - if( LAPACKE_c_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( 1, &alpha, 1 ) ) { return -9; } if( IS_C_NONZERO(alpha) ) { - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -11; } } } #endif - return LAPACKE_ctfsm_work( matrix_layout, transr, side, uplo, trans, diag, m, + return API_SUFFIX(LAPACKE_ctfsm_work)( matrix_layout, transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ctfsm_work.c b/LAPACKE/src/lapacke_ctfsm_work.c index 7ea6ec8cc0..98bc661d55 100644 --- a/LAPACKE/src/lapacke_ctfsm_work.c +++ b/LAPACKE/src/lapacke_ctfsm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfsm_work( int matrix_layout, char transr, char side, +lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, lapack_complex_float alpha, const lapack_complex_float* a, @@ -53,7 +53,7 @@ lapack_int LAPACKE_ctfsm_work( int matrix_layout, char transr, char side, /* Check leading dimension(s) */ if( ldb < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,17 +74,17 @@ lapack_int LAPACKE_ctfsm_work( int matrix_layout, char transr, char side, } /* Transpose input matrices */ if( IS_C_NONZERO(alpha) ) { - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_C_NONZERO(alpha) ) { - LAPACKE_ctf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_C_NONZERO(alpha) ) { LAPACKE_free( a_t ); @@ -93,11 +93,11 @@ lapack_int LAPACKE_ctfsm_work( int matrix_layout, char transr, char side, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctftri.c b/LAPACKE/src/lapacke_ctftri.c index 5916f9e05e..096fe72c24 100644 --- a/LAPACKE/src/lapacke_ctftri.c +++ b/LAPACKE/src/lapacke_ctftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctftri( int matrix_layout, char transr, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctftri)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, lapack_complex_float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -6; } } #endif - return LAPACKE_ctftri_work( matrix_layout, transr, uplo, diag, n, a ); + return API_SUFFIX(LAPACKE_ctftri_work)( matrix_layout, transr, uplo, diag, n, a ); } diff --git a/LAPACKE/src/lapacke_ctftri_work.c b/LAPACKE/src/lapacke_ctftri_work.c index fe135147f0..d9fb46c3ad 100644 --- a/LAPACKE/src/lapacke_ctftri_work.c +++ b/LAPACKE/src/lapacke_ctftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctftri_work)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, lapack_complex_float* a ) { @@ -54,23 +54,23 @@ lapack_int LAPACKE_ctftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_ctftri( &transr, &uplo, &diag, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ctf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); + API_SUFFIX(LAPACKE_ctf_trans)( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctfttp.c b/LAPACKE/src/lapacke_ctfttp.c index 6648c407c7..f26e653ea5 100644 --- a/LAPACKE/src/lapacke_ctfttp.c +++ b/LAPACKE/src/lapacke_ctfttp.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfttp( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctfttp)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* arf, lapack_complex_float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctfttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_ctfttp_work( matrix_layout, transr, uplo, n, arf, ap ); + return API_SUFFIX(LAPACKE_ctfttp_work)( matrix_layout, transr, uplo, n, arf, ap ); } diff --git a/LAPACKE/src/lapacke_ctfttp_work.c b/LAPACKE/src/lapacke_ctfttp_work.c index df022e409d..119be15bfd 100644 --- a/LAPACKE/src/lapacke_ctfttp_work.c +++ b/LAPACKE/src/lapacke_ctfttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfttp_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctfttp_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* arf, lapack_complex_float* ap ) { @@ -62,25 +62,25 @@ lapack_int LAPACKE_ctfttp_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_ctfttp( &transr, &uplo, &n, arf_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctfttr.c b/LAPACKE/src/lapacke_ctfttr.c index c230cf3da2..86460dd543 100644 --- a/LAPACKE/src/lapacke_ctfttr.c +++ b/LAPACKE/src/lapacke_ctfttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfttr( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctfttr)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* arf, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctfttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_cpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_ctfttr_work( matrix_layout, transr, uplo, n, arf, a, lda ); + return API_SUFFIX(LAPACKE_ctfttr_work)( matrix_layout, transr, uplo, n, arf, a, lda ); } diff --git a/LAPACKE/src/lapacke_ctfttr_work.c b/LAPACKE/src/lapacke_ctfttr_work.c index d0ac11a674..3e83a5ba09 100644 --- a/LAPACKE/src/lapacke_ctfttr_work.c +++ b/LAPACKE/src/lapacke_ctfttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctfttr_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctfttr_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* arf, lapack_complex_float* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ctfttr_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ctfttr_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_cpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_ctfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgevc.c b/LAPACKE/src/lapacke_ctgevc.c index 33ea8b4690..15fc954534 100644 --- a/LAPACKE/src/lapacke_ctgevc.c +++ b/LAPACKE/src/lapacke_ctgevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctgevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* s, lapack_int lds, const lapack_complex_float* p, lapack_int ldp, @@ -44,25 +44,25 @@ lapack_int LAPACKE_ctgevc( int matrix_layout, char side, char howmny, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, p, ldp ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, p, ldp ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, s, lds ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_ctgevc( int matrix_layout, char side, char howmny, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctgevc_work( matrix_layout, side, howmny, select, n, s, lds, + info = API_SUFFIX(LAPACKE_ctgevc_work)( matrix_layout, side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_ctgevc( int matrix_layout, char side, char howmny, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgevc_work.c b/LAPACKE/src/lapacke_ctgevc_work.c index 3e3de5df0b..72d2b1b661 100644 --- a/LAPACKE/src/lapacke_ctgevc_work.c +++ b/LAPACKE/src/lapacke_ctgevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctgevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* s, lapack_int lds, const lapack_complex_float* p, lapack_int ldp, @@ -61,22 +61,22 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldp < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); return info; } if( lds < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,mm) ); @@ -101,7 +101,7 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,mm) ); @@ -111,15 +111,15 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, s, lds, s_t, lds_t ); - LAPACKE_cge_trans( matrix_layout, n, n, p, ldp, p_t, ldp_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, p, ldp, p_t, ldp_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t, @@ -129,20 +129,20 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -151,11 +151,11 @@ lapack_int LAPACKE_ctgevc_work( int matrix_layout, char side, char howmny, LAPACKE_free( s_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgexc.c b/LAPACKE/src/lapacke_ctgexc.c index f6f56e457d..70da96c4b1 100644 --- a/LAPACKE/src/lapacke_ctgexc.c +++ b/LAPACKE/src/lapacke_ctgexc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgexc( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_ctgexc)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -41,30 +41,30 @@ lapack_int LAPACKE_ctgexc( int matrix_layout, lapack_logical wantq, lapack_int ifst, lapack_int ilst ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } if( wantq ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -9; } } if( wantz ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif - return LAPACKE_ctgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + return API_SUFFIX(LAPACKE_ctgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst ); } diff --git a/LAPACKE/src/lapacke_ctgexc_work.c b/LAPACKE/src/lapacke_ctgexc_work.c index 1b7e5ed113..6f4355c365 100644 --- a/LAPACKE/src/lapacke_ctgexc_work.c +++ b/LAPACKE/src/lapacke_ctgexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgexc_work( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_ctgexc_work)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -60,22 +60,22 @@ lapack_int LAPACKE_ctgexc_work( int matrix_layout, lapack_logical wantq, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,13 +110,13 @@ lapack_int LAPACKE_ctgexc_work( int matrix_layout, lapack_logical wantq, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t, @@ -125,13 +125,13 @@ lapack_int LAPACKE_ctgexc_work( int matrix_layout, lapack_logical wantq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -147,11 +147,11 @@ lapack_int LAPACKE_ctgexc_work( int matrix_layout, lapack_logical wantq, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsen.c b/LAPACKE/src/lapacke_ctgsen.c index b69c08bb44..65438835b7 100644 --- a/LAPACKE/src/lapacke_ctgsen.c +++ b/LAPACKE/src/lapacke_ctgsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsen( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ctgsen)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, lapack_complex_float* a, lapack_int lda, @@ -51,32 +51,32 @@ lapack_int LAPACKE_ctgsen( int matrix_layout, lapack_int ijob, lapack_int iwork_query; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } if( wantq ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -13; } } if( wantz ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -15; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ctgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_ctgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, q, ldq, z, ldz, m, pl, pr, dif, &work_query, lwork, &iwork_query, liwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_ctgsen( int matrix_layout, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_ctgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -107,7 +107,7 @@ lapack_int LAPACKE_ctgsen( int matrix_layout, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsen_work.c b/LAPACKE/src/lapacke_ctgsen_work.c index 2bf21a8f03..6eaa4c9ef2 100644 --- a/LAPACKE/src/lapacke_ctgsen_work.c +++ b/LAPACKE/src/lapacke_ctgsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsen_work( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ctgsen_work)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, lapack_complex_float* a, lapack_int lda, @@ -66,22 +66,22 @@ lapack_int LAPACKE_ctgsen_work( int matrix_layout, lapack_int ijob, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); return info; } if( ldq < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -123,13 +123,13 @@ lapack_int LAPACKE_ctgsen_work( int matrix_layout, lapack_int ijob, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t, @@ -139,13 +139,13 @@ lapack_int LAPACKE_ctgsen_work( int matrix_layout, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -161,11 +161,11 @@ lapack_int LAPACKE_ctgsen_work( int matrix_layout, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsja.c b/LAPACKE/src/lapacke_ctgsja.c index f864b37bf6..4d81a186fb 100644 --- a/LAPACKE/src/lapacke_ctgsja.c +++ b/LAPACKE/src/lapacke_ctgsja.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsja( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_ctgsja)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, @@ -45,36 +45,36 @@ lapack_int LAPACKE_ctgsja( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgsja", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -22; } } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -14; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -15; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, m, m, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, m, u, ldu ) ) { return -18; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, p, p, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, p, p, v, ldv ) ) { return -20; } } @@ -88,14 +88,14 @@ lapack_int LAPACKE_ctgsja( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctgsja_work( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, + info = API_SUFFIX(LAPACKE_ctgsja_work)( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq, work, ncycle ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsja", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsja_work.c b/LAPACKE/src/lapacke_ctgsja_work.c index 3cfa3ec528..66b1d11a25 100644 --- a/LAPACKE/src/lapacke_ctgsja_work.c +++ b/LAPACKE/src/lapacke_ctgsja_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_ctgsja_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, lapack_complex_float* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); return info; } if( ldq < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); return info; } if( ldu < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); return info; } if( ldv < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,m) ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,p) ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -131,16 +131,16 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( matrix_layout, m, m, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, m, u, ldu, u_t, ldu_t ); } - if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, p, p, v, ldv, v_t, ldv_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, p, p, v, ldv, v_t, ldv_t ); } - if( LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t, @@ -150,27 +150,27 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -179,11 +179,11 @@ lapack_int LAPACKE_ctgsja_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsja_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsna.c b/LAPACKE/src/lapacke_ctgsna.c index 358836a8a5..269709aa49 100644 --- a/LAPACKE/src/lapacke_ctgsna.c +++ b/LAPACKE/src/lapacke_ctgsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctgsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -46,32 +46,32 @@ lapack_int LAPACKE_ctgsna( int matrix_layout, char job, char howmny, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -79,7 +79,7 @@ lapack_int LAPACKE_ctgsna( int matrix_layout, char job, char howmny, } } /* Query optimal working array(s) size */ - info = LAPACKE_ctgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ctgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, &work_query, lwork, iwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_ctgsna( int matrix_layout, char job, char howmny, } lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( work == NULL ) { @@ -96,20 +96,20 @@ lapack_int LAPACKE_ctgsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_ctgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ctgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsna_work.c b/LAPACKE/src/lapacke_ctgsna_work.c index 7728527f93..2596b6e40a 100644 --- a/LAPACKE/src/lapacke_ctgsna_work.c +++ b/LAPACKE/src/lapacke_ctgsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctgsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -62,22 +62,22 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,mm) ); @@ -109,7 +109,7 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,mm) ); @@ -119,13 +119,13 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t, @@ -135,11 +135,11 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -148,11 +148,11 @@ lapack_int LAPACKE_ctgsna_work( int matrix_layout, char job, char howmny, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsyl.c b/LAPACKE/src/lapacke_ctgsyl.c index 3ead5ed916..36304b8387 100644 --- a/LAPACKE/src/lapacke_ctgsyl.c +++ b/LAPACKE/src/lapacke_ctgsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsyl( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ctgsyl)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -48,28 +48,28 @@ lapack_int LAPACKE_ctgsyl( int matrix_layout, char trans, lapack_int ijob, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctgsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_cge_nancheck( matrix_layout, m, m, d, ldd ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, m, d, ldd ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, e, lde ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, e, lde ) ) { return -14; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -16; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_ctgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ctgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_ctgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, &work_query, lwork, iwork ); if( info != 0 ) { @@ -96,7 +96,7 @@ lapack_int LAPACKE_ctgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_ctgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork ); /* Release memory and exit */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_ctgsyl( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsyl", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctgsyl_work.c b/LAPACKE/src/lapacke_ctgsyl_work.c index 1d0b0126ad..5fe3c8fdce 100644 --- a/LAPACKE/src/lapacke_ctgsyl_work.c +++ b/LAPACKE/src/lapacke_ctgsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctgsyl_work( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ctgsyl_work)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -69,32 +69,32 @@ lapack_int LAPACKE_ctgsyl_work( int matrix_layout, char trans, lapack_int ijob, /* Check leading dimension(s) */ if( lda < m ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } if( ldd < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } if( lde < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } if( ldf < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -142,12 +142,12 @@ lapack_int LAPACKE_ctgsyl_work( int matrix_layout, char trans, lapack_int ijob, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_cge_trans( matrix_layout, m, m, d, ldd, d_t, ldd_t ); - LAPACKE_cge_trans( matrix_layout, n, n, e, lde, e_t, lde_t ); - LAPACKE_cge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, m, d, ldd, d_t, ldd_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, e, lde, e_t, lde_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); /* Call LAPACK function and adjust info */ LAPACK_ctgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale, @@ -156,8 +156,8 @@ lapack_int LAPACKE_ctgsyl_work( int matrix_layout, char trans, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); /* Release memory and exit */ LAPACKE_free( f_t ); exit_level_5: @@ -172,11 +172,11 @@ lapack_int LAPACKE_ctgsyl_work( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctgsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpcon.c b/LAPACKE/src/lapacke_ctpcon.c index 9a688e2ea3..e9fa3b3bed 100644 --- a/LAPACKE/src/lapacke_ctpcon.c +++ b/LAPACKE/src/lapacke_ctpcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctpcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_float* ap, float* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_ctpcon( int matrix_layout, char norm, char uplo, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ctp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -6; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_ctpcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctpcon_work( matrix_layout, norm, uplo, diag, n, ap, rcond, + info = API_SUFFIX(LAPACKE_ctpcon_work)( matrix_layout, norm, uplo, diag, n, ap, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_ctpcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpcon_work.c b/LAPACKE/src/lapacke_ctpcon_work.c index e57bcc1987..1c5bc4b554 100644 --- a/LAPACKE/src/lapacke_ctpcon_work.c +++ b/LAPACKE/src/lapacke_ctpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctpcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_float* ap, float* rcond, lapack_complex_float* work, float* rwork ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_ctpcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, rwork, &info ); @@ -66,11 +66,11 @@ lapack_int LAPACKE_ctpcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpmqrt.c b/LAPACKE/src/lapacke_ctpmqrt.c index 78ccd85705..9d71ecc5e8 100644 --- a/LAPACKE/src/lapacke_ctpmqrt.c +++ b/LAPACKE/src/lapacke_ctpmqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpmqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_ctpmqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const lapack_complex_float* v, lapack_int ldv, @@ -46,35 +46,35 @@ lapack_int LAPACKE_ctpmqrt( int matrix_layout, char side, char trans, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpmqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - 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 ) ) { + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0 ); + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0 ); + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_cge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : - ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); + lwork = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); if( work == NULL ) { @@ -82,13 +82,13 @@ lapack_int LAPACKE_ctpmqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctpmqrt_work( matrix_layout, side, trans, m, n, k, l, nb, v, + info = API_SUFFIX(LAPACKE_ctpmqrt_work)( matrix_layout, side, trans, m, n, k, l, nb, v, ldv, t, ldt, a, lda, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpmqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpmqrt_work.c b/LAPACKE/src/lapacke_ctpmqrt_work.c index e01664bdf8..e625410b3b 100644 --- a/LAPACKE/src/lapacke_ctpmqrt_work.c +++ b/LAPACKE/src/lapacke_ctpmqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_ctpmqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const lapack_complex_float* v, lapack_int ldv, @@ -51,11 +51,11 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); return info; } lapack_int lda_t = MAX(1,nrowsA); @@ -69,22 +69,22 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < ncolsA ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); return info; } if( ldb < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); return info; } if( ldv < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -113,10 +113,10 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info ); @@ -124,8 +124,8 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -136,11 +136,11 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpqrt.c b/LAPACKE/src/lapacke_ctpqrt.c index 3c22910185..ecbc2ef68c 100644 --- a/LAPACKE/src/lapacke_ctpqrt.c +++ b/LAPACKE/src/lapacke_ctpqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctpqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -41,16 +41,16 @@ lapack_int LAPACKE_ctpqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -9; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_ctpqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctpqrt_work( matrix_layout, m, n, l, nb, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_ctpqrt_work)( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpqrt2.c b/LAPACKE/src/lapacke_ctpqrt2.c index c1ce56e6eb..da50eea76d 100644 --- a/LAPACKE/src/lapacke_ctpqrt2.c +++ b/LAPACKE/src/lapacke_ctpqrt2.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt2( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_ctpqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } #endif - return LAPACKE_ctpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); + return API_SUFFIX(LAPACKE_ctpqrt2_work)( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/LAPACKE/src/lapacke_ctpqrt2_work.c b/LAPACKE/src/lapacke_ctpqrt2_work.c index cb5c7831d9..3e418991aa 100644 --- a/LAPACKE/src/lapacke_ctpqrt2_work.c +++ b/LAPACKE/src/lapacke_ctpqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt2_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_ctpqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -55,17 +55,17 @@ lapack_int LAPACKE_ctpqrt2_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ctpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2_work", info ); return info; } if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,17 +88,17 @@ lapack_int LAPACKE_ctpqrt2_work( int matrix_layout, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -107,11 +107,11 @@ lapack_int LAPACKE_ctpqrt2_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpqrt_work.c b/LAPACKE/src/lapacke_ctpqrt_work.c index 4ac84f3d50..010a22811c 100644 --- a/LAPACKE/src/lapacke_ctpqrt_work.c +++ b/LAPACKE/src/lapacke_ctpqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctpqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,8 +90,8 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, work, &info ); @@ -99,9 +99,9 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -110,11 +110,11 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctprfb.c b/LAPACKE/src/lapacke_ctprfb.c index d82d269a4c..a8bd37b9d6 100644 --- a/LAPACKE/src/lapacke_ctprfb.c +++ b/LAPACKE/src/lapacke_ctprfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_ctprfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_float* v, lapack_int ldv, @@ -46,7 +46,7 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct lapack_int work_size; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctprfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -61,32 +61,32 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct * or m-by-k (right) * B is m-by-n */ - if( LAPACKE_lsame( storev, 'C' ) ) { + if( API_SUFFIX(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 = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; + } else if( API_SUFFIX(LAPACKE_lsame)( storev, 'R' ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - nrows_a = LAPACKE_lsame( side, 'L' ) ? k : - LAPACKE_lsame( side, 'R' ) ? m : 0; - ncols_a = LAPACKE_lsame( side, 'L' ) ? n : - LAPACKE_lsame( side, 'R' ) ? k : 0; - if( LAPACKE_cge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0; + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } } @@ -107,14 +107,14 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctprfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_ctprfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, a, lda, b, ldb, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctprfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctprfb_work.c b/LAPACKE/src/lapacke_ctprfb_work.c index 8406c1a877..4ccf11ac98 100644 --- a/LAPACKE/src/lapacke_ctprfb_work.c +++ b/LAPACKE/src/lapacke_ctprfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(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, const lapack_complex_float* v, lapack_int ldv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -15; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); return info; } if( ldb < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); return info; } if( ldt < k ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); return info; } if( ldv < k ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -105,18 +105,18 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_cge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); - LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -127,11 +127,11 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctprfs.c b/LAPACKE/src/lapacke_ctprfs.c index 4d7093eae7..64d99a2114 100644 --- a/LAPACKE/src/lapacke_ctprfs.c +++ b/LAPACKE/src/lapacke_ctprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctprfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctprfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ctprfs( int matrix_layout, char uplo, char trans, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ctp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ctprfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctprfs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + info = API_SUFFIX(LAPACKE_ctprfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_ctprfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctprfs_work.c b/LAPACKE/src/lapacke_ctprfs_work.c index 8ee69bee07..45a6d02092 100644 --- a/LAPACKE/src/lapacke_ctprfs_work.c +++ b/LAPACKE/src/lapacke_ctprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctprfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctprfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* b, lapack_int ldb, @@ -57,12 +57,12 @@ lapack_int LAPACKE_ctprfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,9 +88,9 @@ lapack_int LAPACKE_ctprfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_ctp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -105,11 +105,11 @@ lapack_int LAPACKE_ctprfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctptri.c b/LAPACKE/src/lapacke_ctptri.c index ae6b319195..e7bcdaf296 100644 --- a/LAPACKE/src/lapacke_ctptri.c +++ b/LAPACKE/src/lapacke_ctptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctptri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctptri)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ctp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -5; } } #endif - return LAPACKE_ctptri_work( matrix_layout, uplo, diag, n, ap ); + return API_SUFFIX(LAPACKE_ctptri_work)( matrix_layout, uplo, diag, n, ap ); } diff --git a/LAPACKE/src/lapacke_ctptri_work.c b/LAPACKE/src/lapacke_ctptri_work.c index 583550ceb1..ff15ce0e2b 100644 --- a/LAPACKE/src/lapacke_ctptri_work.c +++ b/LAPACKE/src/lapacke_ctptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctptri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctptri_work)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_float* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_ctptri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctptri( &uplo, &diag, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ctp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ctp_trans)( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctptrs.c b/LAPACKE/src/lapacke_ctptrs.c index b9cc0ff364..daa3b10b47 100644 --- a/LAPACKE/src/lapacke_ctptrs.c +++ b/LAPACKE/src/lapacke_ctptrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctptrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctptrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ctp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_ctptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + return API_SUFFIX(LAPACKE_ctptrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ctptrs_work.c b/LAPACKE/src/lapacke_ctptrs_work.c index 2b6de32218..8a0af2befb 100644 --- a/LAPACKE/src/lapacke_ctptrs_work.c +++ b/LAPACKE/src/lapacke_ctptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctptrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctptrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, lapack_complex_float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ctptrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,8 +70,8 @@ lapack_int LAPACKE_ctptrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_ctp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); @@ -79,18 +79,18 @@ lapack_int LAPACKE_ctptrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpttf.c b/LAPACKE/src/lapacke_ctpttf.c index 5683ca4984..6d668e9654 100644 --- a/LAPACKE/src/lapacke_ctpttf.c +++ b/LAPACKE/src/lapacke_ctpttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctpttf)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* ap, lapack_complex_float* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -5; } } #endif - return LAPACKE_ctpttf_work( matrix_layout, transr, uplo, n, ap, arf ); + return API_SUFFIX(LAPACKE_ctpttf_work)( matrix_layout, transr, uplo, n, ap, arf ); } diff --git a/LAPACKE/src/lapacke_ctpttf_work.c b/LAPACKE/src/lapacke_ctpttf_work.c index e34eb02406..5985a680d0 100644 --- a/LAPACKE/src/lapacke_ctpttf_work.c +++ b/LAPACKE/src/lapacke_ctpttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctpttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* ap, lapack_complex_float* arf ) { @@ -62,25 +62,25 @@ lapack_int LAPACKE_ctpttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpttf( &transr, &uplo, &n, ap_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_cpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctpttr.c b/LAPACKE/src/lapacke_ctpttr.c index 8c0445b015..a9928ac822 100644 --- a/LAPACKE/src/lapacke_ctpttr.c +++ b/LAPACKE/src/lapacke_ctpttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpttr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctpttr)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctpttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_ctpttr_work( matrix_layout, uplo, n, ap, a, lda ); + return API_SUFFIX(LAPACKE_ctpttr_work)( matrix_layout, uplo, n, ap, a, lda ); } diff --git a/LAPACKE/src/lapacke_ctpttr_work.c b/LAPACKE/src/lapacke_ctpttr_work.c index 49c6863d70..fcfc5b46f5 100644 --- a/LAPACKE/src/lapacke_ctpttr_work.c +++ b/LAPACKE/src/lapacke_ctpttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpttr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctpttr_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, lapack_complex_float* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ctpttr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ctpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ctpttr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ctpttr( &uplo, &n, ap_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrcon.c b/LAPACKE/src/lapacke_ctrcon.c index e9ace28444..75d30f37f2 100644 --- a/LAPACKE/src/lapacke_ctrcon.c +++ b/LAPACKE/src/lapacke_ctrcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctrcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_ctrcon( int matrix_layout, char norm, char uplo, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -6; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_ctrcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctrcon_work( matrix_layout, norm, uplo, diag, n, a, lda, + info = API_SUFFIX(LAPACKE_ctrcon_work)( matrix_layout, norm, uplo, diag, n, a, lda, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_ctrcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrcon_work.c b/LAPACKE/src/lapacke_ctrcon_work.c index 8e03dfc4a4..ae1a0538fa 100644 --- a/LAPACKE/src/lapacke_ctrcon_work.c +++ b/LAPACKE/src/lapacke_ctrcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctrcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_float* a, lapack_int lda, float* rcond, lapack_complex_float* work, @@ -52,7 +52,7 @@ lapack_int LAPACKE_ctrcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_ctrcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, rwork, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_ctrcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrevc.c b/LAPACKE/src/lapacke_ctrevc.c index af53062eac..0308d8e9bc 100644 --- a/LAPACKE/src/lapacke_ctrevc.c +++ b/LAPACKE/src/lapacke_ctrevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctrevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* vl, lapack_int ldvl, @@ -43,22 +43,22 @@ lapack_int LAPACKE_ctrevc( int matrix_layout, char side, char howmny, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_ctrevc( int matrix_layout, char side, char howmny, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctrevc_work( matrix_layout, side, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_ctrevc_work)( matrix_layout, side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_ctrevc( int matrix_layout, char side, char howmny, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrevc_work.c b/LAPACKE/src/lapacke_ctrevc_work.c index af4b366d9e..3cdb9eedde 100644 --- a/LAPACKE/src/lapacke_ctrevc_work.c +++ b/LAPACKE/src/lapacke_ctrevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctrevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* vl, lapack_int ldvl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,7 +78,7 @@ lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,mm) ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,mm) ); @@ -97,14 +97,14 @@ lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctrevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -113,32 +113,32 @@ lapack_int LAPACKE_ctrevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrexc.c b/LAPACKE/src/lapacke_ctrexc.c index dc003c8430..d69cfdacbf 100644 --- a/LAPACKE/src/lapacke_ctrexc.c +++ b/LAPACKE/src/lapacke_ctrexc.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrexc( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctrexc)( int matrix_layout, char compq, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* q, lapack_int ldq, lapack_int ifst, lapack_int ilst ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -6; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -4; } } #endif - return LAPACKE_ctrexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst, + return API_SUFFIX(LAPACKE_ctrexc_work)( matrix_layout, compq, n, t, ldt, q, ldq, ifst, ilst ); } diff --git a/LAPACKE/src/lapacke_ctrexc_work.c b/LAPACKE/src/lapacke_ctrexc_work.c index 9f301b52a0..af057a9584 100644 --- a/LAPACKE/src/lapacke_ctrexc_work.c +++ b/LAPACKE/src/lapacke_ctrexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrexc_work( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctrexc_work)( int matrix_layout, char compq, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* q, lapack_int ldq, lapack_int ifst, lapack_int ilst ) @@ -50,14 +50,14 @@ lapack_int LAPACKE_ctrexc_work( int matrix_layout, char compq, lapack_int n, lapack_complex_float* t_t = NULL; lapack_complex_float* q_t = NULL; /* Check leading dimension(s) */ - if( ldq < n && LAPACKE_lsame( compq, 'v' ) ) { + if( ldq < n && API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrexc_work", info ); return info; } if( ldt < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ctrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ctrexc_work( int matrix_layout, char compq, lapack_int n, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -77,9 +77,9 @@ lapack_int LAPACKE_ctrexc_work( int matrix_layout, char compq, lapack_int n, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, &ifst, &ilst, @@ -88,23 +88,23 @@ lapack_int LAPACKE_ctrexc_work( int matrix_layout, char compq, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrrfs.c b/LAPACKE/src/lapacke_ctrrfs.c index 20019fd51c..575fcded66 100644 --- a/LAPACKE/src/lapacke_ctrrfs.c +++ b/LAPACKE/src/lapacke_ctrrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctrrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ctrrfs( int matrix_layout, char uplo, char trans, char diag, float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ctrrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ctrrfs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + info = API_SUFFIX(LAPACKE_ctrrfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_ctrrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrrfs_work.c b/LAPACKE/src/lapacke_ctrrfs_work.c index d1babfeee5..a699876f25 100644 --- a/LAPACKE/src/lapacke_ctrrfs_work.c +++ b/LAPACKE/src/lapacke_ctrrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctrrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -58,17 +58,17 @@ lapack_int LAPACKE_ctrrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -93,9 +93,9 @@ lapack_int LAPACKE_ctrrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ctr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -110,11 +110,11 @@ lapack_int LAPACKE_ctrrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsen.c b/LAPACKE/src/lapacke_ctrsen.c index f7a57c6701..6bfcc8f5f3 100644 --- a/LAPACKE/src/lapacke_ctrsen.c +++ b/LAPACKE/src/lapacke_ctrsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsen( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_ctrsen)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* q, lapack_int ldq, @@ -44,24 +44,24 @@ lapack_int LAPACKE_ctrsen( int matrix_layout, char job, char compq, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -8; } } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ctrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_ctrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_ctrsen( int matrix_layout, char job, char compq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_ctrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsen_work.c b/LAPACKE/src/lapacke_ctrsen_work.c index 8959d5ce8f..c27589c783 100644 --- a/LAPACKE/src/lapacke_ctrsen_work.c +++ b/LAPACKE/src/lapacke_ctrsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsen_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_ctrsen_work)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* q, lapack_int ldq, @@ -56,12 +56,12 @@ lapack_int LAPACKE_ctrsen_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldq < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -77,7 +77,7 @@ lapack_int LAPACKE_ctrsen_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); @@ -87,9 +87,9 @@ lapack_int LAPACKE_ctrsen_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctrsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, w, m, @@ -98,23 +98,23 @@ lapack_int LAPACKE_ctrsen_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsna.c b/LAPACKE/src/lapacke_ctrsna.c index 667d40aba4..7260aecabe 100644 --- a/LAPACKE/src/lapacke_ctrsna.c +++ b/LAPACKE/src/lapacke_ctrsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctrsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* t, lapack_int ldt, const lapack_complex_float* vl, lapack_int ldvl, @@ -40,40 +40,40 @@ lapack_int LAPACKE_ctrsna( int matrix_layout, char job, char howmny, float* s, float* sep, lapack_int mm, lapack_int* m ) { lapack_int info = 0; - lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ; + lapack_int ldwork = API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ? 1 : MAX(1,n) ; float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_cge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldwork * MAX(1,n+6) ); @@ -83,20 +83,20 @@ lapack_int LAPACKE_ctrsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_ctrsna_work( matrix_layout, job, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_ctrsna_work)( matrix_layout, job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, rwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( rwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsna_work.c b/LAPACKE/src/lapacke_ctrsna_work.c index 865b5769a4..b97a9e8b11 100644 --- a/LAPACKE/src/lapacke_ctrsna_work.c +++ b/LAPACKE/src/lapacke_ctrsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ctrsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_float* t, lapack_int ldt, const lapack_complex_float* vl, lapack_int ldvl, @@ -59,17 +59,17 @@ lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ctrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ctrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ctrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvl_t * MAX(1,mm) ); @@ -88,7 +88,7 @@ lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvr_t * MAX(1,mm) ); @@ -98,12 +98,12 @@ lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_cge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctrsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -113,22 +113,22 @@ lapack_int LAPACKE_ctrsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsyl.c b/LAPACKE/src/lapacke_ctrsyl.c index 1952e024bf..e8345e240e 100644 --- a/LAPACKE/src/lapacke_ctrsyl.c +++ b/LAPACKE/src/lapacke_ctrsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsyl( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ctrsyl)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -40,23 +40,23 @@ lapack_int LAPACKE_ctrsyl( int matrix_layout, char trana, char tranb, float* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif - return LAPACKE_ctrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + return API_SUFFIX(LAPACKE_ctrsyl_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale ); } diff --git a/LAPACKE/src/lapacke_ctrsyl3.c b/LAPACKE/src/lapacke_ctrsyl3.c index c931aac488..9b079bab69 100644 --- a/LAPACKE/src/lapacke_ctrsyl3.c +++ b/LAPACKE/src/lapacke_ctrsyl3.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsyl3( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ctrsyl3)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -13,25 +13,25 @@ lapack_int LAPACKE_ctrsyl3( int matrix_layout, char trana, char tranb, lapack_int ldswork = -1; lapack_int swork_size = -1; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrsyl3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif /* Query optimal working array sizes */ - info = LAPACKE_ctrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + info = API_SUFFIX(LAPACKE_ctrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork_query, ldswork ); if( info != 0 ) { goto exit_level_0; @@ -44,13 +44,13 @@ lapack_int LAPACKE_ctrsyl3( int matrix_layout, char trana, char tranb, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, + info = API_SUFFIX(LAPACKE_ctrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork, ldswork ); /* Release memory and exit */ LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsyl3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsyl3_work.c b/LAPACKE/src/lapacke_ctrsyl3_work.c index 09c08d92aa..2b0621e115 100644 --- a/LAPACKE/src/lapacke_ctrsyl3_work.c +++ b/LAPACKE/src/lapacke_ctrsyl3_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ctrsyl3_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -26,17 +26,17 @@ lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,9 +59,9 @@ lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrsyl3( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, swork, &ldswork, &info ); @@ -69,7 +69,7 @@ lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -78,11 +78,11 @@ lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrsyl_work.c b/LAPACKE/src/lapacke_ctrsyl_work.c index 1c345f1211..69856666d9 100644 --- a/LAPACKE/src/lapacke_ctrsyl_work.c +++ b/LAPACKE/src/lapacke_ctrsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrsyl_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ctrsyl_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_ctrsyl_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ctrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,9 +90,9 @@ lapack_int LAPACKE_ctrsyl_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_ctrsyl_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -109,11 +109,11 @@ lapack_int LAPACKE_ctrsyl_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrtri.c b/LAPACKE/src/lapacke_ctrtri.c index 6dd50ba90e..45e9f9264c 100644 --- a/LAPACKE/src/lapacke_ctrtri.c +++ b/LAPACKE/src/lapacke_ctrtri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrtri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctrtri)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrtri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_ctrtri_work( matrix_layout, uplo, diag, n, a, lda ); + return API_SUFFIX(LAPACKE_ctrtri_work)( matrix_layout, uplo, diag, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_ctrtri_work.c b/LAPACKE/src/lapacke_ctrtri_work.c index d21c99bce8..fc43bfdf8a 100644 --- a/LAPACKE/src/lapacke_ctrtri_work.c +++ b/LAPACKE/src/lapacke_ctrtri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrtri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ctrtri_work)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_float* a, lapack_int lda ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ctrtri_work( int matrix_layout, char uplo, char diag, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ctrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_ctrtri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ctr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrtri( &uplo, &diag, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ctr_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, + API_SUFFIX(LAPACKE_ctr_trans)( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrtrs.c b/LAPACKE/src/lapacke_ctrtrs.c index 061ae686d7..c7a5a2037c 100644 --- a/LAPACKE/src/lapacke_ctrtrs.c +++ b/LAPACKE/src/lapacke_ctrtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ctrtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_ctrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + return API_SUFFIX(LAPACKE_ctrtrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ctrtrs_work.c b/LAPACKE/src/lapacke_ctrtrs_work.c index 228fd38bac..63e3c6310f 100644 --- a/LAPACKE/src/lapacke_ctrtrs_work.c +++ b/LAPACKE/src/lapacke_ctrtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ctrtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ctrtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ctrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtrs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ctrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_ctrtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ctr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_ctrtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrttf.c b/LAPACKE/src/lapacke_ctrttf.c index e5a3c0e4ae..005d3274a5 100644 --- a/LAPACKE/src/lapacke_ctrttf.c +++ b/LAPACKE/src/lapacke_ctrttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctrttf)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -5; } } #endif - return LAPACKE_ctrttf_work( matrix_layout, transr, uplo, n, a, lda, arf ); + return API_SUFFIX(LAPACKE_ctrttf_work)( matrix_layout, transr, uplo, n, a, lda, arf ); } diff --git a/LAPACKE/src/lapacke_ctrttf_work.c b/LAPACKE/src/lapacke_ctrttf_work.c index 8589a65892..49424fa86f 100644 --- a/LAPACKE/src/lapacke_ctrttf_work.c +++ b/LAPACKE/src/lapacke_ctrttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ctrttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* arf ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ctrttf_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ctrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ctrttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_cpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctrttp.c b/LAPACKE/src/lapacke_ctrttp.c index 624cd2d2fe..ced8afc554 100644 --- a/LAPACKE/src/lapacke_ctrttp.c +++ b/LAPACKE/src/lapacke_ctrttp.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrttp( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctrttp)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctrttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ctr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -4; } } #endif - return LAPACKE_ctrttp_work( matrix_layout, uplo, n, a, lda, ap ); + return API_SUFFIX(LAPACKE_ctrttp_work)( matrix_layout, uplo, n, a, lda, ap ); } diff --git a/LAPACKE/src/lapacke_ctrttp_work.c b/LAPACKE/src/lapacke_ctrttp_work.c index 9a557b6024..f5d71fa1d3 100644 --- a/LAPACKE/src/lapacke_ctrttp_work.c +++ b/LAPACKE/src/lapacke_ctrttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctrttp_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctrttp_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* a, lapack_int lda, lapack_complex_float* ap ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ctrttp_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ctrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ctrttp_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ctrttp( &uplo, &n, a_t, &lda_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_cpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctrttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctzrzf.c b/LAPACKE/src/lapacke_ctzrzf.c index c33b868baa..3808aa608d 100644 --- a/LAPACKE/src/lapacke_ctzrzf.c +++ b/LAPACKE/src/lapacke_ctzrzf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctzrzf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctzrzf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_ctzrzf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ctzrzf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctzrzf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ctzrzf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_ctzrzf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_ctzrzf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctzrzf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_ctzrzf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctzrzf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctzrzf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ctzrzf_work.c b/LAPACKE/src/lapacke_ctzrzf_work.c index c5178ce3fc..a1d7fb1f49 100644 --- a/LAPACKE/src/lapacke_ctzrzf_work.c +++ b/LAPACKE/src/lapacke_ctzrzf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctzrzf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ctzrzf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_ctzrzf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ctzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctzrzf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_ctzrzf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ctzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ctzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctzrzf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ctzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctzrzf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunbdb.c b/LAPACKE/src/lapacke_cunbdb.c index 779e461f32..bf5b7bfa05 100644 --- a/LAPACKE/src/lapacke_cunbdb.c +++ b/LAPACKE/src/lapacke_cunbdb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunbdb( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_cunbdb)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x12, lapack_int ldx12, @@ -50,10 +50,10 @@ lapack_int LAPACKE_cunbdb( int matrix_layout, char trans, char signs, lapack_complex_float work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunbdb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunbdb", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -61,22 +61,22 @@ lapack_int LAPACKE_cunbdb( int matrix_layout, char trans, char signs, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -7; } - if( LAPACKE_cge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -9; } - if( LAPACKE_cge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -11; } - if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -13; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_cunbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, &work_query, lwork ); @@ -92,14 +92,14 @@ lapack_int LAPACKE_cunbdb( int matrix_layout, char trans, char signs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_cunbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunbdb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunbdb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunbdb_work.c b/LAPACKE/src/lapacke_cunbdb_work.c index fa05aafb2f..3a20b82dbf 100644 --- a/LAPACKE/src/lapacke_cunbdb_work.c +++ b/LAPACKE/src/lapacke_cunbdb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunbdb_work( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_cunbdb_work)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, lapack_complex_float* x12, lapack_int ldx12, @@ -63,7 +63,7 @@ lapack_int LAPACKE_cunbdb_work( int matrix_layout, char trans, char signs, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -77,7 +77,7 @@ lapack_int LAPACKE_cunbdb_work( int matrix_layout, char trans, char signs, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunbdb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunbdb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cuncsd.c b/LAPACKE/src/lapacke_cuncsd.c index 91a4ca9f1b..4a99970cda 100644 --- a/LAPACKE/src/lapacke_cuncsd.c +++ b/LAPACKE/src/lapacke_cuncsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_cuncsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, lapack_int ldx11, @@ -55,10 +55,10 @@ lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, lapack_complex_float work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cuncsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -66,16 +66,16 @@ lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -11; } - if( LAPACKE_cge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -13; } - if( LAPACKE_cge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -15; } - if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -17; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cuncsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_cuncsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, &work_query, @@ -110,7 +110,7 @@ lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cuncsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_cuncsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork, @@ -123,7 +123,7 @@ lapack_int LAPACKE_cuncsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cuncsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cuncsd2by1.c b/LAPACKE/src/lapacke_cuncsd2by1.c index 8a1fc02f36..3482377797 100644 --- a/LAPACKE/src/lapacke_cuncsd2by1.c +++ b/LAPACKE/src/lapacke_cuncsd2by1.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(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, @@ -50,7 +50,7 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, lapack_complex_float work_query; lapack_int nrows_x11, nrows_x21; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cuncsd2by1", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -58,11 +58,11 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, /* Optionally check input matrices for NaNs */ nrows_x11 = p; nrows_x21 = m-p; - if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { return -9; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_cuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_cuncsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, &work_query, lwork, &rwork_query, lrwork, iwork ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_cuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_cuncsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork ); /* Release memory and exit */ @@ -106,7 +106,7 @@ lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cuncsd2by1", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cuncsd2by1_work.c b/LAPACKE/src/lapacke_cuncsd2by1_work.c index 4e7e2cc165..1e34d84fcd 100644 --- a/LAPACKE/src/lapacke_cuncsd2by1_work.c +++ b/LAPACKE/src/lapacke_cuncsd2by1_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(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, @@ -56,9 +56,9 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_x11 = p; lapack_int nrows_x21 = m-p; - lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); - lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); - lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int nrows_u1 = ( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ? q : 1); lapack_int ldu1_t = MAX(1,nrows_u1); lapack_int ldu2_t = MAX(1,nrows_u2); lapack_int ldv1t_t = MAX(1,nrows_v1t); @@ -72,27 +72,27 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Check leading dimension(s) */ if( ldu1 < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); return info; } if( ldu2 < m-p ) { info = -23; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); return info; } if( ldv1t < q ) { info = -25; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); return info; } if( ldx11 < q ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); return info; } if( ldx21 < q ) { info = -16; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { u1_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu1_t * MAX(1,p) ); if( u1_t == NULL ) { @@ -122,7 +122,7 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { u2_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldu2_t * MAX(1,m-p) ); if( u2_t == NULL ) { @@ -130,7 +130,7 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_3; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { v1t_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldv1t_t * MAX(1,q) ); if( v1t_t == NULL ) { @@ -139,9 +139,9 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, } } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, ldx11_t ); - LAPACKE_cge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, @@ -152,32 +152,32 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, ldx11 ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, ldx21 ); - if( LAPACKE_lsame( jobu1, 'y' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, ldu1 ); } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, u2, ldu2 ); } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, v1t, ldv1t ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { LAPACKE_free( v1t_t ); } exit_level_4: - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { LAPACKE_free( u2_t ); } exit_level_3: - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { LAPACKE_free( u1_t ); } exit_level_2: @@ -186,11 +186,11 @@ lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( x11_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd2by1_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cuncsd_work.c b/LAPACKE/src/lapacke_cuncsd_work.c index a5c24a301f..40775b1fcc 100644 --- a/LAPACKE/src/lapacke_cuncsd_work.c +++ b/LAPACKE/src/lapacke_cuncsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cuncsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_cuncsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_float* x11, @@ -66,7 +66,7 @@ lapack_int LAPACKE_cuncsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -81,7 +81,7 @@ lapack_int LAPACKE_cuncsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cuncsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cuncsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungbr.c b/LAPACKE/src/lapacke_cungbr.c index d71462d915..5085bc7b2f 100644 --- a/LAPACKE/src/lapacke_cungbr.c +++ b/LAPACKE/src/lapacke_cungbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungbr( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cungbr)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cungbr( int matrix_layout, char vect, lapack_int m, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_c_nancheck( MIN(m,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( MIN(m,k), tau, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungbr_work( matrix_layout, vect, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cungbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cungbr( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungbr_work( matrix_layout, vect, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cungbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungbr_work.c b/LAPACKE/src/lapacke_cungbr_work.c index 88429715c8..9b70f51b30 100644 --- a/LAPACKE/src/lapacke_cungbr_work.c +++ b/LAPACKE/src/lapacke_cungbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungbr_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_cungbr_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_cungbr_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_cungbr_work( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cungbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); @@ -76,16 +76,16 @@ lapack_int LAPACKE_cungbr_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunghr.c b/LAPACKE/src/lapacke_cunghr.c index 45fc0556f7..9cb50541d7 100644 --- a/LAPACKE/src/lapacke_cunghr.c +++ b/LAPACKE/src/lapacke_cunghr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunghr( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_cunghr)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cunghr( int matrix_layout, lapack_int n, lapack_int ilo, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunghr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunghr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cunghr( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cunghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunghr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunghr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunghr_work.c b/LAPACKE/src/lapacke_cunghr_work.c index 14b888ed22..472606ff09 100644 --- a/LAPACKE/src/lapacke_cunghr_work.c +++ b/LAPACKE/src/lapacke_cunghr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_cunghr_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunghr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_cunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cunghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunghr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunghr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunglq.c b/LAPACKE/src/lapacke_cunglq.c index a3bf9abbd9..fac40ab93c 100644 --- a/LAPACKE/src/lapacke_cunglq.c +++ b/LAPACKE/src/lapacke_cunglq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunglq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cunglq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cunglq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunglq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunglq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunglq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cunglq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cunglq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunglq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cunglq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunglq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunglq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunglq_work.c b/LAPACKE/src/lapacke_cunglq_work.c index 3c9d9f806b..cce163d647 100644 --- a/LAPACKE/src/lapacke_cunglq_work.c +++ b/LAPACKE/src/lapacke_cunglq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunglq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cunglq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cunglq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunglq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cunglq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cunglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunglq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunglq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungql.c b/LAPACKE/src/lapacke_cungql.c index 668c39c0fd..30b5e77651 100644 --- a/LAPACKE/src/lapacke_cungql.c +++ b/LAPACKE/src/lapacke_cungql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungql( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungql)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cungql( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungql_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cungql_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cungql( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungql_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cungql_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungql_work.c b/LAPACKE/src/lapacke_cungql_work.c index 8920917bea..9d44a80d5b 100644 --- a/LAPACKE/src/lapacke_cungql_work.c +++ b/LAPACKE/src/lapacke_cungql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungql_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungql_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cungql_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cungql_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cungql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungqr.c b/LAPACKE/src/lapacke_cungqr.c index bad2c322c1..fa18c9a037 100644 --- a/LAPACKE/src/lapacke_cungqr.c +++ b/LAPACKE/src/lapacke_cungqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cungqr( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungqr_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cungqr_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cungqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungqr_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cungqr_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungqr_work.c b/LAPACKE/src/lapacke_cungqr_work.c index 0f8426e232..f22a65aac8 100644 --- a/LAPACKE/src/lapacke_cungqr_work.c +++ b/LAPACKE/src/lapacke_cungqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cungqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cungqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cungqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungrq.c b/LAPACKE/src/lapacke_cungrq.c index 65154554b8..4f1fa5a8ff 100644 --- a/LAPACKE/src/lapacke_cungrq.c +++ b/LAPACKE/src/lapacke_cungrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungrq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungrq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cungrq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungrq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cungrq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cungrq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungrq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cungrq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungrq_work.c b/LAPACKE/src/lapacke_cungrq_work.c index 76a0f9da3f..062413fc9f 100644 --- a/LAPACKE/src/lapacke_cungrq_work.c +++ b/LAPACKE/src/lapacke_cungrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungrq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungrq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cungrq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cungrq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cungrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungtr.c b/LAPACKE/src/lapacke_cungtr.c index c0da66df8d..5016408e13 100644 --- a/LAPACKE/src/lapacke_cungtr.c +++ b/LAPACKE/src/lapacke_cungtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungtr)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_cungtr( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, tau, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungtr_work( matrix_layout, uplo, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_cungtr_work)( matrix_layout, uplo, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_cungtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungtr_work( matrix_layout, uplo, n, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_cungtr_work)( matrix_layout, uplo, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungtr_work.c b/LAPACKE/src/lapacke_cungtr_work.c index b892740de9..d1dd25adee 100644 --- a/LAPACKE/src/lapacke_cungtr_work.c +++ b/LAPACKE/src/lapacke_cungtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungtr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, lapack_complex_float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_cungtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_cungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_cungtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cungtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cungtsqr_row.c b/LAPACKE/src/lapacke_cungtsqr_row.c index bb551fcbc7..a8a27f6186 100644 --- a/LAPACKE/src/lapacke_cungtsqr_row.c +++ b/LAPACKE/src/lapacke_cungtsqr_row.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungtsqr_row)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int ldt ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_cungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cungtsqr_row", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_cge_nancheck( matrix_layout, nb, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, nb, n, t, ldt ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cungtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_cungtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_cungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cungtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_cungtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungtsqr_row", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_cungtsqr_row_work.c b/LAPACKE/src/lapacke_cungtsqr_row_work.c index 96b18ab137..f128e13eab 100644 --- a/LAPACKE/src/lapacke_cungtsqr_row_work.c +++ b/LAPACKE/src/lapacke_cungtsqr_row_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cungtsqr_row_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cungtsqr_row_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, lapack_complex_float* a, lapack_int lda, const lapack_complex_float* t, lapack_int ldt, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row_work", info ); return info; } lapack_int ldt_t = MAX(1,nb); @@ -60,7 +60,7 @@ lapack_int LAPACKE_cungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, nb, n, a, lda, t_t, ldt_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, nb, n, a, lda, t_t, ldt_t ); /* Call LAPACK function and adjust info */ LAPACK_cungtsqr_row( &m, &n, &mb, &nb, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_cungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cungtsqr_row_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_cunhr_col.c b/LAPACKE/src/lapacke_cunhr_col.c index 7ed1ad4c4d..27e6f29a10 100644 --- a/LAPACKE/src/lapacke_cunhr_col.c +++ b/LAPACKE/src/lapacke_cunhr_col.c @@ -1,24 +1,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunhr_col( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cunhr_col)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* d) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunhr_col", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunhr_col", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - info = LAPACKE_cunhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d ); + info = API_SUFFIX(LAPACKE_cunhr_col_work)( matrix_layout, m, n, nb, a, lda, t, ldt, d ); return info; } diff --git a/LAPACKE/src/lapacke_cunhr_col_work.c b/LAPACKE/src/lapacke_cunhr_col_work.c index 76b8366f0d..bd2005dd06 100644 --- a/LAPACKE/src/lapacke_cunhr_col_work.c +++ b/LAPACKE/src/lapacke_cunhr_col_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cunhr_col_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_float* a, lapack_int lda, lapack_complex_float* t, lapack_int ldt, lapack_complex_float* d ) @@ -20,12 +20,12 @@ lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunhr_col_work", info ); return info; } if( ldt < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunhr_col_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -43,15 +43,15 @@ lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cunhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_cge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -59,11 +59,11 @@ lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunhr_col_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunhr_col_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmbr.c b/LAPACKE/src/lapacke_cunmbr.c index 3273b4297b..054d89bc5d 100644 --- a/LAPACKE/src/lapacke_cunmbr.c +++ b/LAPACKE/src/lapacke_cunmbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmbr( int matrix_layout, char vect, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmbr)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -44,27 +44,27 @@ lapack_int LAPACKE_cunmbr( int matrix_layout, char vect, char side, char trans, lapack_complex_float work_query; lapack_int nq, r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nq = LAPACKE_lsame( side, 'l' ) ? m : n; - r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - if( LAPACKE_cge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) { + nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, r, MIN(nq,k), a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_c_nancheck( MIN(nq,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( MIN(nq,k), tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_cunmbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -78,13 +78,13 @@ lapack_int LAPACKE_cunmbr( int matrix_layout, char vect, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_cunmbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmbr_work.c b/LAPACKE/src/lapacke_cunmbr_work.c index 75be3d9e46..06d8a97880 100644 --- a/LAPACKE/src/lapacke_cunmbr_work.c +++ b/LAPACKE/src/lapacke_cunmbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, +lapack_int API_SUFFIX(LAPACKE_cunmbr_work)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -48,8 +48,8 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); + lapack_int nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; @@ -57,12 +57,12 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, /* Check leading dimension(s) */ if( lda < MIN(nq,k) ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(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) ); @@ -88,8 +88,8 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -97,18 +97,18 @@ lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmhr.c b/LAPACKE/src/lapacke_cunmhr.c index 003939ebf8..4305057eee 100644 --- a/LAPACKE/src/lapacke_cunmhr.c +++ b/LAPACKE/src/lapacke_cunmhr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmhr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmhr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_cunmhr( int matrix_layout, char side, char trans, lapack_complex_float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmhr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_cge_nancheck( matrix_layout, r, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, r, r, a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( r-1, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_cunmhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_cunmhr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_cunmhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmhr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmhr_work.c b/LAPACKE/src/lapacke_cunmhr_work.c index d73a76f906..e4ae3d5579 100644 --- a/LAPACKE/src/lapacke_cunmhr_work.c +++ b/LAPACKE/src/lapacke_cunmhr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmhr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmhr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_cunmhr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_cunmhr_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cunmhr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_cunmhr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmhr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmlq.c b/LAPACKE/src/lapacke_cunmlq.c index 224fa7866d..841e92326c 100644 --- a/LAPACKE/src/lapacke_cunmlq.c +++ b/LAPACKE/src/lapacke_cunmlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cunmlq( int matrix_layout, char side, char trans, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_cunmlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmlq_work.c b/LAPACKE/src/lapacke_cunmlq_work.c index 204dc72a71..551826624a 100644 --- a/LAPACKE/src/lapacke_cunmlq_work.c +++ b/LAPACKE/src/lapacke_cunmlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -49,7 +49,7 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(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; @@ -57,12 +57,12 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) ); } else { @@ -90,8 +90,8 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -99,18 +99,18 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmql.c b/LAPACKE/src/lapacke_cunmql.c index 1256dd5475..96133ef66b 100644 --- a/LAPACKE/src/lapacke_cunmql.c +++ b/LAPACKE/src/lapacke_cunmql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmql( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmql)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_cunmql( int matrix_layout, char side, char trans, lapack_complex_float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_cunmql( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmql_work.c b/LAPACKE/src/lapacke_cunmql_work.c index ccfda0ea60..58a338c5f6 100644 --- a/LAPACKE/src/lapacke_cunmql_work.c +++ b/LAPACKE/src/lapacke_cunmql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmql_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmql_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_cunmql_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_cunmql_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cunmql_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_cunmql_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmqr.c b/LAPACKE/src/lapacke_cunmqr.c index a49796773b..e53fdc602a 100644 --- a/LAPACKE/src/lapacke_cunmqr.c +++ b/LAPACKE/src/lapacke_cunmqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_cunmqr( int matrix_layout, char side, char trans, lapack_complex_float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_cunmqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmqr_work.c b/LAPACKE/src/lapacke_cunmqr_work.c index ce5a37cbcc..a380912cea 100644 --- a/LAPACKE/src/lapacke_cunmqr_work.c +++ b/LAPACKE/src/lapacke_cunmqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_cunmqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmrq.c b/LAPACKE/src/lapacke_cunmrq.c index e410b95c86..13edeb1886 100644 --- a/LAPACKE/src/lapacke_cunmrq.c +++ b/LAPACKE/src/lapacke_cunmrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmrq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmrq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cunmrq( int matrix_layout, char side, char trans, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_cunmrq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_cunmrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmrq_work.c b/LAPACKE/src/lapacke_cunmrq_work.c index cc99429406..2cb0379903 100644 --- a/LAPACKE/src/lapacke_cunmrq_work.c +++ b/LAPACKE/src/lapacke_cunmrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmrq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmrq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cunmrq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cunmrq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_cunmrq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmrz.c b/LAPACKE/src/lapacke_cunmrz.c index c2e235ae84..a3f5859c00 100644 --- a/LAPACKE/src/lapacke_cunmrz.c +++ b/LAPACKE/src/lapacke_cunmrz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmrz( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmrz)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_cunmrz( int matrix_layout, char side, char trans, lapack_complex_float* work = NULL; lapack_complex_float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmrz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -8; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_c_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( k, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_cunmrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_cunmrz( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_cunmrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmrz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmrz_work.c b/LAPACKE/src/lapacke_cunmrz_work.c index 5dd15775a3..a634f0d4b9 100644 --- a/LAPACKE/src/lapacke_cunmrz_work.c +++ b/LAPACKE/src/lapacke_cunmrz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmrz_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmrz_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -55,12 +55,12 @@ lapack_int LAPACKE_cunmrz_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -9; - LAPACKE_xerbla( "LAPACKE_cunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_cunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_cunmrz_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_cunmrz_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmrz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmtr.c b/LAPACKE/src/lapacke_cunmtr.c index f98a205763..ab07409807 100644 --- a/LAPACKE/src/lapacke_cunmtr.c +++ b/LAPACKE/src/lapacke_cunmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_cunmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_cunmtr( int matrix_layout, char side, char uplo, char trans, lapack_complex_float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cunmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_che_nancheck( matrix_layout, uplo, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_che_nancheck)( matrix_layout, uplo, r, a, lda ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( r-1, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_cunmtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_cunmtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_cunmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cunmtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_cunmtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cunmtr_work.c b/LAPACKE/src/lapacke_cunmtr_work.c index 8a22f3c7e0..422607a6ab 100644 --- a/LAPACKE/src/lapacke_cunmtr_work.c +++ b/LAPACKE/src/lapacke_cunmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cunmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_cunmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_cunmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_float* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_cunmtr_work( int matrix_layout, char side, char uplo, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_cunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_cunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_cunmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_cunmtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_cunmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cunmtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cupgtr.c b/LAPACKE/src/lapacke_cupgtr.c index 662cce33e7..118492c656 100644 --- a/LAPACKE/src/lapacke_cupgtr.c +++ b/LAPACKE/src/lapacke_cupgtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cupgtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cupgtr)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_complex_float* tau, lapack_complex_float* q, lapack_int ldq ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_cupgtr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cupgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_cpp_nancheck)( n, ap ) ) { return -4; } - if( LAPACKE_c_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( n-1, tau, 1 ) ) { return -5; } } @@ -62,12 +62,12 @@ lapack_int LAPACKE_cupgtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cupgtr_work( matrix_layout, uplo, n, ap, tau, q, ldq, work ); + info = API_SUFFIX(LAPACKE_cupgtr_work)( matrix_layout, uplo, n, ap, tau, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cupgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cupgtr_work.c b/LAPACKE/src/lapacke_cupgtr_work.c index b37afb1c6e..95b9c2f62d 100644 --- a/LAPACKE/src/lapacke_cupgtr_work.c +++ b/LAPACKE/src/lapacke_cupgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cupgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_cupgtr_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float* ap, const lapack_complex_float* tau, lapack_complex_float* q, lapack_int ldq, @@ -52,7 +52,7 @@ lapack_int LAPACKE_cupgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldq < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_cupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupgtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,25 +70,25 @@ lapack_int LAPACKE_cupgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cupgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( q_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cupmtr.c b/LAPACKE/src/lapacke_cupmtr.c index 1ea17ca56b..4c6f4020d0 100644 --- a/LAPACKE/src/lapacke_cupmtr.c +++ b/LAPACKE/src/lapacke_cupmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cupmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_cupmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_float* ap, const lapack_complex_float* tau, @@ -44,28 +44,28 @@ lapack_int LAPACKE_cupmtr( int matrix_layout, char side, char uplo, char trans, lapack_complex_float* work = NULL; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cupmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_cpp_nancheck( r, ap ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_cpp_nancheck)( r, ap ) ) { return -7; } - if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -9; } - if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_c_nancheck)( r-1, tau, 1 ) ) { return -8; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { lwork = MAX(1,n); - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { lwork = MAX(1,m); } else { lwork = 1; /* Any value */ @@ -78,13 +78,13 @@ lapack_int LAPACKE_cupmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_cupmtr_work( matrix_layout, side, uplo, trans, m, n, ap, tau, + info = API_SUFFIX(LAPACKE_cupmtr_work)( matrix_layout, side, uplo, trans, m, n, ap, tau, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cupmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_cupmtr_work.c b/LAPACKE/src/lapacke_cupmtr_work.c index cb273ac44e..56d1424dff 100644 --- a/LAPACKE/src/lapacke_cupmtr_work.c +++ b/LAPACKE/src/lapacke_cupmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_cupmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_cupmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_float* ap, const lapack_complex_float* tau, @@ -48,14 +48,14 @@ lapack_int LAPACKE_cupmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int ldc_t = MAX(1,m); lapack_complex_float* c_t = NULL; lapack_complex_float* ap_t = NULL; /* Check leading dimension(s) */ if( ldc < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_cupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupmtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,8 +73,8 @@ lapack_int LAPACKE_cupmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_cpp_trans( matrix_layout, uplo, r, ap, ap_t ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_cpp_trans)( matrix_layout, uplo, r, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_cupmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t, work, &info ); @@ -82,18 +82,18 @@ lapack_int LAPACKE_cupmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_cupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cupmtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbbcsd.c b/LAPACKE/src/lapacke_dbbcsd.c index afa01f3cbc..3f32865d75 100644 --- a/LAPACKE/src/lapacke_dbbcsd.c +++ b/LAPACKE/src/lapacke_dbbcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dbbcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double* theta, double* phi, double* u1, lapack_int ldu1, double* u2, @@ -48,10 +48,10 @@ lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, double work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dbbcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbbcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -59,36 +59,36 @@ lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( q-1, phi, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( q, theta, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( q, theta, 1 ) ) { return -10; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { - if( LAPACKE_dge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, p, p, u1, ldu1 ) ) { return -12; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-p, m-p, u2, ldu2 ) ) { return -14; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - if( LAPACKE_dge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, q, q, v1t, ldv1t ) ) { return -16; } } - if( LAPACKE_lsame( jobv2t, 'y' ) ) { - if( LAPACKE_dge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv2t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { return -18; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_dbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, &work_query, lwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_dbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, work, lwork ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbbcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbbcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbbcsd_work.c b/LAPACKE/src/lapacke_dbbcsd_work.c index 888fa6c2b3..45424f5702 100644 --- a/LAPACKE/src/lapacke_dbbcsd_work.c +++ b/LAPACKE/src/lapacke_dbbcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbbcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dbbcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double* theta, double* phi, double* u1, @@ -61,7 +61,7 @@ lapack_int LAPACKE_dbbcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -76,7 +76,7 @@ lapack_int LAPACKE_dbbcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dbbcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbbcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsdc.c b/LAPACKE/src/lapacke_dbdsdc.c index aaa7060990..46500e130d 100644 --- a/LAPACKE/src/lapacke_dbdsdc.c +++ b/LAPACKE/src/lapacke_dbdsdc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsdc( int matrix_layout, char uplo, char compq, +lapack_int API_SUFFIX(LAPACKE_dbdsdc)( int matrix_layout, char uplo, char compq, lapack_int n, double* d, double* e, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* q, lapack_int* iq ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_dbdsdc( int matrix_layout, char uplo, char compq, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dbdsdc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { lwork = (size_t)3*MAX(1,n)*MAX(1,n)+4*MAX(1,n); - } else if( LAPACKE_lsame( compq, 'p' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( compq, 'p' ) ) { lwork = MAX(1,6*n); - } else if( LAPACKE_lsame( compq, 'n' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( compq, 'n' ) ) { lwork = MAX(1,4*n); } else { lwork = 1; /* Any value */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_dbdsdc( int matrix_layout, char uplo, char compq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dbdsdc_work( matrix_layout, uplo, compq, n, d, e, u, ldu, vt, + info = API_SUFFIX(LAPACKE_dbdsdc_work)( matrix_layout, uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_dbdsdc( int matrix_layout, char uplo, char compq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsdc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsdc_work.c b/LAPACKE/src/lapacke_dbdsdc_work.c index 7e498a225d..9f4d8c94b9 100644 --- a/LAPACKE/src/lapacke_dbdsdc_work.c +++ b/LAPACKE/src/lapacke_dbdsdc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsdc_work( int matrix_layout, char uplo, char compq, +lapack_int API_SUFFIX(LAPACKE_dbdsdc_work)( int matrix_layout, char uplo, char compq, lapack_int n, double* d, double* e, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* q, lapack_int* iq, double* work, @@ -54,23 +54,23 @@ lapack_int LAPACKE_dbdsdc_work( int matrix_layout, char uplo, char compq, /* Check leading dimension(s) */ if( ldu < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc_work", info ); return info; } if( ldvt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { vt_t = (double*) LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -85,27 +85,27 @@ lapack_int LAPACKE_dbdsdc_work( int matrix_layout, char uplo, char compq, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compq, 'i' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( compq, 'i' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { LAPACKE_free( vt_t ); } exit_level_1: - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { LAPACKE_free( u_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsdc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsqr.c b/LAPACKE/src/lapacke_dbdsqr.c index 2f0ba24307..2b78a31d7d 100644 --- a/LAPACKE/src/lapacke_dbdsqr.c +++ b/LAPACKE/src/lapacke_dbdsqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsqr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dbdsqr)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, double* d, double* e, double* vt, lapack_int ldvt, double* u, lapack_int ldu, double* c, @@ -41,30 +41,30 @@ lapack_int LAPACKE_dbdsqr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dbdsqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( ncc != 0 ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, ncc, c, ldc ) ) { return -13; } } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -8; } if( nru != 0 ) { - if( LAPACKE_dge_nancheck( matrix_layout, nru, n, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nru, n, u, ldu ) ) { return -11; } } if( ncvt != 0 ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, ncvt, vt, ldvt ) ) { return -9; } } @@ -77,13 +77,13 @@ lapack_int LAPACKE_dbdsqr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dbdsqr_work( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, + info = API_SUFFIX(LAPACKE_dbdsqr_work)( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsqr_work.c b/LAPACKE/src/lapacke_dbdsqr_work.c index d3330cf9b1..7f5cde0bea 100644 --- a/LAPACKE/src/lapacke_dbdsqr_work.c +++ b/LAPACKE/src/lapacke_dbdsqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsqr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dbdsqr_work)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, double* d, double* e, double* vt, lapack_int ldvt, double* u, lapack_int ldu, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dbdsqr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldc < ncc ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr_work", info ); return info; } if( ldu < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr_work", info ); return info; } if( ldvt < ncvt ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -95,13 +95,13 @@ lapack_int LAPACKE_dbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose input matrices */ if( ncvt != 0 ) { - LAPACKE_dge_trans( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); } if( nru != 0 ) { - LAPACKE_dge_trans( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); } if( ncc != 0 ) { - LAPACKE_dge_trans( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_dbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t, @@ -111,14 +111,14 @@ lapack_int LAPACKE_dbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose output matrices */ if( ncvt != 0 ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, ldvt ); } if( nru != 0 ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); } if( ncc != 0 ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { @@ -134,11 +134,11 @@ lapack_int LAPACKE_dbdsqr_work( int matrix_layout, char uplo, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsvdx.c b/LAPACKE/src/lapacke_dbdsvdx.c index 88d0e87654..2e204b1f94 100644 --- a/LAPACKE/src/lapacke_dbdsvdx.c +++ b/LAPACKE/src/lapacke_dbdsvdx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dbdsvdx)( int matrix_layout, char uplo, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* ns, @@ -45,16 +45,16 @@ lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int* iwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dbdsvdx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsvdx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( n - 1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n - 1, e, 1 ) ) { return -7; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dbdsvdx_work( matrix_layout, uplo, jobz, range, + info = API_SUFFIX(LAPACKE_dbdsvdx_work)( matrix_layout, uplo, jobz, range, n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork); /* Backup significant data from working array(s) */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_dbdsvdx( int matrix_layout, char uplo, char jobz, char range, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsvdx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsvdx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dbdsvdx_work.c b/LAPACKE/src/lapacke_dbdsvdx_work.c index f5506ac1dc..ea24dac521 100644 --- a/LAPACKE/src/lapacke_dbdsvdx_work.c +++ b/LAPACKE/src/lapacke_dbdsvdx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dbdsvdx_work)( int matrix_layout, char uplo, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* ns, @@ -49,19 +49,19 @@ lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char r info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - 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 nrows_z = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 2*n : 0; + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? + ( API_SUFFIX(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 < ncols_z ) { info = -3; - LAPACKE_xerbla( "LAPACKE_dbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsvdx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(ncols_z,1) ); if( z_t == NULL ) { @@ -77,20 +77,20 @@ lapack_int LAPACKE_dbdsvdx_work( int matrix_layout, char uplo, char jobz, char r info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsvdx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dbdsvdx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ddisna.c b/LAPACKE/src/lapacke_ddisna.c index a73a6e9478..919cad029a 100644 --- a/LAPACKE/src/lapacke_ddisna.c +++ b/LAPACKE/src/lapacke_ddisna.c @@ -32,16 +32,16 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ddisna( char job, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ddisna)( char job, lapack_int m, lapack_int n, const double* d, double* sep ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(m,n), d, 1 ) ) { return -4; } } #endif - return LAPACKE_ddisna_work( job, m, n, d, sep ); + return API_SUFFIX(LAPACKE_ddisna_work)( job, m, n, d, sep ); } diff --git a/LAPACKE/src/lapacke_ddisna_work.c b/LAPACKE/src/lapacke_ddisna_work.c index b8e03c6836..dadbd8be11 100644 --- a/LAPACKE/src/lapacke_ddisna_work.c +++ b/LAPACKE/src/lapacke_ddisna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ddisna_work( char job, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ddisna_work)( char job, lapack_int m, lapack_int n, const double* d, double* sep ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dgbbrd.c b/LAPACKE/src/lapacke_dgbbrd.c index ff655d969e..68d2614b6d 100644 --- a/LAPACKE/src/lapacke_dgbbrd.c +++ b/LAPACKE/src/lapacke_dgbbrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbbrd( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgbbrd)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, double* ab, lapack_int ldab, double* d, double* e, double* q, lapack_int ldq, @@ -42,17 +42,17 @@ lapack_int LAPACKE_dgbbrd( int matrix_layout, char vect, lapack_int m, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbbrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -8; } if( ncc != 0 ) { - if( LAPACKE_dge_nancheck( matrix_layout, m, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, ncc, c, ldc ) ) { return -16; } } @@ -65,13 +65,13 @@ lapack_int LAPACKE_dgbbrd( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgbbrd_work( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, + info = API_SUFFIX(LAPACKE_dgbbrd_work)( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, d, e, q, ldq, pt, ldpt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbbrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbbrd_work.c b/LAPACKE/src/lapacke_dgbbrd_work.c index 79c7a9ec11..98fccae1f5 100644 --- a/LAPACKE/src/lapacke_dgbbrd_work.c +++ b/LAPACKE/src/lapacke_dgbbrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbbrd_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgbbrd_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, double* ab, lapack_int ldab, double* d, double* e, double* q, lapack_int ldq, @@ -59,22 +59,22 @@ lapack_int LAPACKE_dgbbrd_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); return info; } if( ldc < ncc ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); return info; } if( ldpt < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); return info; } if( ldq < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -83,14 +83,14 @@ lapack_int LAPACKE_dgbbrd_work( int matrix_layout, char vect, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,m) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { pt_t = (double*) LAPACKE_malloc( sizeof(double) * ldpt_t * MAX(1,n) ); if( pt_t == NULL ) { @@ -107,9 +107,9 @@ lapack_int LAPACKE_dgbbrd_work( int matrix_layout, char vect, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); if( ncc != 0 ) { - LAPACKE_dge_trans( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_dgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t, @@ -118,38 +118,38 @@ lapack_int LAPACKE_dgbbrd_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); } if( ncc != 0 ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { LAPACKE_free( c_t ); } exit_level_3: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { LAPACKE_free( pt_t ); } exit_level_2: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbbrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbcon.c b/LAPACKE/src/lapacke_dgbcon.c index c1d0f430e5..866c8c3322 100644 --- a/LAPACKE/src/lapacke_dgbcon.c +++ b/LAPACKE/src/lapacke_dgbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbcon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbcon)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, const lapack_int* ipiv, double anorm, double* rcond ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_dgbcon( int matrix_layout, char norm, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -9; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_dgbcon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgbcon_work( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, + info = API_SUFFIX(LAPACKE_dgbcon_work)( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_dgbcon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbcon_work.c b/LAPACKE/src/lapacke_dgbcon_work.c index 1e7904e6e5..ca0bb14557 100644 --- a/LAPACKE/src/lapacke_dgbcon_work.c +++ b/LAPACKE/src/lapacke_dgbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbcon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbcon_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, const lapack_int* ipiv, double anorm, double* rcond, double* work, @@ -52,7 +52,7 @@ lapack_int LAPACKE_dgbcon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_dgbcon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond, @@ -74,11 +74,11 @@ lapack_int LAPACKE_dgbcon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbequ.c b/LAPACKE/src/lapacke_dgbequ.c index 465e599e8b..78fb51fb4f 100644 --- a/LAPACKE/src/lapacke_dgbequ.c +++ b/LAPACKE/src/lapacke_dgbequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbequ)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_dgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_dgbequ_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_dgbequ_work.c b/LAPACKE/src/lapacke_dgbequ_work.c index fcba3475b1..dbd1cb5747 100644 --- a/LAPACKE/src/lapacke_dgbequ_work.c +++ b/LAPACKE/src/lapacke_dgbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbequ_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dgbequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dgbequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dgbequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbequb.c b/LAPACKE/src/lapacke_dgbequb.c index 6fbbdb2b53..d7befeda6f 100644 --- a/LAPACKE/src/lapacke_dgbequb.c +++ b/LAPACKE/src/lapacke_dgbequb.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbequb)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_dgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_dgbequb_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_dgbequb_work.c b/LAPACKE/src/lapacke_dgbequb_work.c index 3eaafa13c6..bf83deaa17 100644 --- a/LAPACKE/src/lapacke_dgbequb_work.c +++ b/LAPACKE/src/lapacke_dgbequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbequb_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dgbequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dgbequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dgbequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbrfs.c b/LAPACKE/src/lapacke_dgbrfs.c index 7877ab94d1..a93c1c1f78 100644 --- a/LAPACKE/src/lapacke_dgbrfs.c +++ b/LAPACKE/src/lapacke_dgbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbrfs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, lapack_int ldafb, const lapack_int* ipiv, @@ -43,22 +43,22 @@ lapack_int LAPACKE_dgbrfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -7; } - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_dgbrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgbrfs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_dgbrfs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_dgbrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbrfs_work.c b/LAPACKE/src/lapacke_dgbrfs_work.c index 9c095e2832..8fcc5b67f7 100644 --- a/LAPACKE/src/lapacke_dgbrfs_work.c +++ b/LAPACKE/src/lapacke_dgbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, lapack_int ldafb, @@ -61,22 +61,22 @@ lapack_int LAPACKE_dgbrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -101,11 +101,11 @@ lapack_int LAPACKE_dgbrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, @@ -114,7 +114,7 @@ lapack_int LAPACKE_dgbrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -125,11 +125,11 @@ lapack_int LAPACKE_dgbrfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbrfsx.c b/LAPACKE/src/lapacke_dgbrfsx.c index 3f54f67e87..128355b8df 100644 --- a/LAPACKE/src/lapacke_dgbrfsx.c +++ b/LAPACKE/src/lapacke_dgbrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbrfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_dgbrfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, lapack_int ldafb, @@ -47,37 +47,37 @@ lapack_int LAPACKE_dgbrfsx( int matrix_layout, char trans, char equed, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -15; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -14; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -13; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -17; } } @@ -94,7 +94,7 @@ lapack_int LAPACKE_dgbrfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgbrfsx_work( matrix_layout, trans, equed, n, kl, ku, nrhs, + info = API_SUFFIX(LAPACKE_dgbrfsx_work)( matrix_layout, trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_dgbrfsx( int matrix_layout, char trans, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbrfsx_work.c b/LAPACKE/src/lapacke_dgbrfsx_work.c index 484d10d96f..bae397f585 100644 --- a/LAPACKE/src/lapacke_dgbrfsx_work.c +++ b/LAPACKE/src/lapacke_dgbrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbrfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_dgbrfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, @@ -69,22 +69,22 @@ lapack_int LAPACKE_dgbrfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -18; - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -121,11 +121,11 @@ lapack_int LAPACKE_dgbrfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -135,10 +135,10 @@ lapack_int LAPACKE_dgbrfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -154,11 +154,11 @@ lapack_int LAPACKE_dgbrfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbsv.c b/LAPACKE/src/lapacke_dgbsv.c index 305ad68c81..a36906e5a4 100644 --- a/LAPACKE/src/lapacke_dgbsv.c +++ b/LAPACKE/src/lapacke_dgbsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsv( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_dgbsv)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_dgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, + return API_SUFFIX(LAPACKE_dgbsv_work)( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dgbsv_work.c b/LAPACKE/src/lapacke_dgbsv_work.c index cb29d3d952..f927851157 100644 --- a/LAPACKE/src/lapacke_dgbsv_work.c +++ b/LAPACKE/src/lapacke_dgbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_dgbsv_work)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, lapack_int* ipiv, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsv_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,9 +72,9 @@ lapack_int LAPACKE_dgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -82,20 +82,20 @@ lapack_int LAPACKE_dgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbsvx.c b/LAPACKE/src/lapacke_dgbsvx.c index 0176dc952d..ceb8695a78 100644 --- a/LAPACKE/src/lapacke_dgbsvx.c +++ b/LAPACKE/src/lapacke_dgbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgbsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, lapack_int* ipiv, @@ -45,33 +45,33 @@ lapack_int LAPACKE_dgbsvx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -15; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -14; } } @@ -89,7 +89,7 @@ lapack_int LAPACKE_dgbsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgbsvx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_dgbsvx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Backup significant data from working array(s) */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_dgbsvx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbsvx_work.c b/LAPACKE/src/lapacke_dgbsvx_work.c index 6b48820658..f3a73eff96 100644 --- a/LAPACKE/src/lapacke_dgbsvx_work.c +++ b/LAPACKE/src/lapacke_dgbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgbsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, lapack_int* ipiv, @@ -62,22 +62,22 @@ lapack_int LAPACKE_dgbsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -102,12 +102,12 @@ lapack_int LAPACKE_dgbsvx_work( int matrix_layout, char fact, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -116,20 +116,20 @@ lapack_int LAPACKE_dgbsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -140,11 +140,11 @@ lapack_int LAPACKE_dgbsvx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbsvxx.c b/LAPACKE/src/lapacke_dgbsvxx.c index 9178bc3b7a..2e0af69c43 100644 --- a/LAPACKE/src/lapacke_dgbsvxx.c +++ b/LAPACKE/src/lapacke_dgbsvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsvxx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgbsvxx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, lapack_int* ipiv, @@ -47,38 +47,38 @@ lapack_int LAPACKE_dgbsvxx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -15; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -27; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -14; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_dgbsvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgbsvxx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_dgbsvxx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, @@ -107,7 +107,7 @@ lapack_int LAPACKE_dgbsvxx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbsvxx_work.c b/LAPACKE/src/lapacke_dgbsvxx_work.c index a52d721876..d751168102 100644 --- a/LAPACKE/src/lapacke_dgbsvxx_work.c +++ b/LAPACKE/src/lapacke_dgbsvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbsvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgbsvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, @@ -69,22 +69,22 @@ lapack_int LAPACKE_dgbsvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -121,12 +121,12 @@ lapack_int LAPACKE_dgbsvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, @@ -137,23 +137,23 @@ lapack_int LAPACKE_dgbsvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -169,11 +169,11 @@ lapack_int LAPACKE_dgbsvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbsvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbtrf.c b/LAPACKE/src/lapacke_dgbtrf.c index baac4b61c2..b9fceb8e30 100644 --- a/LAPACKE/src/lapacke_dgbtrf.c +++ b/LAPACKE/src/lapacke_dgbtrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbtrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbtrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, double* ab, lapack_int ldab, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_dgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); + return API_SUFFIX(LAPACKE_dgbtrf_work)( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); } diff --git a/LAPACKE/src/lapacke_dgbtrf_work.c b/LAPACKE/src/lapacke_dgbtrf_work.c index ff5096f964..06eb39d2cb 100644 --- a/LAPACKE/src/lapacke_dgbtrf_work.c +++ b/LAPACKE/src/lapacke_dgbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbtrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, double* ab, lapack_int ldab, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info ); @@ -67,17 +67,17 @@ lapack_int LAPACKE_dgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dgb_trans)( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgbtrs.c b/LAPACKE/src/lapacke_dgbtrs.c index cb86478d1e..58b0ca1fac 100644 --- a/LAPACKE/src/lapacke_dgbtrs.c +++ b/LAPACKE/src/lapacke_dgbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbtrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbtrs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_dgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + return API_SUFFIX(LAPACKE_dgbtrs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dgbtrs_work.c b/LAPACKE/src/lapacke_dgbtrs_work.c index bdc2d129e5..8fd4855723 100644 --- a/LAPACKE/src/lapacke_dgbtrs_work.c +++ b/LAPACKE/src/lapacke_dgbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgbtrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgbtrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const double* ab, lapack_int ldab, const lapack_int* ipiv, double* b, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dgbtrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,9 +74,9 @@ lapack_int LAPACKE_dgbtrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_dgbtrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgebak.c b/LAPACKE/src/lapacke_dgebak.c index 744ca54f3e..e66337c761 100644 --- a/LAPACKE/src/lapacke_dgebak.c +++ b/LAPACKE/src/lapacke_dgebak.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgebak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* scale, lapack_int m, double* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgebak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, scale, 1 ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -9; } } #endif - return LAPACKE_dgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m, + return API_SUFFIX(LAPACKE_dgebak_work)( matrix_layout, job, side, n, ilo, ihi, scale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_dgebak_work.c b/LAPACKE/src/lapacke_dgebak_work.c index afa8b1e52d..da726ab168 100644 --- a/LAPACKE/src/lapacke_dgebak_work.c +++ b/LAPACKE/src/lapacke_dgebak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_dgebak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* scale, lapack_int m, double* v, lapack_int ldv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgebak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_dgebak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_dgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t, &info ); @@ -68,16 +68,16 @@ lapack_int LAPACKE_dgebak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgebal.c b/LAPACKE/src/lapacke_dgebal.c index e9a63fbad0..a16c21c526 100644 --- a/LAPACKE/src/lapacke_dgebal.c +++ b/LAPACKE/src/lapacke_dgebal.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebal( int matrix_layout, char job, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dgebal)( int matrix_layout, char job, lapack_int n, double* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, double* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgebal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } } #endif - return LAPACKE_dgebal_work( matrix_layout, job, n, a, lda, ilo, ihi, scale ); + return API_SUFFIX(LAPACKE_dgebal_work)( matrix_layout, job, n, a, lda, ilo, ihi, scale ); } diff --git a/LAPACKE/src/lapacke_dgebal_work.c b/LAPACKE/src/lapacke_dgebal_work.c index c0d113e19e..e9622d17e4 100644 --- a/LAPACKE/src/lapacke_dgebal_work.c +++ b/LAPACKE/src/lapacke_dgebal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgebal_work)( int matrix_layout, char job, lapack_int n, double* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, double* scale ) { @@ -49,12 +49,12 @@ lapack_int LAPACKE_dgebal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -62,9 +62,9 @@ lapack_int LAPACKE_dgebal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } /* Call LAPACK function and adjust info */ LAPACK_dgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info ); @@ -72,22 +72,22 @@ lapack_int LAPACKE_dgebal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgebrd.c b/LAPACKE/src/lapacke_dgebrd.c index 9ffc4374b5..3c33661982 100644 --- a/LAPACKE/src/lapacke_dgebrd.c +++ b/LAPACKE/src/lapacke_dgebrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebrd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgebrd)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* d, double* e, double* tauq, double* taup ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dgebrd( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgebrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_dgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_dgebrd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_dgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgebrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgebrd_work.c b/LAPACKE/src/lapacke_dgebrd_work.c index 267d773b51..c9096694d5 100644 --- a/LAPACKE/src/lapacke_dgebrd_work.c +++ b/LAPACKE/src/lapacke_dgebrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgebrd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgebrd_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* d, double* e, double* tauq, double* taup, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgebrd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_dgebrd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork, &info ); @@ -74,16 +74,16 @@ lapack_int LAPACKE_dgebrd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgebrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgecon.c b/LAPACKE/src/lapacke_dgecon.c index 9ca44f8a7c..52ad3df3c2 100644 --- a/LAPACKE/src/lapacke_dgecon.c +++ b/LAPACKE/src/lapacke_dgecon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgecon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgecon)( int matrix_layout, char norm, lapack_int n, const double* a, lapack_int lda, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_dgecon( int matrix_layout, char norm, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgecon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgecon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_dgecon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgecon_work( matrix_layout, norm, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_dgecon_work)( matrix_layout, norm, n, a, lda, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_dgecon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgecon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgecon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgecon_work.c b/LAPACKE/src/lapacke_dgecon_work.c index 9b475df5ba..6c838b1476 100644 --- a/LAPACKE/src/lapacke_dgecon_work.c +++ b/LAPACKE/src/lapacke_dgecon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgecon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgecon_work)( int matrix_layout, char norm, lapack_int n, const double* a, lapack_int lda, double anorm, double* rcond, double* work, lapack_int* iwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgecon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgecon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dgecon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, iwork, &info ); @@ -70,11 +70,11 @@ lapack_int LAPACKE_dgecon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgecon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgecon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgedmd.c b/LAPACKE/src/lapacke_dgedmd.c index 6802378da6..3077b6ea5d 100644 --- a/LAPACKE/src/lapacke_dgedmd.c +++ b/LAPACKE/src/lapacke_dgedmd.c @@ -32,14 +32,14 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgedmd( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_dgedmd)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, double* x, lapack_int ldx, double* y, lapack_int ldy, lapack_int nrnk, double* tol, lapack_int k, double* reig, double* imeig, double* z, lapack_int ldz, double* res, double* b, lapack_int ldb, - double* w, lapack_int ldw, double* s, lapack_int lds) + double* w, lapack_int ldw, double* s, lapack_int lds) { lapack_int info = 0; lapack_int lwork = -1; @@ -49,34 +49,34 @@ lapack_int LAPACKE_dgedmd( int matrix_layout, char jobs, char jobz, char jobr, double work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgedmd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -15; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -18; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -20; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, w, ldw ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, w, ldw ) ) { return -22; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_dgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, w, ldw, s, lds, &work_query, lwork, &iwork_query, liwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_dgedmd( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_dgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, w, ldw, s, lds, work, lwork, iwork, liwork ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_dgedmd( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgedmd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgedmd_work.c b/LAPACKE/src/lapacke_dgedmd_work.c index 987709a1b0..6a99b09021 100644 --- a/LAPACKE/src/lapacke_dgedmd_work.c +++ b/LAPACKE/src/lapacke_dgedmd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_dgedmd_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, double* x, lapack_int ldx, double* y, lapack_int ldy, @@ -69,32 +69,32 @@ lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldx < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } if( ldy < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } if( ldb < n ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } if( ldw < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } if( lds < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -136,12 +136,12 @@ lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_dge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_dge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); - LAPACKE_dge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_dgedmd( &jobs, &jobz, &jobr, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, &ldy_t, &nrnk, tol, &k, reig, imeig, z_t, &ldz_t, res, b_t, @@ -151,12 +151,12 @@ lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_5: @@ -171,11 +171,11 @@ lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgedmdq.c b/LAPACKE/src/lapacke_dgedmdq.c index 5c3c39308b..7b7dc8ef15 100644 --- a/LAPACKE/src/lapacke_dgedmdq.c +++ b/LAPACKE/src/lapacke_dgedmdq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgedmdq( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_dgedmdq)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, double* f, lapack_int ldf, double* x, lapack_int ldx, double* y, lapack_int ldy, @@ -49,37 +49,37 @@ lapack_int LAPACKE_dgedmdq( int matrix_layout, char jobs, char jobz, char jobr, double work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgedmdq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -11; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -13; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -15; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -22; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -25; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, v, ldv ) ) { return -27; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -29; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_dgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, v, ldv, s, lds, &work_query, lwork, @@ -102,7 +102,7 @@ lapack_int LAPACKE_dgedmdq( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_dgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, v, ldv, s, lds, work, lwork, iwork, @@ -113,7 +113,7 @@ lapack_int LAPACKE_dgedmdq( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgedmdq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgedmdq_work.c b/LAPACKE/src/lapacke_dgedmdq_work.c index 149e6d24f6..8cc4a77bb6 100644 --- a/LAPACKE/src/lapacke_dgedmdq_work.c +++ b/LAPACKE/src/lapacke_dgedmdq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_dgedmdq_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, double* f, lapack_int ldf, double* x, @@ -73,37 +73,37 @@ lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldf < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( ldx < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( ldy < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( ldz < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( ldb < n ) { info = -26; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( ldv < n ) { info = -28; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } if( lds < n ) { info = -30; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -151,13 +151,13 @@ lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, goto exit_level_6; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); - LAPACKE_dge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_dge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_dge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, m, n, v, ldv, v_t, ldv_t ); - LAPACKE_dge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_dgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, tol, &k, reig, imeig, @@ -167,13 +167,13 @@ lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_6: @@ -190,11 +190,11 @@ lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( f_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgedmdq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeequ.c b/LAPACKE/src/lapacke_dgeequ.c index b6c1c23b45..b1b8024e7b 100644 --- a/LAPACKE/src/lapacke_dgeequ.c +++ b/LAPACKE/src/lapacke_dgeequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeequ)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_dgeequ_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_dgeequ_work.c b/LAPACKE/src/lapacke_dgeequ_work.c index 09290ed478..d5a03019f7 100644 --- a/LAPACKE/src/lapacke_dgeequ_work.c +++ b/LAPACKE/src/lapacke_dgeequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeequ_work)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgeequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_dgeequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_dgeequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeequb.c b/LAPACKE/src/lapacke_dgeequb.c index 0011c76509..2891ab1ceb 100644 --- a/LAPACKE/src/lapacke_dgeequb.c +++ b/LAPACKE/src/lapacke_dgeequb.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeequb)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_dgeequb_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_dgeequb_work.c b/LAPACKE/src/lapacke_dgeequb_work.c index 36336d1b65..c46c781b6d 100644 --- a/LAPACKE/src/lapacke_dgeequb_work.c +++ b/LAPACKE/src/lapacke_dgeequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeequb_work)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgeequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_dgeequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); @@ -71,11 +71,11 @@ lapack_int LAPACKE_dgeequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgees.c b/LAPACKE/src/lapacke_dgees.c index 875972d296..776cc2c56e 100644 --- a/LAPACKE/src/lapacke_dgees.c +++ b/LAPACKE/src/lapacke_dgees.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgees( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_dgees)( int matrix_layout, char jobvs, char sort, LAPACK_D_SELECT2 select, lapack_int n, double* a, lapack_int lda, lapack_int* sdim, double* wr, double* wi, double* vs, lapack_int ldvs ) @@ -43,19 +43,19 @@ lapack_int LAPACKE_dgees( int matrix_layout, char jobvs, char sort, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgees", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -64,7 +64,7 @@ lapack_int LAPACKE_dgees( int matrix_layout, char jobvs, char sort, } } /* Query optimal working array(s) size */ - info = LAPACKE_dgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_dgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, &work_query, lwork, bwork ); if( info != 0 ) { @@ -78,17 +78,17 @@ lapack_int LAPACKE_dgees( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_dgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgees", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgees_work.c b/LAPACKE/src/lapacke_dgees_work.c index 6a18199fa9..30fe0d8c56 100644 --- a/LAPACKE/src/lapacke_dgees_work.c +++ b/LAPACKE/src/lapacke_dgees_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgees_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_dgees_work)( int matrix_layout, char jobvs, char sort, LAPACK_D_SELECT2 select, lapack_int n, double* a, lapack_int lda, lapack_int* sdim, double* wr, double* wi, double* vs, lapack_int ldvs, @@ -55,12 +55,12 @@ lapack_int LAPACKE_dgees_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees_work", info ); return info; } if( ldvs < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -75,7 +75,7 @@ lapack_int LAPACKE_dgees_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (double*) LAPACKE_malloc( sizeof(double) * ldvs_t * MAX(1,n) ); if( vs_t == NULL ) { @@ -84,7 +84,7 @@ lapack_int LAPACKE_dgees_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, wr, wi, vs_t, &ldvs_t, work, &lwork, bwork, &info ); @@ -92,23 +92,23 @@ lapack_int LAPACKE_dgees_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgees_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeesx.c b/LAPACKE/src/lapacke_dgeesx.c index 0460b64062..374057c00c 100644 --- a/LAPACKE/src/lapacke_dgeesx.c +++ b/LAPACKE/src/lapacke_dgeesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_dgeesx)( int matrix_layout, char jobvs, char sort, LAPACK_D_SELECT2 select, char sense, lapack_int n, double* a, lapack_int lda, lapack_int* sdim, double* wr, double* wi, double* vs, lapack_int ldvs, @@ -47,19 +47,19 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -68,7 +68,7 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, } } /* Query optimal working array(s) size */ - info = LAPACKE_dgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_dgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, &work_query, lwork, &iwork_query, liwork, bwork ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); } else { @@ -94,7 +94,7 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_dgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_dgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork ); /* Release memory and exit */ @@ -102,12 +102,12 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, exit_level_2: LAPACKE_free( iwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeesx_work.c b/LAPACKE/src/lapacke_dgeesx_work.c index dcdd64621b..48c6fad89e 100644 --- a/LAPACKE/src/lapacke_dgeesx_work.c +++ b/LAPACKE/src/lapacke_dgeesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeesx_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_dgeesx_work)( int matrix_layout, char jobvs, char sort, LAPACK_D_SELECT2 select, char sense, lapack_int n, double* a, lapack_int lda, lapack_int* sdim, double* wr, double* wi, @@ -58,12 +58,12 @@ lapack_int LAPACKE_dgeesx_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx_work", info ); return info; } if( ldvs < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_dgeesx_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (double*) LAPACKE_malloc( sizeof(double) * ldvs_t * MAX(1,n) ); if( vs_t == NULL ) { @@ -88,7 +88,7 @@ lapack_int LAPACKE_dgeesx_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, wr, wi, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, iwork, @@ -97,23 +97,23 @@ lapack_int LAPACKE_dgeesx_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeev.c b/LAPACKE/src/lapacke_dgeev.c index a2a351d1b5..2c3a0d5619 100644 --- a/LAPACKE/src/lapacke_dgeev.c +++ b/LAPACKE/src/lapacke_dgeev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_dgeev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* wr, double* wi, double* vl, lapack_int ldvl, double* vr, lapack_int ldvr ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_dgeev( int matrix_layout, char jobvl, char jobvr, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, + info = API_SUFFIX(LAPACKE_dgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_dgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, + info = API_SUFFIX(LAPACKE_dgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeev_work.c b/LAPACKE/src/lapacke_dgeev_work.c index 424f5d1766..83c4f83f38 100644 --- a/LAPACKE/src/lapacke_dgeev_work.c +++ b/LAPACKE/src/lapacke_dgeev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_dgeev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* wr, double* wi, double* vl, lapack_int ldvl, double* vr, lapack_int ldvr, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { @@ -98,7 +98,7 @@ lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeev( &jobvl, &jobvr, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, &info ); @@ -106,30 +106,30 @@ lapack_int LAPACKE_dgeev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeevx.c b/LAPACKE/src/lapacke_dgeevx.c index dd14b990e2..3f222b6231 100644 --- a/LAPACKE/src/lapacke_dgeevx.c +++ b/LAPACKE/src/lapacke_dgeevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_dgeevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, double* a, lapack_int lda, double* wr, double* wi, double* vl, lapack_int ldvl, double* vr, lapack_int ldvr, @@ -45,19 +45,19 @@ lapack_int LAPACKE_dgeevx( int matrix_layout, char balanc, char jobvl, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*) LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*n-2) ); if( iwork == NULL ) { @@ -66,7 +66,7 @@ lapack_int LAPACKE_dgeevx( int matrix_layout, char balanc, char jobvl, } } /* Query optimal working array(s) size */ - info = LAPACKE_dgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_dgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, &work_query, lwork, iwork ); @@ -81,19 +81,19 @@ lapack_int LAPACKE_dgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_dgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeevx_work.c b/LAPACKE/src/lapacke_dgeevx_work.c index 7f4c6881d5..ab240498e0 100644 --- a/LAPACKE/src/lapacke_dgeevx_work.c +++ b/LAPACKE/src/lapacke_dgeevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_dgeevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, double* a, lapack_int lda, double* wr, double* wi, double* vl, lapack_int ldvl, double* vr, @@ -60,17 +60,17 @@ lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { @@ -103,7 +103,7 @@ lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm, @@ -112,30 +112,30 @@ lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgehrd.c b/LAPACKE/src/lapacke_dgehrd.c index f5b8c2871e..35eead5971 100644 --- a/LAPACKE/src/lapacke_dgehrd.c +++ b/LAPACKE/src/lapacke_dgehrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgehrd( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_dgehrd)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dgehrd( int matrix_layout, lapack_int n, lapack_int ilo, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgehrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgehrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_dgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_dgehrd( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgehrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgehrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgehrd_work.c b/LAPACKE/src/lapacke_dgehrd_work.c index 019bc822b8..18f03981f0 100644 --- a/LAPACKE/src/lapacke_dgehrd_work.c +++ b/LAPACKE/src/lapacke_dgehrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_dgehrd_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgehrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgehrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgehrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgejsv.c b/LAPACKE/src/lapacke_dgejsv.c index b8952e21be..4ef9f484d3 100644 --- a/LAPACKE/src/lapacke_dgejsv.c +++ b/LAPACKE/src/lapacke_dgejsv.c @@ -32,55 +32,55 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dgejsv)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, double* a, lapack_int lda, double* sva, double* u, lapack_int ldu, double* v, lapack_int ldv, double* stat, lapack_int* istat ) { lapack_int info = 0; - lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) || - LAPACKE_lsame( joba, 'e' ) || - LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) : - ( (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - ( LAPACKE_lsame( joba, 'e' ) || - LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - (!( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) : - ( ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : + lapack_int lwork = (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) : + ( (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + (!( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) ) ? MAX(7,2*n+m) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) ) ? MAX(7,2*n+m) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ? MAX(1,6*n+2*n*n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : 7) ) ) ) ) ); lapack_int* iwork = NULL; double* work = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgejsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } } @@ -93,15 +93,15 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, } 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' ); + int want_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ); + int want_v = API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ); + int want_sce = API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || API_SUFFIX(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 + if( want_u && API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1 + if( want_u && API_SUFFIX(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 ) { @@ -109,7 +109,7 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt, + info = API_SUFFIX(LAPACKE_dgejsv_work)( matrix_layout, joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork ); /* Backup significant data from working array(s) */ @@ -125,7 +125,7 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgejsv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgejsv_work.c b/LAPACKE/src/lapacke_dgejsv_work.c index b13a240760..4cc0f0d4f0 100644 --- a/LAPACKE/src/lapacke_dgejsv_work.c +++ b/LAPACKE/src/lapacke_dgejsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, +lapack_int API_SUFFIX(LAPACKE_dgejsv_work)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, double* a, lapack_int lda, double* sva, double* u, @@ -50,10 +50,10 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } } 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 nu = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : m; + lapack_int nv = API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : + API_SUFFIX(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); @@ -63,17 +63,17 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv_work", info ); return info; } if( ldu < ncols_u ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv_work", info ); return info; } if( ldv < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,16 +82,16 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { 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; } } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -99,7 +99,7 @@ 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 ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_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, @@ -108,33 +108,33 @@ lapack_int LAPACKE_dgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { + API_SUFFIX(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' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { LAPACKE_free( v_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { LAPACKE_free( u_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgejsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelq.c b/LAPACKE/src/lapacke_dgelq.c index 35d9d826dd..77c08e8903 100644 --- a/LAPACKE/src/lapacke_dgelq.c +++ b/LAPACKE/src/lapacke_dgelq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelq)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_dgelq_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_dgelq_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelq2.c b/LAPACKE/src/lapacke_dgelq2.c index 3bf06cee7d..5ef3f4528d 100644 --- a/LAPACKE/src/lapacke_dgelq2.c +++ b/LAPACKE/src/lapacke_dgelq2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelq2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelq2)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelq2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_dgelq2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgelq2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_dgelq2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelq2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelq2_work.c b/LAPACKE/src/lapacke_dgelq2_work.c index cf838d01db..b14c1b5700 100644 --- a/LAPACKE/src/lapacke_dgelq2_work.c +++ b/LAPACKE/src/lapacke_dgelq2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelq2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelq2_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgelq2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dgelq2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelq2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelq_work.c b/LAPACKE/src/lapacke_dgelq_work.c index 7d367b19e8..77cf070d1c 100644 --- a/LAPACKE/src/lapacke_dgelq_work.c +++ b/LAPACKE/src/lapacke_dgelq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelq_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int tsize, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelqf.c b/LAPACKE/src/lapacke_dgelqf.c index 8880e3ca2e..5bc7365593 100644 --- a/LAPACKE/src/lapacke_dgelqf.c +++ b/LAPACKE/src/lapacke_dgelqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelqf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgelqf( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgelqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dgelqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgelqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgelqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dgelqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelqf_work.c b/LAPACKE/src/lapacke_dgelqf_work.c index 7a64cded6e..595dc2853c 100644 --- a/LAPACKE/src/lapacke_dgelqf_work.c +++ b/LAPACKE/src/lapacke_dgelqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelqf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgelqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgelqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgels.c b/LAPACKE/src/lapacke_dgels.c index 1852cfb228..def2cf406c 100644 --- a/LAPACKE/src/lapacke_dgels.c +++ b/LAPACKE/src/lapacke_dgels.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgels( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgels)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dgels( int matrix_layout, char trans, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgels", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dgels( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgels", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgels_work.c b/LAPACKE/src/lapacke_dgels_work.c index 853c5614f0..7edf30fb01 100644 --- a/LAPACKE/src/lapacke_dgels_work.c +++ b/LAPACKE/src/lapacke_dgels_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgels_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -88,8 +88,8 @@ lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -97,11 +97,11 @@ lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgels_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelsd.c b/LAPACKE/src/lapacke_dgelsd.c index d096313d5a..d4a83dda04 100644 --- a/LAPACKE/src/lapacke_dgelsd.c +++ b/LAPACKE/src/lapacke_dgelsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelsd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelsd)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* s, double rcond, lapack_int* rank ) @@ -46,25 +46,25 @@ lapack_int LAPACKE_dgelsd( int matrix_layout, lapack_int m, lapack_int n, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_dgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, &iwork_query ); if( info != 0 ) { goto exit_level_0; @@ -83,7 +83,7 @@ lapack_int LAPACKE_dgelsd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_dgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_dgelsd( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelsd_work.c b/LAPACKE/src/lapacke_dgelsd_work.c index 242082216f..4e28931be1 100644 --- a/LAPACKE/src/lapacke_dgelsd_work.c +++ b/LAPACKE/src/lapacke_dgelsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelsd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelsd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* s, double rcond, lapack_int* rank, double* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dgelsd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dgelsd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, iwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_dgelsd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_dgelsd_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelss.c b/LAPACKE/src/lapacke_dgelss.c index e1692dc300..4b178c3eda 100644 --- a/LAPACKE/src/lapacke_dgelss.c +++ b/LAPACKE/src/lapacke_dgelss.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelss( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelss)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* s, double rcond, lapack_int* rank ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_dgelss( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelss", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_dgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_dgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_dgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelss", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelss_work.c b/LAPACKE/src/lapacke_dgelss_work.c index a3d595acb2..111b274a57 100644 --- a/LAPACKE/src/lapacke_dgelss_work.c +++ b/LAPACKE/src/lapacke_dgelss_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelss_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelss_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* s, double rcond, lapack_int* rank, double* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dgelss_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dgelss_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_dgelss_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_dgelss_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelss_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelsy.c b/LAPACKE/src/lapacke_dgelsy.c index 97a1c90ac4..7b6b2a05bc 100644 --- a/LAPACKE/src/lapacke_dgelsy.c +++ b/LAPACKE/src/lapacke_dgelsy.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelsy( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelsy)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* jpvt, double rcond, lapack_int* rank ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_dgelsy( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgelsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_dgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_dgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_dgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgelsy_work.c b/LAPACKE/src/lapacke_dgelsy_work.c index 2ba4f07ca3..70369af285 100644 --- a/LAPACKE/src/lapacke_dgelsy_work.c +++ b/LAPACKE/src/lapacke_dgelsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgelsy_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgelsy_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* jpvt, double rcond, lapack_int* rank, double* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dgelsy_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dgelsy_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond, rank, work, &lwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_dgelsy_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_dgelsy_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgelsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemlq.c b/LAPACKE/src/lapacke_dgemlq.c index a5fc7b8850..f9d7bb68c2 100644 --- a/LAPACKE/src/lapacke_dgemlq.c +++ b/LAPACKE/src/lapacke_dgemlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* t, lapack_int tsize, @@ -43,25 +43,25 @@ lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgemlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_dgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_dgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemlq_work.c b/LAPACKE/src/lapacke_dgemlq_work.c index 80072ffdf5..f015fd11cb 100644 --- a/LAPACKE/src/lapacke_dgemlq_work.c +++ b/LAPACKE/src/lapacke_dgemlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,k); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) ); } else { a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); @@ -87,8 +87,8 @@ lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -96,18 +96,18 @@ lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemqr.c b/LAPACKE/src/lapacke_dgemqr.c index 6fbcc20476..da4b3e423c 100644 --- a/LAPACKE/src/lapacke_dgemqr.c +++ b/LAPACKE/src/lapacke_dgemqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* t, lapack_int tsize, @@ -44,26 +44,26 @@ lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgemqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_dgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -76,13 +76,13 @@ lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_dgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemqr_work.c b/LAPACKE/src/lapacke_dgemqr_work.c index b254538a25..5687fda577 100644 --- a/LAPACKE/src/lapacke_dgemqr_work.c +++ b/LAPACKE/src/lapacke_dgemqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -94,18 +94,18 @@ lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemqrt.c b/LAPACKE/src/lapacke_dgemqrt.c index 7b9e8c3503..7d2073fc0f 100644 --- a/LAPACKE/src/lapacke_dgemqrt.c +++ b/LAPACKE/src/lapacke_dgemqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* c, @@ -42,21 +42,21 @@ lapack_int LAPACKE_dgemqrt( int matrix_layout, char side, char trans, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgemqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* 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 ) ) { + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } } @@ -68,13 +68,13 @@ lapack_int LAPACKE_dgemqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgemqrt_work( matrix_layout, side, trans, m, n, k, nb, v, ldv, + info = API_SUFFIX(LAPACKE_dgemqrt_work)( matrix_layout, side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgemqrt_work.c b/LAPACKE/src/lapacke_dgemqrt_work.c index 2ecca45374..061fbbf181 100644 --- a/LAPACKE/src/lapacke_dgemqrt_work.c +++ b/LAPACKE/src/lapacke_dgemqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgemqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dgemqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* c, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dgemqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt_work", info ); return info; } if( ldt < nb ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt_work", info ); return info; } if( ldv < k ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,9 +86,9 @@ lapack_int LAPACKE_dgemqrt_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_dge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &info ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_dgemqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_dgemqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgemqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqlf.c b/LAPACKE/src/lapacke_dgeqlf.c index c8891f6f2a..1f42a3d6f7 100644 --- a/LAPACKE/src/lapacke_dgeqlf.c +++ b/LAPACKE/src/lapacke_dgeqlf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqlf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqlf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgeqlf( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqlf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqlf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeqlf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dgeqlf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgeqlf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqlf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dgeqlf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqlf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqlf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqlf_work.c b/LAPACKE/src/lapacke_dgeqlf_work.c index c5274633f8..d8a8e3ce0b 100644 --- a/LAPACKE/src/lapacke_dgeqlf_work.c +++ b/LAPACKE/src/lapacke_dgeqlf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqlf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqlf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqlf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqlf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqp3.c b/LAPACKE/src/lapacke_dgeqp3.c index b9bde96f21..d713daa4f5 100644 --- a/LAPACKE/src/lapacke_dgeqp3.c +++ b/LAPACKE/src/lapacke_dgeqp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqp3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqp3)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* jpvt, double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dgeqp3( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, + info = API_SUFFIX(LAPACKE_dgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_dgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_dgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqp3_work.c b/LAPACKE/src/lapacke_dgeqp3_work.c index 130490ab12..1828581c51 100644 --- a/LAPACKE/src/lapacke_dgeqp3_work.c +++ b/LAPACKE/src/lapacke_dgeqp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqp3_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* jpvt, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqpf.c b/LAPACKE/src/lapacke_dgeqpf.c index 74256a0fd6..4331e7fddd 100644 --- a/LAPACKE/src/lapacke_dgeqpf.c +++ b/LAPACKE/src/lapacke_dgeqpf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqpf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqpf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* jpvt, double* tau ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqpf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqpf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_dgeqpf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqpf_work( matrix_layout, m, n, a, lda, jpvt, tau, work ); + info = API_SUFFIX(LAPACKE_dgeqpf_work)( matrix_layout, m, n, a, lda, jpvt, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqpf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqpf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqpf_work.c b/LAPACKE/src/lapacke_dgeqpf_work.c index 8d53351d76..fad6b21025 100644 --- a/LAPACKE/src/lapacke_dgeqpf_work.c +++ b/LAPACKE/src/lapacke_dgeqpf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqpf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* jpvt, double* tau, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqpf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqpf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqpf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqr.c b/LAPACKE/src/lapacke_dgeqr.c index 20a1700fdb..467ace5fc9 100644 --- a/LAPACKE/src/lapacke_dgeqr.c +++ b/LAPACKE/src/lapacke_dgeqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqr)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_dgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_dgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqr2.c b/LAPACKE/src/lapacke_dgeqr2.c index a340e3a9a7..bbd1793ff0 100644 --- a/LAPACKE/src/lapacke_dgeqr2.c +++ b/LAPACKE/src/lapacke_dgeqr2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqr2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqr2)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_dgeqr2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqr2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_dgeqr2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqr2_work.c b/LAPACKE/src/lapacke_dgeqr2_work.c index 6e461c643c..44374bb730 100644 --- a/LAPACKE/src/lapacke_dgeqr2_work.c +++ b/LAPACKE/src/lapacke_dgeqr2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqr2_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqr2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqr_work.c b/LAPACKE/src/lapacke_dgeqr_work.c index 112e3fcbca..51f44322cf 100644 --- a/LAPACKE/src/lapacke_dgeqr_work.c +++ b/LAPACKE/src/lapacke_dgeqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqr_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int tsize, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dgeqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_dgeqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrf.c b/LAPACKE/src/lapacke_dgeqrf.c index 81a2d4d6b0..9b1cd92678 100644 --- a/LAPACKE/src/lapacke_dgeqrf.c +++ b/LAPACKE/src/lapacke_dgeqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgeqrf( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeqrf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dgeqrf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgeqrf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqrf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dgeqrf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrf_work.c b/LAPACKE/src/lapacke_dgeqrf_work.c index abd8f1726a..df9a6896d0 100644 --- a/LAPACKE/src/lapacke_dgeqrf_work.c +++ b/LAPACKE/src/lapacke_dgeqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrfp.c b/LAPACKE/src/lapacke_dgeqrfp.c index fcac667628..4657175203 100644 --- a/LAPACKE/src/lapacke_dgeqrfp.c +++ b/LAPACKE/src/lapacke_dgeqrfp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrfp( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrfp)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgeqrfp( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrfp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrfp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgeqrfp_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dgeqrfp_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgeqrfp( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqrfp_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dgeqrfp_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrfp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrfp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrfp_work.c b/LAPACKE/src/lapacke_dgeqrfp_work.c index 433e34bfcd..d748059e1f 100644 --- a/LAPACKE/src/lapacke_dgeqrfp_work.c +++ b/LAPACKE/src/lapacke_dgeqrfp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrfp_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrfp_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrfp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrfp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrt.c b/LAPACKE/src/lapacke_dgeqrt.c index 3967b5c19a..06f3390d2e 100644 --- a/LAPACKE/src/lapacke_dgeqrt.c +++ b/LAPACKE/src/lapacke_dgeqrt.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, double* a, lapack_int lda, double* t, lapack_int ldt ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_dgeqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgeqrt_work( matrix_layout, m, n, nb, a, lda, t, ldt, work ); + info = API_SUFFIX(LAPACKE_dgeqrt_work)( matrix_layout, m, n, nb, a, lda, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrt2.c b/LAPACKE/src/lapacke_dgeqrt2.c index f522694547..a056713fd5 100644 --- a/LAPACKE/src/lapacke_dgeqrt2.c +++ b/LAPACKE/src/lapacke_dgeqrt2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt2)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_dgeqrt2_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_dgeqrt2_work.c b/LAPACKE/src/lapacke_dgeqrt2_work.c index 04a7985091..b332ee6b28 100644 --- a/LAPACKE/src/lapacke_dgeqrt2_work.c +++ b/LAPACKE/src/lapacke_dgeqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt2_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_dgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrt3.c b/LAPACKE/src/lapacke_dgeqrt3.c index 513cf68155..8548b65d81 100644 --- a/LAPACKE/src/lapacke_dgeqrt3.c +++ b/LAPACKE/src/lapacke_dgeqrt3.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt3)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_dgeqrt3_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_dgeqrt3_work.c b/LAPACKE/src/lapacke_dgeqrt3_work.c index e2c8706aa0..69a17f6a86 100644 --- a/LAPACKE/src/lapacke_dgeqrt3_work.c +++ b/LAPACKE/src/lapacke_dgeqrt3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt3_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt3_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_dgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgeqrt_work.c b/LAPACKE/src/lapacke_dgeqrt_work.c index 000c94e0b6..103c177bf5 100644 --- a/LAPACKE/src/lapacke_dgeqrt_work.c +++ b/LAPACKE/src/lapacke_dgeqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgeqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, double* a, lapack_int lda, double* t, lapack_int ldt, double* work ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt_work", info ); return info; } if( ldt < MIN(m,n) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,15 +72,15 @@ lapack_int LAPACKE_dgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -88,11 +88,11 @@ lapack_int LAPACKE_dgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgeqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerfs.c b/LAPACKE/src/lapacke_dgerfs.c index b447e258af..81239fefe9 100644 --- a/LAPACKE/src/lapacke_dgerfs.c +++ b/LAPACKE/src/lapacke_dgerfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgerfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, const double* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_dgerfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgerfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_dgerfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgerfs_work( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_dgerfs_work)( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_dgerfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerfs_work.c b/LAPACKE/src/lapacke_dgerfs_work.c index 85e53a74fd..05b35b13ec 100644 --- a/LAPACKE/src/lapacke_dgerfs_work.c +++ b/LAPACKE/src/lapacke_dgerfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgerfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dgerfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,10 +100,10 @@ lapack_int LAPACKE_dgerfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_dgerfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_dgerfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerfsx.c b/LAPACKE/src/lapacke_dgerfsx.c index ce069abf82..ce36f0d36f 100644 --- a/LAPACKE/src/lapacke_dgerfsx.c +++ b/LAPACKE/src/lapacke_dgerfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_dgerfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, const double* r, @@ -46,37 +46,37 @@ lapack_int LAPACKE_dgerfsx( int matrix_layout, char trans, char equed, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgerfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -12; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -11; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -93,7 +93,7 @@ lapack_int LAPACKE_dgerfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgerfsx_work( matrix_layout, trans, equed, n, nrhs, a, lda, + info = API_SUFFIX(LAPACKE_dgerfsx_work)( matrix_layout, trans, equed, n, nrhs, a, lda, af, ldaf, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_dgerfsx( int matrix_layout, char trans, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerfsx_work.c b/LAPACKE/src/lapacke_dgerfsx_work.c index d6606e3f3a..a2ccdfbf4b 100644 --- a/LAPACKE/src/lapacke_dgerfsx_work.c +++ b/LAPACKE/src/lapacke_dgerfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_dgerfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -68,22 +68,22 @@ lapack_int LAPACKE_dgerfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -120,10 +120,10 @@ lapack_int LAPACKE_dgerfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -133,10 +133,10 @@ lapack_int LAPACKE_dgerfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -152,11 +152,11 @@ lapack_int LAPACKE_dgerfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerqf.c b/LAPACKE/src/lapacke_dgerqf.c index 6cea16ba97..f87186b94f 100644 --- a/LAPACKE/src/lapacke_dgerqf.c +++ b/LAPACKE/src/lapacke_dgerqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgerqf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgerqf( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgerqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgerqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dgerqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgerqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgerqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dgerqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgerqf_work.c b/LAPACKE/src/lapacke_dgerqf_work.c index cd571fb092..e7e441aabb 100644 --- a/LAPACKE/src/lapacke_dgerqf_work.c +++ b/LAPACKE/src/lapacke_dgerqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgerqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgerqf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgerqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgerqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgerqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgesdd.c b/LAPACKE/src/lapacke_dgesdd.c index 6b261e9534..76584d5786 100644 --- a/LAPACKE/src/lapacke_dgesdd.c +++ b/LAPACKE/src/lapacke_dgesdd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgesdd( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgesdd)( int matrix_layout, char jobz, lapack_int m, lapack_int n, double* a, lapack_int lda, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt ) @@ -43,13 +43,13 @@ lapack_int LAPACKE_dgesdd( int matrix_layout, char jobz, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgesdd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_dgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_dgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, &work_query, lwork, iwork ); if( info != 0 ) { goto exit_level_1; @@ -75,7 +75,7 @@ lapack_int LAPACKE_dgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_dgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_dgesdd( int matrix_layout, char jobz, lapack_int m, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgesdd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgesdd_work.c b/LAPACKE/src/lapacke_dgesdd_work.c index 7bef2230c3..733fbd9fce 100644 --- a/LAPACKE/src/lapacke_dgesdd_work.c +++ b/LAPACKE/src/lapacke_dgesdd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgesdd_work)( int matrix_layout, char jobz, lapack_int m, lapack_int n, double* a, lapack_int lda, double* s, double* u, lapack_int ldu, double* vt, lapack_int ldvt, double* work, @@ -47,15 +47,15 @@ lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) || - LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && m=n) ) ? n : - ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m=n) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1); lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); @@ -65,17 +65,17 @@ lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd_work", info ); return info; } if( ldu < ncols_u ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd_work", info ); return info; } if( ldvt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -90,8 +90,8 @@ lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { vt_t = (double*) LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { @@ -109,7 +109,7 @@ lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, iwork, &info ); @@ -117,36 +117,36 @@ lapack_int LAPACKE_dgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -12; } } @@ -94,7 +94,7 @@ lapack_int LAPACKE_dgesvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgesvxx_work( matrix_layout, fact, trans, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dgesvxx_work)( matrix_layout, fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_dgesvxx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgesvxx_work.c b/LAPACKE/src/lapacke_dgesvxx_work.c index 7fce9ac206..6a5d17d16a 100644 --- a/LAPACKE/src/lapacke_dgesvxx_work.c +++ b/LAPACKE/src/lapacke_dgesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgesvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgesvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, lapack_int* ipiv, char* equed, double* r, @@ -68,22 +68,22 @@ lapack_int LAPACKE_dgesvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -120,11 +120,11 @@ lapack_int LAPACKE_dgesvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgesvxx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -134,21 +134,21 @@ lapack_int LAPACKE_dgesvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -164,11 +164,11 @@ lapack_int LAPACKE_dgesvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetf2.c b/LAPACKE/src/lapacke_dgetf2.c index 2e34caba42..c38eb6a0df 100644 --- a/LAPACKE/src/lapacke_dgetf2.c +++ b/LAPACKE/src/lapacke_dgetf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetf2)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgetf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_dgetf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_dgetf2_work.c b/LAPACKE/src/lapacke_dgetf2_work.c index 5835fc51d8..3e798d65f8 100644 --- a/LAPACKE/src/lapacke_dgetf2_work.c +++ b/LAPACKE/src/lapacke_dgetf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetf2_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dgetf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dgetf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetrf.c b/LAPACKE/src/lapacke_dgetrf.c index 819196bc49..6232721b4c 100644 --- a/LAPACKE/src/lapacke_dgetrf.c +++ b/LAPACKE/src/lapacke_dgetrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgetrf_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_dgetrf_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_dgetrf2.c b/LAPACKE/src/lapacke_dgetrf2.c index ed34dde9af..b886332e08 100644 --- a/LAPACKE/src/lapacke_dgetrf2.c +++ b/LAPACKE/src/lapacke_dgetrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrf2)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dgetrf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_dgetrf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_dgetrf2_work.c b/LAPACKE/src/lapacke_dgetrf2_work.c index 4ef372005c..433d2ad07c 100644 --- a/LAPACKE/src/lapacke_dgetrf2_work.c +++ b/LAPACKE/src/lapacke_dgetrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrf2_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetrf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetrf_work.c b/LAPACKE/src/lapacke_dgetrf_work.c index 6f79ae7375..62e6fa5027 100644 --- a/LAPACKE/src/lapacke_dgetrf_work.c +++ b/LAPACKE/src/lapacke_dgetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dgetrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dgetrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetrf( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetri.c b/LAPACKE/src/lapacke_dgetri.c index 9f889e4641..d776684acb 100644 --- a/LAPACKE/src/lapacke_dgetri.c +++ b/LAPACKE/src/lapacke_dgetri.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetri( int matrix_layout, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dgetri)( int matrix_layout, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dgetri( int matrix_layout, lapack_int n, double* a, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgetri_work( matrix_layout, n, a, lda, ipiv, &work_query, + info = API_SUFFIX(LAPACKE_dgetri_work)( matrix_layout, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dgetri( int matrix_layout, lapack_int n, double* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgetri_work( matrix_layout, n, a, lda, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_dgetri_work)( matrix_layout, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetri_work.c b/LAPACKE/src/lapacke_dgetri_work.c index dbc9e10a79..fc395e8dce 100644 --- a/LAPACKE/src/lapacke_dgetri_work.c +++ b/LAPACKE/src/lapacke_dgetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dgetri_work)( int matrix_layout, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_dgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetri_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetrs.c b/LAPACKE/src/lapacke_dgetrs.c index 1dfc507eed..2d269244e9 100644 --- a/LAPACKE/src/lapacke_dgetrs.c +++ b/LAPACKE/src/lapacke_dgetrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_dgetrs_work)( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dgetrs_work.c b/LAPACKE/src/lapacke_dgetrs_work.c index b2de85a6c8..89dba256bb 100644 --- a/LAPACKE/src/lapacke_dgetrs_work.c +++ b/LAPACKE/src/lapacke_dgetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dgetrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dgetrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dgetrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetsls.c b/LAPACKE/src/lapacke_dgetsls.c index 2098e94246..5a3e082ead 100644 --- a/LAPACKE/src/lapacke_dgetsls.c +++ b/LAPACKE/src/lapacke_dgetsls.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgetsls)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetsls", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetsls", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetsls_work.c b/LAPACKE/src/lapacke_dgetsls_work.c index c551b6266e..abba19e0fb 100644 --- a/LAPACKE/src/lapacke_dgetsls_work.c +++ b/LAPACKE/src/lapacke_dgetsls_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dgetsls_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -88,8 +88,8 @@ lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -97,11 +97,11 @@ lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsls_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgetsqrhrt.c b/LAPACKE/src/lapacke_dgetsqrhrt.c index cf0e3200ce..80de83441d 100644 --- a/LAPACKE/src/lapacke_dgetsqrhrt.c +++ b/LAPACKE/src/lapacke_dgetsqrhrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetsqrhrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, double* a, lapack_int lda, double* t, lapack_int ldt ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_dgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_dgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_dgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_dgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_dgetsqrhrt_work.c b/LAPACKE/src/lapacke_dgetsqrhrt_work.c index f91887ffec..2da2c171d9 100644 --- a/LAPACKE/src/lapacke_dgetsqrhrt_work.c +++ b/LAPACKE/src/lapacke_dgetsqrhrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgetsqrhrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, double* a, lapack_int lda, double* t, lapack_int ldt, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt_work", info ); return info; } if( ldt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_dgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dgetsqrhrt( &m, &n, &mb1, &nb1, &nb2, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgetsqrhrt_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_dggbak.c b/LAPACKE/src/lapacke_dggbak.c index 8dfb851ef0..b5f3072c3f 100644 --- a/LAPACKE/src/lapacke_dggbak.c +++ b/LAPACKE/src/lapacke_dggbak.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggbak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dggbak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* lscale, const double* rscale, lapack_int m, double* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggbak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, lscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, lscale, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n, rscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, rscale, 1 ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -10; } } #endif - return LAPACKE_dggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale, + return API_SUFFIX(LAPACKE_dggbak_work)( matrix_layout, job, side, n, ilo, ihi, lscale, rscale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_dggbak_work.c b/LAPACKE/src/lapacke_dggbak_work.c index c49152aa7d..c2a7bd6275 100644 --- a/LAPACKE/src/lapacke_dggbak_work.c +++ b/LAPACKE/src/lapacke_dggbak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggbak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_dggbak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* lscale, const double* rscale, lapack_int m, double* v, lapack_int ldv ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dggbak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dggbak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_dggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t, &ldv_t, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_dggbak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggbal.c b/LAPACKE/src/lapacke_dggbal.c index 42f58afc4f..934bb224d6 100644 --- a/LAPACKE/src/lapacke_dggbal.c +++ b/LAPACKE/src/lapacke_dggbal.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggbal( int matrix_layout, char job, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dggbal)( int matrix_layout, char job, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, double* lscale, double* rscale ) @@ -42,28 +42,28 @@ lapack_int LAPACKE_dggbal( int matrix_layout, char job, lapack_int n, double* a, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggbal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 's' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { lwork = MAX(1,6*n); } else { lwork = 1; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dggbal( int matrix_layout, char job, lapack_int n, double* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggbal_work( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, + info = API_SUFFIX(LAPACKE_dggbal_work)( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggbal", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggbal_work.c b/LAPACKE/src/lapacke_dggbal_work.c index f512d6afed..1c239da79c 100644 --- a/LAPACKE/src/lapacke_dggbal_work.c +++ b/LAPACKE/src/lapacke_dggbal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggbal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dggbal_work)( int matrix_layout, char job, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, double* lscale, double* rscale, @@ -54,25 +54,25 @@ lapack_int LAPACKE_dggbal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { 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; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -80,13 +80,13 @@ lapack_int LAPACKE_dggbal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_dggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, @@ -95,31 +95,31 @@ lapack_int LAPACKE_dggbal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggbal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgges.c b/LAPACKE/src/lapacke_dgges.c index b2c3fa3c72..a5472cb21c 100644 --- a/LAPACKE/src/lapacke_dgges.c +++ b/LAPACKE/src/lapacke_dgges.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgges( int matrix_layout, char jobvsl, char jobvsr, char sort, +lapack_int API_SUFFIX(LAPACKE_dgges)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, double* alphar, double* alphai, @@ -45,22 +45,22 @@ lapack_int LAPACKE_dgges( int matrix_layout, char jobvsl, char jobvsr, char sort double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgges", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -69,7 +69,7 @@ lapack_int LAPACKE_dgges( int matrix_layout, char jobvsl, char jobvsr, char sort } } /* Query optimal working array(s) size */ - info = LAPACKE_dgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_dgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, bwork ); if( info != 0 ) { @@ -83,18 +83,18 @@ lapack_int LAPACKE_dgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_dgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgges", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgges3.c b/LAPACKE/src/lapacke_dgges3.c index 079ead78cf..b843d679da 100644 --- a/LAPACKE/src/lapacke_dgges3.c +++ b/LAPACKE/src/lapacke_dgges3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgges3( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_dgges3)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, double* alphar, double* alphai, @@ -45,22 +45,22 @@ lapack_int LAPACKE_dgges3( int matrix_layout, char jobvsl, char jobvsr, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgges3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -69,7 +69,7 @@ lapack_int LAPACKE_dgges3( int matrix_layout, char jobvsl, char jobvsr, } } /* Query optimal working array(s) size */ - info = LAPACKE_dgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_dgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, bwork ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_dgges3( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_dgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgges3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgges3_work.c b/LAPACKE/src/lapacke_dgges3_work.c index 43771ef17b..162afdf3b6 100644 --- a/LAPACKE/src/lapacke_dgges3_work.c +++ b/LAPACKE/src/lapacke_dgges3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_dgges3_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, @@ -63,22 +63,22 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); return info; } if( ldvsl < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); return info; } if( ldvsr < n ) { info = -18; - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -107,7 +107,7 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -116,8 +116,8 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -126,22 +126,22 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_dgges3_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgges_work.c b/LAPACKE/src/lapacke_dgges_work.c index bc6bf47d9f..10ae6abc50 100644 --- a/LAPACKE/src/lapacke_dgges_work.c +++ b/LAPACKE/src/lapacke_dgges_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_dgges_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, double* alphar, @@ -62,22 +62,22 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -18; - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -106,7 +106,7 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -115,8 +115,8 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -125,22 +125,22 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -149,11 +149,11 @@ lapack_int LAPACKE_dgges_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgges_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggesx.c b/LAPACKE/src/lapacke_dggesx.c index 605b637c8b..4290db8e27 100644 --- a/LAPACKE/src/lapacke_dggesx.c +++ b/LAPACKE/src/lapacke_dggesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_dggesx)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, char sense, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, double* alphar, @@ -49,22 +49,22 @@ lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -10; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -73,7 +73,7 @@ lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, } } /* Query optimal working array(s) size */ - info = LAPACKE_dggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_dggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, &work_query, lwork, &iwork_query, liwork, @@ -95,7 +95,7 @@ lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_dggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_dggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, iwork, liwork, bwork ); @@ -104,12 +104,12 @@ lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, exit_level_2: LAPACKE_free( iwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggesx_work.c b/LAPACKE/src/lapacke_dggesx_work.c index bde1321d7b..2430581112 100644 --- a/LAPACKE/src/lapacke_dggesx_work.c +++ b/LAPACKE/src/lapacke_dggesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_dggesx_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_D_SELECT3 selctg, char sense, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, lapack_int* sdim, @@ -65,22 +65,22 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -110,7 +110,7 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -119,8 +119,8 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -130,22 +130,22 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -154,11 +154,11 @@ lapack_int LAPACKE_dggesx_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggev.c b/LAPACKE/src/lapacke_dggev.c index 002f4ac989..2d3114edb0 100644 --- a/LAPACKE/src/lapacke_dggev.c +++ b/LAPACKE/src/lapacke_dggev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_dggev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* alphar, double* alphai, double* beta, double* vl, lapack_int ldvl, double* vr, @@ -43,22 +43,22 @@ lapack_int LAPACKE_dggev( int matrix_layout, char jobvl, char jobvr, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_dggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggev3.c b/LAPACKE/src/lapacke_dggev3.c index 2323ec8f88..a376dabc1a 100644 --- a/LAPACKE/src/lapacke_dggev3.c +++ b/LAPACKE/src/lapacke_dggev3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggev3( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_dggev3)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -45,22 +45,22 @@ lapack_int LAPACKE_dggev3( int matrix_layout, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggev3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { @@ -74,14 +74,14 @@ lapack_int LAPACKE_dggev3( int matrix_layout, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggev3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggev3_work.c b/LAPACKE/src/lapacke_dggev3_work.c index 2f9f5c34db..8812fefce8 100644 --- a/LAPACKE/src/lapacke_dggev3_work.c +++ b/LAPACKE/src/lapacke_dggev3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_dggev3_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* alphar, double* alphai, double* beta, double* vl, @@ -48,10 +48,10 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -63,22 +63,22 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); return info; } if( ldvl < ncols_vl ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); return info; } if( ldvr < ncols_vr ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,ncols_vl) ); if( vl_t == NULL ) { @@ -107,7 +107,7 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,ncols_vr) ); if( vr_t == NULL ) { @@ -116,8 +116,8 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggev3( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, @@ -126,22 +126,22 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggev_work.c b/LAPACKE/src/lapacke_dggev_work.c index 0a6ff6ab05..78f70a83e9 100644 --- a/LAPACKE/src/lapacke_dggev_work.c +++ b/LAPACKE/src/lapacke_dggev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_dggev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* alphar, double* alphai, double* beta, double* vl, @@ -48,10 +48,10 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -63,22 +63,22 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); return info; } if( ldvl < ncols_vl ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); return info; } if( ldvr < ncols_vr ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,ncols_vl) ); if( vl_t == NULL ) { @@ -107,7 +107,7 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,ncols_vr) ); if( vr_t == NULL ) { @@ -116,8 +116,8 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, @@ -126,22 +126,22 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_dggev_work( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggevx.c b/LAPACKE/src/lapacke_dggevx.c index 723b6c340e..4c8def034a 100644 --- a/LAPACKE/src/lapacke_dggevx.c +++ b/LAPACKE/src/lapacke_dggevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_dggevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* alphar, double* alphai, double* beta, @@ -48,23 +48,23 @@ lapack_int LAPACKE_dggevx( int matrix_layout, char balanc, char jobvl, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -72,8 +72,8 @@ lapack_int LAPACKE_dggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } } - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -81,7 +81,7 @@ lapack_int LAPACKE_dggevx( int matrix_layout, char balanc, char jobvl, } } /* Query optimal working array(s) size */ - info = LAPACKE_dggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_dggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, &work_query, lwork, iwork, @@ -97,25 +97,25 @@ lapack_int LAPACKE_dggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_dggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_dggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, iwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggevx_work.c b/LAPACKE/src/lapacke_dggevx_work.c index 458832e1e3..798b837a30 100644 --- a/LAPACKE/src/lapacke_dggevx_work.c +++ b/LAPACKE/src/lapacke_dggevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_dggevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* alphar, double* alphai, double* beta, @@ -65,22 +65,22 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); return info; } if( ldvl < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); return info; } if( ldvr < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { @@ -110,7 +110,7 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { @@ -119,8 +119,8 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, @@ -130,20 +130,20 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -152,11 +152,11 @@ lapack_int LAPACKE_dggevx_work( int matrix_layout, char balanc, char jobvl, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggglm.c b/LAPACKE/src/lapacke_dggglm.c index c896ee1852..bf2106346d 100644 --- a/LAPACKE/src/lapacke_dggglm.c +++ b/LAPACKE/src/lapacke_dggglm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggglm( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dggglm)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, double* a, lapack_int lda, double* b, lapack_int ldb, double* d, double* x, double* y ) { @@ -41,25 +41,25 @@ lapack_int LAPACKE_dggglm( int matrix_layout, lapack_int n, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggglm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_dggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_dggglm( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_dggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggglm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggglm_work.c b/LAPACKE/src/lapacke_dggglm_work.c index 72b11309ca..dc69295c17 100644 --- a/LAPACKE/src/lapacke_dggglm_work.c +++ b/LAPACKE/src/lapacke_dggglm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggglm_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dggglm_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, double* a, lapack_int lda, double* b, lapack_int ldb, double* d, double* x, double* y, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dggglm_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm_work", info ); return info; } if( ldb < p ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dggglm_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dggglm_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggglm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgghd3.c b/LAPACKE/src/lapacke_dgghd3.c index 900bb4dd1c..36b4e7f97f 100644 --- a/LAPACKE/src/lapacke_dgghd3.c +++ b/LAPACKE/src/lapacke_dgghd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgghd3( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_dgghd3)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -44,32 +44,32 @@ lapack_int LAPACKE_dgghd3( int matrix_layout, char compq, char compz, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgghd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_dgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -83,13 +83,13 @@ lapack_int LAPACKE_dgghd3( int matrix_layout, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_dgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgghd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgghd3_work.c b/LAPACKE/src/lapacke_dgghd3_work.c index a115b2bd6c..d029ac542a 100644 --- a/LAPACKE/src/lapacke_dgghd3_work.c +++ b/LAPACKE/src/lapacke_dgghd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_dgghd3_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* b, lapack_int ldb, double* q, lapack_int ldq, @@ -65,22 +65,22 @@ lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -94,14 +94,14 @@ lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -109,13 +109,13 @@ lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dgghd3( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -124,20 +124,20 @@ lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -146,11 +146,11 @@ lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgghrd.c b/LAPACKE/src/lapacke_dgghrd.c index fd6083a739..1fb5890b7e 100644 --- a/LAPACKE/src/lapacke_dgghrd.c +++ b/LAPACKE/src/lapacke_dgghrd.c @@ -32,37 +32,37 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgghrd( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_dgghrd)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* b, lapack_int ldb, double* q, lapack_int ldq, double* z, lapack_int ldz ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgghrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif - return LAPACKE_dgghrd_work( matrix_layout, compq, compz, n, ilo, ihi, a, lda, + return API_SUFFIX(LAPACKE_dgghrd_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz ); } diff --git a/LAPACKE/src/lapacke_dgghrd_work.c b/LAPACKE/src/lapacke_dgghrd_work.c index 58110b553e..1c130fb077 100644 --- a/LAPACKE/src/lapacke_dgghrd_work.c +++ b/LAPACKE/src/lapacke_dgghrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_dgghrd_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, double* b, lapack_int ldb, double* q, lapack_int ldq, @@ -58,22 +58,22 @@ lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,14 +87,14 @@ lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -102,13 +102,13 @@ lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -117,20 +117,20 @@ lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -139,11 +139,11 @@ lapack_int LAPACKE_dgghrd_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgghrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgglse.c b/LAPACKE/src/lapacke_dgglse.c index e666c40a3f..3f61e392f6 100644 --- a/LAPACKE/src/lapacke_dgglse.c +++ b/LAPACKE/src/lapacke_dgglse.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgglse( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgglse)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, double* a, lapack_int lda, double* b, lapack_int ldb, double* c, double* d, double* x ) { @@ -41,28 +41,28 @@ lapack_int LAPACKE_dgglse( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgglse", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( m, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( m, c, 1 ) ) { return -9; } - if( LAPACKE_d_nancheck( p, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( p, d, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_dgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dgglse( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_dgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgglse", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgglse_work.c b/LAPACKE/src/lapacke_dgglse_work.c index 3f1e8e9412..67dd77aaa1 100644 --- a/LAPACKE/src/lapacke_dgglse_work.c +++ b/LAPACKE/src/lapacke_dgglse_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgglse_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgglse_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, double* a, lapack_int lda, double* b, lapack_int ldb, double* c, double* d, double* x, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dgglse_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dgglse_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dgglse_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgglse_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggqrf.c b/LAPACKE/src/lapacke_dggqrf.c index fd16eacafe..43526233ad 100644 --- a/LAPACKE/src/lapacke_dggqrf.c +++ b/LAPACKE/src/lapacke_dggqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggqrf( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dggqrf)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, double* a, lapack_int lda, double* taua, double* b, lapack_int ldb, double* taub ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_dggqrf( int matrix_layout, lapack_int n, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_dggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_dggqrf( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_dggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggqrf_work.c b/LAPACKE/src/lapacke_dggqrf_work.c index 01b8770b30..f442a57877 100644 --- a/LAPACKE/src/lapacke_dggqrf_work.c +++ b/LAPACKE/src/lapacke_dggqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggqrf_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dggqrf_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, double* a, lapack_int lda, double* taua, double* b, lapack_int ldb, double* taub, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dggqrf_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf_work", info ); return info; } if( ldb < p ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dggqrf_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dggqrf_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggrqf.c b/LAPACKE/src/lapacke_dggrqf.c index 5bbb7046c2..7cb2367073 100644 --- a/LAPACKE/src/lapacke_dggrqf.c +++ b/LAPACKE/src/lapacke_dggrqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggrqf( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_dggrqf)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* taua, double* b, lapack_int ldb, double* taub ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_dggrqf( int matrix_layout, lapack_int m, lapack_int p, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggrqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_dggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_dggrqf( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_dggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggrqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggrqf_work.c b/LAPACKE/src/lapacke_dggrqf_work.c index e6dc6f64a6..e2a296443d 100644 --- a/LAPACKE/src/lapacke_dggrqf_work.c +++ b/LAPACKE/src/lapacke_dggrqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggrqf_work( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_dggrqf_work)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* taua, double* b, lapack_int ldb, double* taub, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dggrqf_work( int matrix_layout, lapack_int m, lapack_int p, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dggrqf_work( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dggrqf_work( int matrix_layout, lapack_int m, lapack_int p, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggrqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvd.c b/LAPACKE/src/lapacke_dggsvd.c index 2eb8b271b5..50f9d8a903 100644 --- a/LAPACKE/src/lapacke_dggsvd.c +++ b/LAPACKE/src/lapacke_dggsvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvd( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_dggsvd)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -43,16 +43,16 @@ lapack_int LAPACKE_dggsvd( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } @@ -64,14 +64,14 @@ lapack_int LAPACKE_dggsvd( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggsvd_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_dggsvd_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvd3.c b/LAPACKE/src/lapacke_dggsvd3.c index 586254997e..76fc0721a6 100644 --- a/LAPACKE/src/lapacke_dggsvd3.c +++ b/LAPACKE/src/lapacke_dggsvd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvd3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_dggsvd3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -45,21 +45,21 @@ lapack_int LAPACKE_dggsvd3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } #endif - info = LAPACKE_dggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_dggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, &work_query, lwork, iwork ); if( info != 0 ) @@ -72,14 +72,14 @@ lapack_int LAPACKE_dggsvd3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_dggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvd3_work.c b/LAPACKE/src/lapacke_dggsvd3_work.c index 1a5cc2e81d..e46167122d 100644 --- a/LAPACKE/src/lapacke_dggsvd3_work.c +++ b/LAPACKE/src/lapacke_dggsvd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dggsvd3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, double* a, lapack_int lda, double* b, @@ -65,27 +65,27 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -106,21 +106,21 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -128,8 +128,8 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -138,27 +138,27 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -167,11 +167,11 @@ lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvd_work.c b/LAPACKE/src/lapacke_dggsvd_work.c index eda8e4a225..6ccef6a4bb 100644 --- a/LAPACKE/src/lapacke_dggsvd_work.c +++ b/LAPACKE/src/lapacke_dggsvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dggsvd_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, double* a, lapack_int lda, double* b, @@ -64,27 +64,27 @@ lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,21 +98,21 @@ lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -120,8 +120,8 @@ lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggsvd( &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, @@ -130,27 +130,27 @@ lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_dggsvd_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvp.c b/LAPACKE/src/lapacke_dggsvp.c index 1ddd7cc633..99e3cf6f9d 100644 --- a/LAPACKE/src/lapacke_dggsvp.c +++ b/LAPACKE/src/lapacke_dggsvp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_dggsvp)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double tola, double tolb, lapack_int* k, @@ -44,22 +44,22 @@ lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, double* tau = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -13; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_dggsvp_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_dggsvp_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, work ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvp3.c b/LAPACKE/src/lapacke_dggsvp3.c index 3e5ad77afe..8f58586005 100644 --- a/LAPACKE/src/lapacke_dggsvp3.c +++ b/LAPACKE/src/lapacke_dggsvp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_dggsvp3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double tola, double tolb, lapack_int* k, @@ -46,28 +46,28 @@ lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -13; } } #endif /* Query optimal size for working array */ - info = LAPACKE_dggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + info = API_SUFFIX(LAPACKE_dggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, &work_query, lwork ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_dggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_dggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, work, lwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvp3_work.c b/LAPACKE/src/lapacke_dggsvp3_work.c index d5b119d0f2..ad0ea40f37 100644 --- a/LAPACKE/src/lapacke_dggsvp3_work.c +++ b/LAPACKE/src/lapacke_dggsvp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dggsvp3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double tola, @@ -65,27 +65,27 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); return info; } if( lwork == -1 ) { @@ -106,21 +106,21 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -128,8 +128,8 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -138,27 +138,27 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -167,11 +167,11 @@ lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dggsvp_work.c b/LAPACKE/src/lapacke_dggsvp_work.c index 5e919c501e..827b802c33 100644 --- a/LAPACKE/src/lapacke_dggsvp_work.c +++ b/LAPACKE/src/lapacke_dggsvp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dggsvp_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double tola, @@ -64,27 +64,27 @@ lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); return info; } if( ldv < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,21 +98,21 @@ lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -120,8 +120,8 @@ lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dggsvp( &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, @@ -130,27 +130,27 @@ lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, m, 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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_dggsvp_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dggsvp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtcon.c b/LAPACKE/src/lapacke_dgtcon.c index 378693ea5a..12b00b4bf3 100644 --- a/LAPACKE/src/lapacke_dgtcon.c +++ b/LAPACKE/src/lapacke_dgtcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl, +lapack_int API_SUFFIX(LAPACKE_dgtcon)( char norm, lapack_int n, const double* dl, const double* d, const double* du, const double* du2, const lapack_int* ipiv, double anorm, double* rcond ) { @@ -42,19 +42,19 @@ lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -8; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -3; } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-2, du2, 1 ) ) { return -6; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_dgtcon_work)( norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_dgtcon( char norm, lapack_int n, const double* dl, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtcon_work.c b/LAPACKE/src/lapacke_dgtcon_work.c index 56d9c45cb7..fe31ee5534 100644 --- a/LAPACKE/src/lapacke_dgtcon_work.c +++ b/LAPACKE/src/lapacke_dgtcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtcon_work( char norm, lapack_int n, const double* dl, +lapack_int API_SUFFIX(LAPACKE_dgtcon_work)( char norm, lapack_int n, const double* dl, const double* d, const double* du, const double* du2, const lapack_int* ipiv, double anorm, double* rcond, double* work, diff --git a/LAPACKE/src/lapacke_dgtrfs.c b/LAPACKE/src/lapacke_dgtrfs.c index 98f3e38e15..98e9f61478 100644 --- a/LAPACKE/src/lapacke_dgtrfs.c +++ b/LAPACKE/src/lapacke_dgtrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgtrfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, const double* dlf, const double* df, const double* duf, @@ -44,37 +44,37 @@ lapack_int LAPACKE_dgtrfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgtrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -9; } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dlf, 1 ) ) { return -8; } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-2, du2, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, duf, 1 ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_dgtrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgtrfs_work( matrix_layout, trans, n, nrhs, dl, d, du, dlf, + info = API_SUFFIX(LAPACKE_dgtrfs_work)( matrix_layout, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_dgtrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtrfs_work.c b/LAPACKE/src/lapacke_dgtrfs_work.c index 557e9a8531..0f93273364 100644 --- a/LAPACKE/src/lapacke_dgtrfs_work.c +++ b/LAPACKE/src/lapacke_dgtrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgtrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, const double* dlf, const double* df, @@ -58,12 +58,12 @@ lapack_int LAPACKE_dgtrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,8 +78,8 @@ lapack_int LAPACKE_dgtrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, @@ -88,18 +88,18 @@ lapack_int LAPACKE_dgtrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtsv.c b/LAPACKE/src/lapacke_dgtsv.c index 9efdd73aac..eafdd4fd4f 100644 --- a/LAPACKE/src/lapacke_dgtsv.c +++ b/LAPACKE/src/lapacke_dgtsv.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dgtsv)( int matrix_layout, lapack_int n, lapack_int nrhs, double* dl, double* d, double* du, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgtsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -6; } } #endif - return LAPACKE_dgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb ); + return API_SUFFIX(LAPACKE_dgtsv_work)( matrix_layout, n, nrhs, dl, d, du, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dgtsv_work.c b/LAPACKE/src/lapacke_dgtsv_work.c index a230e204ef..4cef203964 100644 --- a/LAPACKE/src/lapacke_dgtsv_work.c +++ b/LAPACKE/src/lapacke_dgtsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dgtsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, double* dl, double* d, double* du, double* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtsvx.c b/LAPACKE/src/lapacke_dgtsvx.c index 9ad89a7123..fb6d209fde 100644 --- a/LAPACKE/src/lapacke_dgtsvx.c +++ b/LAPACKE/src/lapacke_dgtsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgtsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, double* dlf, double* df, double* duf, double* du2, @@ -44,41 +44,41 @@ lapack_int LAPACKE_dgtsvx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgtsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -14; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -10; } } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dlf, 1 ) ) { return -9; } } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-2, du2, 1 ) ) { return -12; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, duf, 1 ) ) { return -11; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_dgtsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dgtsvx_work( matrix_layout, fact, trans, n, nrhs, dl, d, du, + info = API_SUFFIX(LAPACKE_dgtsvx_work)( matrix_layout, fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_dgtsvx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgtsvx_work.c b/LAPACKE/src/lapacke_dgtsvx_work.c index 3cbc8f31a2..5205289dd4 100644 --- a/LAPACKE/src/lapacke_dgtsvx_work.c +++ b/LAPACKE/src/lapacke_dgtsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgtsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_dgtsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, double* dlf, double* df, double* duf, double* du2, @@ -58,12 +58,12 @@ lapack_int LAPACKE_dgtsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,7 +78,7 @@ lapack_int LAPACKE_dgtsvx_work( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -87,18 +87,18 @@ lapack_int LAPACKE_dgtsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgtsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dgttrf.c b/LAPACKE/src/lapacke_dgttrf.c index bed9525416..d298fa6e82 100644 --- a/LAPACKE/src/lapacke_dgttrf.c +++ b/LAPACKE/src/lapacke_dgttrf.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgttrf( lapack_int n, double* dl, double* d, double* du, +lapack_int API_SUFFIX(LAPACKE_dgttrf)( lapack_int n, double* dl, double* d, double* du, double* du2, lapack_int* ipiv ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -4; } } #endif - return LAPACKE_dgttrf_work( n, dl, d, du, du2, ipiv ); + return API_SUFFIX(LAPACKE_dgttrf_work)( n, dl, d, du, du2, ipiv ); } diff --git a/LAPACKE/src/lapacke_dgttrf_work.c b/LAPACKE/src/lapacke_dgttrf_work.c index 04b9fe325c..ffe3273b6e 100644 --- a/LAPACKE/src/lapacke_dgttrf_work.c +++ b/LAPACKE/src/lapacke_dgttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgttrf_work( lapack_int n, double* dl, double* d, double* du, +lapack_int API_SUFFIX(LAPACKE_dgttrf_work)( lapack_int n, double* dl, double* d, double* du, double* du2, lapack_int* ipiv ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dgttrs.c b/LAPACKE/src/lapacke_dgttrs.c index 1e14efca3c..744c916c12 100644 --- a/LAPACKE/src/lapacke_dgttrs.c +++ b/LAPACKE/src/lapacke_dgttrs.c @@ -32,35 +32,35 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgttrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgttrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, const double* du2, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dgttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-2, du2, 1 ) ) { return -8; } } #endif - return LAPACKE_dgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2, + return API_SUFFIX(LAPACKE_dgttrs_work)( matrix_layout, trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dgttrs_work.c b/LAPACKE/src/lapacke_dgttrs_work.c index ca581622ea..6c3356f6b6 100644 --- a/LAPACKE/src/lapacke_dgttrs_work.c +++ b/LAPACKE/src/lapacke_dgttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dgttrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dgttrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const double* dl, const double* d, const double* du, const double* du2, const lapack_int* ipiv, @@ -52,7 +52,7 @@ lapack_int LAPACKE_dgttrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_dgttrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t, &info ); @@ -70,16 +70,16 @@ lapack_int LAPACKE_dgttrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhgeqz.c b/LAPACKE/src/lapacke_dhgeqz.c index d333594705..3038afd42c 100644 --- a/LAPACKE/src/lapacke_dhgeqz.c +++ b/LAPACKE/src/lapacke_dhgeqz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhgeqz( int matrix_layout, char job, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_dhgeqz)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* h, lapack_int ldh, double* t, lapack_int ldt, double* alphar, double* alphai, double* beta, @@ -44,32 +44,32 @@ lapack_int LAPACKE_dhgeqz( int matrix_layout, char job, char compq, char compz, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dhgeqz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -8; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -15; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -10; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -17; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dhgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_dhgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alphar, alphai, beta, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -83,14 +83,14 @@ lapack_int LAPACKE_dhgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dhgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_dhgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alphar, alphai, beta, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhgeqz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhgeqz_work.c b/LAPACKE/src/lapacke_dhgeqz_work.c index dd08080b7a..c7b2e1be9a 100644 --- a/LAPACKE/src/lapacke_dhgeqz_work.c +++ b/LAPACKE/src/lapacke_dhgeqz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_dhgeqz_work)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* h, lapack_int ldh, double* t, lapack_int ldt, double* alphar, @@ -61,22 +61,22 @@ lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldh < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); return info; } if( ldq < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); return info; } if( ldz < n ) { info = -18; - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -97,14 +97,14 @@ lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -112,13 +112,13 @@ lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dhgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t, @@ -128,20 +128,20 @@ lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_dhgeqz_work( int matrix_layout, char job, char compq, LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhgeqz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhsein.c b/LAPACKE/src/lapacke_dhsein.c index 3843701cc4..2ef746204d 100644 --- a/LAPACKE/src/lapacke_dhsein.c +++ b/LAPACKE/src/lapacke_dhsein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhsein( int matrix_layout, char job, char eigsrc, char initv, +lapack_int API_SUFFIX(LAPACKE_dhsein)( int matrix_layout, char job, char eigsrc, char initv, lapack_logical* select, lapack_int n, const double* h, lapack_int ldh, double* wr, const double* wi, double* vl, lapack_int ldvl, @@ -43,29 +43,29 @@ lapack_int LAPACKE_dhsein( int matrix_layout, char job, char eigsrc, char initv, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dhsein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -11; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -13; } } - if( LAPACKE_d_nancheck( n, wi, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, wi, 1 ) ) { return -10; } - if( LAPACKE_d_nancheck( n, wr, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, wr, 1 ) ) { return -9; } } @@ -77,14 +77,14 @@ lapack_int LAPACKE_dhsein( int matrix_layout, char job, char eigsrc, char initv, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dhsein_work( matrix_layout, job, eigsrc, initv, select, n, h, + info = API_SUFFIX(LAPACKE_dhsein_work)( matrix_layout, job, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhsein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhsein_work.c b/LAPACKE/src/lapacke_dhsein_work.c index b234c97404..6feb9e7028 100644 --- a/LAPACKE/src/lapacke_dhsein_work.c +++ b/LAPACKE/src/lapacke_dhsein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, +lapack_int API_SUFFIX(LAPACKE_dhsein_work)( int matrix_layout, char job, char eigsrc, char initv, lapack_logical* select, lapack_int n, const double* h, lapack_int ldh, double* wr, const double* wi, double* vl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein_work", info ); return info; } if( ldvl < mm ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein_work", info ); return info; } if( ldvr < mm ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,7 +77,7 @@ lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { @@ -94,14 +94,14 @@ lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'l' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'r' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_dhsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, wr, wi, @@ -111,31 +111,31 @@ lapack_int LAPACKE_dhsein_work( int matrix_layout, char job, char eigsrc, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhsein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhseqr.c b/LAPACKE/src/lapacke_dhseqr.c index 736bf3ea04..9069ad2f8a 100644 --- a/LAPACKE/src/lapacke_dhseqr.c +++ b/LAPACKE/src/lapacke_dhseqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhseqr( int matrix_layout, char job, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dhseqr)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* h, lapack_int ldh, double* wr, double* wi, double* z, lapack_int ldz ) @@ -42,24 +42,24 @@ lapack_int LAPACKE_dhseqr( int matrix_layout, char job, char compz, lapack_int n double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dhseqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dhseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_dhseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_dhseqr( int matrix_layout, char job, char compz, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dhseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_dhseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhseqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dhseqr_work.c b/LAPACKE/src/lapacke_dhseqr_work.c index 5bd6de7aa4..e8e265ad73 100644 --- a/LAPACKE/src/lapacke_dhseqr_work.c +++ b/LAPACKE/src/lapacke_dhseqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dhseqr_work( int matrix_layout, char job, char compz, +lapack_int API_SUFFIX(LAPACKE_dhseqr_work)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* h, lapack_int ldh, double* wr, double* wi, double* z, lapack_int ldz, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dhseqr_work( int matrix_layout, char job, char compz, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_dhseqr_work( int matrix_layout, char job, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,9 +82,9 @@ lapack_int LAPACKE_dhseqr_work( int matrix_layout, char job, char compz, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dhseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, wr, wi, z_t, @@ -93,23 +93,23 @@ lapack_int LAPACKE_dhseqr_work( int matrix_layout, char job, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dhseqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlacn2.c b/LAPACKE/src/lapacke_dlacn2.c index 6658b5bf15..26059d1482 100644 --- a/LAPACKE/src/lapacke_dlacn2.c +++ b/LAPACKE/src/lapacke_dlacn2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlacn2( lapack_int n, double* v, double* x, lapack_int* isgn, +lapack_int API_SUFFIX(LAPACKE_dlacn2)( lapack_int n, double* v, double* x, lapack_int* isgn, double* est, lapack_int* kase, lapack_int* isave ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, est, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, est, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, x, 1 ) ) { return -3; } } #endif - return LAPACKE_dlacn2_work( n, v, x, isgn, est, kase, isave ); + return API_SUFFIX(LAPACKE_dlacn2_work)( n, v, x, isgn, est, kase, isave ); } diff --git a/LAPACKE/src/lapacke_dlacn2_work.c b/LAPACKE/src/lapacke_dlacn2_work.c index 0e4cb07b5f..4ed7f7a452 100644 --- a/LAPACKE/src/lapacke_dlacn2_work.c +++ b/LAPACKE/src/lapacke_dlacn2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlacn2_work( lapack_int n, double* v, double* x, +lapack_int API_SUFFIX(LAPACKE_dlacn2_work)( lapack_int n, double* v, double* x, lapack_int* isgn, double* est, lapack_int* kase, lapack_int* isave ) { diff --git a/LAPACKE/src/lapacke_dlacpy.c b/LAPACKE/src/lapacke_dlacpy.c index 8c59e75e05..1c102991ff 100644 --- a/LAPACKE/src/lapacke_dlacpy.c +++ b/LAPACKE/src/lapacke_dlacpy.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlacpy( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlacpy)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlacpy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlacpy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_dlacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_dlacpy_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dlacpy_work.c b/LAPACKE/src/lapacke_dlacpy_work.c index 82a76dca37..fa20a9dcff 100644 --- a/LAPACKE/src/lapacke_dlacpy_work.c +++ b/LAPACKE/src/lapacke_dlacpy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlacpy_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlacpy_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* b, lapack_int ldb ) { @@ -48,12 +48,12 @@ lapack_int LAPACKE_dlacpy_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlacpy_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlacpy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,23 +68,23 @@ lapack_int LAPACKE_dlacpy_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlacpy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlacpy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlag2s.c b/LAPACKE/src/lapacke_dlag2s.c index e5421b34e7..af14376c84 100644 --- a/LAPACKE/src/lapacke_dlag2s.c +++ b/LAPACKE/src/lapacke_dlag2s.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlag2s( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlag2s)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, float* sa, lapack_int ldsa ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlag2s", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlag2s", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dlag2s_work( matrix_layout, m, n, a, lda, sa, ldsa ); + return API_SUFFIX(LAPACKE_dlag2s_work)( matrix_layout, m, n, a, lda, sa, ldsa ); } diff --git a/LAPACKE/src/lapacke_dlag2s_work.c b/LAPACKE/src/lapacke_dlag2s_work.c index a5ec0383e4..a4bd6d2912 100644 --- a/LAPACKE/src/lapacke_dlag2s_work.c +++ b/LAPACKE/src/lapacke_dlag2s_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlag2s_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlag2s_work)( int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, float* sa, lapack_int ldsa ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dlag2s_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dlag2s_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlag2s_work", info ); return info; } if( ldsa < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dlag2s_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlag2s_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,25 +71,25 @@ lapack_int LAPACKE_dlag2s_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlag2s( &m, &n, a_t, &lda_t, sa_t, &ldsa_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, sa_t, ldsa_t, sa, ldsa ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, sa_t, ldsa_t, sa, ldsa ); /* Release memory and exit */ LAPACKE_free( sa_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlag2s_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlag2s_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlag2s_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlag2s_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlagge.c b/LAPACKE/src/lapacke_dlagge.c index 5fe0bb5781..a9d2889a8f 100644 --- a/LAPACKE/src/lapacke_dlagge.c +++ b/LAPACKE/src/lapacke_dlagge.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlagge( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlagge)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* d, double* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlagge", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagge", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(m,n), d, 1 ) ) { return -6; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_dlagge( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dlagge_work( matrix_layout, m, n, kl, ku, d, a, lda, iseed, + info = API_SUFFIX(LAPACKE_dlagge_work)( matrix_layout, m, n, kl, ku, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlagge", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagge", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlagge_work.c b/LAPACKE/src/lapacke_dlagge_work.c index ccf3ae9b08..a8d2233d2f 100644 --- a/LAPACKE/src/lapacke_dlagge_work.c +++ b/LAPACKE/src/lapacke_dlagge_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlagge_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlagge_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* d, double* a, lapack_int lda, lapack_int* iseed, double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dlagge_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagge_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,16 +65,16 @@ lapack_int LAPACKE_dlagge_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagge_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagge_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlagsy.c b/LAPACKE/src/lapacke_dlagsy.c index b081fd5008..d26e0190f3 100644 --- a/LAPACKE/src/lapacke_dlagsy.c +++ b/LAPACKE/src/lapacke_dlagsy.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlagsy( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_dlagsy)( int matrix_layout, lapack_int n, lapack_int k, const double* d, double* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlagsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_dlagsy( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dlagsy_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_dlagsy_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlagsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlagsy_work.c b/LAPACKE/src/lapacke_dlagsy_work.c index d160fcbdeb..3460f72d7a 100644 --- a/LAPACKE/src/lapacke_dlagsy_work.c +++ b/LAPACKE/src/lapacke_dlagsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlagsy_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_dlagsy_work)( int matrix_layout, lapack_int n, lapack_int k, const double* d, double* a, lapack_int lda, lapack_int* iseed, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dlagsy_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagsy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,16 +64,16 @@ lapack_int LAPACKE_dlagsy_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlagsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlamch.c b/LAPACKE/src/lapacke_dlamch.c index 0828867874..e406a097b2 100644 --- a/LAPACKE/src/lapacke_dlamch.c +++ b/LAPACKE/src/lapacke_dlamch.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlamch( char cmach ) +double API_SUFFIX(LAPACKE_dlamch)( char cmach ) { - return LAPACKE_dlamch_work( cmach ); + return API_SUFFIX(LAPACKE_dlamch_work)( cmach ); } diff --git a/LAPACKE/src/lapacke_dlamch_work.c b/LAPACKE/src/lapacke_dlamch_work.c index cc57f6e0bb..a8a5927d1d 100644 --- a/LAPACKE/src/lapacke_dlamch_work.c +++ b/LAPACKE/src/lapacke_dlamch_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlamch_work( char cmach ) +double API_SUFFIX(LAPACKE_dlamch_work)( char cmach ) { double res; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dlangb.c b/LAPACKE/src/lapacke_dlangb.c index ca16ea7f46..618625f99c 100644 --- a/LAPACKE/src/lapacke_dlangb.c +++ b/LAPACKE/src/lapacke_dlangb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlangb( int matrix_layout, char norm, lapack_int n, +double API_SUFFIX(LAPACKE_dlangb)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab ) { @@ -40,19 +40,19 @@ double LAPACKE_dlangb( int matrix_layout, char norm, lapack_int n, double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlangb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlangb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ double LAPACKE_dlangb( int matrix_layout, char norm, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_dlangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work ); + res = API_SUFFIX(LAPACKE_dlangb_work)( matrix_layout, norm, n, kl, ku, ab, ldab, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlangb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlangb", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlangb_work.c b/LAPACKE/src/lapacke_dlangb_work.c index ba04c2b628..6ab5a35d89 100644 --- a/LAPACKE/src/lapacke_dlangb_work.c +++ b/LAPACKE/src/lapacke_dlangb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlangb_work( int matrix_layout, char norm, lapack_int n, +double API_SUFFIX(LAPACKE_dlangb_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const double* ab, lapack_int ldab, double* work ) { @@ -47,18 +47,18 @@ double LAPACKE_dlangb_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < kl+ku+1 ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlangb_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ double LAPACKE_dlangb_work( int matrix_layout, char norm, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlangb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlangb_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlange.c b/LAPACKE/src/lapacke_dlange.c index 30094bd9e4..3ae347614e 100644 --- a/LAPACKE/src/lapacke_dlange.c +++ b/LAPACKE/src/lapacke_dlange.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -double LAPACKE_dlange( int matrix_layout, char norm, lapack_int m, +double API_SUFFIX(LAPACKE_dlange)( int matrix_layout, char norm, lapack_int m, lapack_int n, const double* a, lapack_int lda ) { lapack_int info = 0; double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlange", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlange", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -59,14 +59,14 @@ double LAPACKE_dlange( int matrix_layout, char norm, lapack_int m, } } /* Call middle-level interface */ - res = LAPACKE_dlange_work( matrix_layout, norm, m, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_dlange_work)( matrix_layout, norm, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlange", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlange", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlange_work.c b/LAPACKE/src/lapacke_dlange_work.c index 56750bb76f..dbe9aafb15 100644 --- a/LAPACKE/src/lapacke_dlange_work.c +++ b/LAPACKE/src/lapacke_dlange_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlange_work( int matrix_layout, char norm, lapack_int m, +double API_SUFFIX(LAPACKE_dlange_work)( int matrix_layout, char norm, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* work ) { @@ -47,18 +47,18 @@ double LAPACKE_dlange_work( int matrix_layout, char norm, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlange_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ double LAPACKE_dlange_work( int matrix_layout, char norm, lapack_int m, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlange_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlange_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlansy.c b/LAPACKE/src/lapacke_dlansy.c index 4007cc9127..917bd1e683 100644 --- a/LAPACKE/src/lapacke_dlansy.c +++ b/LAPACKE/src/lapacke_dlansy.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -double LAPACKE_dlansy( int matrix_layout, char norm, char uplo, lapack_int n, +double API_SUFFIX(LAPACKE_dlansy)( int matrix_layout, char norm, char uplo, lapack_int n, const double* a, lapack_int lda ) { lapack_int info = 0; double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlansy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlansy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ double LAPACKE_dlansy( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_dlansy_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_dlansy_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlansy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlansy", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlansy_work.c b/LAPACKE/src/lapacke_dlansy_work.c index a370261c35..59c4ebf495 100644 --- a/LAPACKE/src/lapacke_dlansy_work.c +++ b/LAPACKE/src/lapacke_dlansy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlansy_work( int matrix_layout, char norm, char uplo, +double API_SUFFIX(LAPACKE_dlansy_work)( int matrix_layout, char norm, char uplo, lapack_int n, const double* a, lapack_int lda, double* work ) { @@ -50,7 +50,7 @@ double LAPACKE_dlansy_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlansy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ double LAPACKE_dlansy_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_dlansy( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -68,11 +68,11 @@ double LAPACKE_dlansy_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlansy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlansy_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlantr.c b/LAPACKE/src/lapacke_dlantr.c index b20af0eb46..41745d83b5 100644 --- a/LAPACKE/src/lapacke_dlantr.c +++ b/LAPACKE/src/lapacke_dlantr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlantr( int matrix_layout, char norm, char uplo, char diag, +double API_SUFFIX(LAPACKE_dlantr)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const double* a, lapack_int lda ) { @@ -40,19 +40,19 @@ double LAPACKE_dlantr( int matrix_layout, char norm, char uplo, char diag, double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlantr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlantr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtz_nancheck)( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,MAX(m,n)) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ double LAPACKE_dlantr( int matrix_layout, char norm, char uplo, char diag, } } /* Call middle-level interface */ - res = LAPACKE_dlantr_work( matrix_layout, norm, uplo, diag, m, n, a, lda, + res = API_SUFFIX(LAPACKE_dlantr_work)( matrix_layout, norm, uplo, diag, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlantr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlantr", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlantr_work.c b/LAPACKE/src/lapacke_dlantr_work.c index 34fa94c439..876a2095f3 100644 --- a/LAPACKE/src/lapacke_dlantr_work.c +++ b/LAPACKE/src/lapacke_dlantr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo, +double API_SUFFIX(LAPACKE_dlantr_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const double* a, lapack_int lda, double* work ) { @@ -48,23 +48,23 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlantr_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } - if( LAPACKE_lsame( uplo, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { uplo_lapack = 'l'; } else { uplo_lapack = 'u'; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -79,11 +79,11 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlantr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlantr_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_dlapmr.c b/LAPACKE/src/lapacke_dlapmr.c index 3ccddda2fb..424d04d849 100644 --- a/LAPACKE/src/lapacke_dlapmr.c +++ b/LAPACKE/src/lapacke_dlapmr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlapmr( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_dlapmr)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, double* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlapmr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_dlapmr_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_dlapmr_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_dlapmr_work.c b/LAPACKE/src/lapacke_dlapmr_work.c index 888649e0b3..deb4a7b070 100644 --- a/LAPACKE/src/lapacke_dlapmr_work.c +++ b/LAPACKE/src/lapacke_dlapmr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlapmr_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_dlapmr_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, double* x, lapack_int ldx, lapack_int* k ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dlapmr_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_dlapmr_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dlapmr( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlapmt.c b/LAPACKE/src/lapacke_dlapmt.c index 23f3932ffc..2544c81a9e 100644 --- a/LAPACKE/src/lapacke_dlapmt.c +++ b/LAPACKE/src/lapacke_dlapmt.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlapmt( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_dlapmt)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, double* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlapmt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_dlapmt_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_dlapmt_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_dlapmt_work.c b/LAPACKE/src/lapacke_dlapmt_work.c index 1eb7557854..b2da97b19d 100644 --- a/LAPACKE/src/lapacke_dlapmt_work.c +++ b/LAPACKE/src/lapacke_dlapmt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlapmt_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_dlapmt_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, double* x, lapack_int ldx, lapack_int* k ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dlapmt_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_dlapmt_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dlapmt( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlapmt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlapy2.c b/LAPACKE/src/lapacke_dlapy2.c index fd8a145932..83b1b55a29 100644 --- a/LAPACKE/src/lapacke_dlapy2.c +++ b/LAPACKE/src/lapacke_dlapy2.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -double LAPACKE_dlapy2( double x, double y ) +double API_SUFFIX(LAPACKE_dlapy2)( double x, double y ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_d_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &y, 1 ) ) { return -2; } } #endif - return LAPACKE_dlapy2_work( x, y ); + return API_SUFFIX(LAPACKE_dlapy2_work)( x, y ); } diff --git a/LAPACKE/src/lapacke_dlapy2_work.c b/LAPACKE/src/lapacke_dlapy2_work.c index 45377c523f..4aa91781e9 100644 --- a/LAPACKE/src/lapacke_dlapy2_work.c +++ b/LAPACKE/src/lapacke_dlapy2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlapy2_work( double x, double y ) +double API_SUFFIX(LAPACKE_dlapy2_work)( double x, double y ) { double res = 0.; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dlapy3.c b/LAPACKE/src/lapacke_dlapy3.c index f1ef9420b7..62ae6e9da1 100644 --- a/LAPACKE/src/lapacke_dlapy3.c +++ b/LAPACKE/src/lapacke_dlapy3.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -double LAPACKE_dlapy3( double x, double y, double z ) +double API_SUFFIX(LAPACKE_dlapy3)( double x, double y, double z ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_d_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &y, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( 1, &z, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &z, 1 ) ) { return -3; } } #endif - return LAPACKE_dlapy3_work( x, y, z ); + return API_SUFFIX(LAPACKE_dlapy3_work)( x, y, z ); } diff --git a/LAPACKE/src/lapacke_dlapy3_work.c b/LAPACKE/src/lapacke_dlapy3_work.c index 98a17d3669..353b0b1234 100644 --- a/LAPACKE/src/lapacke_dlapy3_work.c +++ b/LAPACKE/src/lapacke_dlapy3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_dlapy3_work( double x, double y, double z ) +double API_SUFFIX(LAPACKE_dlapy3_work)( double x, double y, double z ) { double res = 0.; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dlarfb.c b/LAPACKE/src/lapacke_dlarfb.c index aeebd8dec6..fee6d8e3b0 100644 --- a/LAPACKE/src/lapacke_dlarfb.c +++ b/LAPACKE/src/lapacke_dlarfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_dlarfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* c, @@ -45,39 +45,39 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct lapack_logical left, col, forward; char uplo; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlarfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); uplo = ( ( forward && col ) || !( forward || col ) ) ? 'l' : 'u'; if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { - LAPACKE_xerbla( "LAPACKE_dlarfb", -8 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb", -8 ); return -8; } - if( LAPACKE_dtz_nancheck( matrix_layout, direct, uplo, 'u', + if( API_SUFFIX(LAPACKE_dtz_nancheck)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -11; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -13; } } #endif - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { ldwork = n; - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { ldwork = m; } else { ldwork = 1; @@ -89,13 +89,13 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dlarfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_dlarfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlarfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlarfb_work.c b/LAPACKE/src/lapacke_dlarfb_work.c index de2f41e662..fec4ac692e 100644 --- a/LAPACKE/src/lapacke_dlarfb_work.c +++ b/LAPACKE/src/lapacke_dlarfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dlarfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const double* v, lapack_int ldv, const double* t, lapack_int ldt, @@ -53,9 +53,9 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); @@ -67,22 +67,22 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); return info; } if( ldv < ncols_v ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); return info; } if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -103,16 +103,16 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dtz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, + API_SUFFIX(LAPACKE_dtz_trans)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv, v_t, ldv_t ); - LAPACKE_dge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -121,11 +121,11 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlarfg.c b/LAPACKE/src/lapacke_dlarfg.c index 95cd4d7d3f..ba0c600e21 100644 --- a/LAPACKE/src/lapacke_dlarfg.c +++ b/LAPACKE/src/lapacke_dlarfg.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfg( lapack_int n, double* alpha, double* x, +lapack_int API_SUFFIX(LAPACKE_dlarfg)( lapack_int n, double* alpha, double* x, lapack_int incx, double* tau ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, alpha, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( n-1, x, incx ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, x, incx ) ) { return -3; } } #endif - return LAPACKE_dlarfg_work( n, alpha, x, incx, tau ); + return API_SUFFIX(LAPACKE_dlarfg_work)( n, alpha, x, incx, tau ); } diff --git a/LAPACKE/src/lapacke_dlarfg_work.c b/LAPACKE/src/lapacke_dlarfg_work.c index eaa49449d7..226c5398df 100644 --- a/LAPACKE/src/lapacke_dlarfg_work.c +++ b/LAPACKE/src/lapacke_dlarfg_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfg_work( lapack_int n, double* alpha, double* x, +lapack_int API_SUFFIX(LAPACKE_dlarfg_work)( lapack_int n, double* alpha, double* x, lapack_int incx, double* tau ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dlarft.c b/LAPACKE/src/lapacke_dlarft.c index a8d8fa6d3d..e02d8b03ae 100644 --- a/LAPACKE/src/lapacke_dlarft.c +++ b/LAPACKE/src/lapacke_dlarft.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarft( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_dlarft)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const double* v, lapack_int ldv, const double* tau, double* t, lapack_int ldt ) { lapack_int ncols_v, nrows_v; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlarft", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarft", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -6; } } #endif - return LAPACKE_dlarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau, + return API_SUFFIX(LAPACKE_dlarft_work)( matrix_layout, direct, storev, n, k, v, ldv, tau, t, ldt ); } diff --git a/LAPACKE/src/lapacke_dlarft_work.c b/LAPACKE/src/lapacke_dlarft_work.c index c430f1bb57..ff5e56d7d6 100644 --- a/LAPACKE/src/lapacke_dlarft_work.c +++ b/LAPACKE/src/lapacke_dlarft_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarft_work( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_dlarft_work)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const double* v, lapack_int ldv, const double* tau, double* t, lapack_int ldt ) @@ -48,21 +48,21 @@ lapack_int LAPACKE_dlarft_work( int matrix_layout, char direct, char storev, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); ldt_t = MAX(1,k); ldv_t = MAX(1,nrows_v); /* Check leading dimension(s) */ if( ldt < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarft_work", info ); return info; } if( ldv < ncols_v ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarft_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,24 +78,24 @@ lapack_int LAPACKE_dlarft_work( int matrix_layout, char direct, char storev, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_dlarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t, &ldt_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarft_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarft_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlarfx.c b/LAPACKE/src/lapacke_dlarfx.c index 18676b4cc1..0b76d1f51a 100644 --- a/LAPACKE/src/lapacke_dlarfx.c +++ b/LAPACKE/src/lapacke_dlarfx.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfx( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlarfx)( int matrix_layout, char side, lapack_int m, lapack_int n, const double* v, double tau, double* c, lapack_int ldc, double* work ) { lapack_int lv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlarfx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tau, 1 ) ) { return -6; } - lv = (LAPACKE_lsame( side, 'l' ) ? m : n); - if( LAPACKE_d_nancheck( lv, v, 1 ) ) { + lv = (API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n); + if( API_SUFFIX(LAPACKE_d_nancheck)( lv, v, 1 ) ) { return -5; } } #endif - return LAPACKE_dlarfx_work( matrix_layout, side, m, n, v, tau, c, ldc, + return API_SUFFIX(LAPACKE_dlarfx_work)( matrix_layout, side, m, n, v, tau, c, ldc, work ); } diff --git a/LAPACKE/src/lapacke_dlarfx_work.c b/LAPACKE/src/lapacke_dlarfx_work.c index 7345976b85..f9ac0626ee 100644 --- a/LAPACKE/src/lapacke_dlarfx_work.c +++ b/LAPACKE/src/lapacke_dlarfx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarfx_work( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlarfx_work)( int matrix_layout, char side, lapack_int m, lapack_int n, const double* v, double tau, double* c, lapack_int ldc, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dlarfx_work( int matrix_layout, char side, lapack_int m, /* Check leading dimension(s) */ if( ldc < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_dlarfx_work( int matrix_layout, char side, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dlarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlarfx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlarnv.c b/LAPACKE/src/lapacke_dlarnv.c index 004fee2ae3..f634150ccc 100644 --- a/LAPACKE/src/lapacke_dlarnv.c +++ b/LAPACKE/src/lapacke_dlarnv.c @@ -32,8 +32,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarnv( lapack_int idist, lapack_int* iseed, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlarnv)( lapack_int idist, lapack_int* iseed, lapack_int n, double* x ) { - return LAPACKE_dlarnv_work( idist, iseed, n, x ); + return API_SUFFIX(LAPACKE_dlarnv_work)( idist, iseed, n, x ); } diff --git a/LAPACKE/src/lapacke_dlarnv_work.c b/LAPACKE/src/lapacke_dlarnv_work.c index e430e52ac0..5cc116e1f0 100644 --- a/LAPACKE/src/lapacke_dlarnv_work.c +++ b/LAPACKE/src/lapacke_dlarnv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlarnv_work( lapack_int idist, lapack_int* iseed, +lapack_int API_SUFFIX(LAPACKE_dlarnv_work)( lapack_int idist, lapack_int* iseed, lapack_int n, double* x ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dlartgp.c b/LAPACKE/src/lapacke_dlartgp.c index 1ec778e09a..053c39886a 100644 --- a/LAPACKE/src/lapacke_dlartgp.c +++ b/LAPACKE/src/lapacke_dlartgp.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlartgp( double f, double g, double* cs, double* sn, +lapack_int API_SUFFIX(LAPACKE_dlartgp)( double f, double g, double* cs, double* sn, double* r ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &f, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &f, 1 ) ) { return -1; } - if( LAPACKE_d_nancheck( 1, &g, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &g, 1 ) ) { return -2; } } #endif - return LAPACKE_dlartgp_work( f, g, cs, sn, r ); + return API_SUFFIX(LAPACKE_dlartgp_work)( f, g, cs, sn, r ); } diff --git a/LAPACKE/src/lapacke_dlartgp_work.c b/LAPACKE/src/lapacke_dlartgp_work.c index ee71072a53..94f45f977f 100644 --- a/LAPACKE/src/lapacke_dlartgp_work.c +++ b/LAPACKE/src/lapacke_dlartgp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlartgp_work( double f, double g, double* cs, double* sn, +lapack_int API_SUFFIX(LAPACKE_dlartgp_work)( double f, double g, double* cs, double* sn, double* r ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dlartgs.c b/LAPACKE/src/lapacke_dlartgs.c index 795164466e..d31d1499ef 100644 --- a/LAPACKE/src/lapacke_dlartgs.c +++ b/LAPACKE/src/lapacke_dlartgs.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlartgs( double x, double y, double sigma, double* cs, +lapack_int API_SUFFIX(LAPACKE_dlartgs)( double x, double y, double sigma, double* cs, double* sn ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &sigma, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &sigma, 1 ) ) { return -3; } - if( LAPACKE_d_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_d_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &y, 1 ) ) { return -2; } } #endif - return LAPACKE_dlartgs_work( x, y, sigma, cs, sn ); + return API_SUFFIX(LAPACKE_dlartgs_work)( x, y, sigma, cs, sn ); } diff --git a/LAPACKE/src/lapacke_dlartgs_work.c b/LAPACKE/src/lapacke_dlartgs_work.c index 1e3f805273..acf576e370 100644 --- a/LAPACKE/src/lapacke_dlartgs_work.c +++ b/LAPACKE/src/lapacke_dlartgs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlartgs_work( double x, double y, double sigma, double* cs, +lapack_int API_SUFFIX(LAPACKE_dlartgs_work)( double x, double y, double sigma, double* cs, double* sn ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dlascl.c b/LAPACKE/src/lapacke_dlascl.c index 71a7ef4e45..2d5b7a88c9 100644 --- a/LAPACKE/src/lapacke_dlascl.c +++ b/LAPACKE/src/lapacke_dlascl.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_dlascl)( int matrix_layout, char type, lapack_int kl, lapack_int ku, double cfrom, double cto, lapack_int m, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlascl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlascl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -46,68 +46,68 @@ 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, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -9; } break; case 'L': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_dgb_nancheck)( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { return -9; } break; case 'U': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_dgb_nancheck)( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { return -9; } break; case 'H': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(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 ) ) { + if( API_SUFFIX(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 ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, 'U', n, ku, a, lda ) ) { return -9; } break; case 'Z': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { return -9; } break; } } #endif - return LAPACKE_dlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); + return API_SUFFIX(LAPACKE_dlascl_work)( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dlascl_work.c b/LAPACKE/src/lapacke_dlascl_work.c index 0ab8570b79..95566f78a0 100644 --- a/LAPACKE/src/lapacke_dlascl_work.c +++ b/LAPACKE/src/lapacke_dlascl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_dlascl_work)( int matrix_layout, char type, lapack_int kl, lapack_int ku, double cfrom, double cto, lapack_int m, lapack_int n, double* a, lapack_int lda ) @@ -45,15 +45,15 @@ 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 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 nrows_a = API_SUFFIX(LAPACKE_lsame)(type, 'b') ? kl + 1 : + API_SUFFIX(LAPACKE_lsame)(type, 'q') ? ku + 1 : + API_SUFFIX(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 ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlascl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,23 +63,23 @@ 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, nrows_a, n, a, lda, a_t, lda_t ); + API_SUFFIX(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); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlascl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlascl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlaset.c b/LAPACKE/src/lapacke_dlaset.c index 7de7dac21b..4f95ad75f2 100644 --- a/LAPACKE/src/lapacke_dlaset.c +++ b/LAPACKE/src/lapacke_dlaset.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlaset( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlaset)( int matrix_layout, char uplo, lapack_int m, lapack_int n, double alpha, double beta, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlaset", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaset", -1 ); return -1; } @@ -49,14 +49,14 @@ lapack_int LAPACKE_dlaset( int matrix_layout, char uplo, lapack_int m, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &alpha, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &beta, 1 ) ) { return -6; } } #endif - return LAPACKE_dlaset_work( matrix_layout, uplo, m, n, alpha, beta, a, lda ); + return API_SUFFIX(LAPACKE_dlaset_work)( matrix_layout, uplo, m, n, alpha, beta, a, lda ); } diff --git a/LAPACKE/src/lapacke_dlaset_work.c b/LAPACKE/src/lapacke_dlaset_work.c index b18cc331c4..768c9e3058 100644 --- a/LAPACKE/src/lapacke_dlaset_work.c +++ b/LAPACKE/src/lapacke_dlaset_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlaset_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dlaset_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, double alpha, double beta, double* a, lapack_int lda ) { @@ -46,7 +46,7 @@ lapack_int LAPACKE_dlaset_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaset_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -56,21 +56,21 @@ lapack_int LAPACKE_dlaset_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlaset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaset_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaset_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlasrt.c b/LAPACKE/src/lapacke_dlasrt.c index 101917a233..190abf470a 100644 --- a/LAPACKE/src/lapacke_dlasrt.c +++ b/LAPACKE/src/lapacke_dlasrt.c @@ -32,15 +32,15 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlasrt( char id, lapack_int n, double* d ) +lapack_int API_SUFFIX(LAPACKE_dlasrt)( char id, lapack_int n, double* d ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -3; } } #endif - return LAPACKE_dlasrt_work( id, n, d ); + return API_SUFFIX(LAPACKE_dlasrt_work)( id, n, d ); } diff --git a/LAPACKE/src/lapacke_dlasrt_work.c b/LAPACKE/src/lapacke_dlasrt_work.c index cce8791496..1831a070ac 100644 --- a/LAPACKE/src/lapacke_dlasrt_work.c +++ b/LAPACKE/src/lapacke_dlasrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlasrt_work( char id, lapack_int n, double* d ) +lapack_int API_SUFFIX(LAPACKE_dlasrt_work)( char id, lapack_int n, double* d ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dlassq.c b/LAPACKE/src/lapacke_dlassq.c index 6bd255804a..3905354397 100644 --- a/LAPACKE/src/lapacke_dlassq.c +++ b/LAPACKE/src/lapacke_dlassq.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlassq( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq ) +lapack_int API_SUFFIX(LAPACKE_dlassq)( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */ - if( LAPACKE_d_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, x, incx ) ) { return -2; } - if( LAPACKE_d_nancheck( 1, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, scale, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, sumsq, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, sumsq, 1 ) ) { return -5; } } #endif - return LAPACKE_dlassq_work( n, x, incx, scale, sumsq ); + return API_SUFFIX(LAPACKE_dlassq_work)( n, x, incx, scale, sumsq ); } diff --git a/LAPACKE/src/lapacke_dlassq_work.c b/LAPACKE/src/lapacke_dlassq_work.c index 56a29bcdd5..46ab6e8e04 100644 --- a/LAPACKE/src/lapacke_dlassq_work.c +++ b/LAPACKE/src/lapacke_dlassq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlassq_work( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq ) +lapack_int API_SUFFIX(LAPACKE_dlassq_work)( lapack_int n, double* x, lapack_int incx, double* scale, double* sumsq ) { lapack_int info = 0; LAPACK_dlassq( &n, x, &incx, scale, sumsq ); diff --git a/LAPACKE/src/lapacke_dlaswp.c b/LAPACKE/src/lapacke_dlaswp.c index de4e540b5c..f4a42c8de3 100644 --- a/LAPACKE/src/lapacke_dlaswp.c +++ b/LAPACKE/src/lapacke_dlaswp.c @@ -32,12 +32,12 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlaswp( int matrix_layout, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dlaswp)( int matrix_layout, lapack_int n, double* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlaswp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaswp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -47,15 +47,15 @@ lapack_int LAPACKE_dlaswp( int matrix_layout, lapack_int n, double* a, * Disable the check as is below, the check below was checking for NaN * from lda to n since there is no (obvious) way to knowing m. This is not * a good idea. We could get a lower bound of m by scanning from ipiv. Or - * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable + * we could pass on the NaN check to API_SUFFIX(LAPACKE_dlaswp_work). For now disable * the buggy Nan check. * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827 *****************************************************************************/ - /* if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) { + /* if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, lda, n, a, lda ) ) { * return -3; * } */ } #endif - return LAPACKE_dlaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); + return API_SUFFIX(LAPACKE_dlaswp_work)( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); } diff --git a/LAPACKE/src/lapacke_dlaswp_work.c b/LAPACKE/src/lapacke_dlaswp_work.c index ac61ce4e89..1c4574ec3a 100644 --- a/LAPACKE/src/lapacke_dlaswp_work.c +++ b/LAPACKE/src/lapacke_dlaswp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlaswp_work( int matrix_layout, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dlaswp_work)( int matrix_layout, lapack_int n, double* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_dlaswp_work( int matrix_layout, lapack_int n, double* a, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_dlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaswp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,21 +63,21 @@ lapack_int LAPACKE_dlaswp_work( int matrix_layout, lapack_int n, double* a, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaswp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlaswp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlatms.c b/LAPACKE/src/lapacke_dlatms.c index a20fedb57d..4c4bcd909f 100644 --- a/LAPACKE/src/lapacke_dlatms.c +++ b/LAPACKE/src/lapacke_dlatms.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlatms( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlatms)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, double* d, lapack_int mode, double cond, double dmax, lapack_int kl, lapack_int ku, char pack, double* a, @@ -41,22 +41,22 @@ lapack_int LAPACKE_dlatms( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlatms", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlatms", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -14; } - if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &cond, 1 ) ) { return -9; } - if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(n,m), d, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &dmax, 1 ) ) { return -10; } } @@ -68,13 +68,13 @@ lapack_int LAPACKE_dlatms( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dlatms_work( matrix_layout, m, n, dist, iseed, sym, d, mode, + info = API_SUFFIX(LAPACKE_dlatms_work)( matrix_layout, m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlatms", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlatms", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlatms_work.c b/LAPACKE/src/lapacke_dlatms_work.c index 3f98722466..7801edf593 100644 --- a/LAPACKE/src/lapacke_dlatms_work.c +++ b/LAPACKE/src/lapacke_dlatms_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlatms_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlatms_work)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, double* d, lapack_int mode, double cond, double dmax, lapack_int kl, lapack_int ku, @@ -53,7 +53,7 @@ lapack_int LAPACKE_dlatms_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlatms_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_dlatms_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a_t, &lda_t, work, &info ); @@ -71,16 +71,16 @@ lapack_int LAPACKE_dlatms_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlatms_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlatms_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dlauum.c b/LAPACKE/src/lapacke_dlauum.c index 8c9c54599b..05587a8c00 100644 --- a/LAPACKE/src/lapacke_dlauum.c +++ b/LAPACKE/src/lapacke_dlauum.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlauum( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dlauum)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dlauum", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlauum", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dlauum_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_dlauum_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dlauum_work.c b/LAPACKE/src/lapacke_dlauum_work.c index b28543f9ce..ae1bcc59bf 100644 --- a/LAPACKE/src/lapacke_dlauum_work.c +++ b/LAPACKE/src/lapacke_dlauum_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dlauum_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dlauum_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dlauum_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlauum_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dlauum_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dlauum( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlauum_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dlauum_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dopgtr.c b/LAPACKE/src/lapacke_dopgtr.c index 74d4b62ff6..518f50d9e4 100644 --- a/LAPACKE/src/lapacke_dopgtr.c +++ b/LAPACKE/src/lapacke_dopgtr.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dopgtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dopgtr)( int matrix_layout, char uplo, lapack_int n, const double* ap, const double* tau, double* q, lapack_int ldq ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dopgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, tau, 1 ) ) { return -5; } } @@ -60,12 +60,12 @@ lapack_int LAPACKE_dopgtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dopgtr_work( matrix_layout, uplo, n, ap, tau, q, ldq, work ); + info = API_SUFFIX(LAPACKE_dopgtr_work)( matrix_layout, uplo, n, ap, tau, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dopgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dopgtr_work.c b/LAPACKE/src/lapacke_dopgtr_work.c index d5b704447d..592fbf44f2 100644 --- a/LAPACKE/src/lapacke_dopgtr_work.c +++ b/LAPACKE/src/lapacke_dopgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dopgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dopgtr_work)( int matrix_layout, char uplo, lapack_int n, const double* ap, const double* tau, double* q, lapack_int ldq, double* work ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dopgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldq < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopgtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_dopgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dopgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( q_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dopmtr.c b/LAPACKE/src/lapacke_dopmtr.c index 9ec15270c6..75feb46545 100644 --- a/LAPACKE/src/lapacke_dopmtr.c +++ b/LAPACKE/src/lapacke_dopmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dopmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dopmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const double* ap, const double* tau, double* c, lapack_int ldc ) { @@ -42,28 +42,28 @@ lapack_int LAPACKE_dopmtr( int matrix_layout, char side, char uplo, char trans, double* work = NULL; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dopmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dsp_nancheck( r, ap ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dsp_nancheck)( r, ap ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -9; } - if( LAPACKE_d_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( r-1, tau, 1 ) ) { return -8; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { lwork = MAX(1,n); - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { lwork = MAX(1,m); } else { lwork = 1; /* Any value */ @@ -75,13 +75,13 @@ lapack_int LAPACKE_dopmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dopmtr_work( matrix_layout, side, uplo, trans, m, n, ap, tau, + info = API_SUFFIX(LAPACKE_dopmtr_work)( matrix_layout, side, uplo, trans, m, n, ap, tau, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dopmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dopmtr_work.c b/LAPACKE/src/lapacke_dopmtr_work.c index 2fa65f2f6b..49bc10d13c 100644 --- a/LAPACKE/src/lapacke_dopmtr_work.c +++ b/LAPACKE/src/lapacke_dopmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dopmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_dopmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const double* ap, const double* tau, double* c, lapack_int ldc, double* work ) @@ -49,12 +49,12 @@ lapack_int LAPACKE_dopmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( ldc < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopmtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,8 +70,8 @@ lapack_int LAPACKE_dopmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, r, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, r, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dopmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t, work, &info ); @@ -79,18 +79,18 @@ lapack_int LAPACKE_dopmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dopmtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorbdb.c b/LAPACKE/src/lapacke_dorbdb.c index bd7eaf5d1a..f936da23f9 100644 --- a/LAPACKE/src/lapacke_dorbdb.c +++ b/LAPACKE/src/lapacke_dorbdb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorbdb( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_dorbdb)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x12, lapack_int ldx12, double* x21, lapack_int ldx21, @@ -46,10 +46,10 @@ lapack_int LAPACKE_dorbdb( int matrix_layout, char trans, char signs, double work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorbdb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorbdb", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -57,22 +57,22 @@ lapack_int LAPACKE_dorbdb( int matrix_layout, char trans, char signs, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -7; } - if( LAPACKE_dge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -9; } - if( LAPACKE_dge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -11; } - if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -13; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_dorbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, &work_query, lwork ); @@ -87,14 +87,14 @@ lapack_int LAPACKE_dorbdb( int matrix_layout, char trans, char signs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_dorbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorbdb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorbdb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorbdb_work.c b/LAPACKE/src/lapacke_dorbdb_work.c index 6286c3cec7..e2d8828152 100644 --- a/LAPACKE/src/lapacke_dorbdb_work.c +++ b/LAPACKE/src/lapacke_dorbdb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorbdb_work( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_dorbdb_work)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x12, lapack_int ldx12, double* x21, lapack_int ldx21, @@ -59,7 +59,7 @@ lapack_int LAPACKE_dorbdb_work( int matrix_layout, char trans, char signs, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -73,7 +73,7 @@ lapack_int LAPACKE_dorbdb_work( int matrix_layout, char trans, char signs, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorbdb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorbdb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorcsd.c b/LAPACKE/src/lapacke_dorcsd.c index 26756ff52b..a5846cbedb 100644 --- a/LAPACKE/src/lapacke_dorcsd.c +++ b/LAPACKE/src/lapacke_dorcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dorcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x12, @@ -49,10 +49,10 @@ lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, double work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -60,16 +60,16 @@ lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -11; } - if( LAPACKE_dge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -13; } - if( LAPACKE_dge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -15; } - if( LAPACKE_dge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -17; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dorcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_dorcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, &work_query, @@ -97,7 +97,7 @@ lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dorcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_dorcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork, @@ -108,7 +108,7 @@ lapack_int LAPACKE_dorcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorcsd2by1.c b/LAPACKE/src/lapacke_dorcsd2by1.c index 213af715b8..30ec654054 100644 --- a/LAPACKE/src/lapacke_dorcsd2by1.c +++ b/LAPACKE/src/lapacke_dorcsd2by1.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dorcsd2by1)( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x21, lapack_int ldx21, double* theta, double* u1, lapack_int ldu1, double* u2, @@ -45,7 +45,7 @@ lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, double work_query; lapack_int nrows_x11, nrows_x21; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorcsd2by1", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -53,11 +53,11 @@ lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, /* Optionally check input matrices for NaNs */ nrows_x11 = p; nrows_x21 = m-p; - if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_dorcsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, &work_query, lwork, iwork ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_dorcsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, iwork ); /* Release memory and exit */ @@ -93,7 +93,7 @@ lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorcsd2by1", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorcsd2by1_work.c b/LAPACKE/src/lapacke_dorcsd2by1_work.c index 3e8802bcf8..57a0323e52 100644 --- a/LAPACKE/src/lapacke_dorcsd2by1_work.c +++ b/LAPACKE/src/lapacke_dorcsd2by1_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dorcsd2by1_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, double* x21, lapack_int ldx21, @@ -54,9 +54,9 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_x11 = p; lapack_int nrows_x21 = m-p; - lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); - lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); - lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int nrows_u1 = ( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ? q : 1); lapack_int ldu1_t = MAX(1,nrows_u1); lapack_int ldu2_t = MAX(1,nrows_u2); lapack_int ldv1t_t = MAX(1,nrows_v1t); @@ -70,27 +70,27 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Check leading dimension(s) */ if( ldu1 < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); return info; } if( ldu2 < m-p ) { info = -23; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); return info; } if( ldv1t < q ) { info = -25; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); return info; } if( ldx11 < q ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); return info; } if( ldx21 < q ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -112,7 +112,7 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { u1_t = (double*) LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) ); if( u1_t == NULL ) { @@ -120,7 +120,7 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { u2_t = (double*) LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) ); if( u2_t == NULL ) { @@ -128,7 +128,7 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_3; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { v1t_t = (double*) LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) ); if( v1t_t == NULL ) { @@ -137,9 +137,9 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, ldx11_t ); - LAPACKE_dge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, @@ -150,32 +150,32 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, ldx11 ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, ldx21 ); - if( LAPACKE_lsame( jobu1, 'y' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, ldu1 ); } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, u2, ldu2 ); } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, v1t, ldv1t ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { LAPACKE_free( v1t_t ); } exit_level_4: - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { LAPACKE_free( u2_t ); } exit_level_3: - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { LAPACKE_free( u1_t ); } exit_level_2: @@ -184,11 +184,11 @@ lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( x11_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd2by1_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorcsd_work.c b/LAPACKE/src/lapacke_dorcsd_work.c index d121f7cd65..09b6ad80f5 100644 --- a/LAPACKE/src/lapacke_dorcsd_work.c +++ b/LAPACKE/src/lapacke_dorcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_dorcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, double* x11, lapack_int ldx11, @@ -62,7 +62,7 @@ lapack_int LAPACKE_dorcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -77,7 +77,7 @@ lapack_int LAPACKE_dorcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgbr.c b/LAPACKE/src/lapacke_dorgbr.c index 9f001a8cde..6d75ff139b 100644 --- a/LAPACKE/src/lapacke_dorgbr.c +++ b/LAPACKE/src/lapacke_dorgbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgbr( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dorgbr)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorgbr( int matrix_layout, char vect, lapack_int m, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( MIN(m,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(m,k), tau, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgbr_work( matrix_layout, vect, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dorgbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorgbr( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgbr_work( matrix_layout, vect, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorgbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgbr_work.c b/LAPACKE/src/lapacke_dorgbr_work.c index 8e5bc130d9..1945f603aa 100644 --- a/LAPACKE/src/lapacke_dorgbr_work.c +++ b/LAPACKE/src/lapacke_dorgbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgbr_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_dorgbr_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorgbr_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_dorgbr_work( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); @@ -74,16 +74,16 @@ lapack_int LAPACKE_dorgbr_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorghr.c b/LAPACKE/src/lapacke_dorghr.c index 982f906e88..3185743fe8 100644 --- a/LAPACKE/src/lapacke_dorghr.c +++ b/LAPACKE/src/lapacke_dorghr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorghr( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_dorghr)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorghr( int matrix_layout, lapack_int n, lapack_int ilo, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorghr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorghr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_dorghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorghr( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorghr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorghr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorghr_work.c b/LAPACKE/src/lapacke_dorghr_work.c index cca0413d85..ad5445e367 100644 --- a/LAPACKE/src/lapacke_dorghr_work.c +++ b/LAPACKE/src/lapacke_dorghr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_dorghr_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorghr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_dorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorghr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorghr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorglq.c b/LAPACKE/src/lapacke_dorglq.c index d984ace1a8..a50cd263b4 100644 --- a/LAPACKE/src/lapacke_dorglq.c +++ b/LAPACKE/src/lapacke_dorglq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorglq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorglq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorglq( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorglq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorglq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorglq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dorglq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorglq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorglq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorglq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorglq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorglq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorglq_work.c b/LAPACKE/src/lapacke_dorglq_work.c index b69ceddade..c791885fd0 100644 --- a/LAPACKE/src/lapacke_dorglq_work.c +++ b/LAPACKE/src/lapacke_dorglq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorglq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorglq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorglq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorglq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dorglq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorglq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorglq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgql.c b/LAPACKE/src/lapacke_dorgql.c index ce8e1177a2..f0bf0e903d 100644 --- a/LAPACKE/src/lapacke_dorgql.c +++ b/LAPACKE/src/lapacke_dorgql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgql( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgql)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorgql( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgql_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dorgql_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorgql( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgql_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorgql_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgql_work.c b/LAPACKE/src/lapacke_dorgql_work.c index 636d1f682d..f5bda0116b 100644 --- a/LAPACKE/src/lapacke_dorgql_work.c +++ b/LAPACKE/src/lapacke_dorgql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgql_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgql_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorgql_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dorgql_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgqr.c b/LAPACKE/src/lapacke_dorgqr.c index 6cbd699013..c9b6127946 100644 --- a/LAPACKE/src/lapacke_dorgqr.c +++ b/LAPACKE/src/lapacke_dorgqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorgqr( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgqr_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dorgqr_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorgqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgqr_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorgqr_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgqr_work.c b/LAPACKE/src/lapacke_dorgqr_work.c index 44f6b7ea1a..07b8c14557 100644 --- a/LAPACKE/src/lapacke_dorgqr_work.c +++ b/LAPACKE/src/lapacke_dorgqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorgqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dorgqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgrq.c b/LAPACKE/src/lapacke_dorgrq.c index bea1bd6e2e..9b54b6b933 100644 --- a/LAPACKE/src/lapacke_dorgrq.c +++ b/LAPACKE/src/lapacke_dorgrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgrq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgrq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dorgrq( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgrq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dorgrq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dorgrq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgrq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorgrq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgrq_work.c b/LAPACKE/src/lapacke_dorgrq_work.c index 784915f0b4..17b9d41406 100644 --- a/LAPACKE/src/lapacke_dorgrq_work.c +++ b/LAPACKE/src/lapacke_dorgrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgrq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgrq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dorgrq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dorgrq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgtr.c b/LAPACKE/src/lapacke_dorgtr.c index 14e9b5f36a..967ff698cf 100644 --- a/LAPACKE/src/lapacke_dorgtr.c +++ b/LAPACKE/src/lapacke_dorgtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgtr( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dorgtr)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const double* tau ) { lapack_int info = 0; @@ -40,22 +40,22 @@ lapack_int LAPACKE_dorgtr( int matrix_layout, char uplo, lapack_int n, double* a double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, tau, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgtr_work( matrix_layout, uplo, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dorgtr_work)( matrix_layout, uplo, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_dorgtr( int matrix_layout, char uplo, lapack_int n, double* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgtr_work( matrix_layout, uplo, n, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_dorgtr_work)( matrix_layout, uplo, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgtr_work.c b/LAPACKE/src/lapacke_dorgtr_work.c index 709d131254..08dcd9d4f0 100644 --- a/LAPACKE/src/lapacke_dorgtr_work.c +++ b/LAPACKE/src/lapacke_dorgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgtr_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dorgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dorgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dorgtsqr_row.c b/LAPACKE/src/lapacke_dorgtsqr_row.c index 1da3405a89..156ba48571 100644 --- a/LAPACKE/src/lapacke_dorgtsqr_row.c +++ b/LAPACKE/src/lapacke_dorgtsqr_row.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgtsqr_row)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, double* a, lapack_int lda, const double* t, lapack_int ldt ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_dorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, nb, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nb, n, t, ldt ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dorgtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_dorgtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_dorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dorgtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_dorgtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_dorgtsqr_row_work.c b/LAPACKE/src/lapacke_dorgtsqr_row_work.c index e16467f3a2..b76bf8c655 100644 --- a/LAPACKE/src/lapacke_dorgtsqr_row_work.c +++ b/LAPACKE/src/lapacke_dorgtsqr_row_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorgtsqr_row_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, double* a, lapack_int lda, const double* t, lapack_int ldt, @@ -52,7 +52,7 @@ lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row_work", info ); return info; } lapack_int ldt_t = MAX(1,nb); @@ -60,7 +60,7 @@ lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, nb, n, a, lda, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, nb, n, a, lda, t_t, ldt_t ); /* Call LAPACK function and adjust info */ LAPACK_dorgtsqr_row( &m, &n, &mb, &nb, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_dorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorgtsqr_row_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_dorhr_col.c b/LAPACKE/src/lapacke_dorhr_col.c index 1f37725e91..3350f516e0 100644 --- a/LAPACKE/src/lapacke_dorhr_col.c +++ b/LAPACKE/src/lapacke_dorhr_col.c @@ -1,24 +1,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorhr_col( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorhr_col)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, double* a, lapack_int lda, double* t, lapack_int ldt, double* d) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dorhr_col", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorhr_col", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - info = LAPACKE_dorhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d ); + info = API_SUFFIX(LAPACKE_dorhr_col_work)( matrix_layout, m, n, nb, a, lda, t, ldt, d ); return info; } diff --git a/LAPACKE/src/lapacke_dorhr_col_work.c b/LAPACKE/src/lapacke_dorhr_col_work.c index 28b80cc02e..f4a5524bd5 100644 --- a/LAPACKE/src/lapacke_dorhr_col_work.c +++ b/LAPACKE/src/lapacke_dorhr_col_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dorhr_col_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, double* a, lapack_int lda, double* t, lapack_int ldt, double* d ) @@ -20,12 +20,12 @@ lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorhr_col_work", info ); return info; } if( ldt < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorhr_col_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -43,15 +43,15 @@ lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dorhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -59,11 +59,11 @@ lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorhr_col_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dorhr_col_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormbr.c b/LAPACKE/src/lapacke_dormbr.c index 298fce81c4..01fb982f5f 100644 --- a/LAPACKE/src/lapacke_dormbr.c +++ b/LAPACKE/src/lapacke_dormbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormbr( int matrix_layout, char vect, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormbr)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -43,28 +43,28 @@ lapack_int LAPACKE_dormbr( int matrix_layout, char vect, char side, char trans, double work_query; lapack_int nq, ar, ac; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nq = LAPACKE_lsame( side, 'l' ) ? m : n; - ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq; - if( LAPACKE_dge_nancheck( matrix_layout, ar, ac, a, lda ) ) { + nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + ar = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + ac = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? MIN(nq,k) : nq; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, ar, ac, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_d_nancheck( MIN(nq,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(nq,k), tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_dormbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_dormbr( int matrix_layout, char vect, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_dormbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormbr_work.c b/LAPACKE/src/lapacke_dormbr_work.c index d7cf78a2d2..b0d0d5c8b3 100644 --- a/LAPACKE/src/lapacke_dormbr_work.c +++ b/LAPACKE/src/lapacke_dormbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormbr_work( int matrix_layout, char vect, char side, +lapack_int API_SUFFIX(LAPACKE_dormbr_work)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -47,9 +47,9 @@ lapack_int LAPACKE_dormbr_work( int matrix_layout, char vect, char side, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - lapack_int ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq; + lapack_int nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + lapack_int ar = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + lapack_int ac = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? MIN(nq,k) : nq; lapack_int lda_t = MAX(1,ar); lapack_int ldc_t = MAX(1,m); double *a_t = NULL; @@ -57,12 +57,12 @@ lapack_int LAPACKE_dormbr_work( int matrix_layout, char vect, char side, /* Check leading dimension(s) */ if( lda < ac ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_dormbr_work( int matrix_layout, char vect, char side, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, ar, ac, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, ar, ac, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_dormbr_work( int matrix_layout, char vect, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormhr.c b/LAPACKE/src/lapacke_dormhr.c index 627b92aa4c..3a65a8bbc2 100644 --- a/LAPACKE/src/lapacke_dormhr.c +++ b/LAPACKE/src/lapacke_dormhr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormhr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormhr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_dormhr( int matrix_layout, char side, char trans, double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormhr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dge_nancheck( matrix_layout, r, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, r, r, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_d_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( r-1, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_dormhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dormhr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_dormhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormhr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormhr_work.c b/LAPACKE/src/lapacke_dormhr_work.c index f158f71613..65a15905bb 100644 --- a/LAPACKE/src/lapacke_dormhr_work.c +++ b/LAPACKE/src/lapacke_dormhr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormhr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormhr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_dormhr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_dormhr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_dormhr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormhr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormlq.c b/LAPACKE/src/lapacke_dormlq.c index 06880747a8..c15a4ad796 100644 --- a/LAPACKE/src/lapacke_dormlq.c +++ b/LAPACKE/src/lapacke_dormlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -42,26 +42,26 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) { + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, r, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormlq_work.c b/LAPACKE/src/lapacke_dormlq_work.c index 6bd12624f0..73205bfa01 100644 --- a/LAPACKE/src/lapacke_dormlq_work.c +++ b/LAPACKE/src/lapacke_dormlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -47,7 +47,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,k); lapack_int ldc_t = MAX(1,m); double *a_t = NULL; @@ -55,12 +55,12 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, k, r, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -90,18 +90,18 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormql.c b/LAPACKE/src/lapacke_dormql.c index 1e4d7efd3e..50f9c70f59 100644 --- a/LAPACKE/src/lapacke_dormql.c +++ b/LAPACKE/src/lapacke_dormql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormql( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormql)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_dormql( int matrix_layout, char side, char trans, double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dormql( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormql_work.c b/LAPACKE/src/lapacke_dormql_work.c index c7336e816b..639b6d8d1d 100644 --- a/LAPACKE/src/lapacke_dormql_work.c +++ b/LAPACKE/src/lapacke_dormql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormql_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormql_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_dormql_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_dormql_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_dormql_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormqr.c b/LAPACKE/src/lapacke_dormqr.c index 820805ba00..c2f80f98b7 100644 --- a/LAPACKE/src/lapacke_dormqr.c +++ b/LAPACKE/src/lapacke_dormqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_dormqr( int matrix_layout, char side, char trans, double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dormqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormqr_work.c b/LAPACKE/src/lapacke_dormqr_work.c index 2455774420..0cafc9c8e0 100644 --- a/LAPACKE/src/lapacke_dormqr_work.c +++ b/LAPACKE/src/lapacke_dormqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_dormqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_dormqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_dormqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormrq.c b/LAPACKE/src/lapacke_dormrq.c index cfa1deef21..bb4aeb8af7 100644 --- a/LAPACKE/src/lapacke_dormrq.c +++ b/LAPACKE/src/lapacke_dormrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormrq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormrq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_dormrq( int matrix_layout, char side, char trans, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_dormrq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_dormrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormrq_work.c b/LAPACKE/src/lapacke_dormrq_work.c index f4372a186c..f9db22099b 100644 --- a/LAPACKE/src/lapacke_dormrq_work.c +++ b/LAPACKE/src/lapacke_dormrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormrq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormrq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dormrq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dormrq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_dormrq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormrz.c b/LAPACKE/src/lapacke_dormrz.c index 091248c1c2..2d2715f538 100644 --- a/LAPACKE/src/lapacke_dormrz.c +++ b/LAPACKE/src/lapacke_dormrz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormrz( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormrz)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_dormrz( int matrix_layout, char side, char trans, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormrz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_d_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( k, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_dormrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_dormrz( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_dormrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormrz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormrz_work.c b/LAPACKE/src/lapacke_dormrz_work.c index c77cb505ce..07f59731a7 100644 --- a/LAPACKE/src/lapacke_dormrz_work.c +++ b/LAPACKE/src/lapacke_dormrz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormrz_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dormrz_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dormrz_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dormrz_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_dormrz_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormrz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormtr.c b/LAPACKE/src/lapacke_dormtr.c index 56add4b3fb..fbd7ff170f 100644 --- a/LAPACKE/src/lapacke_dormtr.c +++ b/LAPACKE/src/lapacke_dormtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dormtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_dormtr( int matrix_layout, char side, char uplo, char trans, double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dormtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, r, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_d_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( r-1, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dormtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_dormtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_dormtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dormtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_dormtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dormtr_work.c b/LAPACKE/src/lapacke_dormtr_work.c index cb53363d41..2a58d81c9f 100644 --- a/LAPACKE/src/lapacke_dormtr_work.c +++ b/LAPACKE/src/lapacke_dormtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dormtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_dormtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* tau, double* c, lapack_int ldc, @@ -49,18 +49,18 @@ lapack_int LAPACKE_dormtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_dormtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -90,18 +90,18 @@ lapack_int LAPACKE_dormtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dormtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbcon.c b/LAPACKE/src/lapacke_dpbcon.c index a5ef670e80..fd4efab0e7 100644 --- a/LAPACKE/src/lapacke_dpbcon.c +++ b/LAPACKE/src/lapacke_dpbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbcon)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_dpbcon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_dpbcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dpbcon_work( matrix_layout, uplo, n, kd, ab, ldab, anorm, + info = API_SUFFIX(LAPACKE_dpbcon_work)( matrix_layout, uplo, n, kd, ab, ldab, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_dpbcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbcon_work.c b/LAPACKE/src/lapacke_dpbcon_work.c index a75a9152d0..0dcb89c588 100644 --- a/LAPACKE/src/lapacke_dpbcon_work.c +++ b/LAPACKE/src/lapacke_dpbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbcon_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double anorm, double* rcond, double* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dpbcon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dpbcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dpbcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbequ.c b/LAPACKE/src/lapacke_dpbequ.c index c938b22937..da5c213655 100644 --- a/LAPACKE/src/lapacke_dpbequ.c +++ b/LAPACKE/src/lapacke_dpbequ.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbequ)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_dpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond, + return API_SUFFIX(LAPACKE_dpbequ_work)( matrix_layout, uplo, n, kd, ab, ldab, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_dpbequ_work.c b/LAPACKE/src/lapacke_dpbequ_work.c index 9c00aebb0d..c0ce0ed1c5 100644 --- a/LAPACKE/src/lapacke_dpbequ_work.c +++ b/LAPACKE/src/lapacke_dpbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbequ_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double* s, double* scond, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dpbequ_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_dpbequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_dpbequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbrfs.c b/LAPACKE/src/lapacke_dpbrfs.c index 3c88bfdcf9..d86fb81c38 100644 --- a/LAPACKE/src/lapacke_dpbrfs.c +++ b/LAPACKE/src/lapacke_dpbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, lapack_int ldafb, const double* b, lapack_int ldb, double* x, @@ -42,22 +42,22 @@ lapack_int LAPACKE_dpbrfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_dpbrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dpbrfs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, + info = API_SUFFIX(LAPACKE_dpbrfs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -83,7 +83,7 @@ lapack_int LAPACKE_dpbrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbrfs_work.c b/LAPACKE/src/lapacke_dpbrfs_work.c index df4ec65a14..5567146a74 100644 --- a/LAPACKE/src/lapacke_dpbrfs_work.c +++ b/LAPACKE/src/lapacke_dpbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, const double* afb, lapack_int ldafb, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dpbrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); return info; } if( ldafb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,11 +100,11 @@ lapack_int LAPACKE_dpbrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, @@ -113,7 +113,7 @@ lapack_int LAPACKE_dpbrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -124,11 +124,11 @@ lapack_int LAPACKE_dpbrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbstf.c b/LAPACKE/src/lapacke_dpbstf.c index 5404aba9e4..56c28cc7e9 100644 --- a/LAPACKE/src/lapacke_dpbstf.c +++ b/LAPACKE/src/lapacke_dpbstf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbstf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbstf)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, double* bb, lapack_int ldbb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbstf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbstf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -5; } } #endif - return LAPACKE_dpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb ); + return API_SUFFIX(LAPACKE_dpbstf_work)( matrix_layout, uplo, n, kb, bb, ldbb ); } diff --git a/LAPACKE/src/lapacke_dpbstf_work.c b/LAPACKE/src/lapacke_dpbstf_work.c index d1521a6f5b..a9a335a04b 100644 --- a/LAPACKE/src/lapacke_dpbstf_work.c +++ b/LAPACKE/src/lapacke_dpbstf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbstf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbstf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, double* bb, lapack_int ldbb ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dpbstf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldbb < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbstf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_dpbstf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_dpb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); /* Release memory and exit */ LAPACKE_free( bb_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbstf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbstf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbsv.c b/LAPACKE/src/lapacke_dpbsv.c index f5daeaefcf..bf01e3e0a2 100644 --- a/LAPACKE/src/lapacke_dpbsv.c +++ b/LAPACKE/src/lapacke_dpbsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbsv)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, double* ab, lapack_int ldab, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_dpbsv_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpbsv_work.c b/LAPACKE/src/lapacke_dpbsv_work.c index 0d4ba28dec..0b84ed01c4 100644 --- a/LAPACKE/src/lapacke_dpbsv_work.c +++ b/LAPACKE/src/lapacke_dpbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, double* ab, lapack_int ldab, double* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dpbsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,8 +71,8 @@ lapack_int LAPACKE_dpbsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -80,20 +80,20 @@ lapack_int LAPACKE_dpbsv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbsvx.c b/LAPACKE/src/lapacke_dpbsvx.c index 60f2605978..fafa59e0ab 100644 --- a/LAPACKE/src/lapacke_dpbsvx.c +++ b/LAPACKE/src/lapacke_dpbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, char* equed, double* s, double* b, lapack_int ldb, @@ -43,25 +43,25 @@ lapack_int LAPACKE_dpbsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -9; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_dpbsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dpbsvx_work( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_dpbsvx_work)( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -88,7 +88,7 @@ lapack_int LAPACKE_dpbsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbsvx_work.c b/LAPACKE/src/lapacke_dpbsvx_work.c index be99b7ad74..15917737b9 100644 --- a/LAPACKE/src/lapacke_dpbsvx_work.c +++ b/LAPACKE/src/lapacke_dpbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpbsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, double* ab, lapack_int ldab, double* afb, lapack_int ldafb, char* equed, double* s, @@ -61,22 +61,22 @@ lapack_int LAPACKE_dpbsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -101,12 +101,12 @@ lapack_int LAPACKE_dpbsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -115,16 +115,16 @@ lapack_int LAPACKE_dpbsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, afb, ldafb ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -135,11 +135,11 @@ lapack_int LAPACKE_dpbsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbtrf.c b/LAPACKE/src/lapacke_dpbtrf.c index c18992fd8b..1917084896 100644 --- a/LAPACKE/src/lapacke_dpbtrf.c +++ b/LAPACKE/src/lapacke_dpbtrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbtrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbtrf)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_dpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_dpbtrf_work)( matrix_layout, uplo, n, kd, ab, ldab ); } diff --git a/LAPACKE/src/lapacke_dpbtrf_work.c b/LAPACKE/src/lapacke_dpbtrf_work.c index d1e1bbcb09..a39cb5e028 100644 --- a/LAPACKE/src/lapacke_dpbtrf_work.c +++ b/LAPACKE/src/lapacke_dpbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbtrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbtrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dpbtrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_dpbtrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpbtrs.c b/LAPACKE/src/lapacke_dpbtrs.c index de35260c55..4ef68d1731 100644 --- a/LAPACKE/src/lapacke_dpbtrs.c +++ b/LAPACKE/src/lapacke_dpbtrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbtrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbtrs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_dpbtrs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpbtrs_work.c b/LAPACKE/src/lapacke_dpbtrs_work.c index a87645a03c..8d2fc67791 100644 --- a/LAPACKE/src/lapacke_dpbtrs_work.c +++ b/LAPACKE/src/lapacke_dpbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpbtrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpbtrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dpbtrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dpbtrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dpbtrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpftrf.c b/LAPACKE/src/lapacke_dpftrf.c index 444f4b945b..1e870a1412 100644 --- a/LAPACKE/src/lapacke_dpftrf.c +++ b/LAPACKE/src/lapacke_dpftrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftrf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftrf)( int matrix_layout, char transr, char uplo, lapack_int n, double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpftrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_dpftrf_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_dpftrf_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_dpftrf_work.c b/LAPACKE/src/lapacke_dpftrf_work.c index 289b5ab260..75e7d1928e 100644 --- a/LAPACKE/src/lapacke_dpftrf_work.c +++ b/LAPACKE/src/lapacke_dpftrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftrf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftrf_work)( int matrix_layout, char transr, char uplo, lapack_int n, double* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dpftrf_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dpftrf( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_dpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpftri.c b/LAPACKE/src/lapacke_dpftri.c index 367b670a69..65012f32b0 100644 --- a/LAPACKE/src/lapacke_dpftri.c +++ b/LAPACKE/src/lapacke_dpftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftri( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftri)( int matrix_layout, char transr, char uplo, lapack_int n, double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_dpftri_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_dpftri_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_dpftri_work.c b/LAPACKE/src/lapacke_dpftri_work.c index 7845489d2c..84626ebc04 100644 --- a/LAPACKE/src/lapacke_dpftri_work.c +++ b/LAPACKE/src/lapacke_dpftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftri_work)( int matrix_layout, char transr, char uplo, lapack_int n, double* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dpftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dpftri( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_dpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpftrs.c b/LAPACKE/src/lapacke_dpftrs.c index 3ed9450384..795edd0bb9 100644 --- a/LAPACKE/src/lapacke_dpftrs.c +++ b/LAPACKE/src/lapacke_dpftrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftrs( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftrs)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const double* a, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpftrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, a ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b, + return API_SUFFIX(LAPACKE_dpftrs_work)( matrix_layout, transr, uplo, n, nrhs, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpftrs_work.c b/LAPACKE/src/lapacke_dpftrs_work.c index c5a826d16f..ffddfc83e1 100644 --- a/LAPACKE/src/lapacke_dpftrs_work.c +++ b/LAPACKE/src/lapacke_dpftrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpftrs_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dpftrs_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const double* a, double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dpftrs_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,26 +66,26 @@ lapack_int LAPACKE_dpftrs_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dpftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpftrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpocon.c b/LAPACKE/src/lapacke_dpocon.c index faca6f32b7..9658ec8f22 100644 --- a/LAPACKE/src/lapacke_dpocon.c +++ b/LAPACKE/src/lapacke_dpocon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpocon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpocon)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_dpocon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpocon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpocon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_dpocon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dpocon_work( matrix_layout, uplo, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_dpocon_work)( matrix_layout, uplo, n, a, lda, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_dpocon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpocon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpocon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpocon_work.c b/LAPACKE/src/lapacke_dpocon_work.c index 12537eb065..0f1d6b32a9 100644 --- a/LAPACKE/src/lapacke_dpocon_work.c +++ b/LAPACKE/src/lapacke_dpocon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpocon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpocon_work)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double anorm, double* rcond, double* work, lapack_int* iwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpocon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpocon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dpocon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, iwork, &info ); @@ -70,11 +70,11 @@ lapack_int LAPACKE_dpocon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpocon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpocon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpoequ.c b/LAPACKE/src/lapacke_dpoequ.c index c31be21395..d96b60e400 100644 --- a/LAPACKE/src/lapacke_dpoequ.c +++ b/LAPACKE/src/lapacke_dpoequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpoequ( int matrix_layout, lapack_int n, const double* a, +lapack_int API_SUFFIX(LAPACKE_dpoequ)( int matrix_layout, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpoequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_dpoequ_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_dpoequ_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_dpoequ_work.c b/LAPACKE/src/lapacke_dpoequ_work.c index f1d1fb743c..d248a638ee 100644 --- a/LAPACKE/src/lapacke_dpoequ_work.c +++ b/LAPACKE/src/lapacke_dpoequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpoequ_work( int matrix_layout, lapack_int n, const double* a, +lapack_int API_SUFFIX(LAPACKE_dpoequ_work)( int matrix_layout, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpoequ_work( int matrix_layout, lapack_int n, const double* a /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_dpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dpoequ_work( int matrix_layout, lapack_int n, const double* a goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpoequ( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_dpoequ_work( int matrix_layout, lapack_int n, const double* a LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpoequb.c b/LAPACKE/src/lapacke_dpoequb.c index 661008de7f..f9c668dfdb 100644 --- a/LAPACKE/src/lapacke_dpoequb.c +++ b/LAPACKE/src/lapacke_dpoequb.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpoequb( int matrix_layout, lapack_int n, const double* a, +lapack_int API_SUFFIX(LAPACKE_dpoequb)( int matrix_layout, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpoequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_dpoequb_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_dpoequb_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_dpoequb_work.c b/LAPACKE/src/lapacke_dpoequb_work.c index c59c251d9c..ee44ece2dc 100644 --- a/LAPACKE/src/lapacke_dpoequb_work.c +++ b/LAPACKE/src/lapacke_dpoequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpoequb_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpoequb_work)( int matrix_layout, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpoequb_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_dpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dpoequb_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpoequb( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_dpoequb_work( int matrix_layout, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpoequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dporfs.c b/LAPACKE/src/lapacke_dporfs.c index b55e84ce6c..5d1984d6fd 100644 --- a/LAPACKE/src/lapacke_dporfs.c +++ b/LAPACKE/src/lapacke_dporfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dporfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dporfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -42,22 +42,22 @@ lapack_int LAPACKE_dporfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dporfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_dporfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dporfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_dporfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_dporfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dporfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dporfs_work.c b/LAPACKE/src/lapacke_dporfs_work.c index 79e04ce3fb..9f8ad65eca 100644 --- a/LAPACKE/src/lapacke_dporfs_work.c +++ b/LAPACKE/src/lapacke_dporfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dporfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dporfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const double* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dporfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,10 +100,10 @@ lapack_int LAPACKE_dporfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_dporfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_dporfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dporfsx.c b/LAPACKE/src/lapacke_dporfsx.c index 2cb74dad1d..86314f8b40 100644 --- a/LAPACKE/src/lapacke_dporfsx.c +++ b/LAPACKE/src/lapacke_dporfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dporfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_dporfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const double* s, const double* b, lapack_int ldb, @@ -45,32 +45,32 @@ lapack_int LAPACKE_dporfsx( int matrix_layout, char uplo, char equed, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dporfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -21; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -10; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -13; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_dporfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dporfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dporfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -97,7 +97,7 @@ lapack_int LAPACKE_dporfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dporfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dporfsx_work.c b/LAPACKE/src/lapacke_dporfsx_work.c index c43dff18a9..2328c82723 100644 --- a/LAPACKE/src/lapacke_dporfsx_work.c +++ b/LAPACKE/src/lapacke_dporfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dporfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_dporfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const double* s, @@ -66,22 +66,22 @@ lapack_int LAPACKE_dporfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -118,10 +118,10 @@ lapack_int LAPACKE_dporfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dporfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, &n_err_bnds, @@ -131,10 +131,10 @@ lapack_int LAPACKE_dporfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -150,11 +150,11 @@ lapack_int LAPACKE_dporfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dporfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dposv.c b/LAPACKE/src/lapacke_dposv.c index 1ca4b4d389..41eab3f44c 100644 --- a/LAPACKE/src/lapacke_dposv.c +++ b/LAPACKE/src/lapacke_dposv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_dposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dposv_work.c b/LAPACKE/src/lapacke_dposv_work.c index afdb6d6eee..e07398dec6 100644 --- a/LAPACKE/src/lapacke_dposv_work.c +++ b/LAPACKE/src/lapacke_dposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,27 +71,27 @@ lapack_int LAPACKE_dposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dposvx.c b/LAPACKE/src/lapacke_dposvx.c index cc2fbc8a87..2b9b1d8de8 100644 --- a/LAPACKE/src/lapacke_dposvx.c +++ b/LAPACKE/src/lapacke_dposvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dposvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, char* equed, double* s, double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -42,25 +42,25 @@ lapack_int LAPACKE_dposvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dposvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_dposvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dposvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dposvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_dposvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dposvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dposvx_work.c b/LAPACKE/src/lapacke_dposvx_work.c index f5967c5eb5..7437dcffb8 100644 --- a/LAPACKE/src/lapacke_dposvx_work.c +++ b/LAPACKE/src/lapacke_dposvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dposvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, char* equed, double* s, double* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dposvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,11 +100,11 @@ lapack_int LAPACKE_dposvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, @@ -113,15 +113,15 @@ lapack_int LAPACKE_dposvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -132,11 +132,11 @@ lapack_int LAPACKE_dposvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dposvxx.c b/LAPACKE/src/lapacke_dposvxx.c index aca5eb1b58..611d2fc850 100644 --- a/LAPACKE/src/lapacke_dposvxx.c +++ b/LAPACKE/src/lapacke_dposvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dposvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, char* equed, double* s, double* b, lapack_int ldb, @@ -45,30 +45,30 @@ lapack_int LAPACKE_dposvxx( int matrix_layout, char fact, char uplo, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dposvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } @@ -86,7 +86,7 @@ lapack_int LAPACKE_dposvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dposvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dposvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_dposvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dposvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dposvxx_work.c b/LAPACKE/src/lapacke_dposvxx_work.c index a14cf72b2a..e84ba8b803 100644 --- a/LAPACKE/src/lapacke_dposvxx_work.c +++ b/LAPACKE/src/lapacke_dposvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dposvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dposvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, char* equed, double* s, double* b, @@ -67,22 +67,22 @@ lapack_int LAPACKE_dposvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,11 +119,11 @@ lapack_int LAPACKE_dposvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr, @@ -133,18 +133,18 @@ lapack_int LAPACKE_dposvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -160,11 +160,11 @@ lapack_int LAPACKE_dposvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dposvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpotrf.c b/LAPACKE/src/lapacke_dpotrf.c index 6915b607df..8c2cb63fb1 100644 --- a/LAPACKE/src/lapacke_dpotrf.c +++ b/LAPACKE/src/lapacke_dpotrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrf( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dpotrf)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpotrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dpotrf_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_dpotrf_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dpotrf2.c b/LAPACKE/src/lapacke_dpotrf2.c index f3498f9874..c9052aa389 100644 --- a/LAPACKE/src/lapacke_dpotrf2.c +++ b/LAPACKE/src/lapacke_dpotrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrf2( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dpotrf2)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpotrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dpotrf2_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_dpotrf2_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dpotrf2_work.c b/LAPACKE/src/lapacke_dpotrf2_work.c index de5720b6a8..316546f79e 100644 --- a/LAPACKE/src/lapacke_dpotrf2_work.c +++ b/LAPACKE/src/lapacke_dpotrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrf2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpotrf2_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dpotrf2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dpotrf2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpotrf2( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpotrf_work.c b/LAPACKE/src/lapacke_dpotrf_work.c index 6bb5cb3a6c..b9910ad7ce 100644 --- a/LAPACKE/src/lapacke_dpotrf_work.c +++ b/LAPACKE/src/lapacke_dpotrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpotrf_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dpotrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dpotrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpotrf( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpotri.c b/LAPACKE/src/lapacke_dpotri.c index 41084ab966..b0746d7969 100644 --- a/LAPACKE/src/lapacke_dpotri.c +++ b/LAPACKE/src/lapacke_dpotri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotri( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dpotri)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpotri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dpotri_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_dpotri_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dpotri_work.c b/LAPACKE/src/lapacke_dpotri_work.c index 6e84a886ae..08c9f543d5 100644 --- a/LAPACKE/src/lapacke_dpotri_work.c +++ b/LAPACKE/src/lapacke_dpotri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpotri_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dpotri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dpotri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpotri( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpotrs.c b/LAPACKE/src/lapacke_dpotrs.c index eeb355bd7a..b42acc1f8f 100644 --- a/LAPACKE/src/lapacke_dpotrs.c +++ b/LAPACKE/src/lapacke_dpotrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpotrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpotrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_dpotrs_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpotrs_work.c b/LAPACKE/src/lapacke_dpotrs_work.c index 11307f5ed3..498c12c7ae 100644 --- a/LAPACKE/src/lapacke_dpotrs_work.c +++ b/LAPACKE/src/lapacke_dpotrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpotrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpotrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dpotrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrs_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_dpotrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpotrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppcon.c b/LAPACKE/src/lapacke_dppcon.c index ffe002fa8e..f0834c7519 100644 --- a/LAPACKE/src/lapacke_dppcon.c +++ b/LAPACKE/src/lapacke_dppcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppcon)( int matrix_layout, char uplo, lapack_int n, const double* ap, double anorm, double* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dppcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -5; } - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -4; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_dppcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dppcon_work( matrix_layout, uplo, n, ap, anorm, rcond, work, + info = API_SUFFIX(LAPACKE_dppcon_work)( matrix_layout, uplo, n, ap, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_dppcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppcon_work.c b/LAPACKE/src/lapacke_dppcon_work.c index 09a8e28384..e4544d9ea3 100644 --- a/LAPACKE/src/lapacke_dppcon_work.c +++ b/LAPACKE/src/lapacke_dppcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppcon_work)( int matrix_layout, char uplo, lapack_int n, const double* ap, double anorm, double* rcond, double* work, lapack_int* iwork ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_dppcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dppcon( &uplo, &n, ap_t, &anorm, rcond, work, iwork, &info ); if( info < 0 ) { @@ -63,11 +63,11 @@ lapack_int LAPACKE_dppcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppequ.c b/LAPACKE/src/lapacke_dppequ.c index d9de7cf765..14532157cc 100644 --- a/LAPACKE/src/lapacke_dppequ.c +++ b/LAPACKE/src/lapacke_dppequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppequ)( int matrix_layout, char uplo, lapack_int n, const double* ap, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dppequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dppequ_work( matrix_layout, uplo, n, ap, s, scond, amax ); + return API_SUFFIX(LAPACKE_dppequ_work)( matrix_layout, uplo, n, ap, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_dppequ_work.c b/LAPACKE/src/lapacke_dppequ_work.c index 8b7513c238..d441b43b72 100644 --- a/LAPACKE/src/lapacke_dppequ_work.c +++ b/LAPACKE/src/lapacke_dppequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppequ_work)( int matrix_layout, char uplo, lapack_int n, const double* ap, double* s, double* scond, double* amax ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_dppequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dppequ( &uplo, &n, ap_t, s, scond, amax, &info ); if( info < 0 ) { @@ -63,11 +63,11 @@ lapack_int LAPACKE_dppequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpprfs.c b/LAPACKE/src/lapacke_dpprfs.c index e16f25e7a2..fa5e5110a2 100644 --- a/LAPACKE/src/lapacke_dpprfs.c +++ b/LAPACKE/src/lapacke_dpprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const double* afp, const double* b, lapack_int ldb, double* x, lapack_int ldx, double* ferr, double* berr ) @@ -41,22 +41,22 @@ lapack_int LAPACKE_dpprfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -9; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_dpprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dpprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, + info = API_SUFFIX(LAPACKE_dpprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_dpprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpprfs_work.c b/LAPACKE/src/lapacke_dpprfs_work.c index f88877800d..5c42c009a8 100644 --- a/LAPACKE/src/lapacke_dpprfs_work.c +++ b/LAPACKE/src/lapacke_dpprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const double* afp, const double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_dpprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -111,11 +111,11 @@ lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppsv.c b/LAPACKE/src/lapacke_dppsv.c index ef3dc82a2a..ae4a69f3bc 100644 --- a/LAPACKE/src/lapacke_dppsv.c +++ b/LAPACKE/src/lapacke_dppsv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* ap, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dppsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_dppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_dppsv_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dppsv_work.c b/LAPACKE/src/lapacke_dppsv_work.c index 4e1ff98b2c..3a1515ecc2 100644 --- a/LAPACKE/src/lapacke_dppsv_work.c +++ b/LAPACKE/src/lapacke_dppsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* ap, double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dppsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,27 +66,27 @@ lapack_int LAPACKE_dppsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppsvx.c b/LAPACKE/src/lapacke_dppsvx.c index a8bf715236..6d294067ba 100644 --- a/LAPACKE/src/lapacke_dppsvx.c +++ b/LAPACKE/src/lapacke_dppsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dppsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* ap, double* afp, char* equed, double* s, double* b, lapack_int ldb, double* x, lapack_int ldx, double* rcond, @@ -42,25 +42,25 @@ lapack_int LAPACKE_dppsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dppsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -9; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_dppsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dppsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_dppsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_dppsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dppsvx_work.c b/LAPACKE/src/lapacke_dppsvx_work.c index 5eafa8681e..d99930431b 100644 --- a/LAPACKE/src/lapacke_dppsvx_work.c +++ b/LAPACKE/src/lapacke_dppsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dppsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dppsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* ap, double* afp, char* equed, double* s, double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_dppsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_dppsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_dppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t, @@ -102,13 +102,13 @@ lapack_int LAPACKE_dppsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -120,11 +120,11 @@ lapack_int LAPACKE_dppsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dppsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpptrf.c b/LAPACKE/src/lapacke_dpptrf.c index 777345a8b6..3fdc01c3fe 100644 --- a/LAPACKE/src/lapacke_dpptrf.c +++ b/LAPACKE/src/lapacke_dpptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptrf)( int matrix_layout, char uplo, lapack_int n, double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dpptrf_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_dpptrf_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_dpptrf_work.c b/LAPACKE/src/lapacke_dpptrf_work.c index ff66fde216..37482b4320 100644 --- a/LAPACKE/src/lapacke_dpptrf_work.c +++ b/LAPACKE/src/lapacke_dpptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptrf_work)( int matrix_layout, char uplo, lapack_int n, double* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dpptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dpptrf( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpptri.c b/LAPACKE/src/lapacke_dpptri.c index e798ae11f7..f25f5cdef1 100644 --- a/LAPACKE/src/lapacke_dpptri.c +++ b/LAPACKE/src/lapacke_dpptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptri)( int matrix_layout, char uplo, lapack_int n, double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dpptri_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_dpptri_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_dpptri_work.c b/LAPACKE/src/lapacke_dpptri_work.c index ca88281882..882adbf096 100644 --- a/LAPACKE/src/lapacke_dpptri_work.c +++ b/LAPACKE/src/lapacke_dpptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptri_work)( int matrix_layout, char uplo, lapack_int n, double* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dpptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dpptri( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpptrs.c b/LAPACKE/src/lapacke_dpptrs.c index ff6198cd23..fdda07065a 100644 --- a/LAPACKE/src/lapacke_dpptrs.c +++ b/LAPACKE/src/lapacke_dpptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_dpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_dpptrs_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpptrs_work.c b/LAPACKE/src/lapacke_dpptrs_work.c index 25312dbca4..37cb76624f 100644 --- a/LAPACKE/src/lapacke_dpptrs_work.c +++ b/LAPACKE/src/lapacke_dpptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dpptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,26 +66,26 @@ lapack_int LAPACKE_dpptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dpptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpstrf.c b/LAPACKE/src/lapacke_dpstrf.c index c153d665a9..8bd5edee82 100644 --- a/LAPACKE/src/lapacke_dpstrf.c +++ b/LAPACKE/src/lapacke_dpstrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpstrf( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dpstrf)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* piv, lapack_int* rank, double tol ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpstrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpstrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tol, 1 ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_dpstrf( int matrix_layout, char uplo, lapack_int n, double* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dpstrf_work( matrix_layout, uplo, n, a, lda, piv, rank, tol, + info = API_SUFFIX(LAPACKE_dpstrf_work)( matrix_layout, uplo, n, a, lda, piv, rank, tol, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpstrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpstrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpstrf_work.c b/LAPACKE/src/lapacke_dpstrf_work.c index fa9a729cdc..b2b2135e54 100644 --- a/LAPACKE/src/lapacke_dpstrf_work.c +++ b/LAPACKE/src/lapacke_dpstrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpstrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpstrf_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* piv, lapack_int* rank, double tol, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpstrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpstrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dpstrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dpstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpstrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpstrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptcon.c b/LAPACKE/src/lapacke_dptcon.c index 7279485e9d..2a5b993872 100644 --- a/LAPACKE/src/lapacke_dptcon.c +++ b/LAPACKE/src/lapacke_dptcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e, +lapack_int API_SUFFIX(LAPACKE_dptcon)( lapack_int n, const double* d, const double* e, double anorm, double* rcond ) { lapack_int info = 0; @@ -40,13 +40,13 @@ lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -3; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_dptcon( lapack_int n, const double* d, const double* e, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dptcon_work( n, d, e, anorm, rcond, work ); + info = API_SUFFIX(LAPACKE_dptcon_work)( n, d, e, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptcon_work.c b/LAPACKE/src/lapacke_dptcon_work.c index d48767a6d7..1474249a2a 100644 --- a/LAPACKE/src/lapacke_dptcon_work.c +++ b/LAPACKE/src/lapacke_dptcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptcon_work( lapack_int n, const double* d, const double* e, +lapack_int API_SUFFIX(LAPACKE_dptcon_work)( lapack_int n, const double* d, const double* e, double anorm, double* rcond, double* work ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_dpteqr.c b/LAPACKE/src/lapacke_dpteqr.c index 4ee19366e9..0f91da84e6 100644 --- a/LAPACKE/src/lapacke_dpteqr.c +++ b/LAPACKE/src/lapacke_dpteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpteqr( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpteqr)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_dpteqr( int matrix_layout, char compz, lapack_int n, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,4*n-4); @@ -72,12 +72,12 @@ lapack_int LAPACKE_dpteqr( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dpteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_dpteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpteqr_work.c b/LAPACKE/src/lapacke_dpteqr_work.c index 902b06bafd..8ce353734b 100644 --- a/LAPACKE/src/lapacke_dpteqr_work.c +++ b/LAPACKE/src/lapacke_dpteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dpteqr_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,8 +59,8 @@ lapack_int LAPACKE_dpteqr_work( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dpteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -68,16 +68,16 @@ lapack_int LAPACKE_dpteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptrfs.c b/LAPACKE/src/lapacke_dptrfs.c index f235dc3d0a..a052855fd4 100644 --- a/LAPACKE/src/lapacke_dptrfs.c +++ b/LAPACKE/src/lapacke_dptrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dptrfs)( int matrix_layout, lapack_int n, lapack_int nrhs, const double* d, const double* e, const double* df, const double* ef, const double* b, lapack_int ldb, double* x, lapack_int ldx, double* ferr, @@ -41,28 +41,28 @@ lapack_int LAPACKE_dptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dptrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, ef, 1 ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -74,13 +74,13 @@ lapack_int LAPACKE_dptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dptrfs_work( matrix_layout, n, nrhs, d, e, df, ef, b, ldb, x, + info = API_SUFFIX(LAPACKE_dptrfs_work)( matrix_layout, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptrfs_work.c b/LAPACKE/src/lapacke_dptrfs_work.c index 7139876f61..4bf79061c6 100644 --- a/LAPACKE/src/lapacke_dptrfs_work.c +++ b/LAPACKE/src/lapacke_dptrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dptrfs_work)( int matrix_layout, lapack_int n, lapack_int nrhs, const double* d, const double* e, const double* df, const double* ef, const double* b, lapack_int ldb, double* x, @@ -55,12 +55,12 @@ lapack_int LAPACKE_dptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_dptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dptrfs( &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_dptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptsv.c b/LAPACKE/src/lapacke_dptsv.c index be1c16cb1f..66d8639415 100644 --- a/LAPACKE/src/lapacke_dptsv.c +++ b/LAPACKE/src/lapacke_dptsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dptsv)( int matrix_layout, lapack_int n, lapack_int nrhs, double* d, double* e, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dptsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_dptsv_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_dptsv_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dptsv_work.c b/LAPACKE/src/lapacke_dptsv_work.c index 92631b3afa..abfe9b655a 100644 --- a/LAPACKE/src/lapacke_dptsv_work.c +++ b/LAPACKE/src/lapacke_dptsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dptsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, double* d, double* e, double* b, lapack_int ldb ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_dptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptsvx.c b/LAPACKE/src/lapacke_dptsvx.c index 6ce2b5e0fa..7e47ecda1c 100644 --- a/LAPACKE/src/lapacke_dptsvx.c +++ b/LAPACKE/src/lapacke_dptsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptsvx( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dptsvx)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const double* d, const double* e, double* df, double* ef, const double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -41,28 +41,28 @@ lapack_int LAPACKE_dptsvx( int matrix_layout, char fact, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dptsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -7; } } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, ef, 1 ) ) { return -8; } } @@ -75,13 +75,13 @@ lapack_int LAPACKE_dptsvx( int matrix_layout, char fact, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dptsvx_work( matrix_layout, fact, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_dptsvx_work)( matrix_layout, fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dptsvx_work.c b/LAPACKE/src/lapacke_dptsvx_work.c index 1040df224a..9846cbb6e6 100644 --- a/LAPACKE/src/lapacke_dptsvx_work.c +++ b/LAPACKE/src/lapacke_dptsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dptsvx_work( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dptsvx_work)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const double* d, const double* e, double* df, double* ef, const double* b, lapack_int ldb, double* x, @@ -55,12 +55,12 @@ lapack_int LAPACKE_dptsvx_work( int matrix_layout, char fact, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,7 +75,7 @@ lapack_int LAPACKE_dptsvx_work( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, &info ); @@ -83,18 +83,18 @@ lapack_int LAPACKE_dptsvx_work( int matrix_layout, char fact, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dptsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dpttrf.c b/LAPACKE/src/lapacke_dpttrf.c index 525dff8b37..500c3b1b28 100644 --- a/LAPACKE/src/lapacke_dpttrf.c +++ b/LAPACKE/src/lapacke_dpttrf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpttrf( lapack_int n, double* d, double* e ) +lapack_int API_SUFFIX(LAPACKE_dpttrf)( lapack_int n, double* d, double* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_dpttrf_work( n, d, e ); + return API_SUFFIX(LAPACKE_dpttrf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_dpttrf_work.c b/LAPACKE/src/lapacke_dpttrf_work.c index e636342068..87ab639829 100644 --- a/LAPACKE/src/lapacke_dpttrf_work.c +++ b/LAPACKE/src/lapacke_dpttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpttrf_work( lapack_int n, double* d, double* e ) +lapack_int API_SUFFIX(LAPACKE_dpttrf_work)( lapack_int n, double* d, double* e ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dpttrs.c b/LAPACKE/src/lapacke_dpttrs.c index 375cb0831f..e4412cd5c4 100644 --- a/LAPACKE/src/lapacke_dpttrs.c +++ b/LAPACKE/src/lapacke_dpttrs.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpttrs( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dpttrs)( int matrix_layout, lapack_int n, lapack_int nrhs, const double* d, const double* e, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dpttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_dpttrs_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_dpttrs_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dpttrs_work.c b/LAPACKE/src/lapacke_dpttrs_work.c index c21df1db76..08c97c8b1f 100644 --- a/LAPACKE/src/lapacke_dpttrs_work.c +++ b/LAPACKE/src/lapacke_dpttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dpttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dpttrs_work)( int matrix_layout, lapack_int n, lapack_int nrhs, const double* d, const double* e, double* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dpttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dpttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dpttrs( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dpttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbev.c b/LAPACKE/src/lapacke_dsbev.c index 2e326c69cb..476032ad72 100644 --- a/LAPACKE/src/lapacke_dsbev.c +++ b/LAPACKE/src/lapacke_dsbev.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_dsbev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsbev_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbev_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbev_2stage.c b/LAPACKE/src/lapacke_dsbev_2stage.c index 6027a602d3..d156fcc47b 100644 --- a/LAPACKE/src/lapacke_dsbev_2stage.c +++ b/LAPACKE/src/lapacke_dsbev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_dsbev_2stage( int matrix_layout, char jobz, char uplo, lapack double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_dsbev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbev_2stage_work.c b/LAPACKE/src/lapacke_dsbev_2stage_work.c index e8bf948d76..16c52c9ec1 100644 --- a/LAPACKE/src/lapacke_dsbev_2stage_work.c +++ b/LAPACKE/src/lapacke_dsbev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsbev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -73,7 +73,7 @@ lapack_int LAPACKE_dsbev_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -81,7 +81,7 @@ lapack_int LAPACKE_dsbev_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbev_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, &info ); @@ -89,24 +89,24 @@ lapack_int LAPACKE_dsbev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbev_work.c b/LAPACKE/src/lapacke_dsbev_work.c index 74321ecbbd..01d9e17344 100644 --- a/LAPACKE/src/lapacke_dsbev_work.c +++ b/LAPACKE/src/lapacke_dsbev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz, double* work ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsbev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsbev_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsbev_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &info ); @@ -83,24 +83,24 @@ lapack_int LAPACKE_dsbev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevd.c b/LAPACKE/src/lapacke_dsbevd.c index 27dd8100a2..9f56b9ffe4 100644 --- a/LAPACKE/src/lapacke_dsbevd.c +++ b/LAPACKE/src/lapacke_dsbevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz ) { @@ -44,19 +44,19 @@ lapack_int LAPACKE_dsbevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsbevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_dsbevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevd_2stage.c b/LAPACKE/src/lapacke_dsbevd_2stage.c index 41e3f3a3aa..455f85717e 100644 --- a/LAPACKE/src/lapacke_dsbevd_2stage.c +++ b/LAPACKE/src/lapacke_dsbevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz ) { @@ -44,19 +44,19 @@ lapack_int LAPACKE_dsbevd_2stage( int matrix_layout, char jobz, char uplo, lapac lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsbevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_dsbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_dsbevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevd_2stage_work.c b/LAPACKE/src/lapacke_dsbevd_2stage_work.c index c2c21fb3c4..5025655d29 100644 --- a/LAPACKE/src/lapacke_dsbevd_2stage_work.c +++ b/LAPACKE/src/lapacke_dsbevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz, double* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dsbevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsbevd_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbevd_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -90,24 +90,24 @@ lapack_int LAPACKE_dsbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevd_work.c b/LAPACKE/src/lapacke_dsbevd_work.c index 8b96b1ecf0..7372709133 100644 --- a/LAPACKE/src/lapacke_dsbevd_work.c +++ b/LAPACKE/src/lapacke_dsbevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* w, double* z, lapack_int ldz, double* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dsbevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsbevd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsbevd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -90,24 +90,24 @@ lapack_int LAPACKE_dsbevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevx.c b/LAPACKE/src/lapacke_dsbevx.c index b27ba2114f..3a06af216e 100644 --- a/LAPACKE/src/lapacke_dsbevx.c +++ b/LAPACKE/src/lapacke_dsbevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* q, lapack_int ldq, double vl, double vu, lapack_int il, lapack_int iu, @@ -43,25 +43,25 @@ lapack_int LAPACKE_dsbevx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_dsbevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbevx_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_dsbevx_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -88,7 +88,7 @@ lapack_int LAPACKE_dsbevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevx_2stage.c b/LAPACKE/src/lapacke_dsbevx_2stage.c index 74d88b99d5..923f425fd4 100644 --- a/LAPACKE/src/lapacke_dsbevx_2stage.c +++ b/LAPACKE/src/lapacke_dsbevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* q, lapack_int ldq, double vl, double vu, lapack_int il, lapack_int iu, @@ -45,32 +45,32 @@ lapack_int LAPACKE_dsbevx_2stage( int matrix_layout, char jobz, char range, char double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_dsbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_dsbevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_dsbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_dsbevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevx_2stage_work.c b/LAPACKE/src/lapacke_dsbevx_2stage_work.c index 6750e2acb1..3bd194ed4a 100644 --- a/LAPACKE/src/lapacke_dsbevx_2stage_work.c +++ b/LAPACKE/src/lapacke_dsbevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsbevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* q, lapack_int ldq, double vl, double vu, @@ -51,9 +51,9 @@ lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,14 +82,14 @@ lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -105,7 +105,7 @@ lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbevx_2stage( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -114,32 +114,32 @@ lapack_int LAPACKE_dsbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbevx_work.c b/LAPACKE/src/lapacke_dsbevx_work.c index 40457ee4a3..00af3b3415 100644 --- a/LAPACKE/src/lapacke_dsbevx_work.c +++ b/LAPACKE/src/lapacke_dsbevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsbevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* q, lapack_int ldq, double vl, double vu, @@ -51,9 +51,9 @@ lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dsbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,14 +82,14 @@ lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -98,7 +98,7 @@ lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -107,32 +107,32 @@ lapack_int LAPACKE_dsbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgst.c b/LAPACKE/src/lapacke_dsbgst.c index 46706d8448..f11211efc7 100644 --- a/LAPACKE/src/lapacke_dsbgst.c +++ b/LAPACKE/src/lapacke_dsbgst.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgst( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbgst)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, const double* bb, lapack_int ldbb, double* x, lapack_int ldx ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_dsbgst( int matrix_layout, char vect, char uplo, lapack_int n lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_dsbgst( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsbgst_work( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_dsbgst_work)( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x, ldx, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgst", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgst_work.c b/LAPACKE/src/lapacke_dsbgst_work.c index 0f2efb15e5..9a69319246 100644 --- a/LAPACKE/src/lapacke_dsbgst_work.c +++ b/LAPACKE/src/lapacke_dsbgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbgst_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, const double* bb, lapack_int ldbb, double* x, lapack_int ldx, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst_work", info ); return info; } if( ldx < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dsbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,n) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_dsb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, x_t, &ldx_t, work, &info ); @@ -97,13 +97,13 @@ lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( x_t ); } exit_level_2: @@ -112,11 +112,11 @@ lapack_int LAPACKE_dsbgst_work( int matrix_layout, char vect, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgv.c b/LAPACKE/src/lapacke_dsbgv.c index 8696973055..b62a6ccbf1 100644 --- a/LAPACKE/src/lapacke_dsbgv.c +++ b/LAPACKE/src/lapacke_dsbgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgv( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbgv)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* w, double* z, lapack_int ldz ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_dsbgv( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_dsbgv( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsbgv_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_dsbgv_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgv_work.c b/LAPACKE/src/lapacke_dsbgv_work.c index c50562dcc0..53eb388b1e 100644 --- a/LAPACKE/src/lapacke_dsbgv_work.c +++ b/LAPACKE/src/lapacke_dsbgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbgv_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* w, double* z, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dsbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_dsb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &info ); @@ -97,15 +97,15 @@ lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -114,11 +114,11 @@ lapack_int LAPACKE_dsbgv_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgvd.c b/LAPACKE/src/lapacke_dsbgvd.c index 05555c89db..6e109b2bbe 100644 --- a/LAPACKE/src/lapacke_dsbgvd.c +++ b/LAPACKE/src/lapacke_dsbgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgvd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbgvd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* w, double* z, lapack_int ldz ) @@ -45,22 +45,22 @@ lapack_int LAPACKE_dsbgvd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_dsbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -80,7 +80,7 @@ lapack_int LAPACKE_dsbgvd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_dsbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_dsbgvd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgvd_work.c b/LAPACKE/src/lapacke_dsbgvd_work.c index 1960271305..8465cb7720 100644 --- a/LAPACKE/src/lapacke_dsbgvd_work.c +++ b/LAPACKE/src/lapacke_dsbgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbgvd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* w, double* z, @@ -57,17 +57,17 @@ lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -95,8 +95,8 @@ lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_dsb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -104,15 +104,15 @@ lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -121,11 +121,11 @@ lapack_int LAPACKE_dsbgvd_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgvx.c b/LAPACKE/src/lapacke_dsbgvx.c index 3217d402ce..4026323269 100644 --- a/LAPACKE/src/lapacke_dsbgvx.c +++ b/LAPACKE/src/lapacke_dsbgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgvx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbgvx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* q, lapack_int ldq, @@ -44,28 +44,28 @@ lapack_int LAPACKE_dsbgvx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -8; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -18; } - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -14; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -15; } } @@ -83,7 +83,7 @@ lapack_int LAPACKE_dsbgvx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsbgvx_work( matrix_layout, jobz, range, uplo, n, ka, kb, ab, + info = API_SUFFIX(LAPACKE_dsbgvx_work)( matrix_layout, jobz, range, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_dsbgvx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbgvx_work.c b/LAPACKE/src/lapacke_dsbgvx_work.c index b381439290..a80da9548b 100644 --- a/LAPACKE/src/lapacke_dsbgvx_work.c +++ b/LAPACKE/src/lapacke_dsbgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsbgvx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, double* ab, lapack_int ldab, double* bb, lapack_int ldbb, double* q, @@ -63,22 +63,22 @@ lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); return info; } if( ldbb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); return info; } if( ldq < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); return info; } if( ldz < n ) { info = -22; - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -92,14 +92,14 @@ lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -107,8 +107,8 @@ lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_dsb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, @@ -117,22 +117,22 @@ lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -141,11 +141,11 @@ lapack_int LAPACKE_dsbgvx_work( int matrix_layout, char jobz, char range, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbtrd.c b/LAPACKE/src/lapacke_dsbtrd.c index 84e84e8360..29b8d70a2a 100644 --- a/LAPACKE/src/lapacke_dsbtrd.c +++ b/LAPACKE/src/lapacke_dsbtrd.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbtrd( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsbtrd)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* d, double* e, double* q, lapack_int ldq ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsbtrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dsb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -10; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_dsbtrd( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsbtrd_work( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, + info = API_SUFFIX(LAPACKE_dsbtrd_work)( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbtrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsbtrd_work.c b/LAPACKE/src/lapacke_dsbtrd_work.c index 0d9ed3cfde..e6926acb3a 100644 --- a/LAPACKE/src/lapacke_dsbtrd_work.c +++ b/LAPACKE/src/lapacke_dsbtrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsbtrd_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsbtrd_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, double* ab, lapack_int ldab, double* d, double* e, double* q, lapack_int ldq, double* work ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsbtrd_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd_work", info ); return info; } if( ldq < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsbtrd_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,9 +75,9 @@ lapack_int LAPACKE_dsbtrd_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_dsb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dsb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_dsbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t, @@ -86,24 +86,24 @@ lapack_int LAPACKE_dsbtrd_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_dsb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsbtrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsfrk.c b/LAPACKE/src/lapacke_dsfrk.c index 4af9a7922e..a30dfd1806 100644 --- a/LAPACKE/src/lapacke_dsfrk.c +++ b/LAPACKE/src/lapacke_dsfrk.c @@ -32,35 +32,35 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsfrk( int matrix_layout, char transr, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dsfrk)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, double alpha, const double* a, lapack_int lda, double beta, double* c ) { lapack_int ka, na; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsfrk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsfrk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - if( LAPACKE_dge_nancheck( matrix_layout, na, ka, a, lda ) ) { + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, na, ka, a, lda ) ) { return -8; } - if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &alpha, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &beta, 1 ) ) { return -10; } - if( LAPACKE_dpf_nancheck( n, c ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, c ) ) { return -11; } } #endif - return LAPACKE_dsfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha, + return API_SUFFIX(LAPACKE_dsfrk_work)( matrix_layout, transr, uplo, trans, n, k, alpha, a, lda, beta, c ); } diff --git a/LAPACKE/src/lapacke_dsfrk_work.c b/LAPACKE/src/lapacke_dsfrk_work.c index 6072648eb2..bebee2c523 100644 --- a/LAPACKE/src/lapacke_dsfrk_work.c +++ b/LAPACKE/src/lapacke_dsfrk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsfrk_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsfrk_work)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, double alpha, const double* a, lapack_int lda, double beta, double* c ) @@ -46,15 +46,15 @@ lapack_int LAPACKE_dsfrk_work( int matrix_layout, char transr, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k; - lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n; + lapack_int na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + lapack_int ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; lapack_int lda_t = MAX(1,na); double* a_t = NULL; double* c_t = NULL; /* Check leading dimension(s) */ if( lda < ka ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,25 +70,25 @@ lapack_int LAPACKE_dsfrk_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, na, ka, a, lda, a_t, lda_t ); - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, c, c_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, na, ka, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_dsfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); + API_SUFFIX(LAPACKE_dpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsfrk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsfrk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsgesv.c b/LAPACKE/src/lapacke_dsgesv.c index b8e8930eac..4b5c9d26ca 100644 --- a/LAPACKE/src/lapacke_dsgesv.c +++ b/LAPACKE/src/lapacke_dsgesv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsgesv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dsgesv)( int matrix_layout, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb, double* x, lapack_int ldx, lapack_int* iter ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_dsgesv( int matrix_layout, lapack_int n, lapack_int nrhs, float* swork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsgesv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsgesv( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb, x, + info = API_SUFFIX(LAPACKE_dsgesv_work)( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work, swork, iter ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsgesv( int matrix_layout, lapack_int n, lapack_int nrhs, LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsgesv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsgesv_work.c b/LAPACKE/src/lapacke_dsgesv_work.c index 5eeaffd0f5..62e266470d 100644 --- a/LAPACKE/src/lapacke_dsgesv_work.c +++ b/LAPACKE/src/lapacke_dsgesv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_dsgesv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb, double* x, lapack_int ldx, double* work, float* swork, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dsgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,8 +86,8 @@ lapack_int LAPACKE_dsgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsgesv( &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, work, swork, iter, &info ); @@ -95,9 +95,9 @@ lapack_int LAPACKE_dsgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_2: @@ -106,11 +106,11 @@ lapack_int LAPACKE_dsgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsgesv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspcon.c b/LAPACKE/src/lapacke_dspcon.c index 3b16c513e4..53c3d605ae 100644 --- a/LAPACKE/src/lapacke_dspcon.c +++ b/LAPACKE/src/lapacke_dspcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspcon)( int matrix_layout, char uplo, lapack_int n, const double* ap, const lapack_int* ipiv, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_dspcon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -4; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_dspcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_dspcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_dspcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspcon_work.c b/LAPACKE/src/lapacke_dspcon_work.c index be0fc30f28..94e263cdeb 100644 --- a/LAPACKE/src/lapacke_dspcon_work.c +++ b/LAPACKE/src/lapacke_dspcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspcon_work)( int matrix_layout, char uplo, lapack_int n, const double* ap, const lapack_int* ipiv, double anorm, double* rcond, double* work, lapack_int* iwork ) @@ -54,7 +54,7 @@ lapack_int LAPACKE_dspcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, iwork, &info ); @@ -65,11 +65,11 @@ lapack_int LAPACKE_dspcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspev.c b/LAPACKE/src/lapacke_dspev.c index 90c1659643..68e36d99ab 100644 --- a/LAPACKE/src/lapacke_dspev.c +++ b/LAPACKE/src/lapacke_dspev.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspev)( int matrix_layout, char jobz, char uplo, lapack_int n, double* ap, double* w, double* z, lapack_int ldz ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } } @@ -56,13 +56,13 @@ lapack_int LAPACKE_dspev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dspev_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_dspev_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspev_work.c b/LAPACKE/src/lapacke_dspev_work.c index f74284bcc7..6d034e8c5f 100644 --- a/LAPACKE/src/lapacke_dspev_work.c +++ b/LAPACKE/src/lapacke_dspev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* ap, double* w, double* z, lapack_int ldz, double* work ) { @@ -50,11 +50,11 @@ lapack_int LAPACKE_dspev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -68,30 +68,30 @@ lapack_int LAPACKE_dspev_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dspev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspevd.c b/LAPACKE/src/lapacke_dspevd.c index 20a0cc8136..af6584d112 100644 --- a/LAPACKE/src/lapacke_dspevd.c +++ b/LAPACKE/src/lapacke_dspevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspevd)( int matrix_layout, char jobz, char uplo, lapack_int n, double* ap, double* w, double* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_dspevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dspevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_dspevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_dspevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_dspevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_dspevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspevd_work.c b/LAPACKE/src/lapacke_dspevd_work.c index af34d8b0a2..19c7d29b20 100644 --- a/LAPACKE/src/lapacke_dspevd_work.c +++ b/LAPACKE/src/lapacke_dspevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* ap, double* w, double* z, lapack_int ldz, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -52,7 +52,7 @@ lapack_int LAPACKE_dspevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_dspevd_work( int matrix_layout, char jobz, char uplo, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -76,7 +76,7 @@ lapack_int LAPACKE_dspevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dspevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -84,23 +84,23 @@ lapack_int LAPACKE_dspevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspevx.c b/LAPACKE/src/lapacke_dspevx.c index 05d3cad17d..272a740a98 100644 --- a/LAPACKE/src/lapacke_dspevx.c +++ b/LAPACKE/src/lapacke_dspevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* ap, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, lapack_int ldz, @@ -42,25 +42,25 @@ lapack_int LAPACKE_dspevx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_dspevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspevx_work( matrix_layout, jobz, range, uplo, n, ap, vl, vu, + info = API_SUFFIX(LAPACKE_dspevx_work)( matrix_layout, jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_dspevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspevx_work.c b/LAPACKE/src/lapacke_dspevx_work.c index ea902587d7..9f38490a19 100644 --- a/LAPACKE/src/lapacke_dspevx_work.c +++ b/LAPACKE/src/lapacke_dspevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dspevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* ap, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -48,20 +48,20 @@ lapack_int LAPACKE_dspevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); double* z_t = NULL; double* ap_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -76,7 +76,7 @@ lapack_int LAPACKE_dspevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dspevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, &info ); @@ -84,24 +84,24 @@ lapack_int LAPACKE_dspevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgst.c b/LAPACKE/src/lapacke_dspgst.c index 9d0e1873ba..bb01a55ab0 100644 --- a/LAPACKE/src/lapacke_dspgst.c +++ b/LAPACKE/src/lapacke_dspgst.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspgst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, double* ap, const double* bp ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dsp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, bp ) ) { return -6; } } #endif - return LAPACKE_dspgst_work( matrix_layout, itype, uplo, n, ap, bp ); + return API_SUFFIX(LAPACKE_dspgst_work)( matrix_layout, itype, uplo, n, ap, bp ); } diff --git a/LAPACKE/src/lapacke_dspgst_work.c b/LAPACKE/src/lapacke_dspgst_work.c index a58614f831..f9b10b6185 100644 --- a/LAPACKE/src/lapacke_dspgst_work.c +++ b/LAPACKE/src/lapacke_dspgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspgst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, double* ap, const double* bp ) { lapack_int info = 0; @@ -59,26 +59,26 @@ lapack_int LAPACKE_dspgst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_dspgst( &itype, &uplo, &n, ap_t, bp_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgv.c b/LAPACKE/src/lapacke_dspgv.c index df42ce91b9..03428fd8f9 100644 --- a/LAPACKE/src/lapacke_dspgv.c +++ b/LAPACKE/src/lapacke_dspgv.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* ap, double* bp, double* w, double* z, lapack_int ldz ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_dsp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, bp ) ) { return -7; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_dspgv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dspgv_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, + info = API_SUFFIX(LAPACKE_dspgv_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgv_work.c b/LAPACKE/src/lapacke_dspgv_work.c index 689517e704..949e56a39c 100644 --- a/LAPACKE/src/lapacke_dspgv_work.c +++ b/LAPACKE/src/lapacke_dspgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* ap, double* bp, double* w, double* z, lapack_int ldz, double* work ) @@ -53,11 +53,11 @@ lapack_int LAPACKE_dspgv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -77,8 +77,8 @@ lapack_int LAPACKE_dspgv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_dspgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &info ); @@ -86,26 +86,26 @@ lapack_int LAPACKE_dspgv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgvd.c b/LAPACKE/src/lapacke_dspgvd.c index ab6910d1dd..8db8ed79a3 100644 --- a/LAPACKE/src/lapacke_dspgvd.c +++ b/LAPACKE/src/lapacke_dspgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* ap, double* bp, double* w, double* z, lapack_int ldz ) { @@ -44,22 +44,22 @@ lapack_int LAPACKE_dspgvd( int matrix_layout, lapack_int itype, char jobz, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_dsp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, bp ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dspgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_dspgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -79,7 +79,7 @@ lapack_int LAPACKE_dspgvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_dspgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_dspgvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgvd_work.c b/LAPACKE/src/lapacke_dspgvd_work.c index 7a075de3d3..bed3971c28 100644 --- a/LAPACKE/src/lapacke_dspgvd_work.c +++ b/LAPACKE/src/lapacke_dspgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* ap, double* bp, double* w, double* z, lapack_int ldz, double* work, lapack_int lwork, @@ -54,7 +54,7 @@ lapack_int LAPACKE_dspgvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_dspgvd_work( int matrix_layout, lapack_int itype, char jobz, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -84,8 +84,8 @@ lapack_int LAPACKE_dspgvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_dspgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -93,26 +93,26 @@ lapack_int LAPACKE_dspgvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgvx.c b/LAPACKE/src/lapacke_dspgvx.c index eb09e490bb..68d62ef312 100644 --- a/LAPACKE/src/lapacke_dspgvx.c +++ b/LAPACKE/src/lapacke_dspgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, double* ap, double* bp, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -43,28 +43,28 @@ lapack_int LAPACKE_dspgvx( int matrix_layout, lapack_int itype, char jobz, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -13; } - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -7; } - if( LAPACKE_dsp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, bp ) ) { return -8; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -9; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -10; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_dspgvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspgvx_work( matrix_layout, itype, jobz, range, uplo, n, ap, + info = API_SUFFIX(LAPACKE_dspgvx_work)( matrix_layout, itype, jobz, range, uplo, n, ap, bp, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_dspgvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspgvx_work.c b/LAPACKE/src/lapacke_dspgvx_work.c index 1a6036b1b4..2c027c84b1 100644 --- a/LAPACKE/src/lapacke_dspgvx_work.c +++ b/LAPACKE/src/lapacke_dspgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspgvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dspgvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, double* ap, double* bp, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -49,9 +49,9 @@ lapack_int LAPACKE_dspgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); double* z_t = NULL; double* ap_t = NULL; @@ -59,11 +59,11 @@ lapack_int LAPACKE_dspgvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -84,8 +84,8 @@ lapack_int LAPACKE_dspgvx_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_dspgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, @@ -94,27 +94,27 @@ lapack_int LAPACKE_dspgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsposv.c b/LAPACKE/src/lapacke_dsposv.c index f589444361..71ecfd63b4 100644 --- a/LAPACKE/src/lapacke_dsposv.c +++ b/LAPACKE/src/lapacke_dsposv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* x, lapack_int ldx, lapack_int* iter ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_dsposv( int matrix_layout, char uplo, lapack_int n, float* swork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsposv( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb, x, + info = API_SUFFIX(LAPACKE_dsposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb, x, ldx, work, swork, iter ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsposv( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsposv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsposv_work.c b/LAPACKE/src/lapacke_dsposv_work.c index 66bbb10528..ad59e66e73 100644 --- a/LAPACKE/src/lapacke_dsposv_work.c +++ b/LAPACKE/src/lapacke_dsposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* b, lapack_int ldb, double* x, lapack_int ldx, double* work, float* swork, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dsposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,8 +86,8 @@ lapack_int LAPACKE_dsposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, work, swork, iter, &info ); @@ -95,9 +95,9 @@ lapack_int LAPACKE_dsposv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_2: @@ -106,11 +106,11 @@ lapack_int LAPACKE_dsposv_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsprfs.c b/LAPACKE/src/lapacke_dsprfs.c index 14a2acf071..f697acbcad 100644 --- a/LAPACKE/src/lapacke_dsprfs.c +++ b/LAPACKE/src/lapacke_dsprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const double* afp, const lapack_int* ipiv, const double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -42,22 +42,22 @@ lapack_int LAPACKE_dsprfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_dsprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsprfs_work.c b/LAPACKE/src/lapacke_dsprfs_work.c index ce6e9c5577..a3149545f9 100644 --- a/LAPACKE/src/lapacke_dsprfs_work.c +++ b/LAPACKE/src/lapacke_dsprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const double* afp, const lapack_int* ipiv, const double* b, lapack_int ldb, double* x, @@ -57,12 +57,12 @@ lapack_int LAPACKE_dsprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_dsprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_dsprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_dsprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -111,11 +111,11 @@ lapack_int LAPACKE_dsprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspsv.c b/LAPACKE/src/lapacke_dspsv.c index 73606a602b..46d01e66ba 100644 --- a/LAPACKE/src/lapacke_dspsv.c +++ b/LAPACKE/src/lapacke_dspsv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* ap, lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_dspsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dspsv_work.c b/LAPACKE/src/lapacke_dspsv_work.c index 3878c651e6..eefbf6776a 100644 --- a/LAPACKE/src/lapacke_dspsv_work.c +++ b/LAPACKE/src/lapacke_dspsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* ap, lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dspsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,27 +66,27 @@ lapack_int LAPACKE_dspsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspsvx.c b/LAPACKE/src/lapacke_dspsvx.c index 6c0fef7753..c2d4bcce7b 100644 --- a/LAPACKE/src/lapacke_dspsvx.c +++ b/LAPACKE/src/lapacke_dspsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dspsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const double* ap, double* afp, lapack_int* ipiv, const double* b, lapack_int ldb, double* x, lapack_int ldx, double* rcond, @@ -42,21 +42,21 @@ lapack_int LAPACKE_dspsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dspsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dsp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_dspsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dspsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_dspsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_dspsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dspsvx_work.c b/LAPACKE/src/lapacke_dspsvx_work.c index dfd1dde265..29df47d5aa 100644 --- a/LAPACKE/src/lapacke_dspsvx_work.c +++ b/LAPACKE/src/lapacke_dspsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dspsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dspsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const double* ap, double* afp, lapack_int* ipiv, const double* b, lapack_int ldb, double* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_dspsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_dspsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dsp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_dspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -101,9 +101,9 @@ lapack_int LAPACKE_dspsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -115,11 +115,11 @@ lapack_int LAPACKE_dspsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dspsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsptrd.c b/LAPACKE/src/lapacke_dsptrd.c index 56941f116e..da8911f91c 100644 --- a/LAPACKE/src/lapacke_dsptrd.c +++ b/LAPACKE/src/lapacke_dsptrd.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrd( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrd)( int matrix_layout, char uplo, lapack_int n, double* ap, double* d, double* e, double* tau ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsptrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dsptrd_work( matrix_layout, uplo, n, ap, d, e, tau ); + return API_SUFFIX(LAPACKE_dsptrd_work)( matrix_layout, uplo, n, ap, d, e, tau ); } diff --git a/LAPACKE/src/lapacke_dsptrd_work.c b/LAPACKE/src/lapacke_dsptrd_work.c index 28b9fc032a..8fbb16db70 100644 --- a/LAPACKE/src/lapacke_dsptrd_work.c +++ b/LAPACKE/src/lapacke_dsptrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrd_work)( int matrix_layout, char uplo, lapack_int n, double* ap, double* d, double* e, double* tau ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dsptrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dsptrd( &uplo, &n, ap_t, d, e, tau, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsptrf.c b/LAPACKE/src/lapacke_dsptrf.c index 01b9c5a6de..8ba3d042e8 100644 --- a/LAPACKE/src/lapacke_dsptrf.c +++ b/LAPACKE/src/lapacke_dsptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrf)( int matrix_layout, char uplo, lapack_int n, double* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dsptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_dsptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_dsptrf_work.c b/LAPACKE/src/lapacke_dsptrf_work.c index c4446492f6..db5590ab7e 100644 --- a/LAPACKE/src/lapacke_dsptrf_work.c +++ b/LAPACKE/src/lapacke_dsptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrf_work)( int matrix_layout, char uplo, lapack_int n, double* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dsptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dsptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsptri.c b/LAPACKE/src/lapacke_dsptri.c index 7817a0d9e4..44149c4375 100644 --- a/LAPACKE/src/lapacke_dsptri.c +++ b/LAPACKE/src/lapacke_dsptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptri)( int matrix_layout, char uplo, lapack_int n, double* ap, const lapack_int* ipiv ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_dsptri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_dsptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsptri_work.c b/LAPACKE/src/lapacke_dsptri_work.c index 5fcef36e7d..bbf2bb9a65 100644 --- a/LAPACKE/src/lapacke_dsptri_work.c +++ b/LAPACKE/src/lapacke_dsptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptri_work)( int matrix_layout, char uplo, lapack_int n, double* ap, const lapack_int* ipiv, double* work ) { @@ -53,23 +53,23 @@ lapack_int LAPACKE_dsptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dsptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsptrs.c b/LAPACKE/src/lapacke_dsptrs.c index d8f2db1c4f..0cb020cdc9 100644 --- a/LAPACKE/src/lapacke_dsptrs.c +++ b/LAPACKE/src/lapacke_dsptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dsptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_dsptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dsptrs_work.c b/LAPACKE/src/lapacke_dsptrs_work.c index 4d21200d5f..f0b8e1a7a8 100644 --- a/LAPACKE/src/lapacke_dsptrs_work.c +++ b/LAPACKE/src/lapacke_dsptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* ap, const lapack_int* ipiv, double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dsptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,26 +67,26 @@ lapack_int LAPACKE_dsptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dsptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstebz.c b/LAPACKE/src/lapacke_dstebz.c index 6616c5b2e9..0a33730c67 100644 --- a/LAPACKE/src/lapacke_dstebz.c +++ b/LAPACKE/src/lapacke_dstebz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl, +lapack_int API_SUFFIX(LAPACKE_dstebz)( char range, char order, lapack_int n, double vl, double vu, lapack_int il, lapack_int iu, double abstol, const double* d, const double* e, lapack_int* m, lapack_int* nsplit, double* w, @@ -44,22 +44,22 @@ lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -8; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -9; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -4; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -5; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstebz_work( range, order, n, vl, vu, il, iu, abstol, d, e, + info = API_SUFFIX(LAPACKE_dstebz_work)( range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_dstebz( char range, char order, lapack_int n, double vl, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstebz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstebz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstebz_work.c b/LAPACKE/src/lapacke_dstebz_work.c index 0861b9d84c..573b0feb48 100644 --- a/LAPACKE/src/lapacke_dstebz_work.c +++ b/LAPACKE/src/lapacke_dstebz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstebz_work( char range, char order, lapack_int n, double vl, +lapack_int API_SUFFIX(LAPACKE_dstebz_work)( char range, char order, lapack_int n, double vl, double vu, lapack_int il, lapack_int iu, double abstol, const double* d, const double* e, lapack_int* m, lapack_int* nsplit, double* w, diff --git a/LAPACKE/src/lapacke_dstedc.c b/LAPACKE/src/lapacke_dstedc.c index 29ef80656f..3d76d8e27b 100644 --- a/LAPACKE/src/lapacke_dstedc.c +++ b/LAPACKE/src/lapacke_dstedc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dstedc)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,27 +43,27 @@ lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstedc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstedc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dstedc_work( matrix_layout, compz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_dstedc_work)( matrix_layout, compz, n, d, e, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -82,7 +82,7 @@ lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstedc_work( matrix_layout, compz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_dstedc_work)( matrix_layout, compz, n, d, e, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstedc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstedc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstedc_work.c b/LAPACKE/src/lapacke_dstedc_work.c index e197899c14..c95567f10e 100644 --- a/LAPACKE/src/lapacke_dstedc_work.c +++ b/LAPACKE/src/lapacke_dstedc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstedc_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dstedc_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dstedc_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstedc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dstedc_work( int matrix_layout, char compz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -69,8 +69,8 @@ lapack_int LAPACKE_dstedc_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork, @@ -79,20 +79,20 @@ lapack_int LAPACKE_dstedc_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstedc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstedc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstegr.c b/LAPACKE/src/lapacke_dstegr.c index 50871aaff0..1afbbf27d8 100644 --- a/LAPACKE/src/lapacke_dstegr.c +++ b/LAPACKE/src/lapacke_dstegr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstegr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstegr)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -46,35 +46,35 @@ lapack_int LAPACKE_dstegr( int matrix_layout, char jobz, char range, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstegr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstegr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_dstegr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_dstegr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstegr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstegr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstegr_work.c b/LAPACKE/src/lapacke_dstegr_work.c index 320f162e12..7538eae8d9 100644 --- a/LAPACKE/src/lapacke_dstegr_work.c +++ b/LAPACKE/src/lapacke_dstegr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstegr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstegr_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -53,9 +53,9 @@ lapack_int LAPACKE_dstegr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); double* z_t = NULL; /* Check leading dimension(s) */ - if( ( LAPACKE_lsame( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { + if( ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstegr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_dstegr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { /* Let be always 'n' instead of 'm' */ z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { @@ -82,20 +82,20 @@ lapack_int LAPACKE_dstegr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstegr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstegr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstein.c b/LAPACKE/src/lapacke_dstein.c index bddfa2ae42..00e6514fae 100644 --- a/LAPACKE/src/lapacke_dstein.c +++ b/LAPACKE/src/lapacke_dstein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstein( int matrix_layout, lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_dstein)( int matrix_layout, lapack_int n, const double* d, const double* e, lapack_int m, const double* w, const lapack_int* iblock, const lapack_int* isplit, double* z, lapack_int ldz, lapack_int* ifailv ) @@ -41,19 +41,19 @@ lapack_int LAPACKE_dstein( int matrix_layout, lapack_int n, const double* d, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, w, 1 ) ) { return -6; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_dstein( int matrix_layout, lapack_int n, const double* d, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstein_work( matrix_layout, n, d, e, m, w, iblock, isplit, z, + info = API_SUFFIX(LAPACKE_dstein_work)( matrix_layout, n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifailv ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_dstein( int matrix_layout, lapack_int n, const double* d, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstein_work.c b/LAPACKE/src/lapacke_dstein_work.c index a1e2779fc8..7c3adc22e9 100644 --- a/LAPACKE/src/lapacke_dstein_work.c +++ b/LAPACKE/src/lapacke_dstein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstein_work( int matrix_layout, lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_dstein_work)( int matrix_layout, lapack_int n, const double* d, const double* e, lapack_int m, const double* w, const lapack_int* iblock, const lapack_int* isplit, double* z, @@ -53,7 +53,7 @@ lapack_int LAPACKE_dstein_work( int matrix_layout, lapack_int n, const double* d /* Check leading dimension(s) */ if( ldz < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,16 +69,16 @@ lapack_int LAPACKE_dstein_work( int matrix_layout, lapack_int n, const double* d info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstemr.c b/LAPACKE/src/lapacke_dstemr.c index a56a36f7b6..b03a0a76b7 100644 --- a/LAPACKE/src/lapacke_dstemr.c +++ b/LAPACKE/src/lapacke_dstemr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstemr)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* m, double* w, double* z, lapack_int ldz, @@ -47,28 +47,28 @@ lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstemr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstemr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -88,7 +88,7 @@ lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -97,7 +97,7 @@ lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstemr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstemr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstemr_work.c b/LAPACKE/src/lapacke_dstemr_work.c index 560721b7d2..2d1b702372 100644 --- a/LAPACKE/src/lapacke_dstemr_work.c +++ b/LAPACKE/src/lapacke_dstemr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstemr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstemr_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* m, double* w, double* z, @@ -54,9 +54,9 @@ lapack_int LAPACKE_dstemr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); double* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) { + if( ldz < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ldz < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstemr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_dstemr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,20 +82,20 @@ lapack_int LAPACKE_dstemr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstemr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstemr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsteqr.c b/LAPACKE/src/lapacke_dsteqr.c index fb2c4e8463..e0b4abf921 100644 --- a/LAPACKE/src/lapacke_dsteqr.c +++ b/LAPACKE/src/lapacke_dsteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsteqr( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsteqr)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_dsteqr( int matrix_layout, char compz, lapack_int n, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,2*n-2); @@ -72,12 +72,12 @@ lapack_int LAPACKE_dsteqr( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_dsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsteqr_work.c b/LAPACKE/src/lapacke_dsteqr_work.c index ae61a378e8..6d7a5aa708 100644 --- a/LAPACKE/src/lapacke_dsteqr_work.c +++ b/LAPACKE/src/lapacke_dsteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsteqr_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, double* z, lapack_int ldz, double* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_dsteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -61,8 +61,8 @@ lapack_int LAPACKE_dsteqr_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dsteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -70,20 +70,20 @@ lapack_int LAPACKE_dsteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsterf.c b/LAPACKE/src/lapacke_dsterf.c index 1dd5a3c8f8..77ed69f3d0 100644 --- a/LAPACKE/src/lapacke_dsterf.c +++ b/LAPACKE/src/lapacke_dsterf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsterf( lapack_int n, double* d, double* e ) +lapack_int API_SUFFIX(LAPACKE_dsterf)( lapack_int n, double* d, double* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_dsterf_work( n, d, e ); + return API_SUFFIX(LAPACKE_dsterf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_dsterf_work.c b/LAPACKE/src/lapacke_dsterf_work.c index 390f5a5799..67f45ec9ae 100644 --- a/LAPACKE/src/lapacke_dsterf_work.c +++ b/LAPACKE/src/lapacke_dsterf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsterf_work( lapack_int n, double* d, double* e ) +lapack_int API_SUFFIX(LAPACKE_dsterf_work)( lapack_int n, double* d, double* e ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_dstev.c b/LAPACKE/src/lapacke_dstev.c index 90c111be53..d1af4cf8ca 100644 --- a/LAPACKE/src/lapacke_dstev.c +++ b/LAPACKE/src/lapacke_dstev.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstev( int matrix_layout, char jobz, lapack_int n, double* d, +lapack_int API_SUFFIX(LAPACKE_dstev)( int matrix_layout, char jobz, lapack_int n, double* d, double* e, double* z, lapack_int ldz ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n-2) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -61,14 +61,14 @@ lapack_int LAPACKE_dstev( int matrix_layout, char jobz, lapack_int n, double* d, } } /* Call middle-level interface */ - info = LAPACKE_dstev_work( matrix_layout, jobz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_dstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work ); /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstev_work.c b/LAPACKE/src/lapacke_dstev_work.c index a71a0ea7e1..0160c12799 100644 --- a/LAPACKE/src/lapacke_dstev_work.c +++ b/LAPACKE/src/lapacke_dstev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstev_work( int matrix_layout, char jobz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dstev_work)( int matrix_layout, char jobz, lapack_int n, double* d, double* e, double* z, lapack_int ldz, double* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_dstev_work( int matrix_layout, char jobz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -66,20 +66,20 @@ lapack_int LAPACKE_dstev_work( int matrix_layout, char jobz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevd.c b/LAPACKE/src/lapacke_dstevd.c index bb5435fa0a..75f2b72717 100644 --- a/LAPACKE/src/lapacke_dstevd.c +++ b/LAPACKE/src/lapacke_dstevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevd( int matrix_layout, char jobz, lapack_int n, double* d, +lapack_int API_SUFFIX(LAPACKE_dstevd)( int matrix_layout, char jobz, lapack_int n, double* d, double* e, double* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,22 +43,22 @@ lapack_int LAPACKE_dstevd( int matrix_layout, char jobz, lapack_int n, double* d lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dstevd_work( matrix_layout, jobz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_dstevd_work)( matrix_layout, jobz, n, d, e, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -77,7 +77,7 @@ lapack_int LAPACKE_dstevd( int matrix_layout, char jobz, lapack_int n, double* d goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstevd_work( matrix_layout, jobz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_dstevd_work)( matrix_layout, jobz, n, d, e, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_dstevd( int matrix_layout, char jobz, lapack_int n, double* d LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevd_work.c b/LAPACKE/src/lapacke_dstevd_work.c index da9577abe9..22d47b0b10 100644 --- a/LAPACKE/src/lapacke_dstevd_work.c +++ b/LAPACKE/src/lapacke_dstevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevd_work( int matrix_layout, char jobz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dstevd_work)( int matrix_layout, char jobz, lapack_int n, double* d, double* e, double* z, lapack_int ldz, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dstevd_work( int matrix_layout, char jobz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dstevd_work( int matrix_layout, char jobz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,20 +75,20 @@ lapack_int LAPACKE_dstevd_work( int matrix_layout, char jobz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevr.c b/LAPACKE/src/lapacke_dstevr.c index b745ce75d1..5d83d6ac6c 100644 --- a/LAPACKE/src/lapacke_dstevr.c +++ b/LAPACKE/src/lapacke_dstevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstevr)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -46,35 +46,35 @@ lapack_int LAPACKE_dstevr( int matrix_layout, char jobz, char range, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dstevr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstevr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_dstevr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstevr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstevr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_dstevr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevr_work.c b/LAPACKE/src/lapacke_dstevr_work.c index 1505226206..21716e7483 100644 --- a/LAPACKE/src/lapacke_dstevr_work.c +++ b/LAPACKE/src/lapacke_dstevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstevr_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -50,15 +50,15 @@ lapack_int LAPACKE_dstevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); double* z_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_dstevr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -85,21 +85,21 @@ lapack_int LAPACKE_dstevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevx.c b/LAPACKE/src/lapacke_dstevx.c index 1b0219dabf..29e5b53162 100644 --- a/LAPACKE/src/lapacke_dstevx.c +++ b/LAPACKE/src/lapacke_dstevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevx( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstevx)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -42,28 +42,28 @@ lapack_int LAPACKE_dstevx( int matrix_layout, char jobz, char range, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dstevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_dstevx( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dstevx_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_dstevx_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ LAPACKE_free( work ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_dstevx( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dstevx_work.c b/LAPACKE/src/lapacke_dstevx_work.c index 6e83917583..19acc72a22 100644 --- a/LAPACKE/src/lapacke_dstevx_work.c +++ b/LAPACKE/src/lapacke_dstevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dstevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dstevx_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -48,19 +48,19 @@ lapack_int LAPACKE_dstevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); double* z_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -75,21 +75,21 @@ lapack_int LAPACKE_dstevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsycon.c b/LAPACKE/src/lapacke_dsycon.c index 6ffc01b2cb..8ab722bb0a 100644 --- a/LAPACKE/src/lapacke_dsycon.c +++ b/LAPACKE/src/lapacke_dsycon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsycon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsycon)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_dsycon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsycon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_dsycon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsycon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_dsycon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsycon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsycon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsycon_3.c b/LAPACKE/src/lapacke_dsycon_3.c index 0ffd22680f..1999ce2e28 100644 --- a/LAPACKE/src/lapacke_dsycon_3.c +++ b/LAPACKE/src/lapacke_dsycon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsycon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsycon_3)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, const double* e, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; double* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsycon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_dsycon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_dsycon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_dsycon_3( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsycon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsycon_3_work.c b/LAPACKE/src/lapacke_dsycon_3_work.c index fedc94cec3..deba4f9ce2 100644 --- a/LAPACKE/src/lapacke_dsycon_3_work.c +++ b/LAPACKE/src/lapacke_dsycon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsycon_3_work)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, const double* e, const lapack_int* ipiv, double anorm, double* rcond, double* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsycon_work.c b/LAPACKE/src/lapacke_dsycon_work.c index 11400648c7..3268e8679a 100644 --- a/LAPACKE/src/lapacke_dsycon_work.c +++ b/LAPACKE/src/lapacke_dsycon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsycon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsycon_work)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond, double* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dsycon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dsycon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dsycon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsycon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyconv.c b/LAPACKE/src/lapacke_dsyconv.c index a1b63f1f0f..f977635e07 100644 --- a/LAPACKE/src/lapacke_dsyconv.c +++ b/LAPACKE/src/lapacke_dsyconv.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyconv( int matrix_layout, char uplo, char way, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyconv)( int matrix_layout, char uplo, char way, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* e ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyconv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyconv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - return LAPACKE_dsyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, e ); + return API_SUFFIX(LAPACKE_dsyconv_work)( matrix_layout, uplo, way, n, a, lda, ipiv, e ); } diff --git a/LAPACKE/src/lapacke_dsyconv_work.c b/LAPACKE/src/lapacke_dsyconv_work.c index 4c3e094dd4..cf710257f8 100644 --- a/LAPACKE/src/lapacke_dsyconv_work.c +++ b/LAPACKE/src/lapacke_dsyconv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, +lapack_int API_SUFFIX(LAPACKE_dsyconv_work)( int matrix_layout, char uplo, char way, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* e ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyconv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, e, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyconv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyconv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyequb.c b/LAPACKE/src/lapacke_dsyequb.c index 80fcad4735..fd851ce56b 100644 --- a/LAPACKE/src/lapacke_dsyequb.c +++ b/LAPACKE/src/lapacke_dsyequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyequb)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_dsyequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsyequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_dsyequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyequb_work.c b/LAPACKE/src/lapacke_dsyequb_work.c index 18dcf9c4c7..7a5eab661e 100644 --- a/LAPACKE/src/lapacke_dsyequb_work.c +++ b/LAPACKE/src/lapacke_dsyequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyequb_work)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double* s, double* scond, double* amax, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsyequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_dsyequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_dsyequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyev.c b/LAPACKE/src/lapacke_dsyev.c index 33c9710f4c..68a91ff1df 100644 --- a/LAPACKE/src/lapacke_dsyev.c +++ b/LAPACKE/src/lapacke_dsyev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyev)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsyev( int matrix_layout, char jobz, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyev_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_dsyev_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsyev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsyev_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_dsyev_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyev_2stage.c b/LAPACKE/src/lapacke_dsyev_2stage.c index ce8b7bbcc0..b5266ebfa9 100644 --- a/LAPACKE/src/lapacke_dsyev_2stage.c +++ b/LAPACKE/src/lapacke_dsyev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsyev_2stage( int matrix_layout, char jobz, char uplo, lapack double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_dsyev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsyev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsyev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_dsyev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyev_2stage_work.c b/LAPACKE/src/lapacke_dsyev_2stage_work.c index a50254d4a3..17f76e5bf0 100644 --- a/LAPACKE/src/lapacke_dsyev_2stage_work.c +++ b/LAPACKE/src/lapacke_dsyev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsyev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsyev_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyev_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyev_work.c b/LAPACKE/src/lapacke_dsyev_work.c index 343135eeab..dc6a7f1568 100644 --- a/LAPACKE/src/lapacke_dsyev_work.c +++ b/LAPACKE/src/lapacke_dsyev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsyev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_dsyev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { @@ -72,19 +72,19 @@ lapack_int LAPACKE_dsyev_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevd.c b/LAPACKE/src/lapacke_dsyevd.c index 1c128f8c7d..79beddbd6f 100644 --- a/LAPACKE/src/lapacke_dsyevd.c +++ b/LAPACKE/src/lapacke_dsyevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyevd)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyevd_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_dsyevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevd_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_dsyevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevd_2stage.c b/LAPACKE/src/lapacke_dsyevd_2stage.c index c720f197a2..94b5b28462 100644 --- a/LAPACKE/src/lapacke_dsyevd_2stage.c +++ b/LAPACKE/src/lapacke_dsyevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapac lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_dsyevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_dsyevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevd_2stage_work.c b/LAPACKE/src/lapacke_dsyevd_2stage_work.c index 4fce77a668..9bc45c60fb 100644 --- a/LAPACKE/src/lapacke_dsyevd_2stage_work.c +++ b/LAPACKE/src/lapacke_dsyevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,19 +76,19 @@ lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevd_work.c b/LAPACKE/src/lapacke_dsyevd_work.c index c3cc755b18..1dead1b00b 100644 --- a/LAPACKE/src/lapacke_dsyevd_work.c +++ b/LAPACKE/src/lapacke_dsyevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* w, double* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,19 +76,19 @@ lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevr.c b/LAPACKE/src/lapacke_dsyevr.c index 8fba691d6c..9af609447d 100644 --- a/LAPACKE/src/lapacke_dsyevr.c +++ b/LAPACKE/src/lapacke_dsyevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevr( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevr)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -46,32 +46,32 @@ lapack_int LAPACKE_dsyevr( int matrix_layout, char jobz, char range, char uplo, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_dsyevr( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_dsyevr( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevr_2stage.c b/LAPACKE/src/lapacke_dsyevr_2stage.c index abd85b8ccf..319a268365 100644 --- a/LAPACKE/src/lapacke_dsyevr_2stage.c +++ b/LAPACKE/src/lapacke_dsyevr_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevr_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevr_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -46,32 +46,32 @@ lapack_int LAPACKE_dsyevr_2stage( int matrix_layout, char jobz, char range, char lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsyevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_dsyevr_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_dsyevr_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevr_2stage_work.c b/LAPACKE/src/lapacke_dsyevr_2stage_work.c index 0e055c1c8b..8308a54bc9 100644 --- a/LAPACKE/src/lapacke_dsyevr_2stage_work.c +++ b/LAPACKE/src/lapacke_dsyevr_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsyevr_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, @@ -51,9 +51,9 @@ lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); double* a_t = NULL; @@ -61,12 +61,12 @@ lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevr_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -100,24 +100,24 @@ lapack_int LAPACKE_dsyevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevr_work.c b/LAPACKE/src/lapacke_dsyevr_work.c index 12c356f285..184629f28e 100644 --- a/LAPACKE/src/lapacke_dsyevr_work.c +++ b/LAPACKE/src/lapacke_dsyevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsyevr_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, @@ -51,10 +51,10 @@ lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); double* a_t = NULL; @@ -62,12 +62,12 @@ lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dsyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,7 +83,7 @@ lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -101,24 +101,24 @@ lapack_int LAPACKE_dsyevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevx.c b/LAPACKE/src/lapacke_dsyevx.c index 39e2b921f5..04ae4d7bcd 100644 --- a/LAPACKE/src/lapacke_dsyevx.c +++ b/LAPACKE/src/lapacke_dsyevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -44,25 +44,25 @@ lapack_int LAPACKE_dsyevx( int matrix_layout, char jobz, char range, char uplo, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsyevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dsyevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_dsyevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_dsyevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevx_2stage.c b/LAPACKE/src/lapacke_dsyevx_2stage.c index 904089295c..4047116f42 100644 --- a/LAPACKE/src/lapacke_dsyevx_2stage.c +++ b/LAPACKE/src/lapacke_dsyevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsyevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, double* z, @@ -44,25 +44,25 @@ lapack_int LAPACKE_dsyevx_2stage( int matrix_layout, char jobz, char range, char double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsyevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dsyevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_dsyevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_dsyevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_dsyevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevx_2stage_work.c b/LAPACKE/src/lapacke_dsyevx_2stage_work.c index ea00282c15..19539a0775 100644 --- a/LAPACKE/src/lapacke_dsyevx_2stage_work.c +++ b/LAPACKE/src/lapacke_dsyevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsyevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, @@ -50,9 +50,9 @@ lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); double* a_t = NULL; @@ -60,12 +60,12 @@ lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevx_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork, @@ -99,24 +99,24 @@ lapack_int LAPACKE_dsyevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyevx_work.c b/LAPACKE/src/lapacke_dsyevx_work.c index 7d94a08951..ce20575663 100644 --- a/LAPACKE/src/lapacke_dsyevx_work.c +++ b/LAPACKE/src/lapacke_dsyevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_dsyevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, @@ -50,10 +50,10 @@ lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); double* a_t = NULL; @@ -61,12 +61,12 @@ lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dsyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork, @@ -100,24 +100,24 @@ lapack_int LAPACKE_dsyevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygst.c b/LAPACKE/src/lapacke_dsygst.c index 128a9a2ac5..836bc152cc 100644 --- a/LAPACKE/src/lapacke_dsygst.c +++ b/LAPACKE/src/lapacke_dsygst.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsygst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, double* a, lapack_int lda, const double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsygst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -7; } } #endif - return LAPACKE_dsygst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_dsygst_work)( matrix_layout, itype, uplo, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dsygst_work.c b/LAPACKE/src/lapacke_dsygst_work.c index e85b641f0d..ce08a50313 100644 --- a/LAPACKE/src/lapacke_dsygst_work.c +++ b/LAPACKE/src/lapacke_dsygst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsygst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, double* a, lapack_int lda, const double* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_dsygst_work( int matrix_layout, lapack_int itype, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygst_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_dsygst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygv.c b/LAPACKE/src/lapacke_dsygv.c index c989bdac2f..56b840a1bb 100644 --- a/LAPACKE/src/lapacke_dsygv.c +++ b/LAPACKE/src/lapacke_dsygv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsygv( int matrix_layout, lapack_int itype, char jobz, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsygv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsygv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsygv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsygv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygv_2stage.c b/LAPACKE/src/lapacke_dsygv_2stage.c index 4bcacd3063..546a63bf6a 100644 --- a/LAPACKE/src/lapacke_dsygv_2stage.c +++ b/LAPACKE/src/lapacke_dsygv_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygv_2stage( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygv_2stage)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsygv_2stage( int matrix_layout, lapack_int itype, char jobz, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsygv_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsygv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsygv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsygv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygv_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygv_2stage_work.c b/LAPACKE/src/lapacke_dsygv_2stage_work.c index 5f6b620230..240097c241 100644 --- a/LAPACKE/src/lapacke_dsygv_2stage_work.c +++ b/LAPACKE/src/lapacke_dsygv_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygv_2stage_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygv_2stage_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsygv_2stage_work( int matrix_layout, lapack_int itype, char /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsygv_2stage_work( int matrix_layout, lapack_int itype, char goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygv_2stage( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsygv_2stage_work( int matrix_layout, lapack_int itype, char info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygv_work.c b/LAPACKE/src/lapacke_dsygv_work.c index 7ccefa4518..eee082d579 100644 --- a/LAPACKE/src/lapacke_dsygv_work.c +++ b/LAPACKE/src/lapacke_dsygv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsygv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsygv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsygv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygvd.c b/LAPACKE/src/lapacke_dsygvd.c index d40c4a1c42..586bed464f 100644 --- a/LAPACKE/src/lapacke_dsygvd.c +++ b/LAPACKE/src/lapacke_dsygvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w ) { @@ -44,22 +44,22 @@ lapack_int LAPACKE_dsygvd( int matrix_layout, lapack_int itype, char jobz, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsygvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsygvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -79,7 +79,7 @@ lapack_int LAPACKE_dsygvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsygvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dsygvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_dsygvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygvd_work.c b/LAPACKE/src/lapacke_dsygvd_work.c index d49ed790b6..125ec686ca 100644 --- a/LAPACKE/src/lapacke_dsygvd_work.c +++ b/LAPACKE/src/lapacke_dsygvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* w, double* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dsygvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_dsygvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, iwork, &liwork, &info ); @@ -89,19 +89,19 @@ lapack_int LAPACKE_dsygvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygvx.c b/LAPACKE/src/lapacke_dsygvx.c index 9396d5a09c..7dacdbbb16 100644 --- a/LAPACKE/src/lapacke_dsygvx.c +++ b/LAPACKE/src/lapacke_dsygvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double vl, double vu, lapack_int il, lapack_int iu, @@ -45,28 +45,28 @@ lapack_int LAPACKE_dsygvx( int matrix_layout, lapack_int itype, char jobz, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsygvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_dsygvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dsygvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_dsygvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_dsygvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsygvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_dsygvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_dsygvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsygvx_work.c b/LAPACKE/src/lapacke_dsygvx_work.c index 91a8d98224..77ec1bca8a 100644 --- a/LAPACKE/src/lapacke_dsygvx_work.c +++ b/LAPACKE/src/lapacke_dsygvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_dsygvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double vl, double vu, lapack_int il, @@ -51,9 +51,9 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dsygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (double*) LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -103,8 +103,8 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, } } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dsy_trans( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -113,14 +113,14 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -129,11 +129,11 @@ lapack_int LAPACKE_dsygvx_work( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsygvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyrfs.c b/LAPACKE/src/lapacke_dsyrfs.c index c63c9c5ce9..e5a8b61ebe 100644 --- a/LAPACKE/src/lapacke_dsyrfs.c +++ b/LAPACKE/src/lapacke_dsyrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, const double* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_dsyrfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_dsyrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyrfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_dsyrfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_dsyrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyrfs_work.c b/LAPACKE/src/lapacke_dsyrfs_work.c index 573087b368..13754f7409 100644 --- a/LAPACKE/src/lapacke_dsyrfs_work.c +++ b/LAPACKE/src/lapacke_dsyrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dsyrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,10 +100,10 @@ lapack_int LAPACKE_dsyrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_dsyrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_dsyrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyrfsx.c b/LAPACKE/src/lapacke_dsyrfsx.c index b0590d60cf..8323043355 100644 --- a/LAPACKE/src/lapacke_dsyrfsx.c +++ b/LAPACKE/src/lapacke_dsyrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyrfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_dsyrfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, const double* s, @@ -46,32 +46,32 @@ lapack_int LAPACKE_dsyrfsx( int matrix_layout, char uplo, char equed, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -88,7 +88,7 @@ lapack_int LAPACKE_dsyrfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsyrfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dsyrfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_dsyrfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyrfsx_work.c b/LAPACKE/src/lapacke_dsyrfsx_work.c index 1e2ba0e578..5ac9e864ca 100644 --- a/LAPACKE/src/lapacke_dsyrfsx_work.c +++ b/LAPACKE/src/lapacke_dsyrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyrfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_dsyrfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -68,22 +68,22 @@ lapack_int LAPACKE_dsyrfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -120,10 +120,10 @@ lapack_int LAPACKE_dsyrfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyrfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -133,10 +133,10 @@ lapack_int LAPACKE_dsyrfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -152,11 +152,11 @@ lapack_int LAPACKE_dsyrfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv.c b/LAPACKE/src/lapacke_dsysv.c index 0ef7fbc6c4..3e00b522cc 100644 --- a/LAPACKE/src/lapacke_dsysv.c +++ b/LAPACKE/src/lapacke_dsysv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsysv( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsysv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_aa.c b/LAPACKE/src/lapacke_dsysv_aa.c index 1197d03fb5..d2525c4556 100644 --- a/LAPACKE/src/lapacke_dsysv_aa.c +++ b/LAPACKE/src/lapacke_dsysv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsysv_aa( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsysv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_aa_2stage.c b/LAPACKE/src/lapacke_dsysv_aa_2stage.c index 95222b0e7b..90b9b156d5 100644 --- a/LAPACKE/src/lapacke_dsysv_aa_2stage.c +++ b/LAPACKE/src/lapacke_dsysv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_dsysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -74,14 +74,14 @@ lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_dsysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_aa_2stage_work.c b/LAPACKE/src/lapacke_dsysv_aa_2stage_work.c index 9e421361a7..dbff2b8410 100644 --- a/LAPACKE/src/lapacke_dsysv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_dsysv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_aa_work.c b/LAPACKE/src/lapacke_dsysv_aa_work.c index 8054b01288..844538f3a2 100644 --- a/LAPACKE/src/lapacke_dsysv_aa_work.c +++ b/LAPACKE/src/lapacke_dsysv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsysv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsysv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsysv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_rk.c b/LAPACKE/src/lapacke_dsysv_rk.c index 2a6303049a..96c16f2c74 100644 --- a/LAPACKE/src/lapacke_dsysv_rk.c +++ b/LAPACKE/src/lapacke_dsysv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* e, lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsysv_rk( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsysv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_dsysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_rk_work.c b/LAPACKE/src/lapacke_dsysv_rk_work.c index f8e41d6ddf..ad638cec85 100644 --- a/LAPACKE/src/lapacke_dsysv_rk_work.c +++ b/LAPACKE/src/lapacke_dsysv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* e, lapack_int* ipiv, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_rook.c b/LAPACKE/src/lapacke_dsysv_rook.c index 843d10b9f0..a918d98ce1 100644 --- a/LAPACKE/src/lapacke_dsysv_rook.c +++ b/LAPACKE/src/lapacke_dsysv_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsysv_rook( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_dsysv_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_rook_work.c b/LAPACKE/src/lapacke_dsysv_rook_work.c index 9d6d10f028..e041179017 100644 --- a/LAPACKE/src/lapacke_dsysv_rook_work.c +++ b/LAPACKE/src/lapacke_dsysv_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsysv_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsysv_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysv_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsysv_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysv_work.c b/LAPACKE/src/lapacke_dsysv_work.c index 2b1f42f51b..16280a2a99 100644 --- a/LAPACKE/src/lapacke_dsysv_work.c +++ b/LAPACKE/src/lapacke_dsysv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, lapack_int* ipiv, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dsysv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_dsysv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_dsysv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysvx.c b/LAPACKE/src/lapacke_dsysvx.c index 8695bd677b..c1df1d85e0 100644 --- a/LAPACKE/src/lapacke_dsysvx.c +++ b/LAPACKE/src/lapacke_dsysvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsysvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* af, lapack_int ldaf, lapack_int* ipiv, const double* b, lapack_int ldb, double* x, @@ -45,21 +45,21 @@ lapack_int LAPACKE_dsysvx( int matrix_layout, char fact, char uplo, lapack_int n double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_dsysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dsysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dsysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, iwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_dsysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dsysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, iwork ); /* Release memory and exit */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_dsysvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysvx_work.c b/LAPACKE/src/lapacke_dsysvx_work.c index 625f7f31ad..7d56fbd424 100644 --- a/LAPACKE/src/lapacke_dsysvx_work.c +++ b/LAPACKE/src/lapacke_dsysvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsysvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* af, lapack_int ldaf, lapack_int* ipiv, const double* b, @@ -62,22 +62,22 @@ lapack_int LAPACKE_dsysvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -109,11 +109,11 @@ lapack_int LAPACKE_dsysvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -122,11 +122,11 @@ lapack_int LAPACKE_dsysvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -137,11 +137,11 @@ lapack_int LAPACKE_dsysvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysvxx.c b/LAPACKE/src/lapacke_dsysvxx.c index 81124a54c7..c8aa120e22 100644 --- a/LAPACKE/src/lapacke_dsysvxx.c +++ b/LAPACKE/src/lapacke_dsysvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsysvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, lapack_int* ipiv, char* equed, double* s, double* b, @@ -46,30 +46,30 @@ lapack_int LAPACKE_dsysvxx( int matrix_layout, char fact, char uplo, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsysvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -12; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_dsysvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dsysvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_dsysvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -97,7 +97,7 @@ lapack_int LAPACKE_dsysvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsysvxx_work.c b/LAPACKE/src/lapacke_dsysvxx_work.c index 722d9dea1c..808e8a15bf 100644 --- a/LAPACKE/src/lapacke_dsysvxx_work.c +++ b/LAPACKE/src/lapacke_dsysvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsysvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_dsysvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* af, lapack_int ldaf, lapack_int* ipiv, char* equed, double* s, @@ -67,22 +67,22 @@ lapack_int LAPACKE_dsysvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,11 +119,11 @@ lapack_int LAPACKE_dsysvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_dsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsysvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -133,20 +133,20 @@ lapack_int LAPACKE_dsysvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -162,11 +162,11 @@ lapack_int LAPACKE_dsysvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsysvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsyswapr.c b/LAPACKE/src/lapacke_dsyswapr.c index 5da8ac7ffd..0155e9cac5 100644 --- a/LAPACKE/src/lapacke_dsyswapr.c +++ b/LAPACKE/src/lapacke_dsyswapr.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_dsyswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_dsyswapr_work.c b/LAPACKE/src/lapacke_dsyswapr_work.c index 32d5c8682c..72a067ebf9 100644 --- a/LAPACKE/src/lapacke_dsyswapr_work.c +++ b/LAPACKE/src/lapacke_dsyswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsyswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsyswapr_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -53,21 +53,21 @@ lapack_int LAPACKE_dsyswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsyswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrd.c b/LAPACKE/src/lapacke_dsytrd.c index b4f09ea46e..b18fe167ca 100644 --- a/LAPACKE/src/lapacke_dsytrd.c +++ b/LAPACKE/src/lapacke_dsytrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrd( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytrd)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* d, double* e, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytrd( int matrix_layout, char uplo, lapack_int n, double* a double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, + info = API_SUFFIX(LAPACKE_dsytrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsytrd( int matrix_layout, char uplo, lapack_int n, double* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, work, + info = API_SUFFIX(LAPACKE_dsytrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrd_work.c b/LAPACKE/src/lapacke_dsytrd_work.c index a501ec7fda..143c1b4382 100644 --- a/LAPACKE/src/lapacke_dsytrd_work.c +++ b/LAPACKE/src/lapacke_dsytrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrd_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* d, double* e, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytrd_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dsytrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf.c b/LAPACKE/src/lapacke_dsytrf.c index 1c452236f6..22900ef30c 100644 --- a/LAPACKE/src/lapacke_dsytrf.c +++ b/LAPACKE/src/lapacke_dsytrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytrf)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytrf( int matrix_layout, char uplo, lapack_int n, double* a double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsytrf( int matrix_layout, char uplo, lapack_int n, double* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_aa.c b/LAPACKE/src/lapacke_dsytrf_aa.c index 17eb31b80c..07b87b305a 100644 --- a/LAPACKE/src/lapacke_dsytrf_aa.c +++ b/LAPACKE/src/lapacke_dsytrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_aa( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytrf_aa)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytrf_aa( int matrix_layout, char uplo, lapack_int n, double double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsytrf_aa( int matrix_layout, char uplo, lapack_int n, double goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_aa_2stage.c b/LAPACKE/src/lapacke_dsytrf_aa_2stage.c index ec153d176d..7a3a91d079 100644 --- a/LAPACKE/src/lapacke_dsytrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_dsytrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_dsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_dsytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -71,14 +71,14 @@ lapack_int LAPACKE_dsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_dsytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_aa_2stage_work.c b/LAPACKE/src/lapacke_dsytrf_aa_2stage_work.c index 77a5940738..aaf30ef65f 100644 --- a/LAPACKE/src/lapacke_dsytrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_dsytrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -90,18 +90,18 @@ lapack_int LAPACKE_dsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_aa_work.c b/LAPACKE/src/lapacke_dsytrf_aa_work.c index f479afc7e5..0c7286b8f8 100644 --- a/LAPACKE/src/lapacke_dsytrf_aa_work.c +++ b/LAPACKE/src/lapacke_dsytrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_aa_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_rk.c b/LAPACKE/src/lapacke_dsytrf_rk.c index 30639d47f3..4996ec74e8 100644 --- a/LAPACKE/src/lapacke_dsytrf_rk.c +++ b/LAPACKE/src/lapacke_dsytrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytrf_rk)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* e, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_dsytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_rk_work.c b/LAPACKE/src/lapacke_dsytrf_rk_work.c index 74eeabbc33..51307c62f0 100644 --- a/LAPACKE/src/lapacke_dsytrf_rk_work.c +++ b/LAPACKE/src/lapacke_dsytrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_rk_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, double* e, lapack_int* ipiv, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_rook.c b/LAPACKE/src/lapacke_dsytrf_rook.c index 5ef77738f5..8091e9c359 100644 --- a/LAPACKE/src/lapacke_dsytrf_rook.c +++ b/LAPACKE/src/lapacke_dsytrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_rook( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytrf_rook)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytrf_rook( int matrix_layout, char uplo, lapack_int n, doub double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_dsytrf_rook( int matrix_layout, char uplo, lapack_int n, doub goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_rook_work.c b/LAPACKE/src/lapacke_dsytrf_rook_work.c index 53536523af..29d5f23d8a 100644 --- a/LAPACKE/src/lapacke_dsytrf_rook_work.c +++ b/LAPACKE/src/lapacke_dsytrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_rook_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrf_work.c b/LAPACKE/src/lapacke_dsytrf_work.c index b6788f76b0..34b4256d79 100644 --- a/LAPACKE/src/lapacke_dsytrf_work.c +++ b/LAPACKE/src/lapacke_dsytrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrf_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, lapack_int* ipiv, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsytrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri.c b/LAPACKE/src/lapacke_dsytri.c index 2175cfaf54..15403a3a5a 100644 --- a/LAPACKE/src/lapacke_dsytri.c +++ b/LAPACKE/src/lapacke_dsytri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytri)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_dsytri( int matrix_layout, char uplo, lapack_int n, double* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_dsytri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri2.c b/LAPACKE/src/lapacke_dsytri2.c index 3ac3f73ad2..487d427c49 100644 --- a/LAPACKE/src/lapacke_dsytri2.c +++ b/LAPACKE/src/lapacke_dsytri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri2)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_dsytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_dsytri2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri2_work.c b/LAPACKE/src/lapacke_dsytri2_work.c index 29881c0c26..3ae17b67af 100644 --- a/LAPACKE/src/lapacke_dsytri2_work.c +++ b/LAPACKE/src/lapacke_dsytri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri2_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dsytri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_dsytri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri2x.c b/LAPACKE/src/lapacke_dsytri2x.c index d322823883..90d6cb8575 100644 --- a/LAPACKE/src/lapacke_dsytri2x.c +++ b/LAPACKE/src/lapacke_dsytri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri2x)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_dsytri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_dsytri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri2x_work.c b/LAPACKE/src/lapacke_dsytri2x_work.c index ae6e70fda7..c0c70d6b43 100644 --- a/LAPACKE/src/lapacke_dsytri2x_work.c +++ b/LAPACKE/src/lapacke_dsytri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri2x_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_dsytri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_dsytri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri_3.c b/LAPACKE/src/lapacke_dsytri_3.c index d71e920c1b..108dca60a3 100644 --- a/LAPACKE/src/lapacke_dsytri_3.c +++ b/LAPACKE/src/lapacke_dsytri_3.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri_3( int matrix_layout, char uplo, lapack_int n, double* a, +lapack_int API_SUFFIX(LAPACKE_dsytri_3)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const double* e, const lapack_int* ipiv ) { lapack_int info = 0; lapack_int lwork = -1; double* work = NULL; double work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_dsytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_dsytri_3( int matrix_layout, char uplo, lapack_int n, double* goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_dsytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri_3_work.c b/LAPACKE/src/lapacke_dsytri_3_work.c index 7c2e831630..3c7c37ca3a 100644 --- a/LAPACKE/src/lapacke_dsytri_3_work.c +++ b/LAPACKE/src/lapacke_dsytri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri_3_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const double* e, const lapack_int* ipiv, double* work, lapack_int lwork) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dsytri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytri_work.c b/LAPACKE/src/lapacke_dsytri_work.c index c8749f9ccc..df9b69fef2 100644 --- a/LAPACKE/src/lapacke_dsytri_work.c +++ b/LAPACKE/src/lapacke_dsytri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytri_work)( int matrix_layout, char uplo, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dsytri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_dsytri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs.c b/LAPACKE/src/lapacke_dsytrs.c index 34df6d777b..44925ac44e 100644 --- a/LAPACKE/src/lapacke_dsytrs.c +++ b/LAPACKE/src/lapacke_dsytrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dsytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_dsytrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dsytrs2.c b/LAPACKE/src/lapacke_dsytrs2.c index 7b653b2ed1..9aa2b285f6 100644 --- a/LAPACKE/src/lapacke_dsytrs2.c +++ b/LAPACKE/src/lapacke_dsytrs2.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_dsytrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsytrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs2_work.c b/LAPACKE/src/lapacke_dsytrs2_work.c index b1af18ea3d..eb3178f43a 100644 --- a/LAPACKE/src/lapacke_dsytrs2_work.c +++ b/LAPACKE/src/lapacke_dsytrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb, double* work ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_3.c b/LAPACKE/src/lapacke_dsytrs_3.c index 34d32831d3..343bc84b54 100644 --- a/LAPACKE/src/lapacke_dsytrs_3.c +++ b/LAPACKE/src/lapacke_dsytrs_3.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* e, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_d_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_dsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_dsytrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dsytrs_3_work.c b/LAPACKE/src/lapacke_dsytrs_3_work.c index cd8b79b94f..3bb9ff95d3 100644 --- a/LAPACKE/src/lapacke_dsytrs_3_work.c +++ b/LAPACKE/src/lapacke_dsytrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* e, const lapack_int* ipiv, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_aa.c b/LAPACKE/src/lapacke_dsytrs_aa.c index 545d9efcd0..56f6dc839a 100644 --- a/LAPACKE/src/lapacke_dsytrs_aa.c +++ b/LAPACKE/src/lapacke_dsytrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_dsytrs_aa( int matrix_layout, char uplo, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_dsytrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_dsytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_aa_2stage.c b/LAPACKE/src/lapacke_dsytrs_aa_2stage.c index 95e4f04ec9..034c66a683 100644 --- a/LAPACKE/src/lapacke_dsytrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_dsytrs_aa_2stage.c @@ -32,32 +32,32 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_dsytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_dsytrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb ); return info; diff --git a/LAPACKE/src/lapacke_dsytrs_aa_2stage_work.c b/LAPACKE/src/lapacke_dsytrs_aa_2stage_work.c index 294e3f36dc..cee0b7c829 100644 --- a/LAPACKE/src/lapacke_dsytrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_dsytrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_aa_work.c b/LAPACKE/src/lapacke_dsytrs_aa_work.c index d259690fce..cbe79b9b19 100644 --- a/LAPACKE/src/lapacke_dsytrs_aa_work.c +++ b/LAPACKE/src/lapacke_dsytrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb, double* work, lapack_int lwork ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_rook.c b/LAPACKE/src/lapacke_dsytrs_rook.c index e086a46cd9..a288c0b5fa 100644 --- a/LAPACKE/src/lapacke_dsytrs_rook.c +++ b/LAPACKE/src/lapacke_dsytrs_rook.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dsytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_dsytrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dsytrs_rook_work.c b/LAPACKE/src/lapacke_dsytrs_rook_work.c index b3ffd24bd9..bf4c0ef95f 100644 --- a/LAPACKE/src/lapacke_dsytrs_rook_work.c +++ b/LAPACKE/src/lapacke_dsytrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dsytrs_work.c b/LAPACKE/src/lapacke_dsytrs_work.c index fe0125dcc8..eb19dbaeeb 100644 --- a/LAPACKE/src/lapacke_dsytrs_work.c +++ b/LAPACKE/src/lapacke_dsytrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dsytrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dsytrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_dsytrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_dsytrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dsytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_dsytrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsytrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtbcon.c b/LAPACKE/src/lapacke_dtbcon.c index e7effad595..cd72084c2d 100644 --- a/LAPACKE/src/lapacke_dtbcon.c +++ b/LAPACKE/src/lapacke_dtbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtbcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_dtbcon( int matrix_layout, char norm, char uplo, char diag, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dtb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -7; } } @@ -63,7 +63,7 @@ lapack_int LAPACKE_dtbcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtbcon_work( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, + info = API_SUFFIX(LAPACKE_dtbcon_work)( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -71,7 +71,7 @@ lapack_int LAPACKE_dtbcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtbcon_work.c b/LAPACKE/src/lapacke_dtbcon_work.c index 03043580f4..d122cfd443 100644 --- a/LAPACKE/src/lapacke_dtbcon_work.c +++ b/LAPACKE/src/lapacke_dtbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtbcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab, double* rcond, double* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dtbcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dtbcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dtb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_dtbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work, @@ -73,11 +73,11 @@ lapack_int LAPACKE_dtbcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtbrfs.c b/LAPACKE/src/lapacke_dtbrfs.c index 69f074b2a0..e87c213db5 100644 --- a/LAPACKE/src/lapacke_dtbrfs.c +++ b/LAPACKE/src/lapacke_dtbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtbrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, const double* b, lapack_int ldb, const double* x, lapack_int ldx, @@ -42,19 +42,19 @@ lapack_int LAPACKE_dtbrfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dtb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_dtbrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtbrfs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + info = API_SUFFIX(LAPACKE_dtbrfs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_dtbrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtbrfs_work.c b/LAPACKE/src/lapacke_dtbrfs_work.c index 6eef42d0d6..4a588eb993 100644 --- a/LAPACKE/src/lapacke_dtbrfs_work.c +++ b/LAPACKE/src/lapacke_dtbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtbrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, const double* b, @@ -58,17 +58,17 @@ lapack_int LAPACKE_dtbrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,10 +88,10 @@ lapack_int LAPACKE_dtbrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dtb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dtb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dtbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -106,11 +106,11 @@ lapack_int LAPACKE_dtbrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtbtrs.c b/LAPACKE/src/lapacke_dtbtrs.c index 87b8d2d91b..5528c1fc31 100644 --- a/LAPACKE/src/lapacke_dtbtrs.c +++ b/LAPACKE/src/lapacke_dtbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtbtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_dtb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_dtbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + return API_SUFFIX(LAPACKE_dtbtrs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dtbtrs_work.c b/LAPACKE/src/lapacke_dtbtrs_work.c index f5e5e313a4..bc74bb640b 100644 --- a/LAPACKE/src/lapacke_dtbtrs_work.c +++ b/LAPACKE/src/lapacke_dtbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtbtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtbtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const double* ab, lapack_int ldab, double* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dtbtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,9 +73,9 @@ lapack_int LAPACKE_dtbtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dtb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_dtb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -83,18 +83,18 @@ lapack_int LAPACKE_dtbtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtfsm.c b/LAPACKE/src/lapacke_dtfsm.c index 7b655e6cb8..8ce40723cd 100644 --- a/LAPACKE/src/lapacke_dtfsm.c +++ b/LAPACKE/src/lapacke_dtfsm.c @@ -32,33 +32,33 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfsm( int matrix_layout, char transr, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, double alpha, const double* a, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtfsm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( IS_D_NONZERO(alpha) ) { - if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -10; } } - if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &alpha, 1 ) ) { return -9; } if( IS_D_NONZERO(alpha) ) { - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -11; } } } #endif - return LAPACKE_dtfsm_work( matrix_layout, transr, side, uplo, trans, diag, m, + return API_SUFFIX(LAPACKE_dtfsm_work)( matrix_layout, transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dtfsm_work.c b/LAPACKE/src/lapacke_dtfsm_work.c index 7d12cf890b..0857b45f7c 100644 --- a/LAPACKE/src/lapacke_dtfsm_work.c +++ b/LAPACKE/src/lapacke_dtfsm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfsm_work( int matrix_layout, char transr, char side, +lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, double alpha, const double* a, double* b, lapack_int ldb ) @@ -52,7 +52,7 @@ lapack_int LAPACKE_dtfsm_work( int matrix_layout, char transr, char side, /* Check leading dimension(s) */ if( ldb < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,17 +72,17 @@ lapack_int LAPACKE_dtfsm_work( int matrix_layout, char transr, char side, } /* Transpose input matrices */ if( IS_D_NONZERO(alpha) ) { - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_D_NONZERO(alpha) ) { - LAPACKE_dtf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_D_NONZERO(alpha) ) { LAPACKE_free( a_t ); @@ -91,11 +91,11 @@ lapack_int LAPACKE_dtfsm_work( int matrix_layout, char transr, char side, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtftri.c b/LAPACKE/src/lapacke_dtftri.c index 1db80b6e70..8adf5a0ba8 100644 --- a/LAPACKE/src/lapacke_dtftri.c +++ b/LAPACKE/src/lapacke_dtftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtftri( int matrix_layout, char transr, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtftri)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -6; } } #endif - return LAPACKE_dtftri_work( matrix_layout, transr, uplo, diag, n, a ); + return API_SUFFIX(LAPACKE_dtftri_work)( matrix_layout, transr, uplo, diag, n, a ); } diff --git a/LAPACKE/src/lapacke_dtftri_work.c b/LAPACKE/src/lapacke_dtftri_work.c index 66150897c0..0cdd738aee 100644 --- a/LAPACKE/src/lapacke_dtftri_work.c +++ b/LAPACKE/src/lapacke_dtftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtftri_work)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, double* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dtftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dtftri( &transr, &uplo, &diag, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dtf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); + API_SUFFIX(LAPACKE_dtf_trans)( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtfttp.c b/LAPACKE/src/lapacke_dtfttp.c index fafc376f3d..71bf80798a 100644 --- a/LAPACKE/src/lapacke_dtfttp.c +++ b/LAPACKE/src/lapacke_dtfttp.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfttp( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtfttp)( int matrix_layout, char transr, char uplo, lapack_int n, const double* arf, double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtfttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_dtfttp_work( matrix_layout, transr, uplo, n, arf, ap ); + return API_SUFFIX(LAPACKE_dtfttp_work)( matrix_layout, transr, uplo, n, arf, ap ); } diff --git a/LAPACKE/src/lapacke_dtfttp_work.c b/LAPACKE/src/lapacke_dtfttp_work.c index a8cf680e80..92caebb447 100644 --- a/LAPACKE/src/lapacke_dtfttp_work.c +++ b/LAPACKE/src/lapacke_dtfttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfttp_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtfttp_work)( int matrix_layout, char transr, char uplo, lapack_int n, const double* arf, double* ap ) { lapack_int info = 0; @@ -59,25 +59,25 @@ lapack_int LAPACKE_dtfttp_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_dtfttp( &transr, &uplo, &n, arf_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtfttr.c b/LAPACKE/src/lapacke_dtfttr.c index 39333cceba..60112b2dab 100644 --- a/LAPACKE/src/lapacke_dtfttr.c +++ b/LAPACKE/src/lapacke_dtfttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfttr( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtfttr)( int matrix_layout, char transr, char uplo, lapack_int n, const double* arf, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtfttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_dpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_dtfttr_work( matrix_layout, transr, uplo, n, arf, a, lda ); + return API_SUFFIX(LAPACKE_dtfttr_work)( matrix_layout, transr, uplo, n, arf, a, lda ); } diff --git a/LAPACKE/src/lapacke_dtfttr_work.c b/LAPACKE/src/lapacke_dtfttr_work.c index b12aae0b05..a532e6907a 100644 --- a/LAPACKE/src/lapacke_dtfttr_work.c +++ b/LAPACKE/src/lapacke_dtfttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtfttr_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtfttr_work)( int matrix_layout, char transr, char uplo, lapack_int n, const double* arf, double* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dtfttr_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_dtfttr_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_dpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_dtfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgevc.c b/LAPACKE/src/lapacke_dtgevc.c index f70abfb4bf..ef0ce13ee9 100644 --- a/LAPACKE/src/lapacke_dtgevc.c +++ b/LAPACKE/src/lapacke_dtgevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtgevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const double* s, lapack_int lds, const double* p, lapack_int ldp, double* vl, lapack_int ldvl, @@ -42,25 +42,25 @@ lapack_int LAPACKE_dtgevc( int matrix_layout, char side, char howmny, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, p, ldp ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, p, ldp ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, s, lds ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } @@ -73,13 +73,13 @@ lapack_int LAPACKE_dtgevc( int matrix_layout, char side, char howmny, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtgevc_work( matrix_layout, side, howmny, select, n, s, lds, + info = API_SUFFIX(LAPACKE_dtgevc_work)( matrix_layout, side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgevc_work.c b/LAPACKE/src/lapacke_dtgevc_work.c index ef4a538455..266b235f91 100644 --- a/LAPACKE/src/lapacke_dtgevc_work.c +++ b/LAPACKE/src/lapacke_dtgevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtgevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const double* s, lapack_int lds, const double* p, lapack_int ldp, double* vl, @@ -59,22 +59,22 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldp < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); return info; } if( lds < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,7 +88,7 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { @@ -96,7 +96,7 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { @@ -105,15 +105,15 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, s, lds, s_t, lds_t ); - LAPACKE_dge_trans( matrix_layout, n, n, p, ldp, p_t, ldp_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, p, ldp, p_t, ldp_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t, @@ -122,20 +122,20 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -144,11 +144,11 @@ lapack_int LAPACKE_dtgevc_work( int matrix_layout, char side, char howmny, LAPACKE_free( s_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgexc.c b/LAPACKE/src/lapacke_dtgexc.c index 6f09f9eb7c..f69962fa39 100644 --- a/LAPACKE/src/lapacke_dtgexc.c +++ b/LAPACKE/src/lapacke_dtgexc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgexc( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_dtgexc)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* q, lapack_int ldq, double* z, lapack_int ldz, @@ -43,32 +43,32 @@ lapack_int LAPACKE_dtgexc( int matrix_layout, lapack_logical wantq, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } if( wantq ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -9; } } if( wantz ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dtgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dtgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, &work_query, lwork ); if( info != 0 ) { @@ -82,13 +82,13 @@ lapack_int LAPACKE_dtgexc( int matrix_layout, lapack_logical wantq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dtgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgexc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgexc_work.c b/LAPACKE/src/lapacke_dtgexc_work.c index 6756d5e60c..a4a8806934 100644 --- a/LAPACKE/src/lapacke_dtgexc_work.c +++ b/LAPACKE/src/lapacke_dtgexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgexc_work( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_dtgexc_work)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, double* q, lapack_int ldq, double* z, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dtgexc_work( int matrix_layout, lapack_logical wantq, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -110,13 +110,13 @@ lapack_int LAPACKE_dtgexc_work( int matrix_layout, lapack_logical wantq, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t, @@ -125,13 +125,13 @@ lapack_int LAPACKE_dtgexc_work( int matrix_layout, lapack_logical wantq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -147,11 +147,11 @@ lapack_int LAPACKE_dtgexc_work( int matrix_layout, lapack_logical wantq, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsen.c b/LAPACKE/src/lapacke_dtgsen.c index 883a795798..81a7f9b744 100644 --- a/LAPACKE/src/lapacke_dtgsen.c +++ b/LAPACKE/src/lapacke_dtgsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsen( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_dtgsen)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -48,32 +48,32 @@ lapack_int LAPACKE_dtgsen( int matrix_layout, lapack_int ijob, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } if( wantq ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -14; } } if( wantz ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -16; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dtgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_dtgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alphar, alphai, beta, q, ldq, z, ldz, m, pl, pr, dif, &work_query, lwork, &iwork_query, liwork ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_dtgsen( int matrix_layout, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_dtgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alphar, alphai, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_dtgsen( int matrix_layout, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsen_work.c b/LAPACKE/src/lapacke_dtgsen_work.c index a8b68763e3..422f8a41d1 100644 --- a/LAPACKE/src/lapacke_dtgsen_work.c +++ b/LAPACKE/src/lapacke_dtgsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsen_work( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_dtgsen_work)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, double* a, lapack_int lda, double* b, @@ -64,22 +64,22 @@ lapack_int LAPACKE_dtgsen_work( int matrix_layout, lapack_int ijob, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); return info; } if( ldq < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); return info; } if( ldz < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -116,13 +116,13 @@ lapack_int LAPACKE_dtgsen_work( int matrix_layout, lapack_int ijob, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_dge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t, @@ -132,13 +132,13 @@ lapack_int LAPACKE_dtgsen_work( int matrix_layout, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -154,11 +154,11 @@ lapack_int LAPACKE_dtgsen_work( int matrix_layout, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsja.c b/LAPACKE/src/lapacke_dtgsja.c index 7709fb954f..2fb318cd18 100644 --- a/LAPACKE/src/lapacke_dtgsja.c +++ b/LAPACKE/src/lapacke_dtgsja.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsja( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_dtgsja)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, double* a, lapack_int lda, double* b, lapack_int ldb, @@ -44,36 +44,36 @@ lapack_int LAPACKE_dtgsja( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgsja", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -22; } } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -14; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -15; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, m, m, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, u, ldu ) ) { return -18; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, p, p, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, p, p, v, ldv ) ) { return -20; } } @@ -86,14 +86,14 @@ lapack_int LAPACKE_dtgsja( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtgsja_work( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, + info = API_SUFFIX(LAPACKE_dtgsja_work)( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq, work, ncycle ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsja", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsja_work.c b/LAPACKE/src/lapacke_dtgsja_work.c index 3a4bda6571..3e3dcaf3e8 100644 --- a/LAPACKE/src/lapacke_dtgsja_work.c +++ b/LAPACKE/src/lapacke_dtgsja_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_dtgsja_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, double* a, lapack_int lda, double* b, @@ -65,27 +65,27 @@ lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); return info; } if( ldq < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); return info; } if( ldu < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); return info; } if( ldv < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -99,21 +99,21 @@ lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -121,16 +121,16 @@ lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( matrix_layout, m, m, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, m, u, ldu, u_t, ldu_t ); } - if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, p, p, v, ldv, v_t, ldv_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, p, p, v, ldv, v_t, ldv_t ); } - if( LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t, @@ -140,27 +140,27 @@ lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -169,11 +169,11 @@ lapack_int LAPACKE_dtgsja_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsja_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsna.c b/LAPACKE/src/lapacke_dtgsna.c index e47100422b..bb6380d90b 100644 --- a/LAPACKE/src/lapacke_dtgsna.c +++ b/LAPACKE/src/lapacke_dtgsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtgsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, const double* vl, lapack_int ldvl, @@ -45,32 +45,32 @@ lapack_int LAPACKE_dtgsna( int matrix_layout, char job, char howmny, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -78,7 +78,7 @@ lapack_int LAPACKE_dtgsna( int matrix_layout, char job, char howmny, } } /* Query optimal working array(s) size */ - info = LAPACKE_dtgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dtgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, &work_query, lwork, iwork ); if( info != 0 ) { @@ -86,7 +86,7 @@ lapack_int LAPACKE_dtgsna( int matrix_layout, char job, char howmny, } lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -94,20 +94,20 @@ lapack_int LAPACKE_dtgsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_dtgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_dtgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsna_work.c b/LAPACKE/src/lapacke_dtgsna_work.c index 6b549d00ef..478e71ddef 100644 --- a/LAPACKE/src/lapacke_dtgsna_work.c +++ b/LAPACKE/src/lapacke_dtgsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtgsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, @@ -62,22 +62,22 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { @@ -106,7 +106,7 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { @@ -115,13 +115,13 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t, @@ -131,11 +131,11 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -144,11 +144,11 @@ lapack_int LAPACKE_dtgsna_work( int matrix_layout, char job, char howmny, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsyl.c b/LAPACKE/src/lapacke_dtgsyl.c index 42ad6991c2..cd430880e6 100644 --- a/LAPACKE/src/lapacke_dtgsyl.c +++ b/LAPACKE/src/lapacke_dtgsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsyl( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_dtgsyl)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, lapack_int ldc, const double* d, @@ -46,28 +46,28 @@ lapack_int LAPACKE_dtgsyl( int matrix_layout, char trans, lapack_int ijob, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtgsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_dge_nancheck( matrix_layout, m, m, d, ldd ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, d, ldd ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, e, lde ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, e, lde ) ) { return -14; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -16; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_dtgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_dtgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dtgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, &work_query, lwork, iwork ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_dtgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_dtgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_dtgsyl( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsyl", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtgsyl_work.c b/LAPACKE/src/lapacke_dtgsyl_work.c index 1f7b07e8dc..af4c8a72ad 100644 --- a/LAPACKE/src/lapacke_dtgsyl_work.c +++ b/LAPACKE/src/lapacke_dtgsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtgsyl_work( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_dtgsyl_work)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, lapack_int ldc, const double* d, @@ -66,32 +66,32 @@ lapack_int LAPACKE_dtgsyl_work( int matrix_layout, char trans, lapack_int ijob, /* Check leading dimension(s) */ if( lda < m ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } if( ldd < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } if( lde < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } if( ldf < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -133,12 +133,12 @@ lapack_int LAPACKE_dtgsyl_work( int matrix_layout, char trans, lapack_int ijob, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_dge_trans( matrix_layout, m, m, d, ldd, d_t, ldd_t ); - LAPACKE_dge_trans( matrix_layout, n, n, e, lde, e_t, lde_t ); - LAPACKE_dge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, m, d, ldd, d_t, ldd_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, e, lde, e_t, lde_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); /* Call LAPACK function and adjust info */ LAPACK_dtgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale, @@ -147,8 +147,8 @@ lapack_int LAPACKE_dtgsyl_work( int matrix_layout, char trans, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); /* Release memory and exit */ LAPACKE_free( f_t ); exit_level_5: @@ -163,11 +163,11 @@ lapack_int LAPACKE_dtgsyl_work( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtgsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpcon.c b/LAPACKE/src/lapacke_dtpcon.c index 28884fe767..3438b1e2f9 100644 --- a/LAPACKE/src/lapacke_dtpcon.c +++ b/LAPACKE/src/lapacke_dtpcon.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtpcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const double* ap, double* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_dtp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -6; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_dtpcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtpcon_work( matrix_layout, norm, uplo, diag, n, ap, rcond, + info = API_SUFFIX(LAPACKE_dtpcon_work)( matrix_layout, norm, uplo, diag, n, ap, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -70,7 +70,7 @@ lapack_int LAPACKE_dtpcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpcon_work.c b/LAPACKE/src/lapacke_dtpcon_work.c index 6c87547941..794bf97820 100644 --- a/LAPACKE/src/lapacke_dtpcon_work.c +++ b/LAPACKE/src/lapacke_dtpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtpcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const double* ap, double* rcond, double* work, lapack_int* iwork ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_dtpcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, iwork, &info ); @@ -64,11 +64,11 @@ lapack_int LAPACKE_dtpcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpmqrt.c b/LAPACKE/src/lapacke_dtpmqrt.c index b78da024b2..2a584e0f8a 100644 --- a/LAPACKE/src/lapacke_dtpmqrt.c +++ b/LAPACKE/src/lapacke_dtpmqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpmqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dtpmqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const double* v, lapack_int ldv, const double* t, lapack_int ldt, @@ -45,48 +45,48 @@ lapack_int LAPACKE_dtpmqrt( int matrix_layout, char side, char trans, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpmqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - 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 ) ) { + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0 ); + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0 ); + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_dge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : - ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); + lwork = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtpmqrt_work( matrix_layout, side, trans, m, n, k, l, nb, v, + info = API_SUFFIX(LAPACKE_dtpmqrt_work)( matrix_layout, side, trans, m, n, k, l, nb, v, ldv, t, ldt, a, lda, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpmqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpmqrt_work.c b/LAPACKE/src/lapacke_dtpmqrt_work.c index 366acd3690..a2f17d9700 100644 --- a/LAPACKE/src/lapacke_dtpmqrt_work.c +++ b/LAPACKE/src/lapacke_dtpmqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dtpmqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const double* v, lapack_int ldv, const double* t, @@ -49,11 +49,11 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); return info; } lapack_int lda_t = MAX(1,nrowsA); @@ -67,22 +67,22 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < ncolsA ) { info = -14; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); return info; } if( ldb < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); return info; } if( ldv < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info ); @@ -118,8 +118,8 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -130,11 +130,11 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpqrt.c b/LAPACKE/src/lapacke_dtpqrt.c index 992e179931..ed7950a4f2 100644 --- a/LAPACKE/src/lapacke_dtpqrt.c +++ b/LAPACKE/src/lapacke_dtpqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtpqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_dtpqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -8; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_dtpqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtpqrt_work( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, + info = API_SUFFIX(LAPACKE_dtpqrt_work)( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpqrt2.c b/LAPACKE/src/lapacke_dtpqrt2.c index d68e1102cf..4451c63c45 100644 --- a/LAPACKE/src/lapacke_dtpqrt2.c +++ b/LAPACKE/src/lapacke_dtpqrt2.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt2( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_dtpqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } #endif - return LAPACKE_dtpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); + return API_SUFFIX(LAPACKE_dtpqrt2_work)( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/LAPACKE/src/lapacke_dtpqrt2_work.c b/LAPACKE/src/lapacke_dtpqrt2_work.c index 5a36c475b4..1b221fef81 100644 --- a/LAPACKE/src/lapacke_dtpqrt2_work.c +++ b/LAPACKE/src/lapacke_dtpqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt2_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_dtpqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_dtpqrt2_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2_work", info ); return info; } if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,17 +84,17 @@ lapack_int LAPACKE_dtpqrt2_work( int matrix_layout, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_dtpqrt2_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpqrt_work.c b/LAPACKE/src/lapacke_dtpqrt_work.c index c522f3aa71..dcbbe8cfbc 100644 --- a/LAPACKE/src/lapacke_dtpqrt_work.c +++ b/LAPACKE/src/lapacke_dtpqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtpqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt, double* work ) @@ -55,17 +55,17 @@ lapack_int LAPACKE_dtpqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_dtpqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, work, &info ); @@ -94,9 +94,9 @@ lapack_int LAPACKE_dtpqrt_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_dtpqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtprfb.c b/LAPACKE/src/lapacke_dtprfb.c index b854d5b88a..d2f578fc60 100644 --- a/LAPACKE/src/lapacke_dtprfb.c +++ b/LAPACKE/src/lapacke_dtprfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_dtprfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, const double* t, lapack_int ldt, @@ -44,7 +44,7 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct lapack_int work_size; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtprfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -59,32 +59,32 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct * or m-by-k (right) * B is m-by-n */ - if( LAPACKE_lsame( storev, 'C' ) ) { + if( API_SUFFIX(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 = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; + } else if( API_SUFFIX(LAPACKE_lsame)( storev, 'R' ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - nrows_a = LAPACKE_lsame( side, 'L' ) ? k : - LAPACKE_lsame( side, 'R' ) ? m : 0; - ncols_a = LAPACKE_lsame( side, 'L' ) ? n : - LAPACKE_lsame( side, 'R' ) ? k : 0; - if( LAPACKE_dge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0; + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0; + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } } @@ -105,14 +105,14 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtprfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_dtprfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, a, lda, b, ldb, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtprfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtprfb_work.c b/LAPACKE/src/lapacke_dtprfb_work.c index e4be902045..81339dd751 100644 --- a/LAPACKE/src/lapacke_dtprfb_work.c +++ b/LAPACKE/src/lapacke_dtprfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_dtprfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, @@ -60,22 +60,22 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -15; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); return info; } if( ldb < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); return info; } if( ldt < k ) { info = -13; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); return info; } if( ldv < k ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,18 +100,18 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_dge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); - LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtprfs.c b/LAPACKE/src/lapacke_dtprfs.c index d44d9d8d10..bda7049d59 100644 --- a/LAPACKE/src/lapacke_dtprfs.c +++ b/LAPACKE/src/lapacke_dtprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtprfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtprfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* ap, const double* b, lapack_int ldb, const double* x, lapack_int ldx, double* ferr, double* berr ) @@ -41,19 +41,19 @@ lapack_int LAPACKE_dtprfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_dtp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_dtprfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtprfs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + info = API_SUFFIX(LAPACKE_dtprfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_dtprfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtprfs_work.c b/LAPACKE/src/lapacke_dtprfs_work.c index 26b001117c..61c6c9d5dd 100644 --- a/LAPACKE/src/lapacke_dtprfs_work.c +++ b/LAPACKE/src/lapacke_dtprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtprfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtprfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* ap, const double* b, lapack_int ldb, const double* x, lapack_int ldx, @@ -56,12 +56,12 @@ lapack_int LAPACKE_dtprfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,9 +82,9 @@ lapack_int LAPACKE_dtprfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_dtp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -99,11 +99,11 @@ lapack_int LAPACKE_dtprfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtptri.c b/LAPACKE/src/lapacke_dtptri.c index 1a07325518..dbc9908753 100644 --- a/LAPACKE/src/lapacke_dtptri.c +++ b/LAPACKE/src/lapacke_dtptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtptri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtptri)( int matrix_layout, char uplo, char diag, lapack_int n, double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_dtp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -5; } } #endif - return LAPACKE_dtptri_work( matrix_layout, uplo, diag, n, ap ); + return API_SUFFIX(LAPACKE_dtptri_work)( matrix_layout, uplo, diag, n, ap ); } diff --git a/LAPACKE/src/lapacke_dtptri_work.c b/LAPACKE/src/lapacke_dtptri_work.c index ef158b4532..142dc9b116 100644 --- a/LAPACKE/src/lapacke_dtptri_work.c +++ b/LAPACKE/src/lapacke_dtptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtptri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtptri_work)( int matrix_layout, char uplo, char diag, lapack_int n, double* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_dtptri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtptri( &uplo, &diag, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dtp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dtp_trans)( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtptrs.c b/LAPACKE/src/lapacke_dtptrs.c index 4187f2fa84..71ee10b566 100644 --- a/LAPACKE/src/lapacke_dtptrs.c +++ b/LAPACKE/src/lapacke_dtptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtptrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtptrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* ap, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_dtp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_dtptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + return API_SUFFIX(LAPACKE_dtptrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dtptrs_work.c b/LAPACKE/src/lapacke_dtptrs_work.c index f458e92441..ccbe5124d1 100644 --- a/LAPACKE/src/lapacke_dtptrs_work.c +++ b/LAPACKE/src/lapacke_dtptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtptrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtptrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* ap, double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dtptrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,8 +66,8 @@ lapack_int LAPACKE_dtptrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dtp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); @@ -75,18 +75,18 @@ lapack_int LAPACKE_dtptrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpttf.c b/LAPACKE/src/lapacke_dtpttf.c index f9484ef307..a5a8e15622 100644 --- a/LAPACKE/src/lapacke_dtpttf.c +++ b/LAPACKE/src/lapacke_dtpttf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtpttf)( int matrix_layout, char transr, char uplo, lapack_int n, const double* ap, double* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -5; } } #endif - return LAPACKE_dtpttf_work( matrix_layout, transr, uplo, n, ap, arf ); + return API_SUFFIX(LAPACKE_dtpttf_work)( matrix_layout, transr, uplo, n, ap, arf ); } diff --git a/LAPACKE/src/lapacke_dtpttf_work.c b/LAPACKE/src/lapacke_dtpttf_work.c index 9ad0c4c76c..b074d140f0 100644 --- a/LAPACKE/src/lapacke_dtpttf_work.c +++ b/LAPACKE/src/lapacke_dtpttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtpttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const double* ap, double* arf ) { lapack_int info = 0; @@ -59,25 +59,25 @@ lapack_int LAPACKE_dtpttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpttf( &transr, &uplo, &n, ap_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_dpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtpttr.c b/LAPACKE/src/lapacke_dtpttr.c index 1359dee069..725b78b64c 100644 --- a/LAPACKE/src/lapacke_dtpttr.c +++ b/LAPACKE/src/lapacke_dtpttr.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpttr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtpttr)( int matrix_layout, char uplo, lapack_int n, const double* ap, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtpttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_dpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_dtpttr_work( matrix_layout, uplo, n, ap, a, lda ); + return API_SUFFIX(LAPACKE_dtpttr_work)( matrix_layout, uplo, n, ap, a, lda ); } diff --git a/LAPACKE/src/lapacke_dtpttr_work.c b/LAPACKE/src/lapacke_dtpttr_work.c index 610cc58d6c..729bdf35b1 100644 --- a/LAPACKE/src/lapacke_dtpttr_work.c +++ b/LAPACKE/src/lapacke_dtpttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpttr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtpttr_work)( int matrix_layout, char uplo, lapack_int n, const double* ap, double* a, lapack_int lda ) { lapack_int info = 0; @@ -49,7 +49,7 @@ lapack_int LAPACKE_dtpttr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dtpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,25 +65,25 @@ lapack_int LAPACKE_dtpttr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_dpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_dtpttr( &uplo, &n, ap_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrcon.c b/LAPACKE/src/lapacke_dtrcon.c index b24705f367..b778be6240 100644 --- a/LAPACKE/src/lapacke_dtrcon.c +++ b/LAPACKE/src/lapacke_dtrcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtrcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const double* a, lapack_int lda, double* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_dtrcon( int matrix_layout, char norm, char uplo, char diag, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -6; } } @@ -63,7 +63,7 @@ lapack_int LAPACKE_dtrcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtrcon_work( matrix_layout, norm, uplo, diag, n, a, lda, + info = API_SUFFIX(LAPACKE_dtrcon_work)( matrix_layout, norm, uplo, diag, n, a, lda, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -71,7 +71,7 @@ lapack_int LAPACKE_dtrcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrcon_work.c b/LAPACKE/src/lapacke_dtrcon_work.c index b77869b0d2..b647cd9b2e 100644 --- a/LAPACKE/src/lapacke_dtrcon_work.c +++ b/LAPACKE/src/lapacke_dtrcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtrcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const double* a, lapack_int lda, double* rcond, double* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_dtrcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_dtrcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_dtrcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrevc.c b/LAPACKE/src/lapacke_dtrevc.c index 5e7e6c1305..e38e802fc8 100644 --- a/LAPACKE/src/lapacke_dtrevc.c +++ b/LAPACKE/src/lapacke_dtrevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtrevc)( int matrix_layout, char side, char howmny, lapack_logical* select, lapack_int n, const double* t, lapack_int ldt, double* vl, lapack_int ldvl, double* vr, lapack_int ldvr, @@ -41,22 +41,22 @@ lapack_int LAPACKE_dtrevc( int matrix_layout, char side, char howmny, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_dtrevc( int matrix_layout, char side, char howmny, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtrevc_work( matrix_layout, side, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_dtrevc_work)( matrix_layout, side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrevc_work.c b/LAPACKE/src/lapacke_dtrevc_work.c index 924e4382ad..7b00aa26e8 100644 --- a/LAPACKE/src/lapacke_dtrevc_work.c +++ b/LAPACKE/src/lapacke_dtrevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtrevc_work)( int matrix_layout, char side, char howmny, lapack_logical* select, lapack_int n, const double* t, lapack_int ldt, double* vl, lapack_int ldvl, double* vr, lapack_int ldvr, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,7 +75,7 @@ lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { @@ -83,7 +83,7 @@ lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { @@ -92,14 +92,14 @@ lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtrevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -108,31 +108,31 @@ lapack_int LAPACKE_dtrevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrexc.c b/LAPACKE/src/lapacke_dtrexc.c index 33c1632027..ae17634093 100644 --- a/LAPACKE/src/lapacke_dtrexc.c +++ b/LAPACKE/src/lapacke_dtrexc.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrexc( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtrexc)( int matrix_layout, char compq, lapack_int n, double* t, lapack_int ldt, double* q, lapack_int ldq, lapack_int* ifst, lapack_int* ilst ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -6; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -4; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_dtrexc( int matrix_layout, char compq, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtrexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst, + info = API_SUFFIX(LAPACKE_dtrexc_work)( matrix_layout, compq, n, t, ldt, q, ldq, ifst, ilst, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrexc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrexc_work.c b/LAPACKE/src/lapacke_dtrexc_work.c index 2b2dc2586c..b346b82602 100644 --- a/LAPACKE/src/lapacke_dtrexc_work.c +++ b/LAPACKE/src/lapacke_dtrexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtrexc_work)( int matrix_layout, char compq, lapack_int n, double* t, lapack_int ldt, double* q, lapack_int ldq, lapack_int* ifst, lapack_int* ilst, double* work ) @@ -50,14 +50,14 @@ lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, double* t_t = NULL; double* q_t = NULL; /* Check leading dimension(s) */ - if( ldq < n && LAPACKE_lsame( compq, 'v' ) ) { + if( ldq < n && API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc_work", info ); return info; } if( ldt < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -74,9 +74,9 @@ lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work, @@ -85,23 +85,23 @@ lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrrfs.c b/LAPACKE/src/lapacke_dtrrfs.c index ce32f82d9c..8185ef5f0f 100644 --- a/LAPACKE/src/lapacke_dtrrfs.c +++ b/LAPACKE/src/lapacke_dtrrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtrrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* b, lapack_int ldb, const double* x, lapack_int ldx, double* ferr, @@ -42,19 +42,19 @@ lapack_int LAPACKE_dtrrfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_dtrrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtrrfs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + info = API_SUFFIX(LAPACKE_dtrrfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_dtrrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrrfs_work.c b/LAPACKE/src/lapacke_dtrrfs_work.c index 9cbfe342e4..57d7104c7e 100644 --- a/LAPACKE/src/lapacke_dtrrfs_work.c +++ b/LAPACKE/src/lapacke_dtrrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtrrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_dtrrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,9 +87,9 @@ lapack_int LAPACKE_dtrrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dtr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -104,11 +104,11 @@ lapack_int LAPACKE_dtrrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsen.c b/LAPACKE/src/lapacke_dtrsen.c index 255ea34ea6..e045440edb 100644 --- a/LAPACKE/src/lapacke_dtrsen.c +++ b/LAPACKE/src/lapacke_dtrsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsen( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_dtrsen)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, double* t, lapack_int ldt, double* q, lapack_int ldq, double* wr, double* wi, lapack_int* m, double* s, @@ -46,24 +46,24 @@ lapack_int LAPACKE_dtrsen( int matrix_layout, char job, char compq, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -8; } } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dtrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_dtrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -72,7 +72,7 @@ lapack_int LAPACKE_dtrsen( int matrix_layout, char job, char compq, liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -85,18 +85,18 @@ lapack_int LAPACKE_dtrsen( int matrix_layout, char job, char compq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_dtrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsen_work.c b/LAPACKE/src/lapacke_dtrsen_work.c index 98ac743b9a..bb74d4771e 100644 --- a/LAPACKE/src/lapacke_dtrsen_work.c +++ b/LAPACKE/src/lapacke_dtrsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_dtrsen_work)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, double* t, lapack_int ldt, double* q, lapack_int ldq, double* wr, double* wi, @@ -56,12 +56,12 @@ lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldq < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen_work", info ); return info; } /* Allocate memory for temporary array T */ @@ -71,7 +71,7 @@ lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, goto exit_level_0; } /* Transpose input matrix T */ - LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_dtrsen( &job, &compq, select, &n, t_t, &ldt_t, q, &ldq_t, wr, @@ -80,7 +80,7 @@ lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtrsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, wr, @@ -98,23 +98,23 @@ lapack_int LAPACKE_dtrsen_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsna.c b/LAPACKE/src/lapacke_dtrsna.c index 98ef3279d5..d5a21e9410 100644 --- a/LAPACKE/src/lapacke_dtrsna.c +++ b/LAPACKE/src/lapacke_dtrsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtrsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const double* t, lapack_int ldt, const double* vl, lapack_int ldvl, const double* vr, lapack_int ldvr, @@ -40,33 +40,33 @@ lapack_int LAPACKE_dtrsna( int matrix_layout, char job, char howmny, lapack_int* m ) { lapack_int info = 0; - lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ; + lapack_int ldwork = API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ? 1 : MAX(1,n) ; lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_dge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*) LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*(n-1)) ); if( iwork == NULL ) { @@ -74,7 +74,7 @@ lapack_int LAPACKE_dtrsna( int matrix_layout, char job, char howmny, goto exit_level_0; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * ldwork * MAX(1,n+6) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -82,20 +82,20 @@ lapack_int LAPACKE_dtrsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_dtrsna_work( matrix_layout, job, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_dtrsna_work)( matrix_layout, job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsna_work.c b/LAPACKE/src/lapacke_dtrsna_work.c index bb7723fa71..3fb5010ab5 100644 --- a/LAPACKE/src/lapacke_dtrsna_work.c +++ b/LAPACKE/src/lapacke_dtrsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_dtrsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const double* t, lapack_int ldt, const double* vl, lapack_int ldvl, @@ -59,17 +59,17 @@ lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_dtrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_dtrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_dtrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,7 +78,7 @@ lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (double*) LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { @@ -86,7 +86,7 @@ lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (double*) LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { @@ -95,12 +95,12 @@ lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_dge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtrsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -110,22 +110,22 @@ lapack_int LAPACKE_dtrsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsyl.c b/LAPACKE/src/lapacke_dtrsyl.c index 5652f28467..713899cf60 100644 --- a/LAPACKE/src/lapacke_dtrsyl.c +++ b/LAPACKE/src/lapacke_dtrsyl.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsyl( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_dtrsyl)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, lapack_int ldc, double* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif - return LAPACKE_dtrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + return API_SUFFIX(LAPACKE_dtrsyl_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale ); } diff --git a/LAPACKE/src/lapacke_dtrsyl3.c b/LAPACKE/src/lapacke_dtrsyl3.c index c95a772deb..3ed03f0db4 100644 --- a/LAPACKE/src/lapacke_dtrsyl3.c +++ b/LAPACKE/src/lapacke_dtrsyl3.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_dtrsyl3)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, lapack_int ldc, @@ -15,25 +15,25 @@ lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb, lapack_int* iwork = NULL; lapack_int liwork = -1; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrsyl3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif /* Query optimal working array sizes */ - info = LAPACKE_dtrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + info = API_SUFFIX(LAPACKE_dtrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, &iwork_query, liwork, swork_query, ldswork ); if( info != 0 ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_dtrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, + info = API_SUFFIX(LAPACKE_dtrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, iwork, liwork, swork, ldswork ); /* Release memory and exit */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb, LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsyl3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsyl3_work.c b/LAPACKE/src/lapacke_dtrsyl3_work.c index 272c35b384..2b4dcd44da 100644 --- a/LAPACKE/src/lapacke_dtrsyl3_work.c +++ b/LAPACKE/src/lapacke_dtrsyl3_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_dtrsyl3_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, @@ -26,17 +26,17 @@ lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -56,9 +56,9 @@ lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrsyl3( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, iwork, &liwork, swork, &ldswork, @@ -67,7 +67,7 @@ lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -76,11 +76,11 @@ lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrsyl_work.c b/LAPACKE/src/lapacke_dtrsyl_work.c index f613312457..9129bacd92 100644 --- a/LAPACKE/src/lapacke_dtrsyl_work.c +++ b/LAPACKE/src/lapacke_dtrsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrsyl_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_dtrsyl_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const double* a, lapack_int lda, const double* b, lapack_int ldb, double* c, @@ -56,17 +56,17 @@ lapack_int LAPACKE_dtrsyl_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,9 +86,9 @@ lapack_int LAPACKE_dtrsyl_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, &info ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_dtrsyl_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_dtrsyl_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrtri.c b/LAPACKE/src/lapacke_dtrtri.c index a4cc52162d..a6ef1707c3 100644 --- a/LAPACKE/src/lapacke_dtrtri.c +++ b/LAPACKE/src/lapacke_dtrtri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrtri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtrtri)( int matrix_layout, char uplo, char diag, lapack_int n, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrtri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_dtrtri_work( matrix_layout, uplo, diag, n, a, lda ); + return API_SUFFIX(LAPACKE_dtrtri_work)( matrix_layout, uplo, diag, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_dtrtri_work.c b/LAPACKE/src/lapacke_dtrtri_work.c index 520b68c865..32646ef6ac 100644 --- a/LAPACKE/src/lapacke_dtrtri_work.c +++ b/LAPACKE/src/lapacke_dtrtri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrtri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_dtrtri_work)( int matrix_layout, char uplo, char diag, lapack_int n, double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_dtrtri_work( int matrix_layout, char uplo, char diag, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dtrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_dtrtri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dtr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrtri( &uplo, &diag, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dtr_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, + API_SUFFIX(LAPACKE_dtr_trans)( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrtrs.c b/LAPACKE/src/lapacke_dtrtrs.c index f035927b83..413f54baa8 100644 --- a/LAPACKE/src/lapacke_dtrtrs.c +++ b/LAPACKE/src/lapacke_dtrtrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_dtrtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_dtrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + return API_SUFFIX(LAPACKE_dtrtrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_dtrtrs_work.c b/LAPACKE/src/lapacke_dtrtrs_work.c index 41675e5053..35265f79b3 100644 --- a/LAPACKE/src/lapacke_dtrtrs_work.c +++ b/LAPACKE/src/lapacke_dtrtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_dtrtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, double* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_dtrtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtrs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,8 +73,8 @@ lapack_int LAPACKE_dtrtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dtr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); @@ -82,18 +82,18 @@ lapack_int LAPACKE_dtrtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrttf.c b/LAPACKE/src/lapacke_dtrttf.c index 79deb02771..88762a1408 100644 --- a/LAPACKE/src/lapacke_dtrttf.c +++ b/LAPACKE/src/lapacke_dtrttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtrttf)( int matrix_layout, char transr, char uplo, lapack_int n, const double* a, lapack_int lda, double* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -5; } } #endif - return LAPACKE_dtrttf_work( matrix_layout, transr, uplo, n, a, lda, arf ); + return API_SUFFIX(LAPACKE_dtrttf_work)( matrix_layout, transr, uplo, n, a, lda, arf ); } diff --git a/LAPACKE/src/lapacke_dtrttf_work.c b/LAPACKE/src/lapacke_dtrttf_work.c index 7404ebe17a..4ab395b203 100644 --- a/LAPACKE/src/lapacke_dtrttf_work.c +++ b/LAPACKE/src/lapacke_dtrttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_dtrttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const double* a, lapack_int lda, double* arf ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_dtrttf_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_dtrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_dtrttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_dpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtrttp.c b/LAPACKE/src/lapacke_dtrttp.c index 5f6ddbcdc5..f2360b4637 100644 --- a/LAPACKE/src/lapacke_dtrttp.c +++ b/LAPACKE/src/lapacke_dtrttp.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrttp( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtrttp)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtrttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dtr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -4; } } #endif - return LAPACKE_dtrttp_work( matrix_layout, uplo, n, a, lda, ap ); + return API_SUFFIX(LAPACKE_dtrttp_work)( matrix_layout, uplo, n, a, lda, ap ); } diff --git a/LAPACKE/src/lapacke_dtrttp_work.c b/LAPACKE/src/lapacke_dtrttp_work.c index 6a1fe6fae6..c0c5b4b77c 100644 --- a/LAPACKE/src/lapacke_dtrttp_work.c +++ b/LAPACKE/src/lapacke_dtrttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtrttp_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtrttp_work)( int matrix_layout, char uplo, lapack_int n, const double* a, lapack_int lda, double* ap ) { lapack_int info = 0; @@ -49,7 +49,7 @@ lapack_int LAPACKE_dtrttp_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dtrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,25 +65,25 @@ lapack_int LAPACKE_dtrttp_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrttp( &uplo, &n, a_t, &lda_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_dpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtrttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtzrzf.c b/LAPACKE/src/lapacke_dtzrzf.c index 769c571390..18f6984faf 100644 --- a/LAPACKE/src/lapacke_dtzrzf.c +++ b/LAPACKE/src/lapacke_dtzrzf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtzrzf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtzrzf)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_dtzrzf( int matrix_layout, lapack_int m, lapack_int n, double* work = NULL; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_dtzrzf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtzrzf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_dtzrzf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_dtzrzf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_dtzrzf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_dtzrzf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_dtzrzf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtzrzf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtzrzf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_dtzrzf_work.c b/LAPACKE/src/lapacke_dtzrzf_work.c index e59826ec26..e74194f2b2 100644 --- a/LAPACKE/src/lapacke_dtzrzf_work.c +++ b/LAPACKE/src/lapacke_dtzrzf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtzrzf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_dtzrzf_work)( int matrix_layout, lapack_int m, lapack_int n, double* a, lapack_int lda, double* tau, double* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_dtzrzf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtzrzf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_dtzrzf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dtzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtzrzf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_dtzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtzrzf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ilaver.c b/LAPACKE/src/lapacke_ilaver.c index b37c5c8a22..0de76d31d8 100644 --- a/LAPACKE/src/lapacke_ilaver.c +++ b/LAPACKE/src/lapacke_ilaver.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -void LAPACKE_ilaver( lapack_int* vers_major, +void API_SUFFIX(LAPACKE_ilaver)( lapack_int* vers_major, lapack_int* vers_minor, lapack_int* vers_patch ) { diff --git a/LAPACKE/src/lapacke_nancheck.c b/LAPACKE/src/lapacke_nancheck.c index c7d5c33f1c..55b82e203e 100644 --- a/LAPACKE/src/lapacke_nancheck.c +++ b/LAPACKE/src/lapacke_nancheck.c @@ -47,7 +47,7 @@ int LAPACKE_get_nancheck( ) } /* Check environment variable, once and only once */ - env = getenv( "LAPACKE_NANCHECK" ); + env = getenv( "API_SUFFIX(LAPACKE_)NANCHECK" ); if ( !env ) { /* By default, NaN checking is enabled */ nancheck_flag = 1; diff --git a/LAPACKE/src/lapacke_sbbcsd.c b/LAPACKE/src/lapacke_sbbcsd.c index cee19a9177..542fda7bb7 100644 --- a/LAPACKE/src/lapacke_sbbcsd.c +++ b/LAPACKE/src/lapacke_sbbcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sbbcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, float* theta, float* phi, float* u1, lapack_int ldu1, float* u2, @@ -47,10 +47,10 @@ lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, float work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sbbcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbbcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -58,36 +58,36 @@ lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( q-1, phi, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( q, theta, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( q, theta, 1 ) ) { return -10; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { - if( LAPACKE_sge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, p, p, u1, ldu1 ) ) { return -12; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-p, m-p, u2, ldu2 ) ) { return -14; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - if( LAPACKE_sge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, q, q, v1t, ldv1t ) ) { return -16; } } - if( LAPACKE_lsame( jobv2t, 'y' ) ) { - if( LAPACKE_sge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv2t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { return -18; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_sbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, &work_query, lwork ); @@ -102,7 +102,7 @@ lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_sbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, work, lwork ); @@ -110,7 +110,7 @@ lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbbcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbbcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbbcsd_work.c b/LAPACKE/src/lapacke_sbbcsd_work.c index 9ffc3a0ddb..e829f779f5 100644 --- a/LAPACKE/src/lapacke_sbbcsd_work.c +++ b/LAPACKE/src/lapacke_sbbcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbbcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sbbcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, float* theta, float* phi, float* u1, @@ -61,7 +61,7 @@ lapack_int LAPACKE_sbbcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -76,7 +76,7 @@ lapack_int LAPACKE_sbbcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbbcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsdc.c b/LAPACKE/src/lapacke_sbdsdc.c index 3f475b6d3c..3aa25bc859 100644 --- a/LAPACKE/src/lapacke_sbdsdc.c +++ b/LAPACKE/src/lapacke_sbdsdc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsdc( int matrix_layout, char uplo, char compq, +lapack_int API_SUFFIX(LAPACKE_sbdsdc)( int matrix_layout, char uplo, char compq, lapack_int n, float* d, float* e, float* u, lapack_int ldu, float* vt, lapack_int ldvt, float* q, lapack_int* iq ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_sbdsdc( int matrix_layout, char uplo, char compq, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sbdsdc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { lwork = (size_t)3*MAX(1,n)*MAX(1,n)+4*MAX(1,n); - } else if( LAPACKE_lsame( compq, 'p' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( compq, 'p' ) ) { lwork = MAX(1,6*n); - } else if( LAPACKE_lsame( compq, 'n' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( compq, 'n' ) ) { lwork = MAX(1,4*n); } else { lwork = 1; /* Any value */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_sbdsdc( int matrix_layout, char uplo, char compq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sbdsdc_work( matrix_layout, uplo, compq, n, d, e, u, ldu, vt, + info = API_SUFFIX(LAPACKE_sbdsdc_work)( matrix_layout, uplo, compq, n, d, e, u, ldu, vt, ldvt, q, iq, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_sbdsdc( int matrix_layout, char uplo, char compq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsdc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsdc_work.c b/LAPACKE/src/lapacke_sbdsdc_work.c index b05587f2b2..54788116b1 100644 --- a/LAPACKE/src/lapacke_sbdsdc_work.c +++ b/LAPACKE/src/lapacke_sbdsdc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsdc_work( int matrix_layout, char uplo, char compq, +lapack_int API_SUFFIX(LAPACKE_sbdsdc_work)( int matrix_layout, char uplo, char compq, lapack_int n, float* d, float* e, float* u, lapack_int ldu, float* vt, lapack_int ldvt, float* q, lapack_int* iq, float* work, @@ -54,23 +54,23 @@ lapack_int LAPACKE_sbdsdc_work( int matrix_layout, char uplo, char compq, /* Check leading dimension(s) */ if( ldu < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc_work", info ); return info; } if( ldvt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,n) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { vt_t = (float*)LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -84,27 +84,27 @@ lapack_int LAPACKE_sbdsdc_work( int matrix_layout, char uplo, char compq, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compq, 'i' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( compq, 'i' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { LAPACKE_free( vt_t ); } exit_level_1: - if( LAPACKE_lsame( compq, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) ) { LAPACKE_free( u_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sbdsdc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsdc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsqr.c b/LAPACKE/src/lapacke_sbdsqr.c index 060da17445..1bbfafa87c 100644 --- a/LAPACKE/src/lapacke_sbdsqr.c +++ b/LAPACKE/src/lapacke_sbdsqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsqr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sbdsqr)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, float* d, float* e, float* vt, lapack_int ldvt, float* u, lapack_int ldu, float* c, lapack_int ldc ) @@ -40,30 +40,30 @@ lapack_int LAPACKE_sbdsqr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sbdsqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( ncc != 0 ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, ncc, c, ldc ) ) { return -13; } } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -8; } if( nru != 0 ) { - if( LAPACKE_sge_nancheck( matrix_layout, nru, n, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nru, n, u, ldu ) ) { return -11; } } if( ncvt != 0 ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, ncvt, vt, ldvt ) ) { return -9; } } @@ -76,13 +76,13 @@ lapack_int LAPACKE_sbdsqr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sbdsqr_work( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, + info = API_SUFFIX(LAPACKE_sbdsqr_work)( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsqr_work.c b/LAPACKE/src/lapacke_sbdsqr_work.c index 9d3dfdb064..b41acec137 100644 --- a/LAPACKE/src/lapacke_sbdsqr_work.c +++ b/LAPACKE/src/lapacke_sbdsqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sbdsqr_work)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, float* d, float* e, float* vt, lapack_int ldvt, float* u, lapack_int ldu, float* c, @@ -56,17 +56,17 @@ lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldc < ncc ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr_work", info ); return info; } if( ldu < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr_work", info ); return info; } if( ldvt < ncvt ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -94,13 +94,13 @@ lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose input matrices */ if( ncvt != 0 ) { - LAPACKE_sge_trans( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); } if( nru != 0 ) { - LAPACKE_sge_trans( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); } if( ncc != 0 ) { - LAPACKE_sge_trans( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_sbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t, @@ -110,14 +110,14 @@ lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose output matrices */ if( ncvt != 0 ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, ldvt ); } if( nru != 0 ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); } if( ncc != 0 ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { @@ -133,11 +133,11 @@ lapack_int LAPACKE_sbdsqr_work( int matrix_layout, char uplo, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsvdx.c b/LAPACKE/src/lapacke_sbdsvdx.c index c46fa3d556..88d104d2bf 100644 --- a/LAPACKE/src/lapacke_sbdsvdx.c +++ b/LAPACKE/src/lapacke_sbdsvdx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sbdsvdx)( int matrix_layout, char uplo, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* ns, @@ -45,16 +45,16 @@ lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, lapack_int* iwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sbdsvdx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsvdx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( n - 1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n - 1, e, 1 ) ) { return -7; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sbdsvdx_work( matrix_layout, uplo, jobz, range, + info = API_SUFFIX(LAPACKE_sbdsvdx_work)( matrix_layout, uplo, jobz, range, n, d, e, vl, vu, il, iu, ns, s, z, ldz, work, iwork); /* Backup significant data from working array(s) */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_sbdsvdx( int matrix_layout, char uplo, char jobz, char range, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsvdx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsvdx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sbdsvdx_work.c b/LAPACKE/src/lapacke_sbdsvdx_work.c index bb7096788e..742b604ff2 100644 --- a/LAPACKE/src/lapacke_sbdsvdx_work.c +++ b/LAPACKE/src/lapacke_sbdsvdx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sbdsvdx_work)( int matrix_layout, char uplo, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* ns, @@ -49,19 +49,19 @@ lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char r info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - 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 nrows_z = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 2*n : 0; + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? + ( API_SUFFIX(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 < ncols_z ) { info = -3; - LAPACKE_xerbla( "LAPACKE_sbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsvdx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(ncols_z,1) ); if( z_t == NULL ) { @@ -77,20 +77,20 @@ lapack_int LAPACKE_sbdsvdx_work( int matrix_layout, char uplo, char jobz, char r info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_z, ncols_z, z_t, ldz_t, z, ldz); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsvdx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sbdsvdx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sbdsvdx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sdisna.c b/LAPACKE/src/lapacke_sdisna.c index 10552fd532..f69dc00248 100644 --- a/LAPACKE/src/lapacke_sdisna.c +++ b/LAPACKE/src/lapacke_sdisna.c @@ -32,16 +32,16 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sdisna( char job, lapack_int m, lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_sdisna)( char job, lapack_int m, lapack_int n, const float* d, float* sep ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(m,n), d, 1 ) ) { return -4; } } #endif - return LAPACKE_sdisna_work( job, m, n, d, sep ); + return API_SUFFIX(LAPACKE_sdisna_work)( job, m, n, d, sep ); } diff --git a/LAPACKE/src/lapacke_sdisna_work.c b/LAPACKE/src/lapacke_sdisna_work.c index e6bd6cb6c2..7c1cf1a294 100644 --- a/LAPACKE/src/lapacke_sdisna_work.c +++ b/LAPACKE/src/lapacke_sdisna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sdisna_work( char job, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sdisna_work)( char job, lapack_int m, lapack_int n, const float* d, float* sep ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_sgbbrd.c b/LAPACKE/src/lapacke_sgbbrd.c index 97907b1140..4cadd836fc 100644 --- a/LAPACKE/src/lapacke_sgbbrd.c +++ b/LAPACKE/src/lapacke_sgbbrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbbrd( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgbbrd)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, float* ab, lapack_int ldab, float* d, float* e, float* q, lapack_int ldq, float* pt, @@ -41,17 +41,17 @@ lapack_int LAPACKE_sgbbrd( int matrix_layout, char vect, lapack_int m, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbbrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -8; } if( ncc != 0 ) { - if( LAPACKE_sge_nancheck( matrix_layout, m, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, ncc, c, ldc ) ) { return -16; } } @@ -64,13 +64,13 @@ lapack_int LAPACKE_sgbbrd( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgbbrd_work( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, + info = API_SUFFIX(LAPACKE_sgbbrd_work)( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, d, e, q, ldq, pt, ldpt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbbrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbbrd_work.c b/LAPACKE/src/lapacke_sgbbrd_work.c index 9b6640b354..8f4eac2fa5 100644 --- a/LAPACKE/src/lapacke_sgbbrd_work.c +++ b/LAPACKE/src/lapacke_sgbbrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbbrd_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgbbrd_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, float* ab, lapack_int ldab, float* d, float* e, float* q, lapack_int ldq, @@ -59,22 +59,22 @@ lapack_int LAPACKE_sgbbrd_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); return info; } if( ldc < ncc ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); return info; } if( ldpt < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); return info; } if( ldq < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -83,14 +83,14 @@ lapack_int LAPACKE_sgbbrd_work( int matrix_layout, char vect, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,m) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { pt_t = (float*)LAPACKE_malloc( sizeof(float) * ldpt_t * MAX(1,n) ); if( pt_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -105,9 +105,9 @@ lapack_int LAPACKE_sgbbrd_work( int matrix_layout, char vect, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); if( ncc != 0 ) { - LAPACKE_sge_trans( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_sgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t, @@ -116,38 +116,38 @@ lapack_int LAPACKE_sgbbrd_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); } if( ncc != 0 ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { LAPACKE_free( c_t ); } exit_level_3: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { LAPACKE_free( pt_t ); } exit_level_2: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbbrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbcon.c b/LAPACKE/src/lapacke_sgbcon.c index e3038ccf88..89b6234891 100644 --- a/LAPACKE/src/lapacke_sgbcon.c +++ b/LAPACKE/src/lapacke_sgbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbcon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbcon)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, const lapack_int* ipiv, float anorm, float* rcond ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_sgbcon( int matrix_layout, char norm, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -9; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_sgbcon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgbcon_work( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, + info = API_SUFFIX(LAPACKE_sgbcon_work)( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_sgbcon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbcon_work.c b/LAPACKE/src/lapacke_sgbcon_work.c index 6d42685b25..12a1fe8623 100644 --- a/LAPACKE/src/lapacke_sgbcon_work.c +++ b/LAPACKE/src/lapacke_sgbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbcon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbcon_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, const lapack_int* ipiv, float anorm, float* rcond, float* work, @@ -52,7 +52,7 @@ lapack_int LAPACKE_sgbcon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_sgbcon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond, @@ -74,11 +74,11 @@ lapack_int LAPACKE_sgbcon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbequ.c b/LAPACKE/src/lapacke_sgbequ.c index 74ee036a14..7696da9e00 100644 --- a/LAPACKE/src/lapacke_sgbequ.c +++ b/LAPACKE/src/lapacke_sgbequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbequ)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_sgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_sgbequ_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_sgbequ_work.c b/LAPACKE/src/lapacke_sgbequ_work.c index 674a803eec..e10ecbb0d0 100644 --- a/LAPACKE/src/lapacke_sgbequ_work.c +++ b/LAPACKE/src/lapacke_sgbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbequ_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_sgbequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_sgbequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_sgbequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbequb.c b/LAPACKE/src/lapacke_sgbequb.c index e2d8eb803e..5df29d8c2d 100644 --- a/LAPACKE/src/lapacke_sgbequb.c +++ b/LAPACKE/src/lapacke_sgbequb.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbequb)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_sgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_sgbequb_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_sgbequb_work.c b/LAPACKE/src/lapacke_sgbequb_work.c index 1fa181b44a..636c072421 100644 --- a/LAPACKE/src/lapacke_sgbequb_work.c +++ b/LAPACKE/src/lapacke_sgbequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbequb_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_sgbequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_sgbequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_sgbequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbrfs.c b/LAPACKE/src/lapacke_sgbrfs.c index 238fed38cb..245f2560a8 100644 --- a/LAPACKE/src/lapacke_sgbrfs.c +++ b/LAPACKE/src/lapacke_sgbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbrfs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, lapack_int ldafb, const lapack_int* ipiv, @@ -43,22 +43,22 @@ lapack_int LAPACKE_sgbrfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -7; } - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_sgbrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgbrfs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_sgbrfs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_sgbrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbrfs_work.c b/LAPACKE/src/lapacke_sgbrfs_work.c index 1a386693df..653651f58e 100644 --- a/LAPACKE/src/lapacke_sgbrfs_work.c +++ b/LAPACKE/src/lapacke_sgbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, lapack_int ldafb, @@ -61,22 +61,22 @@ lapack_int LAPACKE_sgbrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -101,11 +101,11 @@ lapack_int LAPACKE_sgbrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, @@ -114,7 +114,7 @@ lapack_int LAPACKE_sgbrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -125,11 +125,11 @@ lapack_int LAPACKE_sgbrfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbrfsx.c b/LAPACKE/src/lapacke_sgbrfsx.c index d2177f7663..fb2b6d9fb4 100644 --- a/LAPACKE/src/lapacke_sgbrfsx.c +++ b/LAPACKE/src/lapacke_sgbrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbrfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_sgbrfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, lapack_int ldafb, @@ -47,37 +47,37 @@ lapack_int LAPACKE_sgbrfsx( int matrix_layout, char trans, char equed, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -15; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -14; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -13; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -17; } } @@ -94,7 +94,7 @@ lapack_int LAPACKE_sgbrfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgbrfsx_work( matrix_layout, trans, equed, n, kl, ku, nrhs, + info = API_SUFFIX(LAPACKE_sgbrfsx_work)( matrix_layout, trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_sgbrfsx( int matrix_layout, char trans, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbrfsx_work.c b/LAPACKE/src/lapacke_sgbrfsx_work.c index a7db63e4b7..7f812790e7 100644 --- a/LAPACKE/src/lapacke_sgbrfsx_work.c +++ b/LAPACKE/src/lapacke_sgbrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbrfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_sgbrfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, @@ -68,22 +68,22 @@ lapack_int LAPACKE_sgbrfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -18; - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -120,11 +120,11 @@ lapack_int LAPACKE_sgbrfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -134,10 +134,10 @@ lapack_int LAPACKE_sgbrfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -153,11 +153,11 @@ lapack_int LAPACKE_sgbrfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbsv.c b/LAPACKE/src/lapacke_sgbsv.c index d8df16eb14..2f2f80f27f 100644 --- a/LAPACKE/src/lapacke_sgbsv.c +++ b/LAPACKE/src/lapacke_sgbsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsv( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_sgbsv)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_sgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, + return API_SUFFIX(LAPACKE_sgbsv_work)( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sgbsv_work.c b/LAPACKE/src/lapacke_sgbsv_work.c index 2d41abf21d..736ac2d724 100644 --- a/LAPACKE/src/lapacke_sgbsv_work.c +++ b/LAPACKE/src/lapacke_sgbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_sgbsv_work)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, lapack_int* ipiv, float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_sgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsv_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,9 +72,9 @@ lapack_int LAPACKE_sgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -82,20 +82,20 @@ lapack_int LAPACKE_sgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbsvx.c b/LAPACKE/src/lapacke_sgbsvx.c index 95b3694a9c..1f67698f50 100644 --- a/LAPACKE/src/lapacke_sgbsvx.c +++ b/LAPACKE/src/lapacke_sgbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgbsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, lapack_int* ipiv, @@ -45,33 +45,33 @@ lapack_int LAPACKE_sgbsvx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -15; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -14; } } @@ -89,7 +89,7 @@ lapack_int LAPACKE_sgbsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgbsvx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_sgbsvx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Backup significant data from working array(s) */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_sgbsvx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbsvx_work.c b/LAPACKE/src/lapacke_sgbsvx_work.c index 2613117905..a654542198 100644 --- a/LAPACKE/src/lapacke_sgbsvx_work.c +++ b/LAPACKE/src/lapacke_sgbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgbsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, lapack_int* ipiv, @@ -62,22 +62,22 @@ lapack_int LAPACKE_sgbsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -102,12 +102,12 @@ lapack_int LAPACKE_sgbsvx_work( int matrix_layout, char fact, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -116,20 +116,20 @@ lapack_int LAPACKE_sgbsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -140,11 +140,11 @@ lapack_int LAPACKE_sgbsvx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbsvxx.c b/LAPACKE/src/lapacke_sgbsvxx.c index e9d8a6251a..517e01b606 100644 --- a/LAPACKE/src/lapacke_sgbsvxx.c +++ b/LAPACKE/src/lapacke_sgbsvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsvxx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgbsvxx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, lapack_int* ipiv, @@ -47,38 +47,38 @@ lapack_int LAPACKE_sgbsvxx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -15; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -27; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -14; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_sgbsvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgbsvxx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_sgbsvxx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, @@ -107,7 +107,7 @@ lapack_int LAPACKE_sgbsvxx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbsvxx_work.c b/LAPACKE/src/lapacke_sgbsvxx_work.c index 9b62a21366..5674bd1a07 100644 --- a/LAPACKE/src/lapacke_sgbsvxx_work.c +++ b/LAPACKE/src/lapacke_sgbsvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbsvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgbsvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, lapack_int* ipiv, @@ -67,22 +67,22 @@ lapack_int LAPACKE_sgbsvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,12 +119,12 @@ lapack_int LAPACKE_sgbsvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, @@ -135,23 +135,23 @@ lapack_int LAPACKE_sgbsvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -167,11 +167,11 @@ lapack_int LAPACKE_sgbsvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbsvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbtrf.c b/LAPACKE/src/lapacke_sgbtrf.c index d6e3415218..4114e42eca 100644 --- a/LAPACKE/src/lapacke_sgbtrf.c +++ b/LAPACKE/src/lapacke_sgbtrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbtrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbtrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, float* ab, lapack_int ldab, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_sgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); + return API_SUFFIX(LAPACKE_sgbtrf_work)( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); } diff --git a/LAPACKE/src/lapacke_sgbtrf_work.c b/LAPACKE/src/lapacke_sgbtrf_work.c index da489148cc..96899ca2cc 100644 --- a/LAPACKE/src/lapacke_sgbtrf_work.c +++ b/LAPACKE/src/lapacke_sgbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbtrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, float* ab, lapack_int ldab, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_sgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info ); @@ -67,17 +67,17 @@ lapack_int LAPACKE_sgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_sgb_trans)( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgbtrs.c b/LAPACKE/src/lapacke_sgbtrs.c index 4e4bb284f3..318fc94c52 100644 --- a/LAPACKE/src/lapacke_sgbtrs.c +++ b/LAPACKE/src/lapacke_sgbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbtrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbtrs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_sgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + return API_SUFFIX(LAPACKE_sgbtrs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sgbtrs_work.c b/LAPACKE/src/lapacke_sgbtrs_work.c index d60177a177..4b024c21e0 100644 --- a/LAPACKE/src/lapacke_sgbtrs_work.c +++ b/LAPACKE/src/lapacke_sgbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgbtrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgbtrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const float* ab, lapack_int ldab, const lapack_int* ipiv, float* b, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sgbtrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,9 +74,9 @@ lapack_int LAPACKE_sgbtrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_sgbtrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgebak.c b/LAPACKE/src/lapacke_sgebak.c index 14973b7a8a..2347f9e281 100644 --- a/LAPACKE/src/lapacke_sgebak.c +++ b/LAPACKE/src/lapacke_sgebak.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgebak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* scale, lapack_int m, float* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgebak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, scale, 1 ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -9; } } #endif - return LAPACKE_sgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m, + return API_SUFFIX(LAPACKE_sgebak_work)( matrix_layout, job, side, n, ilo, ihi, scale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_sgebak_work.c b/LAPACKE/src/lapacke_sgebak_work.c index 7bf021513a..a49fa9ca1f 100644 --- a/LAPACKE/src/lapacke_sgebak_work.c +++ b/LAPACKE/src/lapacke_sgebak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_sgebak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* scale, lapack_int m, float* v, lapack_int ldv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgebak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_sgebak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t, &info ); @@ -68,16 +68,16 @@ lapack_int LAPACKE_sgebak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgebal.c b/LAPACKE/src/lapacke_sgebal.c index be92e0e2ba..12c0a70018 100644 --- a/LAPACKE/src/lapacke_sgebal.c +++ b/LAPACKE/src/lapacke_sgebal.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebal( int matrix_layout, char job, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_sgebal)( int matrix_layout, char job, lapack_int n, float* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, float* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgebal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } } #endif - return LAPACKE_sgebal_work( matrix_layout, job, n, a, lda, ilo, ihi, scale ); + return API_SUFFIX(LAPACKE_sgebal_work)( matrix_layout, job, n, a, lda, ilo, ihi, scale ); } diff --git a/LAPACKE/src/lapacke_sgebal_work.c b/LAPACKE/src/lapacke_sgebal_work.c index ddb4309488..5b55be9d7a 100644 --- a/LAPACKE/src/lapacke_sgebal_work.c +++ b/LAPACKE/src/lapacke_sgebal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgebal_work)( int matrix_layout, char job, lapack_int n, float* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, float* scale ) { @@ -49,12 +49,12 @@ lapack_int LAPACKE_sgebal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -62,9 +62,9 @@ lapack_int LAPACKE_sgebal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } /* Call LAPACK function and adjust info */ LAPACK_sgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info ); @@ -72,22 +72,22 @@ lapack_int LAPACKE_sgebal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgebrd.c b/LAPACKE/src/lapacke_sgebrd.c index 9f31522417..782699e989 100644 --- a/LAPACKE/src/lapacke_sgebrd.c +++ b/LAPACKE/src/lapacke_sgebrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebrd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgebrd)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* d, float* e, float* tauq, float* taup ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_sgebrd( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgebrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_sgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_sgebrd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_sgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgebrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgebrd_work.c b/LAPACKE/src/lapacke_sgebrd_work.c index 323acc713f..18f5e7d606 100644 --- a/LAPACKE/src/lapacke_sgebrd_work.c +++ b/LAPACKE/src/lapacke_sgebrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgebrd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgebrd_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* d, float* e, float* tauq, float* taup, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgebrd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_sgebrd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork, &info ); @@ -74,16 +74,16 @@ lapack_int LAPACKE_sgebrd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgebrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgecon.c b/LAPACKE/src/lapacke_sgecon.c index 81bada83e2..2cb2520687 100644 --- a/LAPACKE/src/lapacke_sgecon.c +++ b/LAPACKE/src/lapacke_sgecon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgecon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgecon)( int matrix_layout, char norm, lapack_int n, const float* a, lapack_int lda, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_sgecon( int matrix_layout, char norm, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgecon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgecon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_sgecon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgecon_work( matrix_layout, norm, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_sgecon_work)( matrix_layout, norm, n, a, lda, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_sgecon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgecon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgecon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgecon_work.c b/LAPACKE/src/lapacke_sgecon_work.c index 77d3c04912..fc89530e64 100644 --- a/LAPACKE/src/lapacke_sgecon_work.c +++ b/LAPACKE/src/lapacke_sgecon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgecon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgecon_work)( int matrix_layout, char norm, lapack_int n, const float* a, lapack_int lda, float anorm, float* rcond, float* work, lapack_int* iwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgecon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgecon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_sgecon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, iwork, &info ); @@ -70,11 +70,11 @@ lapack_int LAPACKE_sgecon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgecon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgecon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgedmd.c b/LAPACKE/src/lapacke_sgedmd.c index 6865fcf653..a5ce50e4ce 100644 --- a/LAPACKE/src/lapacke_sgedmd.c +++ b/LAPACKE/src/lapacke_sgedmd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgedmd( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_sgedmd)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, float* x, lapack_int ldx, float* y, lapack_int ldy, lapack_int nrnk, float* tol, @@ -49,34 +49,34 @@ lapack_int LAPACKE_sgedmd( int matrix_layout, char jobs, char jobz, char jobr, float work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgedmd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -15; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -18; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -20; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, w, ldw ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, w, ldw ) ) { return -22; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_sgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, w, ldw, s, lds, &work_query, lwork, &iwork_query, liwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_sgedmd( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_sgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, w, ldw, s, lds, work, lwork, iwork, liwork ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_sgedmd( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgedmd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgedmd_work.c b/LAPACKE/src/lapacke_sgedmd_work.c index 5b24152da7..8a07e39a46 100644 --- a/LAPACKE/src/lapacke_sgedmd_work.c +++ b/LAPACKE/src/lapacke_sgedmd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_sgedmd_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, float* x, lapack_int ldx, float* y, lapack_int ldy, @@ -69,32 +69,32 @@ lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldx < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } if( ldy < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } if( ldb < n ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } if( ldw < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } if( lds < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -137,12 +137,12 @@ lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_sge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_sge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); - LAPACKE_sge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_sgedmd( &jobs, &jobz, &jobr, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, &ldy_t, &nrnk, tol, &k, reig, imeig, z_t, &ldz_t, @@ -152,12 +152,12 @@ lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_5: @@ -172,11 +172,11 @@ lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgedmdq.c b/LAPACKE/src/lapacke_sgedmdq.c index e65c2094f9..7ae1aeeb5a 100644 --- a/LAPACKE/src/lapacke_sgedmdq.c +++ b/LAPACKE/src/lapacke_sgedmdq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgedmdq( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_sgedmdq)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, float* f, lapack_int ldf, float* x, lapack_int ldx, float* y, lapack_int ldy, @@ -49,37 +49,37 @@ lapack_int LAPACKE_sgedmdq( int matrix_layout, char jobs, char jobz, char jobr, float work_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgedmdq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -11; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -13; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -15; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -22; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -25; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, v, ldv ) ) { return -27; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -29; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_sgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, v, ldv, s, lds, &work_query, lwork, @@ -102,7 +102,7 @@ lapack_int LAPACKE_sgedmdq( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_sgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, reig, imeig, z, ldz, res, b, ldb, v, ldv, s, lds, work, lwork, iwork, @@ -113,7 +113,7 @@ lapack_int LAPACKE_sgedmdq( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgedmdq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgedmdq_work.c b/LAPACKE/src/lapacke_sgedmdq_work.c index e1c1f5c983..98010a24bb 100644 --- a/LAPACKE/src/lapacke_sgedmdq_work.c +++ b/LAPACKE/src/lapacke_sgedmdq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_sgedmdq_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, float* f, lapack_int ldf, float* x, @@ -73,37 +73,37 @@ lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldf < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( ldx < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( ldy < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( ldz < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( ldb < n ) { info = -26; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( ldv < n ) { info = -28; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } if( lds < n ) { info = -30; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -151,13 +151,13 @@ lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, goto exit_level_6; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); - LAPACKE_sge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_sge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_sge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, m, n, v, ldv, v_t, ldv_t ); - LAPACKE_sge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_sgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, tol, &k, reig, imeig, @@ -167,13 +167,13 @@ lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_6: @@ -190,11 +190,11 @@ lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( f_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgedmdq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeequ.c b/LAPACKE/src/lapacke_sgeequ.c index 9395639c13..a41fd77646 100644 --- a/LAPACKE/src/lapacke_sgeequ.c +++ b/LAPACKE/src/lapacke_sgeequ.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeequ)( int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_sgeequ_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_sgeequ_work.c b/LAPACKE/src/lapacke_sgeequ_work.c index b501d6e73f..ca31073088 100644 --- a/LAPACKE/src/lapacke_sgeequ_work.c +++ b/LAPACKE/src/lapacke_sgeequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeequ_work)( int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgeequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_sgeequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_sgeequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeequb.c b/LAPACKE/src/lapacke_sgeequb.c index 10fbf2a1c6..8e720d40c5 100644 --- a/LAPACKE/src/lapacke_sgeequb.c +++ b/LAPACKE/src/lapacke_sgeequb.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeequb)( int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_sgeequb_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_sgeequb_work.c b/LAPACKE/src/lapacke_sgeequb_work.c index 118848ad81..0d9313278c 100644 --- a/LAPACKE/src/lapacke_sgeequb_work.c +++ b/LAPACKE/src/lapacke_sgeequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeequb_work)( int matrix_layout, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* r, float* c, float* rowcnd, float* colcnd, float* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgeequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_sgeequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); @@ -71,11 +71,11 @@ lapack_int LAPACKE_sgeequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgees.c b/LAPACKE/src/lapacke_sgees.c index 28bdcb1ff0..935ca458d5 100644 --- a/LAPACKE/src/lapacke_sgees.c +++ b/LAPACKE/src/lapacke_sgees.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgees( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_sgees)( int matrix_layout, char jobvs, char sort, LAPACK_S_SELECT2 select, lapack_int n, float* a, lapack_int lda, lapack_int* sdim, float* wr, float* wi, float* vs, lapack_int ldvs ) @@ -43,19 +43,19 @@ lapack_int LAPACKE_sgees( int matrix_layout, char jobvs, char sort, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgees", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -64,7 +64,7 @@ lapack_int LAPACKE_sgees( int matrix_layout, char jobvs, char sort, } } /* Query optimal working array(s) size */ - info = LAPACKE_sgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_sgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, &work_query, lwork, bwork ); if( info != 0 ) { @@ -78,17 +78,17 @@ lapack_int LAPACKE_sgees( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_sgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgees", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgees_work.c b/LAPACKE/src/lapacke_sgees_work.c index afcd5c67e4..00b17a8696 100644 --- a/LAPACKE/src/lapacke_sgees_work.c +++ b/LAPACKE/src/lapacke_sgees_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgees_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_sgees_work)( int matrix_layout, char jobvs, char sort, LAPACK_S_SELECT2 select, lapack_int n, float* a, lapack_int lda, lapack_int* sdim, float* wr, float* wi, float* vs, lapack_int ldvs, @@ -55,12 +55,12 @@ lapack_int LAPACKE_sgees_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees_work", info ); return info; } if( ldvs < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -75,7 +75,7 @@ lapack_int LAPACKE_sgees_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (float*)LAPACKE_malloc( sizeof(float) * ldvs_t * MAX(1,n) ); if( vs_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -83,7 +83,7 @@ lapack_int LAPACKE_sgees_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, wr, wi, vs_t, &ldvs_t, work, &lwork, bwork, &info ); @@ -91,23 +91,23 @@ lapack_int LAPACKE_sgees_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgees_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeesx.c b/LAPACKE/src/lapacke_sgeesx.c index d2555ecc83..a32e2ec6b8 100644 --- a/LAPACKE/src/lapacke_sgeesx.c +++ b/LAPACKE/src/lapacke_sgeesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_sgeesx)( int matrix_layout, char jobvs, char sort, LAPACK_S_SELECT2 select, char sense, lapack_int n, float* a, lapack_int lda, lapack_int* sdim, float* wr, float* wi, float* vs, lapack_int ldvs, @@ -47,19 +47,19 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -68,7 +68,7 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, } } /* Query optimal working array(s) size */ - info = LAPACKE_sgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_sgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, &work_query, lwork, &iwork_query, liwork, bwork ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); } else { @@ -94,7 +94,7 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_sgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_sgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork ); /* Release memory and exit */ @@ -102,12 +102,12 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, exit_level_2: LAPACKE_free( iwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeesx_work.c b/LAPACKE/src/lapacke_sgeesx_work.c index 589a8a5b3c..377fd7713c 100644 --- a/LAPACKE/src/lapacke_sgeesx_work.c +++ b/LAPACKE/src/lapacke_sgeesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeesx_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_sgeesx_work)( int matrix_layout, char jobvs, char sort, LAPACK_S_SELECT2 select, char sense, lapack_int n, float* a, lapack_int lda, lapack_int* sdim, float* wr, float* wi, @@ -58,12 +58,12 @@ lapack_int LAPACKE_sgeesx_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx_work", info ); return info; } if( ldvs < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_sgeesx_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (float*)LAPACKE_malloc( sizeof(float) * ldvs_t * MAX(1,n) ); if( vs_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -87,7 +87,7 @@ lapack_int LAPACKE_sgeesx_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, wr, wi, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, iwork, @@ -96,23 +96,23 @@ lapack_int LAPACKE_sgeesx_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeev.c b/LAPACKE/src/lapacke_sgeev.c index d8fb0bb52d..342bea684e 100644 --- a/LAPACKE/src/lapacke_sgeev.c +++ b/LAPACKE/src/lapacke_sgeev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_sgeev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* wr, float* wi, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_sgeev( int matrix_layout, char jobvl, char jobvr, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, + info = API_SUFFIX(LAPACKE_sgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_sgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, + info = API_SUFFIX(LAPACKE_sgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeev_work.c b/LAPACKE/src/lapacke_sgeev_work.c index af6dbedf0c..c2687135bb 100644 --- a/LAPACKE/src/lapacke_sgeev_work.c +++ b/LAPACKE/src/lapacke_sgeev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_sgeev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* wr, float* wi, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, float* work, @@ -56,17 +56,17 @@ lapack_int LAPACKE_sgeev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,14 +81,14 @@ lapack_int LAPACKE_sgeev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -96,7 +96,7 @@ lapack_int LAPACKE_sgeev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeev( &jobvl, &jobvr, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, &info ); @@ -104,30 +104,30 @@ lapack_int LAPACKE_sgeev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeevx.c b/LAPACKE/src/lapacke_sgeevx.c index 89f955bf3a..454a089092 100644 --- a/LAPACKE/src/lapacke_sgeevx.c +++ b/LAPACKE/src/lapacke_sgeevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_sgeevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, float* a, lapack_int lda, float* wr, float* wi, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, @@ -45,19 +45,19 @@ lapack_int LAPACKE_sgeevx( int matrix_layout, char balanc, char jobvl, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*) LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*n-2) ); if( iwork == NULL ) { @@ -66,7 +66,7 @@ lapack_int LAPACKE_sgeevx( int matrix_layout, char balanc, char jobvl, } } /* Query optimal working array(s) size */ - info = LAPACKE_sgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_sgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, &work_query, lwork, iwork ); @@ -81,19 +81,19 @@ lapack_int LAPACKE_sgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_sgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeevx_work.c b/LAPACKE/src/lapacke_sgeevx_work.c index 67f4982bf2..7ff3deb534 100644 --- a/LAPACKE/src/lapacke_sgeevx_work.c +++ b/LAPACKE/src/lapacke_sgeevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_sgeevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, float* a, lapack_int lda, float* wr, float* wi, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, @@ -60,17 +60,17 @@ lapack_int LAPACKE_sgeevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,14 +86,14 @@ lapack_int LAPACKE_sgeevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -101,7 +101,7 @@ lapack_int LAPACKE_sgeevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, wr, wi, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm, @@ -110,30 +110,30 @@ lapack_int LAPACKE_sgeevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgehrd.c b/LAPACKE/src/lapacke_sgehrd.c index 838c7a5877..4399f6c41a 100644 --- a/LAPACKE/src/lapacke_sgehrd.c +++ b/LAPACKE/src/lapacke_sgehrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgehrd( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_sgehrd)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_sgehrd( int matrix_layout, lapack_int n, lapack_int ilo, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgehrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgehrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_sgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_sgehrd( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgehrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgehrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgehrd_work.c b/LAPACKE/src/lapacke_sgehrd_work.c index 127307da88..8a12e1a20b 100644 --- a/LAPACKE/src/lapacke_sgehrd_work.c +++ b/LAPACKE/src/lapacke_sgehrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_sgehrd_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgehrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgehrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgehrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgejsv.c b/LAPACKE/src/lapacke_sgejsv.c index 2138751b97..a25d9150ec 100644 --- a/LAPACKE/src/lapacke_sgejsv.c +++ b/LAPACKE/src/lapacke_sgejsv.c @@ -32,55 +32,55 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_sgejsv)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, float* u, lapack_int ldu, float* v, lapack_int ldv, float* stat, lapack_int* istat ) { lapack_int info = 0; - lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) || - LAPACKE_lsame( joba, 'e' ) || - LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) : - ( (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - ( LAPACKE_lsame( joba, 'e' ) || - LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - (!( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) : - ( ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - (!( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) : - ( ( LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'j' ) ) && - LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : + lapack_int lwork = (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) : + ( (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + (!( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) ) ? MAX(7,2*n+m) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + (!( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) ) ? MAX(7,2*n+m) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ? MAX(1,6*n+2*n*n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ? MAX(7,m+3*n+n*n) : 7) ) ) ) ) ); lapack_int* iwork = NULL; float* work = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgejsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } } @@ -93,15 +93,15 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, } 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' ); + int want_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ); + int want_v = API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ); + int want_sce = API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || API_SUFFIX(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 + if( want_u && API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1 + if( want_u && API_SUFFIX(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 ) { @@ -109,7 +109,7 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt, + info = API_SUFFIX(LAPACKE_sgejsv_work)( matrix_layout, joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork ); /* Backup significant data from working array(s) */ @@ -125,7 +125,7 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgejsv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgejsv_work.c b/LAPACKE/src/lapacke_sgejsv_work.c index 1c5ed064ec..41078572b4 100644 --- a/LAPACKE/src/lapacke_sgejsv_work.c +++ b/LAPACKE/src/lapacke_sgejsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, +lapack_int API_SUFFIX(LAPACKE_sgejsv_work)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, float* u, @@ -50,10 +50,10 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } } 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 nu = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : m; + lapack_int nv = API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : + API_SUFFIX(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); @@ -63,17 +63,17 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv_work", info ); return info; } if( ldu < ncols_u ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv_work", info ); return info; } if( ldv < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,16 +82,16 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { 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; } } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -99,7 +99,7 @@ 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 ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_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, @@ -108,33 +108,33 @@ lapack_int LAPACKE_sgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { + API_SUFFIX(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' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { LAPACKE_free( v_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { LAPACKE_free( u_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgejsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelq.c b/LAPACKE/src/lapacke_sgelq.c index 5228a80723..7653e5f87e 100644 --- a/LAPACKE/src/lapacke_sgelq.c +++ b/LAPACKE/src/lapacke_sgelq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelq)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_sgelq_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_sgelq_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelq2.c b/LAPACKE/src/lapacke_sgelq2.c index 9b4d8dafd1..74771ad4d0 100644 --- a/LAPACKE/src/lapacke_sgelq2.c +++ b/LAPACKE/src/lapacke_sgelq2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelq2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelq2)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelq2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_sgelq2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgelq2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_sgelq2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelq2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelq2_work.c b/LAPACKE/src/lapacke_sgelq2_work.c index 8f7d4fb4f7..11a23dfc3c 100644 --- a/LAPACKE/src/lapacke_sgelq2_work.c +++ b/LAPACKE/src/lapacke_sgelq2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelq2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelq2_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgelq2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_sgelq2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelq2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelq_work.c b/LAPACKE/src/lapacke_sgelq_work.c index 0cd356f4a4..ac26fcf0ee 100644 --- a/LAPACKE/src/lapacke_sgelq_work.c +++ b/LAPACKE/src/lapacke_sgelq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelq_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelqf.c b/LAPACKE/src/lapacke_sgelqf.c index cdbb47a98f..32d2788aff 100644 --- a/LAPACKE/src/lapacke_sgelqf.c +++ b/LAPACKE/src/lapacke_sgelqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelqf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgelqf( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgelqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sgelqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgelqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgelqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_sgelqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelqf_work.c b/LAPACKE/src/lapacke_sgelqf_work.c index f93abf355d..a354cbb84f 100644 --- a/LAPACKE/src/lapacke_sgelqf_work.c +++ b/LAPACKE/src/lapacke_sgelqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelqf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgelqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgelqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgels.c b/LAPACKE/src/lapacke_sgels.c index 9002b95514..899de53a8d 100644 --- a/LAPACKE/src/lapacke_sgels.c +++ b/LAPACKE/src/lapacke_sgels.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgels( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgels)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sgels( int matrix_layout, char trans, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgels", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sgels( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgels", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgels_work.c b/LAPACKE/src/lapacke_sgels_work.c index 7ae2caa05b..0700f651b1 100644 --- a/LAPACKE/src/lapacke_sgels_work.c +++ b/LAPACKE/src/lapacke_sgels_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgels_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgels_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sgels_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sgels_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -88,8 +88,8 @@ lapack_int LAPACKE_sgels_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -97,11 +97,11 @@ lapack_int LAPACKE_sgels_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgels_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelsd.c b/LAPACKE/src/lapacke_sgelsd.c index 7023c3467d..28988eb7ce 100644 --- a/LAPACKE/src/lapacke_sgelsd.c +++ b/LAPACKE/src/lapacke_sgelsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelsd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelsd)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* s, float rcond, lapack_int* rank ) @@ -46,25 +46,25 @@ lapack_int LAPACKE_sgelsd( int matrix_layout, lapack_int m, lapack_int n, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_sgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, &iwork_query ); if( info != 0 ) { goto exit_level_0; @@ -83,7 +83,7 @@ lapack_int LAPACKE_sgelsd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_sgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_sgelsd( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelsd_work.c b/LAPACKE/src/lapacke_sgelsd_work.c index edc7562d03..9bbef500e6 100644 --- a/LAPACKE/src/lapacke_sgelsd_work.c +++ b/LAPACKE/src/lapacke_sgelsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelsd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelsd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* s, float rcond, lapack_int* rank, float* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sgelsd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_sgelsd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, iwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_sgelsd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_sgelsd_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelss.c b/LAPACKE/src/lapacke_sgelss.c index 73f5809c11..f486b35d93 100644 --- a/LAPACKE/src/lapacke_sgelss.c +++ b/LAPACKE/src/lapacke_sgelss.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelss( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelss)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* s, float rcond, lapack_int* rank ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_sgelss( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelss", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_sgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_sgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_sgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelss", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelss_work.c b/LAPACKE/src/lapacke_sgelss_work.c index e747d58963..2cfb3a6448 100644 --- a/LAPACKE/src/lapacke_sgelss_work.c +++ b/LAPACKE/src/lapacke_sgelss_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelss_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelss_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* s, float rcond, lapack_int* rank, float* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sgelss_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_sgelss_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_sgelss_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_sgelss_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelss_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelsy.c b/LAPACKE/src/lapacke_sgelsy.c index 8785996ae4..b5b78ce827 100644 --- a/LAPACKE/src/lapacke_sgelsy.c +++ b/LAPACKE/src/lapacke_sgelsy.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelsy( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelsy)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* jpvt, float rcond, lapack_int* rank ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_sgelsy( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgelsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_sgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_sgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_sgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgelsy_work.c b/LAPACKE/src/lapacke_sgelsy_work.c index a6c207398c..a8c7c897ef 100644 --- a/LAPACKE/src/lapacke_sgelsy_work.c +++ b/LAPACKE/src/lapacke_sgelsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgelsy_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgelsy_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* jpvt, float rcond, lapack_int* rank, float* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sgelsy_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_sgelsy_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond, rank, work, &lwork, &info ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_sgelsy_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_sgelsy_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgelsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemlq.c b/LAPACKE/src/lapacke_sgemlq.c index 6677ae9703..9751f6081d 100644 --- a/LAPACKE/src/lapacke_sgemlq.c +++ b/LAPACKE/src/lapacke_sgemlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* t, lapack_int tsize, @@ -43,25 +43,25 @@ lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgemlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_sgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_sgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemlq_work.c b/LAPACKE/src/lapacke_sgemlq_work.c index d63d4efe80..75942786c5 100644 --- a/LAPACKE/src/lapacke_sgemlq_work.c +++ b/LAPACKE/src/lapacke_sgemlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,k); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) ); } else { a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); @@ -87,8 +87,8 @@ lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -96,18 +96,18 @@ lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemqr.c b/LAPACKE/src/lapacke_sgemqr.c index ceeac349a3..27d9ccc909 100644 --- a/LAPACKE/src/lapacke_sgemqr.c +++ b/LAPACKE/src/lapacke_sgemqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* t, lapack_int tsize, @@ -44,26 +44,26 @@ lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgemqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_sgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -76,13 +76,13 @@ lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_sgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemqr_work.c b/LAPACKE/src/lapacke_sgemqr_work.c index d05c429763..d657c14fa5 100644 --- a/LAPACKE/src/lapacke_sgemqr_work.c +++ b/LAPACKE/src/lapacke_sgemqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -94,18 +94,18 @@ lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemqrt.c b/LAPACKE/src/lapacke_sgemqrt.c index 79685c8ccf..920a26dbc5 100644 --- a/LAPACKE/src/lapacke_sgemqrt.c +++ b/LAPACKE/src/lapacke_sgemqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* c, @@ -42,21 +42,21 @@ lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgemqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* 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 ) ) { + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } } @@ -68,13 +68,13 @@ lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgemqrt_work( matrix_layout, side, trans, m, n, k, nb, v, ldv, + info = API_SUFFIX(LAPACKE_sgemqrt_work)( matrix_layout, side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgemqrt_work.c b/LAPACKE/src/lapacke_sgemqrt_work.c index a1aac6a5ad..ef8388cb93 100644 --- a/LAPACKE/src/lapacke_sgemqrt_work.c +++ b/LAPACKE/src/lapacke_sgemqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgemqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sgemqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* c, @@ -56,17 +56,17 @@ lapack_int LAPACKE_sgemqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt_work", info ); return info; } if( ldt < nb ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt_work", info ); return info; } if( ldv < k ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,9 +86,9 @@ lapack_int LAPACKE_sgemqrt_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_sge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &info ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_sgemqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_sgemqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgemqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqlf.c b/LAPACKE/src/lapacke_sgeqlf.c index 3418461fe7..5616db2aa3 100644 --- a/LAPACKE/src/lapacke_sgeqlf.c +++ b/LAPACKE/src/lapacke_sgeqlf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqlf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqlf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgeqlf( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqlf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqlf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeqlf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sgeqlf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgeqlf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqlf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_sgeqlf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqlf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqlf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqlf_work.c b/LAPACKE/src/lapacke_sgeqlf_work.c index 7892dd23b4..ea3ba44c90 100644 --- a/LAPACKE/src/lapacke_sgeqlf_work.c +++ b/LAPACKE/src/lapacke_sgeqlf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqlf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqlf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqlf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqlf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqp3.c b/LAPACKE/src/lapacke_sgeqp3.c index e9a2382392..7e5162d908 100644 --- a/LAPACKE/src/lapacke_sgeqp3.c +++ b/LAPACKE/src/lapacke_sgeqp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqp3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqp3)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* jpvt, float* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_sgeqp3( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, + info = API_SUFFIX(LAPACKE_sgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_sgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_sgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqp3_work.c b/LAPACKE/src/lapacke_sgeqp3_work.c index 65281a3b19..12c45ba9fe 100644 --- a/LAPACKE/src/lapacke_sgeqp3_work.c +++ b/LAPACKE/src/lapacke_sgeqp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqp3_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* jpvt, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqpf.c b/LAPACKE/src/lapacke_sgeqpf.c index 4a70cee5c3..ff6c0b49a5 100644 --- a/LAPACKE/src/lapacke_sgeqpf.c +++ b/LAPACKE/src/lapacke_sgeqpf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqpf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqpf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* jpvt, float* tau ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqpf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqpf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_sgeqpf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqpf_work( matrix_layout, m, n, a, lda, jpvt, tau, work ); + info = API_SUFFIX(LAPACKE_sgeqpf_work)( matrix_layout, m, n, a, lda, jpvt, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqpf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqpf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqpf_work.c b/LAPACKE/src/lapacke_sgeqpf_work.c index 3d52190193..a468eb2ce6 100644 --- a/LAPACKE/src/lapacke_sgeqpf_work.c +++ b/LAPACKE/src/lapacke_sgeqpf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqpf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* jpvt, float* tau, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqpf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_sgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqpf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqpf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqr.c b/LAPACKE/src/lapacke_sgeqr.c index d3876420b4..030927398e 100644 --- a/LAPACKE/src/lapacke_sgeqr.c +++ b/LAPACKE/src/lapacke_sgeqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqr)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_sgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_sgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqr2.c b/LAPACKE/src/lapacke_sgeqr2.c index 5f125b1705..6ff7663b2c 100644 --- a/LAPACKE/src/lapacke_sgeqr2.c +++ b/LAPACKE/src/lapacke_sgeqr2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqr2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqr2)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_sgeqr2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqr2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_sgeqr2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqr2_work.c b/LAPACKE/src/lapacke_sgeqr2_work.c index 3ac4d12b3f..6e6ac33775 100644 --- a/LAPACKE/src/lapacke_sgeqr2_work.c +++ b/LAPACKE/src/lapacke_sgeqr2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqr2_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_sgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqr2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqr_work.c b/LAPACKE/src/lapacke_sgeqr_work.c index 4951b90f48..fa1219947d 100644 --- a/LAPACKE/src/lapacke_sgeqr_work.c +++ b/LAPACKE/src/lapacke_sgeqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqr_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrf.c b/LAPACKE/src/lapacke_sgeqrf.c index 9f295d9bbd..e26e2ee425 100644 --- a/LAPACKE/src/lapacke_sgeqrf.c +++ b/LAPACKE/src/lapacke_sgeqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgeqrf( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeqrf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sgeqrf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgeqrf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqrf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_sgeqrf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrf_work.c b/LAPACKE/src/lapacke_sgeqrf_work.c index 5df36005b3..07dce5afc1 100644 --- a/LAPACKE/src/lapacke_sgeqrf_work.c +++ b/LAPACKE/src/lapacke_sgeqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrfp.c b/LAPACKE/src/lapacke_sgeqrfp.c index 25a05f70bd..69c20824b3 100644 --- a/LAPACKE/src/lapacke_sgeqrfp.c +++ b/LAPACKE/src/lapacke_sgeqrfp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrfp( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrfp)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgeqrfp( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrfp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrfp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgeqrfp_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sgeqrfp_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgeqrfp( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqrfp_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_sgeqrfp_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrfp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrfp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrfp_work.c b/LAPACKE/src/lapacke_sgeqrfp_work.c index ae8fe0586c..8dec069b36 100644 --- a/LAPACKE/src/lapacke_sgeqrfp_work.c +++ b/LAPACKE/src/lapacke_sgeqrfp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrfp_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrfp_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrfp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrfp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrt.c b/LAPACKE/src/lapacke_sgeqrt.c index d8f0c1d65e..28ad0d294d 100644 --- a/LAPACKE/src/lapacke_sgeqrt.c +++ b/LAPACKE/src/lapacke_sgeqrt.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, float* a, lapack_int lda, float* t, lapack_int ldt ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_sgeqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgeqrt_work( matrix_layout, m, n, nb, a, lda, t, ldt, work ); + info = API_SUFFIX(LAPACKE_sgeqrt_work)( matrix_layout, m, n, nb, a, lda, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrt2.c b/LAPACKE/src/lapacke_sgeqrt2.c index 9f4910695b..36a790bd8c 100644 --- a/LAPACKE/src/lapacke_sgeqrt2.c +++ b/LAPACKE/src/lapacke_sgeqrt2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt2)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_sgeqrt2_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_sgeqrt2_work.c b/LAPACKE/src/lapacke_sgeqrt2_work.c index 3c204620fe..7fd858f459 100644 --- a/LAPACKE/src/lapacke_sgeqrt2_work.c +++ b/LAPACKE/src/lapacke_sgeqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_sgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt2_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_sgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrt3.c b/LAPACKE/src/lapacke_sgeqrt3.c index 32cce825be..8d118bd97c 100644 --- a/LAPACKE/src/lapacke_sgeqrt3.c +++ b/LAPACKE/src/lapacke_sgeqrt3.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt3)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_sgeqrt3_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_sgeqrt3_work.c b/LAPACKE/src/lapacke_sgeqrt3_work.c index 7950df25e4..032d316e23 100644 --- a/LAPACKE/src/lapacke_sgeqrt3_work.c +++ b/LAPACKE/src/lapacke_sgeqrt3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt3_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_sgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt3_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_sgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgeqrt_work.c b/LAPACKE/src/lapacke_sgeqrt_work.c index d357845aec..06a1874b3e 100644 --- a/LAPACKE/src/lapacke_sgeqrt_work.c +++ b/LAPACKE/src/lapacke_sgeqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgeqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, float* a, lapack_int lda, float* t, lapack_int ldt, float* work ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_sgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt_work", info ); return info; } if( ldt < MIN(m,n) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,15 +71,15 @@ lapack_int LAPACKE_sgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -87,11 +87,11 @@ lapack_int LAPACKE_sgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgeqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerfs.c b/LAPACKE/src/lapacke_sgerfs.c index 8cd3aaa83c..e69f05b5e2 100644 --- a/LAPACKE/src/lapacke_sgerfs.c +++ b/LAPACKE/src/lapacke_sgerfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgerfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_sgerfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgerfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_sgerfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgerfs_work( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_sgerfs_work)( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_sgerfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerfs_work.c b/LAPACKE/src/lapacke_sgerfs_work.c index a9a462f76d..f3dfa7e857 100644 --- a/LAPACKE/src/lapacke_sgerfs_work.c +++ b/LAPACKE/src/lapacke_sgerfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgerfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_sgerfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,10 +100,10 @@ lapack_int LAPACKE_sgerfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_sgerfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_sgerfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerfsx.c b/LAPACKE/src/lapacke_sgerfsx.c index e6203ed511..09bdd626b5 100644 --- a/LAPACKE/src/lapacke_sgerfsx.c +++ b/LAPACKE/src/lapacke_sgerfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_sgerfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* r, @@ -46,37 +46,37 @@ lapack_int LAPACKE_sgerfsx( int matrix_layout, char trans, char equed, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgerfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_s_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, c, 1 ) ) { return -12; } } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -11; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -93,7 +93,7 @@ lapack_int LAPACKE_sgerfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgerfsx_work( matrix_layout, trans, equed, n, nrhs, a, lda, + info = API_SUFFIX(LAPACKE_sgerfsx_work)( matrix_layout, trans, equed, n, nrhs, a, lda, af, ldaf, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_sgerfsx( int matrix_layout, char trans, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerfsx_work.c b/LAPACKE/src/lapacke_sgerfsx_work.c index 7e2148606b..b7a61d774e 100644 --- a/LAPACKE/src/lapacke_sgerfsx_work.c +++ b/LAPACKE/src/lapacke_sgerfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_sgerfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -67,22 +67,22 @@ lapack_int LAPACKE_sgerfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,10 +119,10 @@ lapack_int LAPACKE_sgerfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -132,10 +132,10 @@ lapack_int LAPACKE_sgerfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -151,11 +151,11 @@ lapack_int LAPACKE_sgerfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerqf.c b/LAPACKE/src/lapacke_sgerqf.c index b82649a0a6..0d1bae4a37 100644 --- a/LAPACKE/src/lapacke_sgerqf.c +++ b/LAPACKE/src/lapacke_sgerqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgerqf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgerqf( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgerqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgerqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sgerqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgerqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgerqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_sgerqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgerqf_work.c b/LAPACKE/src/lapacke_sgerqf_work.c index a5cd487076..21c4015160 100644 --- a/LAPACKE/src/lapacke_sgerqf_work.c +++ b/LAPACKE/src/lapacke_sgerqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgerqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgerqf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgerqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgerqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgerqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgesdd.c b/LAPACKE/src/lapacke_sgesdd.c index bbefdad384..c13a6d4d2b 100644 --- a/LAPACKE/src/lapacke_sgesdd.c +++ b/LAPACKE/src/lapacke_sgesdd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgesdd( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgesdd)( int matrix_layout, char jobz, lapack_int m, lapack_int n, float* a, lapack_int lda, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt ) @@ -43,13 +43,13 @@ lapack_int LAPACKE_sgesdd( int matrix_layout, char jobz, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgesdd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_sgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_sgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_sgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, &work_query, lwork, iwork ); if( info != 0 ) { goto exit_level_1; @@ -75,7 +75,7 @@ lapack_int LAPACKE_sgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_sgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_sgesdd( int matrix_layout, char jobz, lapack_int m, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgesdd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgesdd_work.c b/LAPACKE/src/lapacke_sgesdd_work.c index b6619e38bb..5dd1cdbc3c 100644 --- a/LAPACKE/src/lapacke_sgesdd_work.c +++ b/LAPACKE/src/lapacke_sgesdd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgesdd_work)( int matrix_layout, char jobz, lapack_int m, lapack_int n, float* a, lapack_int lda, float* s, float* u, lapack_int ldu, float* vt, lapack_int ldvt, float* work, lapack_int lwork, @@ -47,15 +47,15 @@ lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) || - LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && m=n) ) ? n : - ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m=n) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1); lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); @@ -65,17 +65,17 @@ lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd_work", info ); return info; } if( ldu < ncols_u ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd_work", info ); return info; } if( ldvt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -90,8 +90,8 @@ lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { vt_t = (float*)LAPACKE_malloc( sizeof(float) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -108,7 +108,7 @@ lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, iwork, &info ); @@ -116,36 +116,36 @@ lapack_int LAPACKE_sgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_s_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, r, 1 ) ) { return -12; } } @@ -94,7 +94,7 @@ lapack_int LAPACKE_sgesvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgesvxx_work( matrix_layout, fact, trans, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_sgesvxx_work)( matrix_layout, fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_sgesvxx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgesvxx_work.c b/LAPACKE/src/lapacke_sgesvxx_work.c index 66ea83345b..480f685bc3 100644 --- a/LAPACKE/src/lapacke_sgesvxx_work.c +++ b/LAPACKE/src/lapacke_sgesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgesvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgesvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, char* equed, float* r, @@ -67,22 +67,22 @@ lapack_int LAPACKE_sgesvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,11 +119,11 @@ lapack_int LAPACKE_sgesvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgesvxx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -133,21 +133,21 @@ lapack_int LAPACKE_sgesvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -163,11 +163,11 @@ lapack_int LAPACKE_sgesvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetf2.c b/LAPACKE/src/lapacke_sgetf2.c index 249aad026b..0f68d64f4c 100644 --- a/LAPACKE/src/lapacke_sgetf2.c +++ b/LAPACKE/src/lapacke_sgetf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetf2)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgetf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_sgetf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_sgetf2_work.c b/LAPACKE/src/lapacke_sgetf2_work.c index 90e1a398c7..036fd392d5 100644 --- a/LAPACKE/src/lapacke_sgetf2_work.c +++ b/LAPACKE/src/lapacke_sgetf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetf2_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_sgetf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_sgetf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetrf.c b/LAPACKE/src/lapacke_sgetrf.c index 992d0d44d7..4c75edf387 100644 --- a/LAPACKE/src/lapacke_sgetrf.c +++ b/LAPACKE/src/lapacke_sgetrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgetrf_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_sgetrf_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_sgetrf2.c b/LAPACKE/src/lapacke_sgetrf2.c index f320b22dbc..2866fd9f76 100644 --- a/LAPACKE/src/lapacke_sgetrf2.c +++ b/LAPACKE/src/lapacke_sgetrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrf2)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_sgetrf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_sgetrf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_sgetrf2_work.c b/LAPACKE/src/lapacke_sgetrf2_work.c index 502ab66767..bad838e990 100644 --- a/LAPACKE/src/lapacke_sgetrf2_work.c +++ b/LAPACKE/src/lapacke_sgetrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrf2_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_sgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_sgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetrf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetrf_work.c b/LAPACKE/src/lapacke_sgetrf_work.c index 6d24244390..8b5b9d86c6 100644 --- a/LAPACKE/src/lapacke_sgetrf_work.c +++ b/LAPACKE/src/lapacke_sgetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_sgetrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_sgetrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetrf( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetri.c b/LAPACKE/src/lapacke_sgetri.c index 128bf92a27..cd6d2f4ba6 100644 --- a/LAPACKE/src/lapacke_sgetri.c +++ b/LAPACKE/src/lapacke_sgetri.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetri( int matrix_layout, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_sgetri)( int matrix_layout, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_sgetri( int matrix_layout, lapack_int n, float* a, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgetri_work( matrix_layout, n, a, lda, ipiv, &work_query, + info = API_SUFFIX(LAPACKE_sgetri_work)( matrix_layout, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_sgetri( int matrix_layout, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgetri_work( matrix_layout, n, a, lda, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_sgetri_work)( matrix_layout, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetri_work.c b/LAPACKE/src/lapacke_sgetri_work.c index b1f1d18cba..cc5a1446e3 100644 --- a/LAPACKE/src/lapacke_sgetri_work.c +++ b/LAPACKE/src/lapacke_sgetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetri_work( int matrix_layout, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_sgetri_work)( int matrix_layout, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgetri_work( int matrix_layout, lapack_int n, float* a, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_sgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetri_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sgetri_work( int matrix_layout, lapack_int n, float* a, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetrs.c b/LAPACKE/src/lapacke_sgetrs.c index 20595db6d7..4388ac0663 100644 --- a/LAPACKE/src/lapacke_sgetrs.c +++ b/LAPACKE/src/lapacke_sgetrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_sgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_sgetrs_work)( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sgetrs_work.c b/LAPACKE/src/lapacke_sgetrs_work.c index 0917f344d6..ef59c4393c 100644 --- a/LAPACKE/src/lapacke_sgetrs_work.c +++ b/LAPACKE/src/lapacke_sgetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_sgetrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_sgetrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_sgetrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetsls.c b/LAPACKE/src/lapacke_sgetsls.c index 72be1c7ee6..b1f9958d21 100644 --- a/LAPACKE/src/lapacke_sgetsls.c +++ b/LAPACKE/src/lapacke_sgetsls.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgetsls)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetsls", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetsls", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetsls_work.c b/LAPACKE/src/lapacke_sgetsls_work.c index 49a79fd757..253135fe43 100644 --- a/LAPACKE/src/lapacke_sgetsls_work.c +++ b/LAPACKE/src/lapacke_sgetsls_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sgetsls_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -88,8 +88,8 @@ lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -97,11 +97,11 @@ lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsls_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgetsqrhrt.c b/LAPACKE/src/lapacke_sgetsqrhrt.c index 759afce485..069e2a7c7c 100644 --- a/LAPACKE/src/lapacke_sgetsqrhrt.c +++ b/LAPACKE/src/lapacke_sgetsqrhrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetsqrhrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, float* a, lapack_int lda, float* t, lapack_int ldt ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_sgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_sgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_sgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_sgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_sgetsqrhrt_work.c b/LAPACKE/src/lapacke_sgetsqrhrt_work.c index 40193008d5..1c1b316430 100644 --- a/LAPACKE/src/lapacke_sgetsqrhrt_work.c +++ b/LAPACKE/src/lapacke_sgetsqrhrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgetsqrhrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, float* a, lapack_int lda, float* t, lapack_int ldt, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt_work", info ); return info; } if( ldt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_sgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgetsqrhrt( &m, &n, &mb1, &nb1, &nb2, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_sgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgetsqrhrt_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_sggbak.c b/LAPACKE/src/lapacke_sggbak.c index ecc079c60e..1dd606118c 100644 --- a/LAPACKE/src/lapacke_sggbak.c +++ b/LAPACKE/src/lapacke_sggbak.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggbak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sggbak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* lscale, const float* rscale, lapack_int m, float* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggbak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, lscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, lscale, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n, rscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, rscale, 1 ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -10; } } #endif - return LAPACKE_sggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale, + return API_SUFFIX(LAPACKE_sggbak_work)( matrix_layout, job, side, n, ilo, ihi, lscale, rscale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_sggbak_work.c b/LAPACKE/src/lapacke_sggbak_work.c index 9b53851047..a78009615c 100644 --- a/LAPACKE/src/lapacke_sggbak_work.c +++ b/LAPACKE/src/lapacke_sggbak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggbak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_sggbak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* lscale, const float* rscale, lapack_int m, float* v, lapack_int ldv ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_sggbak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_sggbak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_sggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t, &ldv_t, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_sggbak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggbal.c b/LAPACKE/src/lapacke_sggbal.c index 6f82a94154..3e355f19b8 100644 --- a/LAPACKE/src/lapacke_sggbal.c +++ b/LAPACKE/src/lapacke_sggbal.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggbal( int matrix_layout, char job, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_sggbal)( int matrix_layout, char job, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, float* rscale ) @@ -42,28 +42,28 @@ lapack_int LAPACKE_sggbal( int matrix_layout, char job, lapack_int n, float* a, lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggbal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 's' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { lwork = MAX(1,6*n); } else { lwork = 1; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sggbal( int matrix_layout, char job, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggbal_work( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, + info = API_SUFFIX(LAPACKE_sggbal_work)( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggbal", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggbal_work.c b/LAPACKE/src/lapacke_sggbal_work.c index e425e95b29..e224b53086 100644 --- a/LAPACKE/src/lapacke_sggbal_work.c +++ b/LAPACKE/src/lapacke_sggbal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggbal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sggbal_work)( int matrix_layout, char job, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, float* rscale, @@ -54,25 +54,25 @@ lapack_int LAPACKE_sggbal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { 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; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -80,13 +80,13 @@ lapack_int LAPACKE_sggbal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_sggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, @@ -95,31 +95,31 @@ lapack_int LAPACKE_sggbal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggbal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgges.c b/LAPACKE/src/lapacke_sgges.c index 478df5000d..06459652d9 100644 --- a/LAPACKE/src/lapacke_sgges.c +++ b/LAPACKE/src/lapacke_sgges.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgges( int matrix_layout, char jobvsl, char jobvsr, char sort, +lapack_int API_SUFFIX(LAPACKE_sgges)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, float* alphar, float* alphai, @@ -45,22 +45,22 @@ lapack_int LAPACKE_sgges( int matrix_layout, char jobvsl, char jobvsr, char sort float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgges", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -69,7 +69,7 @@ lapack_int LAPACKE_sgges( int matrix_layout, char jobvsl, char jobvsr, char sort } } /* Query optimal working array(s) size */ - info = LAPACKE_sgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_sgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, bwork ); if( info != 0 ) { @@ -83,18 +83,18 @@ lapack_int LAPACKE_sgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_sgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgges", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgges3.c b/LAPACKE/src/lapacke_sgges3.c index 24450034c6..80f8dfbf8f 100644 --- a/LAPACKE/src/lapacke_sgges3.c +++ b/LAPACKE/src/lapacke_sgges3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgges3( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_sgges3)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, float* alphar, float* alphai, @@ -45,22 +45,22 @@ lapack_int LAPACKE_sgges3( int matrix_layout, char jobvsl, char jobvsr, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgges3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -69,7 +69,7 @@ lapack_int LAPACKE_sgges3( int matrix_layout, char jobvsl, char jobvsr, } } /* Query optimal working array(s) size */ - info = LAPACKE_sgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, + info = API_SUFFIX(LAPACKE_sgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, bwork ); if( info != 0 ) { @@ -83,18 +83,18 @@ lapack_int LAPACKE_sgges3( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, + info = API_SUFFIX(LAPACKE_sgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgges3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgges3_work.c b/LAPACKE/src/lapacke_sgges3_work.c index a06adc087b..aebeb06b33 100644 --- a/LAPACKE/src/lapacke_sgges3_work.c +++ b/LAPACKE/src/lapacke_sgges3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_sgges3_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, @@ -63,22 +63,22 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); return info; } if( ldvsl < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); return info; } if( ldvsr < n ) { info = -18; - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -107,7 +107,7 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -116,8 +116,8 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -126,22 +126,22 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_sgges3_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgges_work.c b/LAPACKE/src/lapacke_sgges_work.c index 1bd3eacf48..d5427754d3 100644 --- a/LAPACKE/src/lapacke_sgges_work.c +++ b/LAPACKE/src/lapacke_sgges_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_sgges_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, float* alphar, @@ -62,22 +62,22 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -18; - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -106,7 +106,7 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -115,8 +115,8 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -125,22 +125,22 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -149,11 +149,11 @@ lapack_int LAPACKE_sgges_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgges_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggesx.c b/LAPACKE/src/lapacke_sggesx.c index 4caf461e9f..eda07fa88c 100644 --- a/LAPACKE/src/lapacke_sggesx.c +++ b/LAPACKE/src/lapacke_sggesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_sggesx)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, char sense, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, float* alphar, @@ -49,22 +49,22 @@ lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -10; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -73,7 +73,7 @@ lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, } } /* Query optimal working array(s) size */ - info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_sggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, &work_query, lwork, &iwork_query, liwork, @@ -95,7 +95,7 @@ lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_sggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, iwork, liwork, bwork ); @@ -104,12 +104,12 @@ lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, exit_level_2: LAPACKE_free( iwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggesx_work.c b/LAPACKE/src/lapacke_sggesx_work.c index b1fbe19025..49c2036db7 100644 --- a/LAPACKE/src/lapacke_sggesx_work.c +++ b/LAPACKE/src/lapacke_sggesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_sggesx_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, char sense, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, lapack_int* sdim, @@ -65,22 +65,22 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsl_t * MAX(1,n) ); if( vsl_t == NULL ) { @@ -110,7 +110,7 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { @@ -119,8 +119,8 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t, @@ -130,22 +130,22 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -154,11 +154,11 @@ lapack_int LAPACKE_sggesx_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggev.c b/LAPACKE/src/lapacke_sggev.c index c7ed5d569f..dbe5891fc5 100644 --- a/LAPACKE/src/lapacke_sggev.c +++ b/LAPACKE/src/lapacke_sggev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_sggev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, float* vl, lapack_int ldvl, float* vr, @@ -43,22 +43,22 @@ lapack_int LAPACKE_sggev( int matrix_layout, char jobvl, char jobvr, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_sggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggev3.c b/LAPACKE/src/lapacke_sggev3.c index 1ac2a364bb..d0d1b45bdb 100644 --- a/LAPACKE/src/lapacke_sggev3.c +++ b/LAPACKE/src/lapacke_sggev3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggev3( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_sggev3)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, float* vl, lapack_int ldvl, float* vr, @@ -43,22 +43,22 @@ lapack_int LAPACKE_sggev3( int matrix_layout, char jobvl, char jobvr, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggev3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_sggev3( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_sggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggev3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggev3_work.c b/LAPACKE/src/lapacke_sggev3_work.c index aa61dabd94..c4c569809f 100644 --- a/LAPACKE/src/lapacke_sggev3_work.c +++ b/LAPACKE/src/lapacke_sggev3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggev3_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_sggev3_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, @@ -50,10 +50,10 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -65,22 +65,22 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); return info; } if( ldvl < ncols_vl ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); return info; } if( ldvr < ncols_vr ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,ncols_vl) ); if( vl_t == NULL ) { @@ -109,7 +109,7 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,ncols_vr) ); if( vr_t == NULL ) { @@ -118,8 +118,8 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggev3( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, @@ -128,22 +128,22 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -152,11 +152,11 @@ lapack_int LAPACKE_sggev3_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggev_work.c b/LAPACKE/src/lapacke_sggev_work.c index 6417694408..bb1d078cab 100644 --- a/LAPACKE/src/lapacke_sggev_work.c +++ b/LAPACKE/src/lapacke_sggev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_sggev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, float* vl, lapack_int ldvl, @@ -48,10 +48,10 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -63,22 +63,22 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); return info; } if( ldvl < ncols_vl ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); return info; } if( ldvr < ncols_vr ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,ncols_vl) ); if( vl_t == NULL ) { @@ -107,7 +107,7 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,ncols_vr) ); if( vr_t == NULL ) { @@ -116,8 +116,8 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, @@ -126,22 +126,22 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_sggev_work( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggevx.c b/LAPACKE/src/lapacke_sggevx.c index f40f7e3409..9b076aa76c 100644 --- a/LAPACKE/src/lapacke_sggevx.c +++ b/LAPACKE/src/lapacke_sggevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_sggevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, float* vl, @@ -48,23 +48,23 @@ lapack_int LAPACKE_sggevx( int matrix_layout, char balanc, char jobvl, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -72,8 +72,8 @@ lapack_int LAPACKE_sggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } } - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -81,7 +81,7 @@ lapack_int LAPACKE_sggevx( int matrix_layout, char balanc, char jobvl, } } /* Query optimal working array(s) size */ - info = LAPACKE_sggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_sggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, &work_query, lwork, iwork, @@ -97,25 +97,25 @@ lapack_int LAPACKE_sggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_sggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_sggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alphar, alphai, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, iwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggevx_work.c b/LAPACKE/src/lapacke_sggevx_work.c index 054509abee..ad8ec922f7 100644 --- a/LAPACKE/src/lapacke_sggevx_work.c +++ b/LAPACKE/src/lapacke_sggevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_sggevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, @@ -65,22 +65,22 @@ lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); return info; } if( ldvl < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); return info; } if( ldvr < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,14 +102,14 @@ lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,n) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,n) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -117,8 +117,8 @@ lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, @@ -128,20 +128,20 @@ lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_sggevx_work( int matrix_layout, char balanc, char jobvl, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggglm.c b/LAPACKE/src/lapacke_sggglm.c index 073ed25d1b..906afc9fe9 100644 --- a/LAPACKE/src/lapacke_sggglm.c +++ b/LAPACKE/src/lapacke_sggglm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggglm( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sggglm)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, float* a, lapack_int lda, float* b, lapack_int ldb, float* d, float* x, float* y ) { @@ -41,25 +41,25 @@ lapack_int LAPACKE_sggglm( int matrix_layout, lapack_int n, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggglm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_sggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_sggglm( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_sggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggglm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggglm_work.c b/LAPACKE/src/lapacke_sggglm_work.c index 17342e32ce..286a139556 100644 --- a/LAPACKE/src/lapacke_sggglm_work.c +++ b/LAPACKE/src/lapacke_sggglm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggglm_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sggglm_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, float* a, lapack_int lda, float* b, lapack_int ldb, float* d, float* x, float* y, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sggglm_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm_work", info ); return info; } if( ldb < p ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sggglm_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_sggglm_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggglm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgghd3.c b/LAPACKE/src/lapacke_sgghd3.c index 96e8252f0e..cb1173466f 100644 --- a/LAPACKE/src/lapacke_sgghd3.c +++ b/LAPACKE/src/lapacke_sgghd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgghd3( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_sgghd3)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, float* z, lapack_int ldz ) @@ -42,32 +42,32 @@ lapack_int LAPACKE_sgghd3( int matrix_layout, char compq, char compz, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgghd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_sgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -81,13 +81,13 @@ lapack_int LAPACKE_sgghd3( int matrix_layout, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_sgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgghd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgghd3_work.c b/LAPACKE/src/lapacke_sgghd3_work.c index 7edaa7f224..b06a231989 100644 --- a/LAPACKE/src/lapacke_sgghd3_work.c +++ b/LAPACKE/src/lapacke_sgghd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_sgghd3_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, @@ -65,22 +65,22 @@ lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -94,14 +94,14 @@ lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -109,13 +109,13 @@ lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_sgghd3( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -124,20 +124,20 @@ lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -146,11 +146,11 @@ lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgghrd.c b/LAPACKE/src/lapacke_sgghrd.c index 7f09e4e6e0..469942c675 100644 --- a/LAPACKE/src/lapacke_sgghrd.c +++ b/LAPACKE/src/lapacke_sgghrd.c @@ -32,36 +32,36 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgghrd( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_sgghrd)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, float* z, lapack_int ldz ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgghrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif - return LAPACKE_sgghrd_work( matrix_layout, compq, compz, n, ilo, ihi, a, lda, + return API_SUFFIX(LAPACKE_sgghrd_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz ); } diff --git a/LAPACKE/src/lapacke_sgghrd_work.c b/LAPACKE/src/lapacke_sgghrd_work.c index d770b5d6fe..608e8aa962 100644 --- a/LAPACKE/src/lapacke_sgghrd_work.c +++ b/LAPACKE/src/lapacke_sgghrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_sgghrd_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, @@ -58,22 +58,22 @@ lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,14 +87,14 @@ lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -102,13 +102,13 @@ lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_sgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -117,20 +117,20 @@ lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -139,11 +139,11 @@ lapack_int LAPACKE_sgghrd_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgghrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgglse.c b/LAPACKE/src/lapacke_sgglse.c index df26412536..e854f4fc53 100644 --- a/LAPACKE/src/lapacke_sgglse.c +++ b/LAPACKE/src/lapacke_sgglse.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgglse( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgglse)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, float* a, lapack_int lda, float* b, lapack_int ldb, float* c, float* d, float* x ) { @@ -41,28 +41,28 @@ lapack_int LAPACKE_sgglse( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgglse", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( m, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( m, c, 1 ) ) { return -9; } - if( LAPACKE_s_nancheck( p, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( p, d, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_sgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sgglse( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_sgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgglse", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgglse_work.c b/LAPACKE/src/lapacke_sgglse_work.c index ed7322af93..72bd76b516 100644 --- a/LAPACKE/src/lapacke_sgglse_work.c +++ b/LAPACKE/src/lapacke_sgglse_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgglse_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgglse_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, float* a, lapack_int lda, float* b, lapack_int ldb, float* c, float* d, float* x, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sgglse_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sgglse_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_sgglse_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgglse_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggqrf.c b/LAPACKE/src/lapacke_sggqrf.c index 1a0136379d..39fdad6444 100644 --- a/LAPACKE/src/lapacke_sggqrf.c +++ b/LAPACKE/src/lapacke_sggqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggqrf( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sggqrf)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, float* a, lapack_int lda, float* taua, float* b, lapack_int ldb, float* taub ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sggqrf( int matrix_layout, lapack_int n, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_sggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sggqrf( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_sggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggqrf_work.c b/LAPACKE/src/lapacke_sggqrf_work.c index d15cee195f..c37171e156 100644 --- a/LAPACKE/src/lapacke_sggqrf_work.c +++ b/LAPACKE/src/lapacke_sggqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggqrf_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sggqrf_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, float* a, lapack_int lda, float* taua, float* b, lapack_int ldb, float* taub, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sggqrf_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf_work", info ); return info; } if( ldb < p ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sggqrf_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_sggqrf_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggrqf.c b/LAPACKE/src/lapacke_sggrqf.c index b3a20202ff..f35c499096 100644 --- a/LAPACKE/src/lapacke_sggrqf.c +++ b/LAPACKE/src/lapacke_sggrqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggrqf( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_sggrqf)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* taua, float* b, lapack_int ldb, float* taub ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sggrqf( int matrix_layout, lapack_int m, lapack_int p, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggrqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_sggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sggrqf( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_sggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggrqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggrqf_work.c b/LAPACKE/src/lapacke_sggrqf_work.c index d151c93db7..2b357745c6 100644 --- a/LAPACKE/src/lapacke_sggrqf_work.c +++ b/LAPACKE/src/lapacke_sggrqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggrqf_work( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_sggrqf_work)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* taua, float* b, lapack_int ldb, float* taub, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_sggrqf_work( int matrix_layout, lapack_int m, lapack_int p, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_sggrqf_work( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_sggrqf_work( int matrix_layout, lapack_int m, lapack_int p, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggrqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvd.c b/LAPACKE/src/lapacke_sggsvd.c index e416c85394..3156bfee22 100644 --- a/LAPACKE/src/lapacke_sggsvd.c +++ b/LAPACKE/src/lapacke_sggsvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvd( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_sggsvd)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, float* a, lapack_int lda, float* b, lapack_int ldb, @@ -43,16 +43,16 @@ lapack_int LAPACKE_sggsvd( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } @@ -64,14 +64,14 @@ lapack_int LAPACKE_sggsvd( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggsvd_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_sggsvd_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvd3.c b/LAPACKE/src/lapacke_sggsvd3.c index e602ed1b91..39304d287d 100644 --- a/LAPACKE/src/lapacke_sggsvd3.c +++ b/LAPACKE/src/lapacke_sggsvd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvd3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_sggsvd3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, float* a, lapack_int lda, float* b, lapack_int ldb, @@ -45,22 +45,22 @@ lapack_int LAPACKE_sggsvd3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } #endif /* Query optimal working array(s) size if requested */ - info = LAPACKE_sggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, + info = API_SUFFIX(LAPACKE_sggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, &work_query, lwork, iwork ); if( info != 0 ) @@ -73,14 +73,14 @@ lapack_int LAPACKE_sggsvd3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_sggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, lwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvd3_work.c b/LAPACKE/src/lapacke_sggsvd3_work.c index aec1f1eac5..63026e5b04 100644 --- a/LAPACKE/src/lapacke_sggsvd3_work.c +++ b/LAPACKE/src/lapacke_sggsvd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_sggsvd3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, float* a, lapack_int lda, float* b, @@ -65,27 +65,27 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -107,21 +107,21 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -129,8 +129,8 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -139,27 +139,27 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -168,11 +168,11 @@ lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvd_work.c b/LAPACKE/src/lapacke_sggsvd_work.c index b5805bb4d3..353bef114d 100644 --- a/LAPACKE/src/lapacke_sggsvd_work.c +++ b/LAPACKE/src/lapacke_sggsvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_sggsvd_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, float* a, lapack_int lda, float* b, @@ -64,27 +64,27 @@ lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,21 +98,21 @@ lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -120,8 +120,8 @@ lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggsvd( &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, @@ -130,27 +130,27 @@ lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_sggsvd_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvp.c b/LAPACKE/src/lapacke_sggsvp.c index a5607a139f..e85f15042d 100644 --- a/LAPACKE/src/lapacke_sggsvp.c +++ b/LAPACKE/src/lapacke_sggsvp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_sggsvp)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, float tolb, lapack_int* k, lapack_int* l, float* u, @@ -44,22 +44,22 @@ lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, float* tau = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -13; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_sggsvp_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_sggsvp_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, work ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvp3.c b/LAPACKE/src/lapacke_sggsvp3.c index 475b57dd67..90a8a6ee7f 100644 --- a/LAPACKE/src/lapacke_sggsvp3.c +++ b/LAPACKE/src/lapacke_sggsvp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_sggsvp3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, float tolb, lapack_int* k, lapack_int* l, float* u, @@ -46,28 +46,28 @@ lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -13; } } #endif /* Query optimal size for working array */ - info = LAPACKE_sggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + info = API_SUFFIX(LAPACKE_sggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, &work_query, lwork ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_sggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_sggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, tau, work, lwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvp3_work.c b/LAPACKE/src/lapacke_sggsvp3_work.c index 97707ede1e..49b1b79416 100644 --- a/LAPACKE/src/lapacke_sggsvp3_work.c +++ b/LAPACKE/src/lapacke_sggsvp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_sggsvp3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, @@ -65,27 +65,27 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -107,21 +107,21 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -129,8 +129,8 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -139,27 +139,27 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -168,11 +168,11 @@ lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sggsvp_work.c b/LAPACKE/src/lapacke_sggsvp_work.c index 1fcde307bf..3c0f740154 100644 --- a/LAPACKE/src/lapacke_sggsvp_work.c +++ b/LAPACKE/src/lapacke_sggsvp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_sggsvp_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, @@ -64,27 +64,27 @@ lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); return info; } if( ldv < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,21 +98,21 @@ lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -120,8 +120,8 @@ lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggsvp( &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, @@ -130,27 +130,27 @@ lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, m, 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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sggsvp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtcon.c b/LAPACKE/src/lapacke_sgtcon.c index d851cc857b..3bd5871c7c 100644 --- a/LAPACKE/src/lapacke_sgtcon.c +++ b/LAPACKE/src/lapacke_sgtcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl, +lapack_int API_SUFFIX(LAPACKE_sgtcon)( char norm, lapack_int n, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, float anorm, float* rcond ) { @@ -42,19 +42,19 @@ lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -8; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -3; } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-2, du2, 1 ) ) { return -6; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_sgtcon_work)( norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtcon_work.c b/LAPACKE/src/lapacke_sgtcon_work.c index 157aec3db4..5e444b8ab2 100644 --- a/LAPACKE/src/lapacke_sgtcon_work.c +++ b/LAPACKE/src/lapacke_sgtcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtcon_work( char norm, lapack_int n, const float* dl, +lapack_int API_SUFFIX(LAPACKE_sgtcon_work)( char norm, lapack_int n, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, float anorm, float* rcond, float* work, diff --git a/LAPACKE/src/lapacke_sgtrfs.c b/LAPACKE/src/lapacke_sgtrfs.c index 13bcc61e85..a1954fe670 100644 --- a/LAPACKE/src/lapacke_sgtrfs.c +++ b/LAPACKE/src/lapacke_sgtrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgtrfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, const float* dlf, const float* df, const float* duf, const float* du2, @@ -44,37 +44,37 @@ lapack_int LAPACKE_sgtrfs( int matrix_layout, char trans, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgtrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -9; } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dlf, 1 ) ) { return -8; } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-2, du2, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, duf, 1 ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_sgtrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgtrfs_work( matrix_layout, trans, n, nrhs, dl, d, du, dlf, + info = API_SUFFIX(LAPACKE_sgtrfs_work)( matrix_layout, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_sgtrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtrfs_work.c b/LAPACKE/src/lapacke_sgtrfs_work.c index ced9f2c67b..756bc52b82 100644 --- a/LAPACKE/src/lapacke_sgtrfs_work.c +++ b/LAPACKE/src/lapacke_sgtrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgtrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, const float* dlf, const float* df, @@ -58,12 +58,12 @@ lapack_int LAPACKE_sgtrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,8 +78,8 @@ lapack_int LAPACKE_sgtrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, @@ -88,18 +88,18 @@ lapack_int LAPACKE_sgtrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtsv.c b/LAPACKE/src/lapacke_sgtsv.c index 41a4408896..41f34806bc 100644 --- a/LAPACKE/src/lapacke_sgtsv.c +++ b/LAPACKE/src/lapacke_sgtsv.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sgtsv)( int matrix_layout, lapack_int n, lapack_int nrhs, float* dl, float* d, float* du, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgtsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -6; } } #endif - return LAPACKE_sgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb ); + return API_SUFFIX(LAPACKE_sgtsv_work)( matrix_layout, n, nrhs, dl, d, du, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sgtsv_work.c b/LAPACKE/src/lapacke_sgtsv_work.c index b2f8473e72..ca38061d7d 100644 --- a/LAPACKE/src/lapacke_sgtsv_work.c +++ b/LAPACKE/src/lapacke_sgtsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sgtsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, float* dl, float* d, float* du, float* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_sgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtsvx.c b/LAPACKE/src/lapacke_sgtsvx.c index 2050b62923..8335b4878a 100644 --- a/LAPACKE/src/lapacke_sgtsvx.c +++ b/LAPACKE/src/lapacke_sgtsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgtsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, float* dlf, float* df, float* duf, float* du2, lapack_int* ipiv, @@ -44,41 +44,41 @@ lapack_int LAPACKE_sgtsvx( int matrix_layout, char fact, char trans, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgtsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -14; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -10; } } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dlf, 1 ) ) { return -9; } } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-2, du2, 1 ) ) { return -12; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, duf, 1 ) ) { return -11; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_sgtsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sgtsvx_work( matrix_layout, fact, trans, n, nrhs, dl, d, du, + info = API_SUFFIX(LAPACKE_sgtsvx_work)( matrix_layout, fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_sgtsvx( int matrix_layout, char fact, char trans, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgtsvx_work.c b/LAPACKE/src/lapacke_sgtsvx_work.c index acc72ef82c..305210850c 100644 --- a/LAPACKE/src/lapacke_sgtsvx_work.c +++ b/LAPACKE/src/lapacke_sgtsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgtsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_sgtsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, float* dlf, float* df, float* duf, float* du2, @@ -58,12 +58,12 @@ lapack_int LAPACKE_sgtsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,7 +78,7 @@ lapack_int LAPACKE_sgtsvx_work( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -87,18 +87,18 @@ lapack_int LAPACKE_sgtsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgtsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sgttrf.c b/LAPACKE/src/lapacke_sgttrf.c index 17aa36e9ed..ad33ad2b53 100644 --- a/LAPACKE/src/lapacke_sgttrf.c +++ b/LAPACKE/src/lapacke_sgttrf.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgttrf( lapack_int n, float* dl, float* d, float* du, +lapack_int API_SUFFIX(LAPACKE_sgttrf)( lapack_int n, float* dl, float* d, float* du, float* du2, lapack_int* ipiv ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -4; } } #endif - return LAPACKE_sgttrf_work( n, dl, d, du, du2, ipiv ); + return API_SUFFIX(LAPACKE_sgttrf_work)( n, dl, d, du, du2, ipiv ); } diff --git a/LAPACKE/src/lapacke_sgttrf_work.c b/LAPACKE/src/lapacke_sgttrf_work.c index 0e9e573f5a..48cd98b6ff 100644 --- a/LAPACKE/src/lapacke_sgttrf_work.c +++ b/LAPACKE/src/lapacke_sgttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgttrf_work( lapack_int n, float* dl, float* d, float* du, +lapack_int API_SUFFIX(LAPACKE_sgttrf_work)( lapack_int n, float* dl, float* d, float* du, float* du2, lapack_int* ipiv ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_sgttrs.c b/LAPACKE/src/lapacke_sgttrs.c index 1f7eff2572..445605d487 100644 --- a/LAPACKE/src/lapacke_sgttrs.c +++ b/LAPACKE/src/lapacke_sgttrs.c @@ -32,35 +32,35 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgttrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgttrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sgttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-2, du2, 1 ) ) { return -8; } } #endif - return LAPACKE_sgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2, + return API_SUFFIX(LAPACKE_sgttrs_work)( matrix_layout, trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sgttrs_work.c b/LAPACKE/src/lapacke_sgttrs_work.c index 4a77cf59ff..43eb4dcb6e 100644 --- a/LAPACKE/src/lapacke_sgttrs_work.c +++ b/LAPACKE/src/lapacke_sgttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sgttrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sgttrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, @@ -52,7 +52,7 @@ lapack_int LAPACKE_sgttrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_sgttrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t, &info ); @@ -70,16 +70,16 @@ lapack_int LAPACKE_sgttrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shgeqz.c b/LAPACKE/src/lapacke_shgeqz.c index 4dbc1034e5..18d0357852 100644 --- a/LAPACKE/src/lapacke_shgeqz.c +++ b/LAPACKE/src/lapacke_shgeqz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shgeqz( int matrix_layout, char job, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_shgeqz)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* h, lapack_int ldh, float* t, lapack_int ldt, float* alphar, float* alphai, float* beta, float* q, @@ -43,32 +43,32 @@ lapack_int LAPACKE_shgeqz( int matrix_layout, char job, char compq, char compz, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_shgeqz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -8; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -15; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -10; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -17; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_shgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_shgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alphar, alphai, beta, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -82,14 +82,14 @@ lapack_int LAPACKE_shgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_shgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_shgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alphar, alphai, beta, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shgeqz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shgeqz_work.c b/LAPACKE/src/lapacke_shgeqz_work.c index a0f67bc245..069523ed3f 100644 --- a/LAPACKE/src/lapacke_shgeqz_work.c +++ b/LAPACKE/src/lapacke_shgeqz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_shgeqz_work)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* h, lapack_int ldh, float* t, lapack_int ldt, float* alphar, @@ -61,22 +61,22 @@ lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldh < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); return info; } if( ldq < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); return info; } if( ldz < n ) { info = -18; - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -97,14 +97,14 @@ lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -112,13 +112,13 @@ lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - LAPACKE_sge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_shgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t, @@ -128,20 +128,20 @@ lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_shgeqz_work( int matrix_layout, char job, char compq, LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_shgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shgeqz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shsein.c b/LAPACKE/src/lapacke_shsein.c index 6b4fd25718..ee1852debd 100644 --- a/LAPACKE/src/lapacke_shsein.c +++ b/LAPACKE/src/lapacke_shsein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shsein( int matrix_layout, char job, char eigsrc, char initv, +lapack_int API_SUFFIX(LAPACKE_shsein)( int matrix_layout, char job, char eigsrc, char initv, lapack_logical* select, lapack_int n, const float* h, lapack_int ldh, float* wr, const float* wi, float* vl, lapack_int ldvl, float* vr, @@ -42,29 +42,29 @@ lapack_int LAPACKE_shsein( int matrix_layout, char job, char eigsrc, char initv, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_shsein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -11; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -13; } } - if( LAPACKE_s_nancheck( n, wi, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, wi, 1 ) ) { return -10; } - if( LAPACKE_s_nancheck( n, wr, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, wr, 1 ) ) { return -9; } } @@ -76,14 +76,14 @@ lapack_int LAPACKE_shsein( int matrix_layout, char job, char eigsrc, char initv, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_shsein_work( matrix_layout, job, eigsrc, initv, select, n, h, + info = API_SUFFIX(LAPACKE_shsein_work)( matrix_layout, job, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shsein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shsein_work.c b/LAPACKE/src/lapacke_shsein_work.c index 80db160dfd..e2db05fc65 100644 --- a/LAPACKE/src/lapacke_shsein_work.c +++ b/LAPACKE/src/lapacke_shsein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shsein_work( int matrix_layout, char job, char eigsrc, +lapack_int API_SUFFIX(LAPACKE_shsein_work)( int matrix_layout, char job, char eigsrc, char initv, lapack_logical* select, lapack_int n, const float* h, lapack_int ldh, float* wr, const float* wi, float* vl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_shsein_work( int matrix_layout, char job, char eigsrc, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_shsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein_work", info ); return info; } if( ldvl < mm ) { info = -12; - LAPACKE_xerbla( "LAPACKE_shsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein_work", info ); return info; } if( ldvr < mm ) { info = -14; - LAPACKE_xerbla( "LAPACKE_shsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,14 +77,14 @@ lapack_int LAPACKE_shsein_work( int matrix_layout, char job, char eigsrc, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -92,14 +92,14 @@ lapack_int LAPACKE_shsein_work( int matrix_layout, char job, char eigsrc, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'l' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'r' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_shsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, wr, wi, @@ -109,31 +109,31 @@ lapack_int LAPACKE_shsein_work( int matrix_layout, char job, char eigsrc, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_shsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shsein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shseqr.c b/LAPACKE/src/lapacke_shseqr.c index 45c1b19073..8bf042c6b9 100644 --- a/LAPACKE/src/lapacke_shseqr.c +++ b/LAPACKE/src/lapacke_shseqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shseqr( int matrix_layout, char job, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_shseqr)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* h, lapack_int ldh, float* wr, float* wi, float* z, lapack_int ldz ) @@ -42,24 +42,24 @@ lapack_int LAPACKE_shseqr( int matrix_layout, char job, char compz, lapack_int n float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_shseqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_shseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_shseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_shseqr( int matrix_layout, char job, char compz, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_shseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_shseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shseqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_shseqr_work.c b/LAPACKE/src/lapacke_shseqr_work.c index 8e964b2732..66d6acfce0 100644 --- a/LAPACKE/src/lapacke_shseqr_work.c +++ b/LAPACKE/src/lapacke_shseqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_shseqr_work( int matrix_layout, char job, char compz, +lapack_int API_SUFFIX(LAPACKE_shseqr_work)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* h, lapack_int ldh, float* wr, float* wi, float* z, lapack_int ldz, float* work, @@ -54,12 +54,12 @@ lapack_int LAPACKE_shseqr_work( int matrix_layout, char job, char compz, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_shseqr_work( int matrix_layout, char job, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,9 +82,9 @@ lapack_int LAPACKE_shseqr_work( int matrix_layout, char job, char compz, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, wr, wi, z_t, @@ -93,23 +93,23 @@ lapack_int LAPACKE_shseqr_work( int matrix_layout, char job, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_shseqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slacn2.c b/LAPACKE/src/lapacke_slacn2.c index 3eb1db5b1c..613223a651 100644 --- a/LAPACKE/src/lapacke_slacn2.c +++ b/LAPACKE/src/lapacke_slacn2.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slacn2( lapack_int n, float* v, float* x, lapack_int* isgn, +lapack_int API_SUFFIX(LAPACKE_slacn2)( lapack_int n, float* v, float* x, lapack_int* isgn, float* est, lapack_int* kase, lapack_int* isave ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, est, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, est, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, x, 1 ) ) { return -3; } } #endif - return LAPACKE_slacn2_work( n, v, x, isgn, est, kase, isave ); + return API_SUFFIX(LAPACKE_slacn2_work)( n, v, x, isgn, est, kase, isave ); } diff --git a/LAPACKE/src/lapacke_slacn2_work.c b/LAPACKE/src/lapacke_slacn2_work.c index aa341d7996..3434e75d19 100644 --- a/LAPACKE/src/lapacke_slacn2_work.c +++ b/LAPACKE/src/lapacke_slacn2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slacn2_work( lapack_int n, float* v, float* x, +lapack_int API_SUFFIX(LAPACKE_slacn2_work)( lapack_int n, float* v, float* x, lapack_int* isgn, float* est, lapack_int* kase, lapack_int* isave ) { diff --git a/LAPACKE/src/lapacke_slacpy.c b/LAPACKE/src/lapacke_slacpy.c index 7f6b2e8433..5fec06b49a 100644 --- a/LAPACKE/src/lapacke_slacpy.c +++ b/LAPACKE/src/lapacke_slacpy.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slacpy( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slacpy)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slacpy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slacpy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_slacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_slacpy_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_slacpy_work.c b/LAPACKE/src/lapacke_slacpy_work.c index 5f960a2922..2b4de4dfb6 100644 --- a/LAPACKE/src/lapacke_slacpy_work.c +++ b/LAPACKE/src/lapacke_slacpy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slacpy_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slacpy_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* b, lapack_int ldb ) { @@ -48,12 +48,12 @@ lapack_int LAPACKE_slacpy_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slacpy_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slacpy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,23 +68,23 @@ lapack_int LAPACKE_slacpy_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slacpy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slacpy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slag2d.c b/LAPACKE/src/lapacke_slag2d.c index 28f7ae7e06..bba691dfa8 100644 --- a/LAPACKE/src/lapacke_slag2d.c +++ b/LAPACKE/src/lapacke_slag2d.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slag2d( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slag2d)( int matrix_layout, lapack_int m, lapack_int n, const float* sa, lapack_int ldsa, double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slag2d", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slag2d", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, sa, ldsa ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, sa, ldsa ) ) { return -4; } } #endif - return LAPACKE_slag2d_work( matrix_layout, m, n, sa, ldsa, a, lda ); + return API_SUFFIX(LAPACKE_slag2d_work)( matrix_layout, m, n, sa, ldsa, a, lda ); } diff --git a/LAPACKE/src/lapacke_slag2d_work.c b/LAPACKE/src/lapacke_slag2d_work.c index 374df20ed4..90d86e5355 100644 --- a/LAPACKE/src/lapacke_slag2d_work.c +++ b/LAPACKE/src/lapacke_slag2d_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slag2d_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slag2d_work)( int matrix_layout, lapack_int m, lapack_int n, const float* sa, lapack_int ldsa, double* a, lapack_int lda ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_slag2d_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_slag2d_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slag2d_work", info ); return info; } if( ldsa < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_slag2d_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slag2d_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,25 +71,25 @@ lapack_int LAPACKE_slag2d_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, sa, ldsa, sa_t, ldsa_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, sa, ldsa, sa_t, ldsa_t ); /* Call LAPACK function and adjust info */ LAPACK_slag2d( &m, &n, sa_t, &ldsa_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( sa_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slag2d_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slag2d_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slag2d_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slag2d_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slagge.c b/LAPACKE/src/lapacke_slagge.c index 315b4a4ec6..9e73e4fb7b 100644 --- a/LAPACKE/src/lapacke_slagge.c +++ b/LAPACKE/src/lapacke_slagge.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slagge( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slagge)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* d, float* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slagge", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagge", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(m,n), d, 1 ) ) { return -6; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_slagge( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_slagge_work( matrix_layout, m, n, kl, ku, d, a, lda, iseed, + info = API_SUFFIX(LAPACKE_slagge_work)( matrix_layout, m, n, kl, ku, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slagge", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagge", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slagge_work.c b/LAPACKE/src/lapacke_slagge_work.c index 45c4324537..8339824c93 100644 --- a/LAPACKE/src/lapacke_slagge_work.c +++ b/LAPACKE/src/lapacke_slagge_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slagge_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slagge_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float* d, float* a, lapack_int lda, lapack_int* iseed, float* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_slagge_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagge_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,16 +65,16 @@ lapack_int LAPACKE_slagge_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagge_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagge_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slagsy.c b/LAPACKE/src/lapacke_slagsy.c index d2487a7dac..8a7d8151ee 100644 --- a/LAPACKE/src/lapacke_slagsy.c +++ b/LAPACKE/src/lapacke_slagsy.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slagsy( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_slagsy)( int matrix_layout, lapack_int n, lapack_int k, const float* d, float* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slagsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_slagsy( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_slagsy_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_slagsy_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slagsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slagsy_work.c b/LAPACKE/src/lapacke_slagsy_work.c index 6b2c588b33..ae6da7c773 100644 --- a/LAPACKE/src/lapacke_slagsy_work.c +++ b/LAPACKE/src/lapacke_slagsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slagsy_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_slagsy_work)( int matrix_layout, lapack_int n, lapack_int k, const float* d, float* a, lapack_int lda, lapack_int* iseed, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_slagsy_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagsy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,16 +64,16 @@ lapack_int LAPACKE_slagsy_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slagsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slamch.c b/LAPACKE/src/lapacke_slamch.c index 893525538a..35344b6513 100644 --- a/LAPACKE/src/lapacke_slamch.c +++ b/LAPACKE/src/lapacke_slamch.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slamch( char cmach ) +float API_SUFFIX(LAPACKE_slamch)( char cmach ) { - return LAPACKE_slamch_work( cmach ); + return API_SUFFIX(LAPACKE_slamch_work)( cmach ); } diff --git a/LAPACKE/src/lapacke_slamch_work.c b/LAPACKE/src/lapacke_slamch_work.c index fd115842ab..1e5064f4d4 100644 --- a/LAPACKE/src/lapacke_slamch_work.c +++ b/LAPACKE/src/lapacke_slamch_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slamch_work( char cmach ) +float API_SUFFIX(LAPACKE_slamch_work)( char cmach ) { float res; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_slangb.c b/LAPACKE/src/lapacke_slangb.c index 9ba3f30d8d..bb0bca857f 100644 --- a/LAPACKE/src/lapacke_slangb.c +++ b/LAPACKE/src/lapacke_slangb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slangb( int matrix_layout, char norm, lapack_int n, +float API_SUFFIX(LAPACKE_slangb)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab ) { @@ -40,19 +40,19 @@ float LAPACKE_slangb( int matrix_layout, char norm, lapack_int n, float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slangb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slangb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ float LAPACKE_slangb( int matrix_layout, char norm, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_slangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work ); + res = API_SUFFIX(LAPACKE_slangb_work)( matrix_layout, norm, n, kl, ku, ab, ldab, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slangb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slangb", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slangb_work.c b/LAPACKE/src/lapacke_slangb_work.c index 7ef86e9d90..a15c727ad5 100644 --- a/LAPACKE/src/lapacke_slangb_work.c +++ b/LAPACKE/src/lapacke_slangb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slangb_work( int matrix_layout, char norm, lapack_int n, +float API_SUFFIX(LAPACKE_slangb_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const float* ab, lapack_int ldab, float* work ) { @@ -47,18 +47,18 @@ float LAPACKE_slangb_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < kl+ku+1 ) { info = -7; - LAPACKE_xerbla( "LAPACKE_slangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slangb_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ float LAPACKE_slangb_work( int matrix_layout, char norm, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slangb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slangb_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slange.c b/LAPACKE/src/lapacke_slange.c index 2c4f2dbb80..ff4631ca9c 100644 --- a/LAPACKE/src/lapacke_slange.c +++ b/LAPACKE/src/lapacke_slange.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -float LAPACKE_slange( int matrix_layout, char norm, lapack_int m, +float API_SUFFIX(LAPACKE_slange)( int matrix_layout, char norm, lapack_int m, lapack_int n, const float* a, lapack_int lda ) { lapack_int info = 0; float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slange", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slange", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -59,14 +59,14 @@ float LAPACKE_slange( int matrix_layout, char norm, lapack_int m, } } /* Call middle-level interface */ - res = LAPACKE_slange_work( matrix_layout, norm, m, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_slange_work)( matrix_layout, norm, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slange", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slange", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slange_work.c b/LAPACKE/src/lapacke_slange_work.c index 6be0468e8e..42693cc9f9 100644 --- a/LAPACKE/src/lapacke_slange_work.c +++ b/LAPACKE/src/lapacke_slange_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m, +float API_SUFFIX(LAPACKE_slange_work)( int matrix_layout, char norm, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* work ) { @@ -47,18 +47,18 @@ float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slange_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slange_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slange_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slansy.c b/LAPACKE/src/lapacke_slansy.c index 4e5047cef6..71a16b60a7 100644 --- a/LAPACKE/src/lapacke_slansy.c +++ b/LAPACKE/src/lapacke_slansy.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -float LAPACKE_slansy( int matrix_layout, char norm, char uplo, lapack_int n, +float API_SUFFIX(LAPACKE_slansy)( int matrix_layout, char norm, char uplo, lapack_int n, const float* a, lapack_int lda ) { lapack_int info = 0; float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slansy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slansy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ float LAPACKE_slansy( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_slansy_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_slansy_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slansy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slansy", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slansy_work.c b/LAPACKE/src/lapacke_slansy_work.c index f74856dcb4..285e8937a3 100644 --- a/LAPACKE/src/lapacke_slansy_work.c +++ b/LAPACKE/src/lapacke_slansy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slansy_work( int matrix_layout, char norm, char uplo, +float API_SUFFIX(LAPACKE_slansy_work)( int matrix_layout, char norm, char uplo, lapack_int n, const float* a, lapack_int lda, float* work ) { @@ -50,7 +50,7 @@ float LAPACKE_slansy_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slansy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ float LAPACKE_slansy_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_slansy( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -68,11 +68,11 @@ float LAPACKE_slansy_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slansy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slansy_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slantr.c b/LAPACKE/src/lapacke_slantr.c index e2f67cfd6c..340a08df6f 100644 --- a/LAPACKE/src/lapacke_slantr.c +++ b/LAPACKE/src/lapacke_slantr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slantr( int matrix_layout, char norm, char uplo, char diag, +float API_SUFFIX(LAPACKE_slantr)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const float* a, lapack_int lda ) { @@ -40,19 +40,19 @@ float LAPACKE_slantr( int matrix_layout, char norm, char uplo, char diag, float res = 0.; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slantr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slantr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_stz_nancheck)( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,MAX(m,n)) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ float LAPACKE_slantr( int matrix_layout, char norm, char uplo, char diag, } } /* Call middle-level interface */ - res = LAPACKE_slantr_work( matrix_layout, norm, uplo, diag, m, n, a, lda, + res = API_SUFFIX(LAPACKE_slantr_work)( matrix_layout, norm, uplo, diag, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slantr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slantr", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slantr_work.c b/LAPACKE/src/lapacke_slantr_work.c index de82479615..b27dcbcfff 100644 --- a/LAPACKE/src/lapacke_slantr_work.c +++ b/LAPACKE/src/lapacke_slantr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo, +float API_SUFFIX(LAPACKE_slantr_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* work ) { @@ -48,23 +48,23 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slantr_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } - if( LAPACKE_lsame( uplo, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { uplo_lapack = 'l'; } else { uplo_lapack = 'u'; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -79,11 +79,11 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slantr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slantr_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_slapmr.c b/LAPACKE/src/lapacke_slapmr.c index 6fbbae3c92..b1f88ee2d2 100644 --- a/LAPACKE/src/lapacke_slapmr.c +++ b/LAPACKE/src/lapacke_slapmr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slapmr( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_slapmr)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, float* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slapmr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_slapmr_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_slapmr_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_slapmr_work.c b/LAPACKE/src/lapacke_slapmr_work.c index 0b0cc7995e..f7223ab45b 100644 --- a/LAPACKE/src/lapacke_slapmr_work.c +++ b/LAPACKE/src/lapacke_slapmr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slapmr_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_slapmr_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, float* x, lapack_int ldx, lapack_int* k ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_slapmr_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_slapmr_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_slapmr( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slapmt.c b/LAPACKE/src/lapacke_slapmt.c index 99358f0b23..08c8d79abc 100644 --- a/LAPACKE/src/lapacke_slapmt.c +++ b/LAPACKE/src/lapacke_slapmt.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slapmt( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_slapmt)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, float* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slapmt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_slapmt_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_slapmt_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_slapmt_work.c b/LAPACKE/src/lapacke_slapmt_work.c index c812b7b524..0342cba9fd 100644 --- a/LAPACKE/src/lapacke_slapmt_work.c +++ b/LAPACKE/src/lapacke_slapmt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slapmt_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_slapmt_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, float* x, lapack_int ldx, lapack_int* k ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_slapmt_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_slapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_slapmt_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_slapmt( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slapmt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slapy2.c b/LAPACKE/src/lapacke_slapy2.c index 2c041def9e..b5b86a5ed2 100644 --- a/LAPACKE/src/lapacke_slapy2.c +++ b/LAPACKE/src/lapacke_slapy2.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -float LAPACKE_slapy2( float x, float y ) +float API_SUFFIX(LAPACKE_slapy2)( float x, float y ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_s_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &y, 1 ) ) { return -2; } } #endif - return LAPACKE_slapy2_work( x, y ); + return API_SUFFIX(LAPACKE_slapy2_work)( x, y ); } diff --git a/LAPACKE/src/lapacke_slapy2_work.c b/LAPACKE/src/lapacke_slapy2_work.c index 2f206958a1..dd58c12dbf 100644 --- a/LAPACKE/src/lapacke_slapy2_work.c +++ b/LAPACKE/src/lapacke_slapy2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slapy2_work( float x, float y ) +float API_SUFFIX(LAPACKE_slapy2_work)( float x, float y ) { float res = 0.; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_slapy3.c b/LAPACKE/src/lapacke_slapy3.c index 3aaadc89ca..9d5bc0cd59 100644 --- a/LAPACKE/src/lapacke_slapy3.c +++ b/LAPACKE/src/lapacke_slapy3.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -float LAPACKE_slapy3( float x, float y, float z ) +float API_SUFFIX(LAPACKE_slapy3)( float x, float y, float z ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_s_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &y, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( 1, &z, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &z, 1 ) ) { return -3; } } #endif - return LAPACKE_slapy3_work( x, y, z ); + return API_SUFFIX(LAPACKE_slapy3_work)( x, y, z ); } diff --git a/LAPACKE/src/lapacke_slapy3_work.c b/LAPACKE/src/lapacke_slapy3_work.c index c0351a051b..ad97aff3a5 100644 --- a/LAPACKE/src/lapacke_slapy3_work.c +++ b/LAPACKE/src/lapacke_slapy3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -float LAPACKE_slapy3_work( float x, float y, float z ) +float API_SUFFIX(LAPACKE_slapy3_work)( float x, float y, float z ) { float res = 0.; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_slarfb.c b/LAPACKE/src/lapacke_slarfb.c index 3d6c29f882..39ba18dc1a 100644 --- a/LAPACKE/src/lapacke_slarfb.c +++ b/LAPACKE/src/lapacke_slarfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_slarfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* c, @@ -45,39 +45,39 @@ lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct lapack_logical left, col, forward; char uplo; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slarfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); uplo = ( ( forward && col ) || !( forward || col ) ) ? 'l' : 'u'; if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { - LAPACKE_xerbla( "LAPACKE_slarfb", -8 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb", -8 ); return -8; } - if( LAPACKE_stz_nancheck( matrix_layout, direct, uplo, 'u', + if( API_SUFFIX(LAPACKE_stz_nancheck)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -11; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -13; } } #endif - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { ldwork = n; - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { ldwork = m; } else { ldwork = 1; @@ -89,13 +89,13 @@ lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_slarfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_slarfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slarfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slarfb_work.c b/LAPACKE/src/lapacke_slarfb_work.c index 72a392a771..0ff23f50b4 100644 --- a/LAPACKE/src/lapacke_slarfb_work.c +++ b/LAPACKE/src/lapacke_slarfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_slarfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const float* v, lapack_int ldv, const float* t, lapack_int ldt, @@ -53,9 +53,9 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); @@ -67,22 +67,22 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); return info; } if( ldv < ncols_v ) { info = -10; - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); return info; } if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -102,16 +102,16 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_stz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, + API_SUFFIX(LAPACKE_stz_trans)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv, v_t, ldv_t ); - LAPACKE_sge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_slarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -120,11 +120,11 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slarfg.c b/LAPACKE/src/lapacke_slarfg.c index 56ed416ab8..9db0c5d821 100644 --- a/LAPACKE/src/lapacke_slarfg.c +++ b/LAPACKE/src/lapacke_slarfg.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfg( lapack_int n, float* alpha, float* x, +lapack_int API_SUFFIX(LAPACKE_slarfg)( lapack_int n, float* alpha, float* x, lapack_int incx, float* tau ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, alpha, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( n-1, x, incx ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, x, incx ) ) { return -3; } } #endif - return LAPACKE_slarfg_work( n, alpha, x, incx, tau ); + return API_SUFFIX(LAPACKE_slarfg_work)( n, alpha, x, incx, tau ); } diff --git a/LAPACKE/src/lapacke_slarfg_work.c b/LAPACKE/src/lapacke_slarfg_work.c index f824c29e77..d85b3a1149 100644 --- a/LAPACKE/src/lapacke_slarfg_work.c +++ b/LAPACKE/src/lapacke_slarfg_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfg_work( lapack_int n, float* alpha, float* x, +lapack_int API_SUFFIX(LAPACKE_slarfg_work)( lapack_int n, float* alpha, float* x, lapack_int incx, float* tau ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_slarft.c b/LAPACKE/src/lapacke_slarft.c index d9d1df3360..8aa75cb323 100644 --- a/LAPACKE/src/lapacke_slarft.c +++ b/LAPACKE/src/lapacke_slarft.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarft( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_slarft)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const float* v, lapack_int ldv, const float* tau, float* t, lapack_int ldt ) { lapack_int ncols_v, nrows_v; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slarft", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarft", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -6; } } #endif - return LAPACKE_slarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau, + return API_SUFFIX(LAPACKE_slarft_work)( matrix_layout, direct, storev, n, k, v, ldv, tau, t, ldt ); } diff --git a/LAPACKE/src/lapacke_slarft_work.c b/LAPACKE/src/lapacke_slarft_work.c index 1efb6afd9c..ea518f3358 100644 --- a/LAPACKE/src/lapacke_slarft_work.c +++ b/LAPACKE/src/lapacke_slarft_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarft_work( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_slarft_work)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const float* v, lapack_int ldv, const float* tau, float* t, lapack_int ldt ) @@ -48,21 +48,21 @@ lapack_int LAPACKE_slarft_work( int matrix_layout, char direct, char storev, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); ldt_t = MAX(1,k); ldv_t = MAX(1,nrows_v); /* Check leading dimension(s) */ if( ldt < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_slarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarft_work", info ); return info; } if( ldv < ncols_v ) { info = -7; - LAPACKE_xerbla( "LAPACKE_slarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarft_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,24 +77,24 @@ lapack_int LAPACKE_slarft_work( int matrix_layout, char direct, char storev, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_slarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t, &ldt_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarft_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarft_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slarfx.c b/LAPACKE/src/lapacke_slarfx.c index d5d61fda5c..27c0e3e10c 100644 --- a/LAPACKE/src/lapacke_slarfx.c +++ b/LAPACKE/src/lapacke_slarfx.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfx( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slarfx)( int matrix_layout, char side, lapack_int m, lapack_int n, const float* v, float tau, float* c, lapack_int ldc, float* work ) { lapack_int lv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slarfx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tau, 1 ) ) { return -6; } - lv = (LAPACKE_lsame( side, 'l' ) ? m : n); - if( LAPACKE_s_nancheck( lv, v, 1 ) ) { + lv = (API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n); + if( API_SUFFIX(LAPACKE_s_nancheck)( lv, v, 1 ) ) { return -5; } } #endif - return LAPACKE_slarfx_work( matrix_layout, side, m, n, v, tau, c, ldc, + return API_SUFFIX(LAPACKE_slarfx_work)( matrix_layout, side, m, n, v, tau, c, ldc, work ); } diff --git a/LAPACKE/src/lapacke_slarfx_work.c b/LAPACKE/src/lapacke_slarfx_work.c index cc566a3aea..0be8084dd7 100644 --- a/LAPACKE/src/lapacke_slarfx_work.c +++ b/LAPACKE/src/lapacke_slarfx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarfx_work( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slarfx_work)( int matrix_layout, char side, lapack_int m, lapack_int n, const float* v, float tau, float* c, lapack_int ldc, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_slarfx_work( int matrix_layout, char side, lapack_int m, /* Check leading dimension(s) */ if( ldc < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,21 +59,21 @@ lapack_int LAPACKE_slarfx_work( int matrix_layout, char side, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_slarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slarfx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slarnv.c b/LAPACKE/src/lapacke_slarnv.c index f86bd220c7..e0c63e2c01 100644 --- a/LAPACKE/src/lapacke_slarnv.c +++ b/LAPACKE/src/lapacke_slarnv.c @@ -32,8 +32,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarnv( lapack_int idist, lapack_int* iseed, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slarnv)( lapack_int idist, lapack_int* iseed, lapack_int n, float* x ) { - return LAPACKE_slarnv_work( idist, iseed, n, x ); + return API_SUFFIX(LAPACKE_slarnv_work)( idist, iseed, n, x ); } diff --git a/LAPACKE/src/lapacke_slarnv_work.c b/LAPACKE/src/lapacke_slarnv_work.c index 0024f7ddd9..06bac6f43b 100644 --- a/LAPACKE/src/lapacke_slarnv_work.c +++ b/LAPACKE/src/lapacke_slarnv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slarnv_work( lapack_int idist, lapack_int* iseed, +lapack_int API_SUFFIX(LAPACKE_slarnv_work)( lapack_int idist, lapack_int* iseed, lapack_int n, float* x ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_slartgp.c b/LAPACKE/src/lapacke_slartgp.c index 5e12e3f20b..455f57a30b 100644 --- a/LAPACKE/src/lapacke_slartgp.c +++ b/LAPACKE/src/lapacke_slartgp.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slartgp( float f, float g, float* cs, float* sn, float* r ) +lapack_int API_SUFFIX(LAPACKE_slartgp)( float f, float g, float* cs, float* sn, float* r ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &f, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &f, 1 ) ) { return -1; } - if( LAPACKE_s_nancheck( 1, &g, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &g, 1 ) ) { return -2; } } #endif - return LAPACKE_slartgp_work( f, g, cs, sn, r ); + return API_SUFFIX(LAPACKE_slartgp_work)( f, g, cs, sn, r ); } diff --git a/LAPACKE/src/lapacke_slartgp_work.c b/LAPACKE/src/lapacke_slartgp_work.c index 64d2be328b..57766934e0 100644 --- a/LAPACKE/src/lapacke_slartgp_work.c +++ b/LAPACKE/src/lapacke_slartgp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slartgp_work( float f, float g, float* cs, float* sn, +lapack_int API_SUFFIX(LAPACKE_slartgp_work)( float f, float g, float* cs, float* sn, float* r ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_slartgs.c b/LAPACKE/src/lapacke_slartgs.c index fc56cc442e..02cc4bdf12 100644 --- a/LAPACKE/src/lapacke_slartgs.c +++ b/LAPACKE/src/lapacke_slartgs.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slartgs( float x, float y, float sigma, float* cs, +lapack_int API_SUFFIX(LAPACKE_slartgs)( float x, float y, float sigma, float* cs, float* sn ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &sigma, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &sigma, 1 ) ) { return -3; } - if( LAPACKE_s_nancheck( 1, &x, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &x, 1 ) ) { return -1; } - if( LAPACKE_s_nancheck( 1, &y, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &y, 1 ) ) { return -2; } } #endif - return LAPACKE_slartgs_work( x, y, sigma, cs, sn ); + return API_SUFFIX(LAPACKE_slartgs_work)( x, y, sigma, cs, sn ); } diff --git a/LAPACKE/src/lapacke_slartgs_work.c b/LAPACKE/src/lapacke_slartgs_work.c index 4dc3142c8c..f495303b79 100644 --- a/LAPACKE/src/lapacke_slartgs_work.c +++ b/LAPACKE/src/lapacke_slartgs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slartgs_work( float x, float y, float sigma, float* cs, +lapack_int API_SUFFIX(LAPACKE_slartgs_work)( float x, float y, float sigma, float* cs, float* sn ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_slascl.c b/LAPACKE/src/lapacke_slascl.c index 969ba1dd7e..e85f62c63f 100644 --- a/LAPACKE/src/lapacke_slascl.c +++ b/LAPACKE/src/lapacke_slascl.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(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 lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slascl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slascl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -46,68 +46,68 @@ 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, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -9; } break; case 'L': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_sgb_nancheck)( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { return -9; } break; case 'U': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_sgb_nancheck)( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { return -9; } break; case 'H': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(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 ) ) { + if( API_SUFFIX(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 ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, 'U', n, ku, a, lda ) ) { return -9; } break; case 'Z': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { return -9; } break; } } #endif - return LAPACKE_slascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); + return API_SUFFIX(LAPACKE_slascl_work)( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_slascl_work.c b/LAPACKE/src/lapacke_slascl_work.c index ee373c6832..6449f36702 100644 --- a/LAPACKE/src/lapacke_slascl_work.c +++ b/LAPACKE/src/lapacke_slascl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_slascl_work)( 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 lda ) @@ -45,15 +45,15 @@ 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 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 nrows_a = API_SUFFIX(LAPACKE_lsame)(type, 'b') ? kl + 1 : + API_SUFFIX(LAPACKE_lsame)(type, 'q') ? ku + 1 : + API_SUFFIX(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 ) { info = -9; - LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slascl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,23 +63,23 @@ 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, nrows_a, n, a, lda, a_t, lda_t ); + API_SUFFIX(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); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slascl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slascl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slaset.c b/LAPACKE/src/lapacke_slaset.c index 031565bf5a..b109c4c6ff 100644 --- a/LAPACKE/src/lapacke_slaset.c +++ b/LAPACKE/src/lapacke_slaset.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slaset( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slaset)( int matrix_layout, char uplo, lapack_int m, lapack_int n, float alpha, float beta, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slaset", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaset", -1 ); return -1; } @@ -50,14 +50,14 @@ lapack_int LAPACKE_slaset( int matrix_layout, char uplo, lapack_int m, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &alpha, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &beta, 1 ) ) { return -6; } } #endif - return LAPACKE_slaset_work( matrix_layout, uplo, m, n, alpha, beta, a, lda ); + return API_SUFFIX(LAPACKE_slaset_work)( matrix_layout, uplo, m, n, alpha, beta, a, lda ); } diff --git a/LAPACKE/src/lapacke_slaset_work.c b/LAPACKE/src/lapacke_slaset_work.c index 38a66a14d4..c573686733 100644 --- a/LAPACKE/src/lapacke_slaset_work.c +++ b/LAPACKE/src/lapacke_slaset_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slaset_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_slaset_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, float alpha, float beta, float* a, lapack_int lda ) { @@ -46,7 +46,7 @@ lapack_int LAPACKE_slaset_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_slaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaset_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -56,21 +56,21 @@ lapack_int LAPACKE_slaset_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slaset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaset_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaset_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slasrt.c b/LAPACKE/src/lapacke_slasrt.c index 78a7509a26..618f6f996d 100644 --- a/LAPACKE/src/lapacke_slasrt.c +++ b/LAPACKE/src/lapacke_slasrt.c @@ -32,15 +32,15 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slasrt( char id, lapack_int n, float* d ) +lapack_int API_SUFFIX(LAPACKE_slasrt)( char id, lapack_int n, float* d ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -3; } } #endif - return LAPACKE_slasrt_work( id, n, d ); + return API_SUFFIX(LAPACKE_slasrt_work)( id, n, d ); } diff --git a/LAPACKE/src/lapacke_slasrt_work.c b/LAPACKE/src/lapacke_slasrt_work.c index eff9b6a519..adad429794 100644 --- a/LAPACKE/src/lapacke_slasrt_work.c +++ b/LAPACKE/src/lapacke_slasrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slasrt_work( char id, lapack_int n, float* d ) +lapack_int API_SUFFIX(LAPACKE_slasrt_work)( char id, lapack_int n, float* d ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_slassq.c b/LAPACKE/src/lapacke_slassq.c index 81330d63e4..a72cc5178e 100644 --- a/LAPACKE/src/lapacke_slassq.c +++ b/LAPACKE/src/lapacke_slassq.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slassq( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq ) +lapack_int API_SUFFIX(LAPACKE_slassq)( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */ - if( LAPACKE_s_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, x, incx ) ) { return -2; } - if( LAPACKE_s_nancheck( 1, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, scale, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, sumsq, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, sumsq, 1 ) ) { return -5; } } #endif - return LAPACKE_slassq_work( n, x, incx, scale, sumsq ); + return API_SUFFIX(LAPACKE_slassq_work)( n, x, incx, scale, sumsq ); } diff --git a/LAPACKE/src/lapacke_slassq_work.c b/LAPACKE/src/lapacke_slassq_work.c index f206ef4a01..9fbfa81f65 100644 --- a/LAPACKE/src/lapacke_slassq_work.c +++ b/LAPACKE/src/lapacke_slassq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slassq_work( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq ) +lapack_int API_SUFFIX(LAPACKE_slassq_work)( lapack_int n, float* x, lapack_int incx, float* scale, float* sumsq ) { lapack_int info = 0; LAPACK_slassq( &n, x, &incx, scale, sumsq ); diff --git a/LAPACKE/src/lapacke_slaswp.c b/LAPACKE/src/lapacke_slaswp.c index d71a2dfbf0..b9905ad1c6 100644 --- a/LAPACKE/src/lapacke_slaswp.c +++ b/LAPACKE/src/lapacke_slaswp.c @@ -32,12 +32,12 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slaswp( int matrix_layout, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_slaswp)( int matrix_layout, lapack_int n, float* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slaswp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaswp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -47,15 +47,15 @@ lapack_int LAPACKE_slaswp( int matrix_layout, lapack_int n, float* a, * Disable the check as is below, the check below was checking for NaN * from lda to n since there is no (obvious) way to knowing m. This is not * a good idea. We could get a lower bound of m by scanning from ipiv. Or - * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable + * we could pass on the NaN check to API_SUFFIX(LAPACKE_dlaswp_work). For now disable * the buggy Nan check. * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827 *****************************************************************************/ - /* if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) { + /* if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, lda, n, a, lda ) ) { * return -3; * } */ } #endif - return LAPACKE_slaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); + return API_SUFFIX(LAPACKE_slaswp_work)( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); } diff --git a/LAPACKE/src/lapacke_slaswp_work.c b/LAPACKE/src/lapacke_slaswp_work.c index 32f5c8a4f6..36ddcd3104 100644 --- a/LAPACKE/src/lapacke_slaswp_work.c +++ b/LAPACKE/src/lapacke_slaswp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_slaswp_work)( int matrix_layout, lapack_int n, float* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_slaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaswp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,21 +63,21 @@ lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaswp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slaswp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slatms.c b/LAPACKE/src/lapacke_slatms.c index 75a9198169..f7028ef07a 100644 --- a/LAPACKE/src/lapacke_slatms.c +++ b/LAPACKE/src/lapacke_slatms.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slatms( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slatms)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, float* d, lapack_int mode, float cond, float dmax, lapack_int kl, lapack_int ku, char pack, float* a, @@ -41,22 +41,22 @@ lapack_int LAPACKE_slatms( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slatms", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slatms", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -14; } - if( LAPACKE_s_nancheck( 1, &cond, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &cond, 1 ) ) { return -9; } - if( LAPACKE_s_nancheck( MIN(n,m), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(n,m), d, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &dmax, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &dmax, 1 ) ) { return -10; } } @@ -68,13 +68,13 @@ lapack_int LAPACKE_slatms( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_slatms_work( matrix_layout, m, n, dist, iseed, sym, d, mode, + info = API_SUFFIX(LAPACKE_slatms_work)( matrix_layout, m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slatms", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slatms", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slatms_work.c b/LAPACKE/src/lapacke_slatms_work.c index 8a66b8525f..42611f7277 100644 --- a/LAPACKE/src/lapacke_slatms_work.c +++ b/LAPACKE/src/lapacke_slatms_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slatms_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slatms_work)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, float* d, lapack_int mode, float cond, float dmax, lapack_int kl, lapack_int ku, @@ -53,7 +53,7 @@ lapack_int LAPACKE_slatms_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_slatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slatms_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_slatms_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a_t, &lda_t, work, &info ); @@ -71,16 +71,16 @@ lapack_int LAPACKE_slatms_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slatms_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slatms_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_slauum.c b/LAPACKE/src/lapacke_slauum.c index 841e6c05fa..5a16d4b69c 100644 --- a/LAPACKE/src/lapacke_slauum.c +++ b/LAPACKE/src/lapacke_slauum.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slauum( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_slauum)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_slauum", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slauum", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_slauum_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_slauum_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_slauum_work.c b/LAPACKE/src/lapacke_slauum_work.c index 54dae6492c..78e9ab2dba 100644 --- a/LAPACKE/src/lapacke_slauum_work.c +++ b/LAPACKE/src/lapacke_slauum_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_slauum_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_slauum_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_slauum_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_slauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slauum_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_slauum_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slauum( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_slauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slauum_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_slauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_slauum_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sopgtr.c b/LAPACKE/src/lapacke_sopgtr.c index 28a2d19585..7b26a2070c 100644 --- a/LAPACKE/src/lapacke_sopgtr.c +++ b/LAPACKE/src/lapacke_sopgtr.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sopgtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sopgtr)( int matrix_layout, char uplo, lapack_int n, const float* ap, const float* tau, float* q, lapack_int ldq ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sopgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, tau, 1 ) ) { return -5; } } @@ -60,12 +60,12 @@ lapack_int LAPACKE_sopgtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sopgtr_work( matrix_layout, uplo, n, ap, tau, q, ldq, work ); + info = API_SUFFIX(LAPACKE_sopgtr_work)( matrix_layout, uplo, n, ap, tau, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sopgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sopgtr_work.c b/LAPACKE/src/lapacke_sopgtr_work.c index c85d8827f9..be3b193a45 100644 --- a/LAPACKE/src/lapacke_sopgtr_work.c +++ b/LAPACKE/src/lapacke_sopgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sopgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sopgtr_work)( int matrix_layout, char uplo, lapack_int n, const float* ap, const float* tau, float* q, lapack_int ldq, float* work ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_sopgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldq < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopgtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_sopgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sopgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( q_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sopgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sopmtr.c b/LAPACKE/src/lapacke_sopmtr.c index b7a5517578..f51e45d867 100644 --- a/LAPACKE/src/lapacke_sopmtr.c +++ b/LAPACKE/src/lapacke_sopmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sopmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_sopmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const float* ap, const float* tau, float* c, lapack_int ldc ) { @@ -42,28 +42,28 @@ lapack_int LAPACKE_sopmtr( int matrix_layout, char side, char uplo, char trans, float* work = NULL; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sopmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_ssp_nancheck( r, ap ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_ssp_nancheck)( r, ap ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -9; } - if( LAPACKE_s_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( r-1, tau, 1 ) ) { return -8; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { lwork = MAX(1,n); - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { lwork = MAX(1,m); } else { lwork = 1; /* Any value */ @@ -75,13 +75,13 @@ lapack_int LAPACKE_sopmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sopmtr_work( matrix_layout, side, uplo, trans, m, n, ap, tau, + info = API_SUFFIX(LAPACKE_sopmtr_work)( matrix_layout, side, uplo, trans, m, n, ap, tau, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sopmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sopmtr_work.c b/LAPACKE/src/lapacke_sopmtr_work.c index 5b7db0c71e..10e7792010 100644 --- a/LAPACKE/src/lapacke_sopmtr_work.c +++ b/LAPACKE/src/lapacke_sopmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sopmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_sopmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const float* ap, const float* tau, float* c, lapack_int ldc, float* work ) @@ -49,12 +49,12 @@ lapack_int LAPACKE_sopmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( ldc < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopmtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,8 +70,8 @@ lapack_int LAPACKE_sopmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, r, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, r, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sopmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t, work, &info ); @@ -79,18 +79,18 @@ lapack_int LAPACKE_sopmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sopmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sopmtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorbdb.c b/LAPACKE/src/lapacke_sorbdb.c index 7f652c2c2f..67975b658e 100644 --- a/LAPACKE/src/lapacke_sorbdb.c +++ b/LAPACKE/src/lapacke_sorbdb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorbdb( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_sorbdb)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, float* x12, lapack_int ldx12, float* x21, lapack_int ldx21, float* x22, @@ -46,10 +46,10 @@ lapack_int LAPACKE_sorbdb( int matrix_layout, char trans, char signs, float work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorbdb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorbdb", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -57,22 +57,22 @@ lapack_int LAPACKE_sorbdb( int matrix_layout, char trans, char signs, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -7; } - if( LAPACKE_sge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -9; } - if( LAPACKE_sge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -11; } - if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -13; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_sorbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, &work_query, lwork ); @@ -87,14 +87,14 @@ lapack_int LAPACKE_sorbdb( int matrix_layout, char trans, char signs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_sorbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorbdb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorbdb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorbdb_work.c b/LAPACKE/src/lapacke_sorbdb_work.c index 9ca4e0b592..b7f6f98d3b 100644 --- a/LAPACKE/src/lapacke_sorbdb_work.c +++ b/LAPACKE/src/lapacke_sorbdb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorbdb_work( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_sorbdb_work)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, float* x12, lapack_int ldx12, float* x21, lapack_int ldx21, @@ -59,7 +59,7 @@ lapack_int LAPACKE_sorbdb_work( int matrix_layout, char trans, char signs, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -73,7 +73,7 @@ lapack_int LAPACKE_sorbdb_work( int matrix_layout, char trans, char signs, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorbdb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorbdb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorcsd.c b/LAPACKE/src/lapacke_sorcsd.c index 90e94ba94b..c104d138c3 100644 --- a/LAPACKE/src/lapacke_sorcsd.c +++ b/LAPACKE/src/lapacke_sorcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sorcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, float* x12, lapack_int ldx12, @@ -49,10 +49,10 @@ lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, float work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -60,16 +60,16 @@ lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -11; } - if( LAPACKE_sge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -13; } - if( LAPACKE_sge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -15; } - if( LAPACKE_sge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -17; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_sorcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_sorcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, &work_query, @@ -97,7 +97,7 @@ lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sorcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_sorcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork, @@ -108,7 +108,7 @@ lapack_int LAPACKE_sorcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorcsd2by1.c b/LAPACKE/src/lapacke_sorcsd2by1.c index c1af8e874b..48854aba20 100644 --- a/LAPACKE/src/lapacke_sorcsd2by1.c +++ b/LAPACKE/src/lapacke_sorcsd2by1.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sorcsd2by1)( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, float* x21, lapack_int ldx21, float* theta, float* u1, lapack_int ldu1, float* u2, @@ -45,7 +45,7 @@ lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, float work_query; lapack_int nrows_x11, nrows_x21; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorcsd2by1", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -53,11 +53,11 @@ lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, /* Optionally check input matrices for NaNs */ nrows_x11 = p; nrows_x21 = m-p; - if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_sorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_sorcsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, &work_query, lwork, iwork ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_sorcsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, iwork ); /* Release memory and exit */ @@ -93,7 +93,7 @@ lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorcsd2by1", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorcsd2by1_work.c b/LAPACKE/src/lapacke_sorcsd2by1_work.c index d9d70ec43d..b12fd3511e 100644 --- a/LAPACKE/src/lapacke_sorcsd2by1_work.c +++ b/LAPACKE/src/lapacke_sorcsd2by1_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sorcsd2by1_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, float* x21, lapack_int ldx21, @@ -54,9 +54,9 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_x11 = p; lapack_int nrows_x21 = m-p; - lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); - lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); - lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int nrows_u1 = ( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ? q : 1); lapack_int ldu1_t = MAX(1,nrows_u1); lapack_int ldu2_t = MAX(1,nrows_u2); lapack_int ldv1t_t = MAX(1,nrows_v1t); @@ -70,27 +70,27 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Check leading dimension(s) */ if( ldu1 < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); return info; } if( ldu2 < m-p ) { info = -23; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); return info; } if( ldv1t < q ) { info = -25; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); return info; } if( ldx11 < q ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); return info; } if( ldx21 < q ) { info = -16; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -112,7 +112,7 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { u1_t = (float*) LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) ); if( u1_t == NULL ) { @@ -120,7 +120,7 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { u2_t = (float*) LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) ); if( u2_t == NULL ) { @@ -128,7 +128,7 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_3; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { v1t_t = (float*) LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) ); if( v1t_t == NULL ) { @@ -137,9 +137,9 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, ldx11_t ); - LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, @@ -150,32 +150,32 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, ldx11 ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, ldx21 ); - if( LAPACKE_lsame( jobu1, 'y' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, ldu1 ); } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, u2, ldu2 ); } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, v1t, ldv1t ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { LAPACKE_free( v1t_t ); } exit_level_4: - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { LAPACKE_free( u2_t ); } exit_level_3: - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { LAPACKE_free( u1_t ); } exit_level_2: @@ -184,11 +184,11 @@ lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( x11_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd2by1_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorcsd_work.c b/LAPACKE/src/lapacke_sorcsd_work.c index 31c957e841..ea21049305 100644 --- a/LAPACKE/src/lapacke_sorcsd_work.c +++ b/LAPACKE/src/lapacke_sorcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_sorcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, float* x11, lapack_int ldx11, @@ -62,7 +62,7 @@ lapack_int LAPACKE_sorcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -77,7 +77,7 @@ lapack_int LAPACKE_sorcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgbr.c b/LAPACKE/src/lapacke_sorgbr.c index 8cb51dbe11..cd1bfc54c8 100644 --- a/LAPACKE/src/lapacke_sorgbr.c +++ b/LAPACKE/src/lapacke_sorgbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgbr( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sorgbr)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorgbr( int matrix_layout, char vect, lapack_int m, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( MIN(m,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(m,k), tau, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgbr_work( matrix_layout, vect, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sorgbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorgbr( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgbr_work( matrix_layout, vect, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorgbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgbr_work.c b/LAPACKE/src/lapacke_sorgbr_work.c index 2788efe69d..1ac7956c9c 100644 --- a/LAPACKE/src/lapacke_sorgbr_work.c +++ b/LAPACKE/src/lapacke_sorgbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgbr_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_sorgbr_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorgbr_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_sorgbr_work( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); @@ -74,16 +74,16 @@ lapack_int LAPACKE_sorgbr_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorghr.c b/LAPACKE/src/lapacke_sorghr.c index c1a267ee35..0c07df3532 100644 --- a/LAPACKE/src/lapacke_sorghr.c +++ b/LAPACKE/src/lapacke_sorghr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorghr( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_sorghr)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorghr( int matrix_layout, lapack_int n, lapack_int ilo, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorghr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorghr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_sorghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorghr( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorghr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorghr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorghr_work.c b/LAPACKE/src/lapacke_sorghr_work.c index 949f28bb2b..f6f1d6e2de 100644 --- a/LAPACKE/src/lapacke_sorghr_work.c +++ b/LAPACKE/src/lapacke_sorghr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_sorghr_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorghr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_sorghr_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorghr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorghr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorglq.c b/LAPACKE/src/lapacke_sorglq.c index e902c2b74a..1154f4ac64 100644 --- a/LAPACKE/src/lapacke_sorglq.c +++ b/LAPACKE/src/lapacke_sorglq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorglq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorglq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorglq( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorglq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorglq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorglq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sorglq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorglq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorglq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorglq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorglq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorglq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorglq_work.c b/LAPACKE/src/lapacke_sorglq_work.c index bb8045093a..351c06c279 100644 --- a/LAPACKE/src/lapacke_sorglq_work.c +++ b/LAPACKE/src/lapacke_sorglq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorglq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorglq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorglq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorglq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sorglq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorglq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorglq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgql.c b/LAPACKE/src/lapacke_sorgql.c index f8855ed904..ec5c11c284 100644 --- a/LAPACKE/src/lapacke_sorgql.c +++ b/LAPACKE/src/lapacke_sorgql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgql( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgql)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorgql( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgql_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sorgql_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorgql( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgql_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorgql_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgql_work.c b/LAPACKE/src/lapacke_sorgql_work.c index 7f7fddcdb9..2a312f34d0 100644 --- a/LAPACKE/src/lapacke_sorgql_work.c +++ b/LAPACKE/src/lapacke_sorgql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgql_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgql_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorgql_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sorgql_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgqr.c b/LAPACKE/src/lapacke_sorgqr.c index 1e6688c344..d05430943c 100644 --- a/LAPACKE/src/lapacke_sorgqr.c +++ b/LAPACKE/src/lapacke_sorgqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorgqr( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgqr_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sorgqr_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorgqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgqr_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorgqr_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgqr_work.c b/LAPACKE/src/lapacke_sorgqr_work.c index 4407ec8877..1c191f76ed 100644 --- a/LAPACKE/src/lapacke_sorgqr_work.c +++ b/LAPACKE/src/lapacke_sorgqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorgqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sorgqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgrq.c b/LAPACKE/src/lapacke_sorgrq.c index 51cabe03a0..c1310e3678 100644 --- a/LAPACKE/src/lapacke_sorgrq.c +++ b/LAPACKE/src/lapacke_sorgrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgrq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgrq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_sorgrq( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgrq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sorgrq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_sorgrq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgrq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorgrq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgrq_work.c b/LAPACKE/src/lapacke_sorgrq_work.c index 290a50f84e..baf0c81e1f 100644 --- a/LAPACKE/src/lapacke_sorgrq_work.c +++ b/LAPACKE/src/lapacke_sorgrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgrq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgrq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_sorgrq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_sorgrq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgtr.c b/LAPACKE/src/lapacke_sorgtr.c index c79b66fe47..bc7a9ebaaa 100644 --- a/LAPACKE/src/lapacke_sorgtr.c +++ b/LAPACKE/src/lapacke_sorgtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgtr( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_sorgtr)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const float* tau ) { lapack_int info = 0; @@ -40,22 +40,22 @@ lapack_int LAPACKE_sorgtr( int matrix_layout, char uplo, lapack_int n, float* a, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, tau, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgtr_work( matrix_layout, uplo, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_sorgtr_work)( matrix_layout, uplo, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_sorgtr( int matrix_layout, char uplo, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgtr_work( matrix_layout, uplo, n, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_sorgtr_work)( matrix_layout, uplo, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgtr_work.c b/LAPACKE/src/lapacke_sorgtr_work.c index 0a93eefa9c..ee8b9858a5 100644 --- a/LAPACKE/src/lapacke_sorgtr_work.c +++ b/LAPACKE/src/lapacke_sorgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgtr_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_sorgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_sorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_sorgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sorgtsqr_row.c b/LAPACKE/src/lapacke_sorgtsqr_row.c index 350783a78f..555765b10e 100644 --- a/LAPACKE/src/lapacke_sorgtsqr_row.c +++ b/LAPACKE/src/lapacke_sorgtsqr_row.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgtsqr_row)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, float* a, lapack_int lda, const float* t, lapack_int ldt ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_sorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, nb, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nb, n, t, ldt ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sorgtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_sorgtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_sorgtsqr_row( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sorgtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_sorgtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_sorgtsqr_row_work.c b/LAPACKE/src/lapacke_sorgtsqr_row_work.c index a66f70b526..67a0198ab9 100644 --- a/LAPACKE/src/lapacke_sorgtsqr_row_work.c +++ b/LAPACKE/src/lapacke_sorgtsqr_row_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorgtsqr_row_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, float* a, lapack_int lda, const float* t, lapack_int ldt, @@ -52,7 +52,7 @@ lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row_work", info ); return info; } lapack_int ldt_t = MAX(1,nb); @@ -60,7 +60,7 @@ lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, nb, n, a, lda, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, nb, n, a, lda, t_t, ldt_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgtsqr_row( &m, &n, &mb, &nb, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_sorgtsqr_row_work( int matrix_layout, lapack_int m, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorgtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorgtsqr_row_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_sorhr_col.c b/LAPACKE/src/lapacke_sorhr_col.c index 60e6e79515..372bd59712 100644 --- a/LAPACKE/src/lapacke_sorhr_col.c +++ b/LAPACKE/src/lapacke_sorhr_col.c @@ -1,24 +1,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorhr_col( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorhr_col)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, float* a, lapack_int lda, float* t, lapack_int ldt, float* d) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sorhr_col", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorhr_col", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - info = LAPACKE_sorhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d ); + info = API_SUFFIX(LAPACKE_sorhr_col_work)( matrix_layout, m, n, nb, a, lda, t, ldt, d ); return info; } diff --git a/LAPACKE/src/lapacke_sorhr_col_work.c b/LAPACKE/src/lapacke_sorhr_col_work.c index 56d6a965e3..0d3d6387f6 100644 --- a/LAPACKE/src/lapacke_sorhr_col_work.c +++ b/LAPACKE/src/lapacke_sorhr_col_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sorhr_col_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, float* a, lapack_int lda, float* t, lapack_int ldt, float* d ) @@ -20,12 +20,12 @@ lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorhr_col_work", info ); return info; } if( ldt < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorhr_col_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -43,15 +43,15 @@ lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -59,11 +59,11 @@ lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorhr_col_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sorhr_col_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormbr.c b/LAPACKE/src/lapacke_sormbr.c index cac61a6d5d..e962a668da 100644 --- a/LAPACKE/src/lapacke_sormbr.c +++ b/LAPACKE/src/lapacke_sormbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormbr( int matrix_layout, char vect, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormbr)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -43,28 +43,28 @@ lapack_int LAPACKE_sormbr( int matrix_layout, char vect, char side, char trans, float work_query; lapack_int nq, ar, ac; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nq = LAPACKE_lsame( side, 'l' ) ? m : n; - ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq; - if( LAPACKE_sge_nancheck( matrix_layout, ar, ac, a, lda ) ) { + nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + ar = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + ac = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? MIN(nq,k) : nq; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, ar, ac, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_s_nancheck( MIN(nq,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( MIN(nq,k), tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_sormbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_sormbr( int matrix_layout, char vect, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_sormbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormbr_work.c b/LAPACKE/src/lapacke_sormbr_work.c index 9d78a45800..e40a291eb2 100644 --- a/LAPACKE/src/lapacke_sormbr_work.c +++ b/LAPACKE/src/lapacke_sormbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, +lapack_int API_SUFFIX(LAPACKE_sormbr_work)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -47,9 +47,9 @@ lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int ar = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - lapack_int ac = LAPACKE_lsame( vect, 'q' ) ? MIN(nq,k) : nq; + lapack_int nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + lapack_int ar = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + lapack_int ac = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? MIN(nq,k) : nq; lapack_int lda_t = MAX(1,ar); lapack_int ldc_t = MAX(1,m); float *a_t = NULL; @@ -57,12 +57,12 @@ lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, /* Check leading dimension(s) */ if( lda < ac ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, ar, ac, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, ar, ac, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormhr.c b/LAPACKE/src/lapacke_sormhr.c index 99c635dc2e..54aab7bc72 100644 --- a/LAPACKE/src/lapacke_sormhr.c +++ b/LAPACKE/src/lapacke_sormhr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormhr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormhr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_sormhr( int matrix_layout, char side, char trans, float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormhr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_sge_nancheck( matrix_layout, r, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, r, r, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_s_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( r-1, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_sormhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sormhr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_sormhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormhr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormhr_work.c b/LAPACKE/src/lapacke_sormhr_work.c index 754aa7bb8a..3025dc610a 100644 --- a/LAPACKE/src/lapacke_sormhr_work.c +++ b/LAPACKE/src/lapacke_sormhr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormhr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormhr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_sormhr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_sormhr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_sormhr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormhr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormlq.c b/LAPACKE/src/lapacke_sormlq.c index 1eac482a2e..4e0568a750 100644 --- a/LAPACKE/src/lapacke_sormlq.c +++ b/LAPACKE/src/lapacke_sormlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -42,26 +42,26 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) { + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, r, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormlq_work.c b/LAPACKE/src/lapacke_sormlq_work.c index 9058f5bb63..03ea0f95d4 100644 --- a/LAPACKE/src/lapacke_sormlq_work.c +++ b/LAPACKE/src/lapacke_sormlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -47,7 +47,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,k); lapack_int ldc_t = MAX(1,m); float *a_t = NULL; @@ -55,12 +55,12 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, k, r, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -90,18 +90,18 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormql.c b/LAPACKE/src/lapacke_sormql.c index bbc7634eb8..df14532008 100644 --- a/LAPACKE/src/lapacke_sormql.c +++ b/LAPACKE/src/lapacke_sormql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormql( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormql)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_sormql( int matrix_layout, char side, char trans, float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sormql( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormql_work.c b/LAPACKE/src/lapacke_sormql_work.c index 1f399c755b..e22342fbc4 100644 --- a/LAPACKE/src/lapacke_sormql_work.c +++ b/LAPACKE/src/lapacke_sormql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormql_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormql_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_sormql_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_sormql_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_sormql_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormqr.c b/LAPACKE/src/lapacke_sormqr.c index 9fd7b2a149..28b1d65e4b 100644 --- a/LAPACKE/src/lapacke_sormqr.c +++ b/LAPACKE/src/lapacke_sormqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_sormqr( int matrix_layout, char side, char trans, float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sormqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormqr_work.c b/LAPACKE/src/lapacke_sormqr_work.c index 1cb7875812..973f90711f 100644 --- a/LAPACKE/src/lapacke_sormqr_work.c +++ b/LAPACKE/src/lapacke_sormqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -50,18 +50,18 @@ lapack_int LAPACKE_sormqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_sormqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_sormqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormrq.c b/LAPACKE/src/lapacke_sormrq.c index 5570c0bb0a..b9b1124672 100644 --- a/LAPACKE/src/lapacke_sormrq.c +++ b/LAPACKE/src/lapacke_sormrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormrq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormrq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_sormrq( int matrix_layout, char side, char trans, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_sormrq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_sormrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormrq_work.c b/LAPACKE/src/lapacke_sormrq_work.c index d773f32b08..e7bc80558e 100644 --- a/LAPACKE/src/lapacke_sormrq_work.c +++ b/LAPACKE/src/lapacke_sormrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormrq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormrq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sormrq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_sormrq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_sormrq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormrz.c b/LAPACKE/src/lapacke_sormrz.c index d6f7f0182d..d70f764a4a 100644 --- a/LAPACKE/src/lapacke_sormrz.c +++ b/LAPACKE/src/lapacke_sormrz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormrz( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormrz)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_sormrz( int matrix_layout, char side, char trans, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormrz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_s_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( k, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_sormrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -73,13 +73,13 @@ lapack_int LAPACKE_sormrz( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_sormrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormrz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormrz_work.c b/LAPACKE/src/lapacke_sormrz_work.c index 885138a448..4860ac89d9 100644 --- a/LAPACKE/src/lapacke_sormrz_work.c +++ b/LAPACKE/src/lapacke_sormrz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormrz_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_sormrz_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sormrz_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_sormrz_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_sormrz_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormrz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormtr.c b/LAPACKE/src/lapacke_sormtr.c index 171cc4fc3d..5552b9a95f 100644 --- a/LAPACKE/src/lapacke_sormtr.c +++ b/LAPACKE/src/lapacke_sormtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_sormtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc ) @@ -43,26 +43,26 @@ lapack_int LAPACKE_sormtr( int matrix_layout, char side, char uplo, char trans, float work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sormtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, r, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_s_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( r-1, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sormtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_sormtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_sormtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sormtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_sormtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sormtr_work.c b/LAPACKE/src/lapacke_sormtr_work.c index ba82ebdaf3..c7238a1a1c 100644 --- a/LAPACKE/src/lapacke_sormtr_work.c +++ b/LAPACKE/src/lapacke_sormtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sormtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_sormtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, @@ -49,18 +49,18 @@ lapack_int LAPACKE_sormtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,8 +81,8 @@ lapack_int LAPACKE_sormtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -90,18 +90,18 @@ lapack_int LAPACKE_sormtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sormtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sormtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbcon.c b/LAPACKE/src/lapacke_spbcon.c index aff83c5225..0b474da193 100644 --- a/LAPACKE/src/lapacke_spbcon.c +++ b/LAPACKE/src/lapacke_spbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbcon)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_spbcon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_spbcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_spbcon_work( matrix_layout, uplo, n, kd, ab, ldab, anorm, + info = API_SUFFIX(LAPACKE_spbcon_work)( matrix_layout, uplo, n, kd, ab, ldab, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_spbcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbcon_work.c b/LAPACKE/src/lapacke_spbcon_work.c index 7db74b4761..48f0db9f4a 100644 --- a/LAPACKE/src/lapacke_spbcon_work.c +++ b/LAPACKE/src/lapacke_spbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbcon_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float anorm, float* rcond, float* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_spbcon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_spbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_spbcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_spbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_spbcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbequ.c b/LAPACKE/src/lapacke_spbequ.c index bffea674dd..4b1fab9fb5 100644 --- a/LAPACKE/src/lapacke_spbequ.c +++ b/LAPACKE/src/lapacke_spbequ.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbequ)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_spbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond, + return API_SUFFIX(LAPACKE_spbequ_work)( matrix_layout, uplo, n, kd, ab, ldab, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_spbequ_work.c b/LAPACKE/src/lapacke_spbequ_work.c index 8e1e2baf2a..b5bda9973d 100644 --- a/LAPACKE/src/lapacke_spbequ_work.c +++ b/LAPACKE/src/lapacke_spbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbequ_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float* s, float* scond, float* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spbequ_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_spbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_spbequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_spbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_spbequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbrfs.c b/LAPACKE/src/lapacke_spbrfs.c index 894b6be8ac..58fa250074 100644 --- a/LAPACKE/src/lapacke_spbrfs.c +++ b/LAPACKE/src/lapacke_spbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, lapack_int ldafb, const float* b, lapack_int ldb, float* x, @@ -42,22 +42,22 @@ lapack_int LAPACKE_spbrfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_spbrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_spbrfs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, + info = API_SUFFIX(LAPACKE_spbrfs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -83,7 +83,7 @@ lapack_int LAPACKE_spbrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbrfs_work.c b/LAPACKE/src/lapacke_spbrfs_work.c index 7450f3f9a8..d296a2ebfc 100644 --- a/LAPACKE/src/lapacke_spbrfs_work.c +++ b/LAPACKE/src/lapacke_spbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, const float* afb, lapack_int ldafb, const float* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_spbrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); return info; } if( ldafb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,11 +100,11 @@ lapack_int LAPACKE_spbrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_spbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, @@ -113,7 +113,7 @@ lapack_int LAPACKE_spbrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -124,11 +124,11 @@ lapack_int LAPACKE_spbrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbstf.c b/LAPACKE/src/lapacke_spbstf.c index 46e795d5c9..68df2dab6b 100644 --- a/LAPACKE/src/lapacke_spbstf.c +++ b/LAPACKE/src/lapacke_spbstf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbstf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbstf)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, float* bb, lapack_int ldbb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbstf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbstf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -5; } } #endif - return LAPACKE_spbstf_work( matrix_layout, uplo, n, kb, bb, ldbb ); + return API_SUFFIX(LAPACKE_spbstf_work)( matrix_layout, uplo, n, kb, bb, ldbb ); } diff --git a/LAPACKE/src/lapacke_spbstf_work.c b/LAPACKE/src/lapacke_spbstf_work.c index 10824426bd..2bf8f41a29 100644 --- a/LAPACKE/src/lapacke_spbstf_work.c +++ b/LAPACKE/src/lapacke_spbstf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbstf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbstf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, float* bb, lapack_int ldbb ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_spbstf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldbb < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_spbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbstf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_spbstf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_spbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_spb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); /* Release memory and exit */ LAPACKE_free( bb_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbstf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbstf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbsv.c b/LAPACKE/src/lapacke_spbsv.c index 4a340fc23d..8037bbdb6e 100644 --- a/LAPACKE/src/lapacke_spbsv.c +++ b/LAPACKE/src/lapacke_spbsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbsv)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, float* ab, lapack_int ldab, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_spbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_spbsv_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spbsv_work.c b/LAPACKE/src/lapacke_spbsv_work.c index 458b8b6901..952f7de2a3 100644 --- a/LAPACKE/src/lapacke_spbsv_work.c +++ b/LAPACKE/src/lapacke_spbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, float* ab, lapack_int ldab, float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_spbsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_spbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,8 +71,8 @@ lapack_int LAPACKE_spbsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -80,20 +80,20 @@ lapack_int LAPACKE_spbsv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_spb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbsvx.c b/LAPACKE/src/lapacke_spbsvx.c index 5e46948f3f..f5c00a71db 100644 --- a/LAPACKE/src/lapacke_spbsvx.c +++ b/LAPACKE/src/lapacke_spbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, char* equed, float* s, float* b, lapack_int ldb, @@ -43,25 +43,25 @@ lapack_int LAPACKE_spbsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -9; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_spbsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_spbsvx_work( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_spbsvx_work)( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -88,7 +88,7 @@ lapack_int LAPACKE_spbsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbsvx_work.c b/LAPACKE/src/lapacke_spbsvx_work.c index 0b55b47e86..2ee016e82c 100644 --- a/LAPACKE/src/lapacke_spbsvx_work.c +++ b/LAPACKE/src/lapacke_spbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_spbsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, float* ab, lapack_int ldab, float* afb, lapack_int ldafb, char* equed, float* s, @@ -61,22 +61,22 @@ lapack_int LAPACKE_spbsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -101,12 +101,12 @@ lapack_int LAPACKE_spbsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -115,16 +115,16 @@ lapack_int LAPACKE_spbsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_spb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_spb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, afb, ldafb ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -135,11 +135,11 @@ lapack_int LAPACKE_spbsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbtrf.c b/LAPACKE/src/lapacke_spbtrf.c index 0131141de4..a29efd0090 100644 --- a/LAPACKE/src/lapacke_spbtrf.c +++ b/LAPACKE/src/lapacke_spbtrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbtrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbtrf)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_spbtrf_work( matrix_layout, uplo, n, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_spbtrf_work)( matrix_layout, uplo, n, kd, ab, ldab ); } diff --git a/LAPACKE/src/lapacke_spbtrf_work.c b/LAPACKE/src/lapacke_spbtrf_work.c index 69262fd3dc..baa7370594 100644 --- a/LAPACKE/src/lapacke_spbtrf_work.c +++ b/LAPACKE/src/lapacke_spbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbtrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbtrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_spbtrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_spbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_spbtrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_spbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_spb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spbtrs.c b/LAPACKE/src/lapacke_spbtrs.c index e2c837409a..3ce650b2b3 100644 --- a/LAPACKE/src/lapacke_spbtrs.c +++ b/LAPACKE/src/lapacke_spbtrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbtrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbtrs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_spb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_spbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_spbtrs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spbtrs_work.c b/LAPACKE/src/lapacke_spbtrs_work.c index 89fd0244bd..89183018cc 100644 --- a/LAPACKE/src/lapacke_spbtrs_work.c +++ b/LAPACKE/src/lapacke_spbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spbtrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,8 +71,8 @@ lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -80,18 +80,18 @@ lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spftrf.c b/LAPACKE/src/lapacke_spftrf.c index 4c1a3ffcbb..f340f23afd 100644 --- a/LAPACKE/src/lapacke_spftrf.c +++ b/LAPACKE/src/lapacke_spftrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftrf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftrf)( int matrix_layout, char transr, char uplo, lapack_int n, float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spftrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_spftrf_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_spftrf_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_spftrf_work.c b/LAPACKE/src/lapacke_spftrf_work.c index e2cf1fc745..dcda1069f4 100644 --- a/LAPACKE/src/lapacke_spftrf_work.c +++ b/LAPACKE/src/lapacke_spftrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftrf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftrf_work)( int matrix_layout, char transr, char uplo, lapack_int n, float* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_spftrf_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_spftrf( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_spf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spftri.c b/LAPACKE/src/lapacke_spftri.c index 83a3c7516d..28c893549e 100644 --- a/LAPACKE/src/lapacke_spftri.c +++ b/LAPACKE/src/lapacke_spftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftri( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftri)( int matrix_layout, char transr, char uplo, lapack_int n, float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_spftri_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_spftri_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_spftri_work.c b/LAPACKE/src/lapacke_spftri_work.c index 887fccac45..0a63d1ce4f 100644 --- a/LAPACKE/src/lapacke_spftri_work.c +++ b/LAPACKE/src/lapacke_spftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftri_work)( int matrix_layout, char transr, char uplo, lapack_int n, float* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_spftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_spftri( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_spf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spftrs.c b/LAPACKE/src/lapacke_spftrs.c index c8b7d034e5..4a5c48dc03 100644 --- a/LAPACKE/src/lapacke_spftrs.c +++ b/LAPACKE/src/lapacke_spftrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftrs( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftrs)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const float* a, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spftrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, a ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_spftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b, + return API_SUFFIX(LAPACKE_spftrs_work)( matrix_layout, transr, uplo, n, nrhs, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spftrs_work.c b/LAPACKE/src/lapacke_spftrs_work.c index e2e7a9b805..507ed57775 100644 --- a/LAPACKE/src/lapacke_spftrs_work.c +++ b/LAPACKE/src/lapacke_spftrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spftrs_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_spftrs_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const float* a, float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_spftrs_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_spftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,26 +66,26 @@ lapack_int LAPACKE_spftrs_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_spftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spftrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spocon.c b/LAPACKE/src/lapacke_spocon.c index 1f2971ca4f..069663225c 100644 --- a/LAPACKE/src/lapacke_spocon.c +++ b/LAPACKE/src/lapacke_spocon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spocon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spocon)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_spocon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spocon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spocon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_spocon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_spocon_work( matrix_layout, uplo, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_spocon_work)( matrix_layout, uplo, n, a, lda, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_spocon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spocon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spocon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spocon_work.c b/LAPACKE/src/lapacke_spocon_work.c index d1292ee916..b7fe2b98b1 100644 --- a/LAPACKE/src/lapacke_spocon_work.c +++ b/LAPACKE/src/lapacke_spocon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spocon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spocon_work)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float anorm, float* rcond, float* work, lapack_int* iwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spocon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_spocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spocon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_spocon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, iwork, &info ); @@ -70,11 +70,11 @@ lapack_int LAPACKE_spocon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spocon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spocon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spoequ.c b/LAPACKE/src/lapacke_spoequ.c index cf8b078e5d..fa690c3f6a 100644 --- a/LAPACKE/src/lapacke_spoequ.c +++ b/LAPACKE/src/lapacke_spoequ.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spoequ( int matrix_layout, lapack_int n, const float* a, +lapack_int API_SUFFIX(LAPACKE_spoequ)( int matrix_layout, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spoequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_spoequ_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_spoequ_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_spoequ_work.c b/LAPACKE/src/lapacke_spoequ_work.c index 774da39c49..f6cd35a45b 100644 --- a/LAPACKE/src/lapacke_spoequ_work.c +++ b/LAPACKE/src/lapacke_spoequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spoequ_work( int matrix_layout, lapack_int n, const float* a, +lapack_int API_SUFFIX(LAPACKE_spoequ_work)( int matrix_layout, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spoequ_work( int matrix_layout, lapack_int n, const float* a, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_spoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_spoequ_work( int matrix_layout, lapack_int n, const float* a, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spoequ( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_spoequ_work( int matrix_layout, lapack_int n, const float* a, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spoequb.c b/LAPACKE/src/lapacke_spoequb.c index 973112f2c0..a431540ef0 100644 --- a/LAPACKE/src/lapacke_spoequb.c +++ b/LAPACKE/src/lapacke_spoequb.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spoequb( int matrix_layout, lapack_int n, const float* a, +lapack_int API_SUFFIX(LAPACKE_spoequb)( int matrix_layout, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spoequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_spoequb_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_spoequb_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_spoequb_work.c b/LAPACKE/src/lapacke_spoequb_work.c index 5f5f974777..014400823f 100644 --- a/LAPACKE/src/lapacke_spoequb_work.c +++ b/LAPACKE/src/lapacke_spoequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spoequb_work( int matrix_layout, lapack_int n, const float* a, +lapack_int API_SUFFIX(LAPACKE_spoequb_work)( int matrix_layout, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spoequb_work( int matrix_layout, lapack_int n, const float* a /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_spoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_spoequb_work( int matrix_layout, lapack_int n, const float* a goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spoequb( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_spoequb_work( int matrix_layout, lapack_int n, const float* a LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spoequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sporfs.c b/LAPACKE/src/lapacke_sporfs.c index e21e075b90..81df00fe21 100644 --- a/LAPACKE/src/lapacke_sporfs.c +++ b/LAPACKE/src/lapacke_sporfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sporfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sporfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -42,22 +42,22 @@ lapack_int LAPACKE_sporfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sporfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_sporfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sporfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_sporfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_sporfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sporfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sporfs_work.c b/LAPACKE/src/lapacke_sporfs_work.c index cd848e5032..4ca8b83b5e 100644 --- a/LAPACKE/src/lapacke_sporfs_work.c +++ b/LAPACKE/src/lapacke_sporfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sporfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sporfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const float* b, lapack_int ldb, float* x, @@ -59,22 +59,22 @@ lapack_int LAPACKE_sporfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -99,10 +99,10 @@ lapack_int LAPACKE_sporfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_spo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -110,7 +110,7 @@ lapack_int LAPACKE_sporfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -121,11 +121,11 @@ lapack_int LAPACKE_sporfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sporfsx.c b/LAPACKE/src/lapacke_sporfsx.c index 10f6c58694..a3da821889 100644 --- a/LAPACKE/src/lapacke_sporfsx.c +++ b/LAPACKE/src/lapacke_sporfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sporfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_sporfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const float* s, const float* b, lapack_int ldb, @@ -45,32 +45,32 @@ lapack_int LAPACKE_sporfsx( int matrix_layout, char uplo, char equed, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sporfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -21; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -10; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -13; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_sporfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sporfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_sporfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -97,7 +97,7 @@ lapack_int LAPACKE_sporfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sporfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sporfsx_work.c b/LAPACKE/src/lapacke_sporfsx_work.c index 3a31356b26..b1626f3a65 100644 --- a/LAPACKE/src/lapacke_sporfsx_work.c +++ b/LAPACKE/src/lapacke_sporfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sporfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_sporfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const float* s, @@ -65,22 +65,22 @@ lapack_int LAPACKE_sporfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -117,10 +117,10 @@ lapack_int LAPACKE_sporfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_ssy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sporfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, &n_err_bnds, @@ -130,10 +130,10 @@ lapack_int LAPACKE_sporfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -149,11 +149,11 @@ lapack_int LAPACKE_sporfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sporfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sposv.c b/LAPACKE/src/lapacke_sposv.c index 6a3095d0c2..6c248c3ce1 100644 --- a/LAPACKE/src/lapacke_sposv.c +++ b/LAPACKE/src/lapacke_sposv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_sposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_sposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sposv_work.c b/LAPACKE/src/lapacke_sposv_work.c index bba55897cd..f6c2ff937f 100644 --- a/LAPACKE/src/lapacke_sposv_work.c +++ b/LAPACKE/src/lapacke_sposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_sposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_sposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,27 +71,27 @@ lapack_int LAPACKE_sposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sposvx.c b/LAPACKE/src/lapacke_sposvx.c index f06b9dc111..9af1e951b4 100644 --- a/LAPACKE/src/lapacke_sposvx.c +++ b/LAPACKE/src/lapacke_sposvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sposvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, char* equed, float* s, float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -42,25 +42,25 @@ lapack_int LAPACKE_sposvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sposvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_sposvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sposvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_sposvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_sposvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sposvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sposvx_work.c b/LAPACKE/src/lapacke_sposvx_work.c index a8911e5c93..5d50c83288 100644 --- a/LAPACKE/src/lapacke_sposvx_work.c +++ b/LAPACKE/src/lapacke_sposvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_sposvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, char* equed, float* s, float* b, lapack_int ldb, @@ -60,22 +60,22 @@ lapack_int LAPACKE_sposvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,11 +100,11 @@ lapack_int LAPACKE_sposvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_spo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, @@ -113,15 +113,15 @@ lapack_int LAPACKE_sposvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -132,11 +132,11 @@ lapack_int LAPACKE_sposvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sposvxx.c b/LAPACKE/src/lapacke_sposvxx.c index d2d0f72f93..69f7eb9de5 100644 --- a/LAPACKE/src/lapacke_sposvxx.c +++ b/LAPACKE/src/lapacke_sposvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_sposvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, char* equed, float* s, float* b, lapack_int ldb, @@ -45,30 +45,30 @@ lapack_int LAPACKE_sposvxx( int matrix_layout, char fact, char uplo, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sposvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } @@ -86,7 +86,7 @@ lapack_int LAPACKE_sposvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sposvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_sposvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_sposvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sposvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sposvxx_work.c b/LAPACKE/src/lapacke_sposvxx_work.c index cb31c80a2e..da9cde175f 100644 --- a/LAPACKE/src/lapacke_sposvxx_work.c +++ b/LAPACKE/src/lapacke_sposvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sposvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_sposvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, char* equed, float* s, float* b, @@ -66,22 +66,22 @@ lapack_int LAPACKE_sposvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -118,11 +118,11 @@ lapack_int LAPACKE_sposvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_spo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr, @@ -132,18 +132,18 @@ lapack_int LAPACKE_sposvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -159,11 +159,11 @@ lapack_int LAPACKE_sposvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sposvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spotrf.c b/LAPACKE/src/lapacke_spotrf.c index 7f3f330e46..04de40683e 100644 --- a/LAPACKE/src/lapacke_spotrf.c +++ b/LAPACKE/src/lapacke_spotrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrf( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_spotrf)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spotrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_spotrf_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_spotrf_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_spotrf2.c b/LAPACKE/src/lapacke_spotrf2.c index b3de0d934c..39c1dfec3c 100644 --- a/LAPACKE/src/lapacke_spotrf2.c +++ b/LAPACKE/src/lapacke_spotrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrf2( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_spotrf2)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spotrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_spotrf2_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_spotrf2_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_spotrf2_work.c b/LAPACKE/src/lapacke_spotrf2_work.c index 12ed95650d..c29fc46b05 100644 --- a/LAPACKE/src/lapacke_spotrf2_work.c +++ b/LAPACKE/src/lapacke_spotrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrf2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spotrf2_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_spotrf2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_spotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_spotrf2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spotrf2( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spotrf_work.c b/LAPACKE/src/lapacke_spotrf_work.c index 82c8431adc..f71e8b897f 100644 --- a/LAPACKE/src/lapacke_spotrf_work.c +++ b/LAPACKE/src/lapacke_spotrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spotrf_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_spotrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_spotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_spotrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spotrf( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spotri.c b/LAPACKE/src/lapacke_spotri.c index 5f4779d976..d9632947a6 100644 --- a/LAPACKE/src/lapacke_spotri.c +++ b/LAPACKE/src/lapacke_spotri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotri( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_spotri)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spotri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_spotri_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_spotri_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_spotri_work.c b/LAPACKE/src/lapacke_spotri_work.c index a8d98c2d9a..92fcfe6c01 100644 --- a/LAPACKE/src/lapacke_spotri_work.c +++ b/LAPACKE/src/lapacke_spotri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spotri_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_spotri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_spotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_spotri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spotri( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spotrs.c b/LAPACKE/src/lapacke_spotrs.c index 739a125ea2..4ed90faeb0 100644 --- a/LAPACKE/src/lapacke_spotrs.c +++ b/LAPACKE/src/lapacke_spotrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spotrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spotrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_spotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_spotrs_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spotrs_work.c b/LAPACKE/src/lapacke_spotrs_work.c index e5cd7c59da..024fc4419a 100644 --- a/LAPACKE/src/lapacke_spotrs_work.c +++ b/LAPACKE/src/lapacke_spotrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spotrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spotrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_spotrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_spotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrs_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_spotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_spotrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spotrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppcon.c b/LAPACKE/src/lapacke_sppcon.c index 0e1c9eb9d3..64170be844 100644 --- a/LAPACKE/src/lapacke_sppcon.c +++ b/LAPACKE/src/lapacke_sppcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppcon)( int matrix_layout, char uplo, lapack_int n, const float* ap, float anorm, float* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sppcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -5; } - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -4; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_sppcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sppcon_work( matrix_layout, uplo, n, ap, anorm, rcond, work, + info = API_SUFFIX(LAPACKE_sppcon_work)( matrix_layout, uplo, n, ap, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_sppcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppcon_work.c b/LAPACKE/src/lapacke_sppcon_work.c index 1e4fee4f43..33cbfe573d 100644 --- a/LAPACKE/src/lapacke_sppcon_work.c +++ b/LAPACKE/src/lapacke_sppcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppcon_work)( int matrix_layout, char uplo, lapack_int n, const float* ap, float anorm, float* rcond, float* work, lapack_int* iwork ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_sppcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sppcon( &uplo, &n, ap_t, &anorm, rcond, work, iwork, &info ); if( info < 0 ) { @@ -63,11 +63,11 @@ lapack_int LAPACKE_sppcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppequ.c b/LAPACKE/src/lapacke_sppequ.c index de1d0d5ece..7c5d6609b0 100644 --- a/LAPACKE/src/lapacke_sppequ.c +++ b/LAPACKE/src/lapacke_sppequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppequ)( int matrix_layout, char uplo, lapack_int n, const float* ap, float* s, float* scond, float* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sppequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_sppequ_work( matrix_layout, uplo, n, ap, s, scond, amax ); + return API_SUFFIX(LAPACKE_sppequ_work)( matrix_layout, uplo, n, ap, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_sppequ_work.c b/LAPACKE/src/lapacke_sppequ_work.c index e3e8fdb910..e3cb6ccc16 100644 --- a/LAPACKE/src/lapacke_sppequ_work.c +++ b/LAPACKE/src/lapacke_sppequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppequ_work)( int matrix_layout, char uplo, lapack_int n, const float* ap, float* s, float* scond, float* amax ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_sppequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sppequ( &uplo, &n, ap_t, s, scond, amax, &info ); if( info < 0 ) { @@ -63,11 +63,11 @@ lapack_int LAPACKE_sppequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spprfs.c b/LAPACKE/src/lapacke_spprfs.c index 1d73b91f3e..a80630b3f9 100644 --- a/LAPACKE/src/lapacke_spprfs.c +++ b/LAPACKE/src/lapacke_spprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const float* afp, const float* b, lapack_int ldb, float* x, lapack_int ldx, float* ferr, float* berr ) @@ -41,22 +41,22 @@ lapack_int LAPACKE_spprfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -9; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_spprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_spprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, + info = API_SUFFIX(LAPACKE_spprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_spprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spprfs_work.c b/LAPACKE/src/lapacke_spprfs_work.c index aae87cd529..d5382f3d71 100644 --- a/LAPACKE/src/lapacke_spprfs_work.c +++ b/LAPACKE/src/lapacke_spprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const float* afp, const float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_spprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_spprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_spprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_spprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_spp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_spprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_spprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -111,11 +111,11 @@ lapack_int LAPACKE_spprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppsv.c b/LAPACKE/src/lapacke_sppsv.c index b8c00b9a41..4a39ec8e27 100644 --- a/LAPACKE/src/lapacke_sppsv.c +++ b/LAPACKE/src/lapacke_sppsv.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* ap, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sppsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_sppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_sppsv_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sppsv_work.c b/LAPACKE/src/lapacke_sppsv_work.c index 1a6946a343..eac20287bd 100644 --- a/LAPACKE/src/lapacke_sppsv_work.c +++ b/LAPACKE/src/lapacke_sppsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* ap, float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_sppsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,27 +66,27 @@ lapack_int LAPACKE_sppsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppsvx.c b/LAPACKE/src/lapacke_sppsvx.c index 961ad403c2..6c4105a9b9 100644 --- a/LAPACKE/src/lapacke_sppsvx.c +++ b/LAPACKE/src/lapacke_sppsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sppsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* ap, float* afp, char* equed, float* s, float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* ferr, @@ -42,25 +42,25 @@ lapack_int LAPACKE_sppsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sppsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_spp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -9; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_sppsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sppsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_sppsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_sppsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sppsvx_work.c b/LAPACKE/src/lapacke_sppsvx_work.c index f08b24c80f..e34f3e197f 100644 --- a/LAPACKE/src/lapacke_sppsvx_work.c +++ b/LAPACKE/src/lapacke_sppsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sppsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_sppsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* ap, float* afp, char* equed, float* s, float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_sppsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_sppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_sppsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_spp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_sppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t, @@ -102,13 +102,13 @@ lapack_int LAPACKE_sppsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -120,11 +120,11 @@ lapack_int LAPACKE_sppsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sppsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spptrf.c b/LAPACKE/src/lapacke_spptrf.c index 32ab5636f7..3c3d597f6f 100644 --- a/LAPACKE/src/lapacke_spptrf.c +++ b/LAPACKE/src/lapacke_spptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptrf)( int matrix_layout, char uplo, lapack_int n, float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_spptrf_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_spptrf_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_spptrf_work.c b/LAPACKE/src/lapacke_spptrf_work.c index ca3ec43d93..9318b616ae 100644 --- a/LAPACKE/src/lapacke_spptrf_work.c +++ b/LAPACKE/src/lapacke_spptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptrf_work)( int matrix_layout, char uplo, lapack_int n, float* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_spptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_spptrf( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spptri.c b/LAPACKE/src/lapacke_spptri.c index 85c2643aee..fc18728c1e 100644 --- a/LAPACKE/src/lapacke_spptri.c +++ b/LAPACKE/src/lapacke_spptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptri)( int matrix_layout, char uplo, lapack_int n, float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_spptri_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_spptri_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_spptri_work.c b/LAPACKE/src/lapacke_spptri_work.c index f67d66f6bd..257f294daa 100644 --- a/LAPACKE/src/lapacke_spptri_work.c +++ b/LAPACKE/src/lapacke_spptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptri_work)( int matrix_layout, char uplo, lapack_int n, float* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_spptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_spptri( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spptrs.c b/LAPACKE/src/lapacke_spptrs.c index 73c0de30d3..009c195de3 100644 --- a/LAPACKE/src/lapacke_spptrs.c +++ b/LAPACKE/src/lapacke_spptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_spptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_spptrs_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spptrs_work.c b/LAPACKE/src/lapacke_spptrs_work.c index edb150c0ec..6cc2c68444 100644 --- a/LAPACKE/src/lapacke_spptrs_work.c +++ b/LAPACKE/src/lapacke_spptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_spptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,26 +66,26 @@ lapack_int LAPACKE_spptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_spptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spstrf.c b/LAPACKE/src/lapacke_spstrf.c index 24b6805ea0..4c6b49a0f7 100644 --- a/LAPACKE/src/lapacke_spstrf.c +++ b/LAPACKE/src/lapacke_spstrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spstrf( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_spstrf)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* piv, lapack_int* rank, float tol ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spstrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spstrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_spo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &tol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tol, 1 ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_spstrf( int matrix_layout, char uplo, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_spstrf_work( matrix_layout, uplo, n, a, lda, piv, rank, tol, + info = API_SUFFIX(LAPACKE_spstrf_work)( matrix_layout, uplo, n, a, lda, piv, rank, tol, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spstrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spstrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spstrf_work.c b/LAPACKE/src/lapacke_spstrf_work.c index 4a55dab52f..bd8716705f 100644 --- a/LAPACKE/src/lapacke_spstrf_work.c +++ b/LAPACKE/src/lapacke_spstrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spstrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spstrf_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* piv, lapack_int* rank, float tol, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spstrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_spstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spstrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_spstrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_spo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_spo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spstrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spstrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptcon.c b/LAPACKE/src/lapacke_sptcon.c index 03ab09a23d..5e148efd8f 100644 --- a/LAPACKE/src/lapacke_sptcon.c +++ b/LAPACKE/src/lapacke_sptcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e, +lapack_int API_SUFFIX(LAPACKE_sptcon)( lapack_int n, const float* d, const float* e, float anorm, float* rcond ) { lapack_int info = 0; @@ -40,13 +40,13 @@ lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -3; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_sptcon( lapack_int n, const float* d, const float* e, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sptcon_work( n, d, e, anorm, rcond, work ); + info = API_SUFFIX(LAPACKE_sptcon_work)( n, d, e, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptcon_work.c b/LAPACKE/src/lapacke_sptcon_work.c index 4e8397ea2a..3e5ebea07f 100644 --- a/LAPACKE/src/lapacke_sptcon_work.c +++ b/LAPACKE/src/lapacke_sptcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptcon_work( lapack_int n, const float* d, const float* e, +lapack_int API_SUFFIX(LAPACKE_sptcon_work)( lapack_int n, const float* d, const float* e, float anorm, float* rcond, float* work ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_spteqr.c b/LAPACKE/src/lapacke_spteqr.c index 74ac93135b..df3626286a 100644 --- a/LAPACKE/src/lapacke_spteqr.c +++ b/LAPACKE/src/lapacke_spteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spteqr( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_spteqr)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_spteqr( int matrix_layout, char compz, lapack_int n, float* d lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,4*n-4); @@ -72,12 +72,12 @@ lapack_int LAPACKE_spteqr( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_spteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_spteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spteqr_work.c b/LAPACKE/src/lapacke_spteqr_work.c index 72e80fe0f3..373bb95b2c 100644 --- a/LAPACKE/src/lapacke_spteqr_work.c +++ b/LAPACKE/src/lapacke_spteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_spteqr_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,8 +59,8 @@ lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_spteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -68,16 +68,16 @@ lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptrfs.c b/LAPACKE/src/lapacke_sptrfs.c index d6c1b98f42..40efda7ad4 100644 --- a/LAPACKE/src/lapacke_sptrfs.c +++ b/LAPACKE/src/lapacke_sptrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sptrfs)( int matrix_layout, lapack_int n, lapack_int nrhs, const float* d, const float* e, const float* df, const float* ef, const float* b, lapack_int ldb, float* x, lapack_int ldx, float* ferr, float* berr ) @@ -40,28 +40,28 @@ lapack_int LAPACKE_sptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sptrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, ef, 1 ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -73,13 +73,13 @@ lapack_int LAPACKE_sptrfs( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sptrfs_work( matrix_layout, n, nrhs, d, e, df, ef, b, ldb, x, + info = API_SUFFIX(LAPACKE_sptrfs_work)( matrix_layout, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptrfs_work.c b/LAPACKE/src/lapacke_sptrfs_work.c index c193372898..bd6da029e0 100644 --- a/LAPACKE/src/lapacke_sptrfs_work.c +++ b/LAPACKE/src/lapacke_sptrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sptrfs_work)( int matrix_layout, lapack_int n, lapack_int nrhs, const float* d, const float* e, const float* df, const float* ef, const float* b, lapack_int ldb, float* x, lapack_int ldx, float* ferr, @@ -54,12 +54,12 @@ lapack_int LAPACKE_sptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_sptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_sptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,8 +74,8 @@ lapack_int LAPACKE_sptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_sptrfs( &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, &info ); @@ -83,18 +83,18 @@ lapack_int LAPACKE_sptrfs_work( int matrix_layout, lapack_int n, lapack_int nrhs info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptsv.c b/LAPACKE/src/lapacke_sptsv.c index 870ff602fa..30d77dc4b1 100644 --- a/LAPACKE/src/lapacke_sptsv.c +++ b/LAPACKE/src/lapacke_sptsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sptsv)( int matrix_layout, lapack_int n, lapack_int nrhs, float* d, float* e, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sptsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_sptsv_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_sptsv_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sptsv_work.c b/LAPACKE/src/lapacke_sptsv_work.c index ea9841ee43..e3414d71de 100644 --- a/LAPACKE/src/lapacke_sptsv_work.c +++ b/LAPACKE/src/lapacke_sptsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_sptsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, float* d, float* e, float* b, lapack_int ldb ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_sptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,23 +58,23 @@ lapack_int LAPACKE_sptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptsvx.c b/LAPACKE/src/lapacke_sptsvx.c index 4462d525fb..f88a51ee0e 100644 --- a/LAPACKE/src/lapacke_sptsvx.c +++ b/LAPACKE/src/lapacke_sptsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptsvx( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sptsvx)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const float* d, const float* e, float* df, float* ef, const float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* ferr, @@ -41,28 +41,28 @@ lapack_int LAPACKE_sptsvx( int matrix_layout, char fact, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sptsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, df, 1 ) ) { return -7; } } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, ef, 1 ) ) { return -8; } } @@ -75,13 +75,13 @@ lapack_int LAPACKE_sptsvx( int matrix_layout, char fact, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sptsvx_work( matrix_layout, fact, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_sptsvx_work)( matrix_layout, fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sptsvx_work.c b/LAPACKE/src/lapacke_sptsvx_work.c index d9e12de176..c022d4b57e 100644 --- a/LAPACKE/src/lapacke_sptsvx_work.c +++ b/LAPACKE/src/lapacke_sptsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sptsvx_work( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sptsvx_work)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const float* d, const float* e, float* df, float* ef, const float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -55,12 +55,12 @@ lapack_int LAPACKE_sptsvx_work( int matrix_layout, char fact, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,7 +75,7 @@ lapack_int LAPACKE_sptsvx_work( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, &info ); @@ -83,18 +83,18 @@ lapack_int LAPACKE_sptsvx_work( int matrix_layout, char fact, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sptsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_spttrf.c b/LAPACKE/src/lapacke_spttrf.c index 3d1e10a9e5..1f22fa7765 100644 --- a/LAPACKE/src/lapacke_spttrf.c +++ b/LAPACKE/src/lapacke_spttrf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spttrf( lapack_int n, float* d, float* e ) +lapack_int API_SUFFIX(LAPACKE_spttrf)( lapack_int n, float* d, float* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_spttrf_work( n, d, e ); + return API_SUFFIX(LAPACKE_spttrf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_spttrf_work.c b/LAPACKE/src/lapacke_spttrf_work.c index 4f6ad23556..8dd4b01785 100644 --- a/LAPACKE/src/lapacke_spttrf_work.c +++ b/LAPACKE/src/lapacke_spttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spttrf_work( lapack_int n, float* d, float* e ) +lapack_int API_SUFFIX(LAPACKE_spttrf_work)( lapack_int n, float* d, float* e ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_spttrs.c b/LAPACKE/src/lapacke_spttrs.c index 20203589b3..18ab39cd1c 100644 --- a/LAPACKE/src/lapacke_spttrs.c +++ b/LAPACKE/src/lapacke_spttrs.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spttrs( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_spttrs)( int matrix_layout, lapack_int n, lapack_int nrhs, const float* d, const float* e, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_spttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_spttrs_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_spttrs_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_spttrs_work.c b/LAPACKE/src/lapacke_spttrs_work.c index 785a757469..15536bc0d5 100644 --- a/LAPACKE/src/lapacke_spttrs_work.c +++ b/LAPACKE/src/lapacke_spttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_spttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_spttrs_work)( int matrix_layout, lapack_int n, lapack_int nrhs, const float* d, const float* e, float* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_spttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_spttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_spttrs_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spttrs( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_spttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_spttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_spttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbev.c b/LAPACKE/src/lapacke_ssbev.c index 1d65b0c3c5..d18d7ac9c6 100644 --- a/LAPACKE/src/lapacke_ssbev.c +++ b/LAPACKE/src/lapacke_ssbev.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_ssbev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssbev_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbev_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbev_2stage.c b/LAPACKE/src/lapacke_ssbev_2stage.c index 91923a9461..803cc41529 100644 --- a/LAPACKE/src/lapacke_ssbev_2stage.c +++ b/LAPACKE/src/lapacke_ssbev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_ssbev_2stage( int matrix_layout, char jobz, char uplo, lapack float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_ssbev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbev_2stage_work.c b/LAPACKE/src/lapacke_ssbev_2stage_work.c index 3f5d5b9520..a7c03df446 100644 --- a/LAPACKE/src/lapacke_ssbev_2stage_work.c +++ b/LAPACKE/src/lapacke_ssbev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssbev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -73,7 +73,7 @@ lapack_int LAPACKE_ssbev_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -81,7 +81,7 @@ lapack_int LAPACKE_ssbev_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbev_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, &info ); @@ -89,24 +89,24 @@ lapack_int LAPACKE_ssbev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbev_work.c b/LAPACKE/src/lapacke_ssbev_work.c index e0dfb2938f..bcc887b8b9 100644 --- a/LAPACKE/src/lapacke_ssbev_work.c +++ b/LAPACKE/src/lapacke_ssbev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz, float* work ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssbev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ssbev_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssbev_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &info ); @@ -83,24 +83,24 @@ lapack_int LAPACKE_ssbev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevd.c b/LAPACKE/src/lapacke_ssbevd.c index 6630b58c50..acc9993a45 100644 --- a/LAPACKE/src/lapacke_ssbevd.c +++ b/LAPACKE/src/lapacke_ssbevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz ) { @@ -44,19 +44,19 @@ lapack_int LAPACKE_ssbevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssbevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_ssbevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevd_2stage.c b/LAPACKE/src/lapacke_ssbevd_2stage.c index a4770d4797..90a078e0b1 100644 --- a/LAPACKE/src/lapacke_ssbevd_2stage.c +++ b/LAPACKE/src/lapacke_ssbevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz ) { @@ -44,19 +44,19 @@ lapack_int LAPACKE_ssbevd_2stage( int matrix_layout, char jobz, char uplo, lapac lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssbevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_ssbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_ssbevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevd_2stage_work.c b/LAPACKE/src/lapacke_ssbevd_2stage_work.c index 2087708e11..0ec152cac8 100644 --- a/LAPACKE/src/lapacke_ssbevd_2stage_work.c +++ b/LAPACKE/src/lapacke_ssbevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz, float* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_ssbevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssbevd_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbevd_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -90,24 +90,24 @@ lapack_int LAPACKE_ssbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevd_work.c b/LAPACKE/src/lapacke_ssbevd_work.c index e56be4b281..6d53102ffb 100644 --- a/LAPACKE/src/lapacke_ssbevd_work.c +++ b/LAPACKE/src/lapacke_ssbevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* w, float* z, lapack_int ldz, float* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_ssbevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssbevd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssbevd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -90,24 +90,24 @@ lapack_int LAPACKE_ssbevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevx.c b/LAPACKE/src/lapacke_ssbevx.c index 01f3f8f06a..e6fd2b6146 100644 --- a/LAPACKE/src/lapacke_ssbevx.c +++ b/LAPACKE/src/lapacke_ssbevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* q, lapack_int ldq, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -43,25 +43,25 @@ lapack_int LAPACKE_ssbevx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_ssbevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbevx_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_ssbevx_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -88,7 +88,7 @@ lapack_int LAPACKE_ssbevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevx_2stage.c b/LAPACKE/src/lapacke_ssbevx_2stage.c index 77ed44004a..4e1cc8f222 100644 --- a/LAPACKE/src/lapacke_ssbevx_2stage.c +++ b/LAPACKE/src/lapacke_ssbevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* q, lapack_int ldq, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -45,32 +45,32 @@ lapack_int LAPACKE_ssbevx_2stage( int matrix_layout, char jobz, char range, char float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_ssbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_ssbevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_ssbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_ssbevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevx_2stage_work.c b/LAPACKE/src/lapacke_ssbevx_2stage_work.c index 36a33fda73..3dbc4d732e 100644 --- a/LAPACKE/src/lapacke_ssbevx_2stage_work.c +++ b/LAPACKE/src/lapacke_ssbevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssbevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* q, lapack_int ldq, float vl, float vu, @@ -51,9 +51,9 @@ lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,14 +82,14 @@ lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -105,7 +105,7 @@ lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbevx_2stage( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -114,32 +114,32 @@ lapack_int LAPACKE_ssbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbevx_work.c b/LAPACKE/src/lapacke_ssbevx_work.c index 5640400624..b3ae7ba7b7 100644 --- a/LAPACKE/src/lapacke_ssbevx_work.c +++ b/LAPACKE/src/lapacke_ssbevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssbevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* q, lapack_int ldq, float vl, float vu, @@ -51,9 +51,9 @@ lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,14 +82,14 @@ lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -98,7 +98,7 @@ lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -107,32 +107,32 @@ lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgst.c b/LAPACKE/src/lapacke_ssbgst.c index 42b89a3bf7..e6c3decf5c 100644 --- a/LAPACKE/src/lapacke_ssbgst.c +++ b/LAPACKE/src/lapacke_ssbgst.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgst( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbgst)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, const float* bb, lapack_int ldbb, float* x, lapack_int ldx ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_ssbgst( int matrix_layout, char vect, char uplo, lapack_int n lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_ssbgst( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssbgst_work( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_ssbgst_work)( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x, ldx, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgst", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgst_work.c b/LAPACKE/src/lapacke_ssbgst_work.c index 5346796fb6..3105b674ea 100644 --- a/LAPACKE/src/lapacke_ssbgst_work.c +++ b/LAPACKE/src/lapacke_ssbgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbgst_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, const float* bb, lapack_int ldbb, float* x, lapack_int ldx, @@ -56,17 +56,17 @@ lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst_work", info ); return info; } if( ldx < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ssbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_ssb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, x_t, &ldx_t, work, &info ); @@ -97,13 +97,13 @@ lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( x_t ); } exit_level_2: @@ -112,11 +112,11 @@ lapack_int LAPACKE_ssbgst_work( int matrix_layout, char vect, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgv.c b/LAPACKE/src/lapacke_ssbgv.c index 22572a28e9..94c1af4f20 100644 --- a/LAPACKE/src/lapacke_ssbgv.c +++ b/LAPACKE/src/lapacke_ssbgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgv( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbgv)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* w, float* z, lapack_int ldz ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_ssbgv( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_ssbgv( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssbgv_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_ssbgv_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgv_work.c b/LAPACKE/src/lapacke_ssbgv_work.c index 60e3df8104..dc86005191 100644 --- a/LAPACKE/src/lapacke_ssbgv_work.c +++ b/LAPACKE/src/lapacke_ssbgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbgv_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* w, float* z, @@ -56,17 +56,17 @@ lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ssbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_ssb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &info ); @@ -97,15 +97,15 @@ lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -114,11 +114,11 @@ lapack_int LAPACKE_ssbgv_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgvd.c b/LAPACKE/src/lapacke_ssbgvd.c index 794e72b613..d0534fdf39 100644 --- a/LAPACKE/src/lapacke_ssbgvd.c +++ b/LAPACKE/src/lapacke_ssbgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgvd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbgvd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* w, float* z, lapack_int ldz ) @@ -45,22 +45,22 @@ lapack_int LAPACKE_ssbgvd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_ssbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -80,7 +80,7 @@ lapack_int LAPACKE_ssbgvd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_ssbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_ssbgvd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgvd_work.c b/LAPACKE/src/lapacke_ssbgvd_work.c index 78b3d4921c..c62052f7fa 100644 --- a/LAPACKE/src/lapacke_ssbgvd_work.c +++ b/LAPACKE/src/lapacke_ssbgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbgvd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* w, float* z, @@ -57,17 +57,17 @@ lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -95,8 +95,8 @@ lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_ssb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -104,15 +104,15 @@ lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -121,11 +121,11 @@ lapack_int LAPACKE_ssbgvd_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgvx.c b/LAPACKE/src/lapacke_ssbgvx.c index 49d62d84f7..f1331aa1dd 100644 --- a/LAPACKE/src/lapacke_ssbgvx.c +++ b/LAPACKE/src/lapacke_ssbgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgvx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbgvx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* q, lapack_int ldq, float vl, @@ -44,28 +44,28 @@ lapack_int LAPACKE_ssbgvx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -8; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -18; } - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -14; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -15; } } @@ -83,7 +83,7 @@ lapack_int LAPACKE_ssbgvx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssbgvx_work( matrix_layout, jobz, range, uplo, n, ka, kb, ab, + info = API_SUFFIX(LAPACKE_ssbgvx_work)( matrix_layout, jobz, range, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_ssbgvx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbgvx_work.c b/LAPACKE/src/lapacke_ssbgvx_work.c index 36d08e6ed2..c948c67f9c 100644 --- a/LAPACKE/src/lapacke_ssbgvx_work.c +++ b/LAPACKE/src/lapacke_ssbgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssbgvx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, float* ab, lapack_int ldab, float* bb, lapack_int ldbb, float* q, @@ -63,22 +63,22 @@ lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); return info; } if( ldbb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); return info; } if( ldq < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); return info; } if( ldz < n ) { info = -22; - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -92,14 +92,14 @@ lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -107,8 +107,8 @@ lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_ssb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, @@ -117,22 +117,22 @@ lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -141,11 +141,11 @@ lapack_int LAPACKE_ssbgvx_work( int matrix_layout, char jobz, char range, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbtrd.c b/LAPACKE/src/lapacke_ssbtrd.c index 0d34aee227..39543987ef 100644 --- a/LAPACKE/src/lapacke_ssbtrd.c +++ b/LAPACKE/src/lapacke_ssbtrd.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbtrd( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssbtrd)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* d, float* e, float* q, lapack_int ldq ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssbtrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ssb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -10; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_ssbtrd( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssbtrd_work( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, + info = API_SUFFIX(LAPACKE_ssbtrd_work)( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbtrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssbtrd_work.c b/LAPACKE/src/lapacke_ssbtrd_work.c index f1d9fda1e1..3b141b4b84 100644 --- a/LAPACKE/src/lapacke_ssbtrd_work.c +++ b/LAPACKE/src/lapacke_ssbtrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssbtrd_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssbtrd_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* d, float* e, float* q, lapack_int ldq, float* work ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssbtrd_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd_work", info ); return info; } if( ldq < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ssbtrd_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,9 +75,9 @@ lapack_int LAPACKE_ssbtrd_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_ssb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ssbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t, @@ -86,24 +86,24 @@ lapack_int LAPACKE_ssbtrd_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_ssb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssbtrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssfrk.c b/LAPACKE/src/lapacke_ssfrk.c index d82bc3e22a..53cc4a7654 100644 --- a/LAPACKE/src/lapacke_ssfrk.c +++ b/LAPACKE/src/lapacke_ssfrk.c @@ -32,34 +32,34 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssfrk( int matrix_layout, char transr, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ssfrk)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, float alpha, const float* a, lapack_int lda, float beta, float* c ) { lapack_int ka, na; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssfrk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssfrk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - if( LAPACKE_sge_nancheck( matrix_layout, na, ka, a, lda ) ) { + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, na, ka, a, lda ) ) { return -8; } - if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &alpha, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &beta, 1 ) ) { return -10; } - if( LAPACKE_spf_nancheck( n, c ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, c ) ) { return -11; } } #endif - return LAPACKE_ssfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha, + return API_SUFFIX(LAPACKE_ssfrk_work)( matrix_layout, transr, uplo, trans, n, k, alpha, a, lda, beta, c ); } diff --git a/LAPACKE/src/lapacke_ssfrk_work.c b/LAPACKE/src/lapacke_ssfrk_work.c index bf156359ee..da2598cc1f 100644 --- a/LAPACKE/src/lapacke_ssfrk_work.c +++ b/LAPACKE/src/lapacke_ssfrk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssfrk_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssfrk_work)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, float alpha, const float* a, lapack_int lda, float beta, float* c ) @@ -46,15 +46,15 @@ lapack_int LAPACKE_ssfrk_work( int matrix_layout, char transr, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k; - lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n; + lapack_int na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + lapack_int ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; lapack_int lda_t = MAX(1,na); float* a_t = NULL; float* c_t = NULL; /* Check leading dimension(s) */ if( lda < ka ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,25 +70,25 @@ lapack_int LAPACKE_ssfrk_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, na, ka, a, lda, a_t, lda_t ); - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, c, c_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, na, ka, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); + API_SUFFIX(LAPACKE_spf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssfrk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssfrk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspcon.c b/LAPACKE/src/lapacke_sspcon.c index 73bbdfb384..ba85453910 100644 --- a/LAPACKE/src/lapacke_sspcon.c +++ b/LAPACKE/src/lapacke_sspcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspcon)( int matrix_layout, char uplo, lapack_int n, const float* ap, const lapack_int* ipiv, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_sspcon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -4; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_sspcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_sspcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_sspcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspcon_work.c b/LAPACKE/src/lapacke_sspcon_work.c index d0010f059f..49dfde68bc 100644 --- a/LAPACKE/src/lapacke_sspcon_work.c +++ b/LAPACKE/src/lapacke_sspcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspcon_work)( int matrix_layout, char uplo, lapack_int n, const float* ap, const lapack_int* ipiv, float anorm, float* rcond, float* work, lapack_int* iwork ) @@ -54,7 +54,7 @@ lapack_int LAPACKE_sspcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, iwork, &info ); @@ -65,11 +65,11 @@ lapack_int LAPACKE_sspcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspev.c b/LAPACKE/src/lapacke_sspev.c index 5ef49226f6..3da357d1c7 100644 --- a/LAPACKE/src/lapacke_sspev.c +++ b/LAPACKE/src/lapacke_sspev.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspev)( int matrix_layout, char jobz, char uplo, lapack_int n, float* ap, float* w, float* z, lapack_int ldz ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } } @@ -56,13 +56,13 @@ lapack_int LAPACKE_sspev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sspev_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_sspev_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspev_work.c b/LAPACKE/src/lapacke_sspev_work.c index ee8ab7898c..d8dd5c06d9 100644 --- a/LAPACKE/src/lapacke_sspev_work.c +++ b/LAPACKE/src/lapacke_sspev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* ap, float* w, float* z, lapack_int ldz, float* work ) { @@ -50,11 +50,11 @@ lapack_int LAPACKE_sspev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -68,30 +68,30 @@ lapack_int LAPACKE_sspev_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sspev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspevd.c b/LAPACKE/src/lapacke_sspevd.c index 8a7e629126..7ee6cdac68 100644 --- a/LAPACKE/src/lapacke_sspevd.c +++ b/LAPACKE/src/lapacke_sspevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspevd)( int matrix_layout, char jobz, char uplo, lapack_int n, float* ap, float* w, float* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_sspevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sspevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_sspevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_sspevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_sspevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_sspevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspevd_work.c b/LAPACKE/src/lapacke_sspevd_work.c index a49a339fe3..6a65c5c84a 100644 --- a/LAPACKE/src/lapacke_sspevd_work.c +++ b/LAPACKE/src/lapacke_sspevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* ap, float* w, float* z, lapack_int ldz, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -52,7 +52,7 @@ lapack_int LAPACKE_sspevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_sspevd_work( int matrix_layout, char jobz, char uplo, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -76,7 +76,7 @@ lapack_int LAPACKE_sspevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sspevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -84,23 +84,23 @@ lapack_int LAPACKE_sspevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspevx.c b/LAPACKE/src/lapacke_sspevx.c index ba16ed8ebc..5d16414f17 100644 --- a/LAPACKE/src/lapacke_sspevx.c +++ b/LAPACKE/src/lapacke_sspevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* ap, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -42,25 +42,25 @@ lapack_int LAPACKE_sspevx( int matrix_layout, char jobz, char range, char uplo, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_sspevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspevx_work( matrix_layout, jobz, range, uplo, n, ap, vl, vu, + info = API_SUFFIX(LAPACKE_sspevx_work)( matrix_layout, jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_sspevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspevx_work.c b/LAPACKE/src/lapacke_sspevx_work.c index 2c02e8ebb1..55604941db 100644 --- a/LAPACKE/src/lapacke_sspevx_work.c +++ b/LAPACKE/src/lapacke_sspevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sspevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* ap, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, @@ -48,20 +48,20 @@ lapack_int LAPACKE_sspevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); float* z_t = NULL; float* ap_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -76,7 +76,7 @@ lapack_int LAPACKE_sspevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sspevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, &info ); @@ -84,24 +84,24 @@ lapack_int LAPACKE_sspevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgst.c b/LAPACKE/src/lapacke_sspgst.c index 834abeb61a..f8471df4b8 100644 --- a/LAPACKE/src/lapacke_sspgst.c +++ b/LAPACKE/src/lapacke_sspgst.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspgst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, float* ap, const float* bp ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_ssp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, bp ) ) { return -6; } } #endif - return LAPACKE_sspgst_work( matrix_layout, itype, uplo, n, ap, bp ); + return API_SUFFIX(LAPACKE_sspgst_work)( matrix_layout, itype, uplo, n, ap, bp ); } diff --git a/LAPACKE/src/lapacke_sspgst_work.c b/LAPACKE/src/lapacke_sspgst_work.c index 98d55b3a90..512a704bb6 100644 --- a/LAPACKE/src/lapacke_sspgst_work.c +++ b/LAPACKE/src/lapacke_sspgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspgst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, float* ap, const float* bp ) { lapack_int info = 0; @@ -59,26 +59,26 @@ lapack_int LAPACKE_sspgst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_sspgst( &itype, &uplo, &n, ap_t, bp_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgv.c b/LAPACKE/src/lapacke_sspgv.c index 2cbd2b4215..f073f1abbc 100644 --- a/LAPACKE/src/lapacke_sspgv.c +++ b/LAPACKE/src/lapacke_sspgv.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* ap, float* bp, float* w, float* z, lapack_int ldz ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_ssp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, bp ) ) { return -7; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_sspgv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_sspgv_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, + info = API_SUFFIX(LAPACKE_sspgv_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgv_work.c b/LAPACKE/src/lapacke_sspgv_work.c index ae9c2ff61a..6130fc446e 100644 --- a/LAPACKE/src/lapacke_sspgv_work.c +++ b/LAPACKE/src/lapacke_sspgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* ap, float* bp, float* w, float* z, lapack_int ldz, float* work ) { @@ -52,11 +52,11 @@ lapack_int LAPACKE_sspgv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -76,8 +76,8 @@ lapack_int LAPACKE_sspgv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_sspgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &info ); @@ -85,26 +85,26 @@ lapack_int LAPACKE_sspgv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgvd.c b/LAPACKE/src/lapacke_sspgvd.c index df2ddfa5d4..6fca317f1f 100644 --- a/LAPACKE/src/lapacke_sspgvd.c +++ b/LAPACKE/src/lapacke_sspgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* ap, float* bp, float* w, float* z, lapack_int ldz ) { @@ -44,22 +44,22 @@ lapack_int LAPACKE_sspgvd( int matrix_layout, lapack_int itype, char jobz, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_ssp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, bp ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sspgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_sspgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -79,7 +79,7 @@ lapack_int LAPACKE_sspgvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_sspgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_sspgvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgvd_work.c b/LAPACKE/src/lapacke_sspgvd_work.c index 572016567a..f0b97fcd0c 100644 --- a/LAPACKE/src/lapacke_sspgvd_work.c +++ b/LAPACKE/src/lapacke_sspgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* ap, float* bp, float* w, float* z, lapack_int ldz, float* work, lapack_int lwork, lapack_int* iwork, @@ -54,7 +54,7 @@ lapack_int LAPACKE_sspgvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_sspgvd_work( int matrix_layout, lapack_int itype, char jobz, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -84,8 +84,8 @@ lapack_int LAPACKE_sspgvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_sspgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &lwork, iwork, &liwork, &info ); @@ -93,26 +93,26 @@ lapack_int LAPACKE_sspgvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgvx.c b/LAPACKE/src/lapacke_sspgvx.c index 44bcb23997..e9c96fc0eb 100644 --- a/LAPACKE/src/lapacke_sspgvx.c +++ b/LAPACKE/src/lapacke_sspgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* ap, float* bp, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, @@ -42,28 +42,28 @@ lapack_int LAPACKE_sspgvx( int matrix_layout, lapack_int itype, char jobz, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -13; } - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -7; } - if( LAPACKE_ssp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, bp ) ) { return -8; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -9; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -10; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_sspgvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspgvx_work( matrix_layout, itype, jobz, range, uplo, n, ap, + info = API_SUFFIX(LAPACKE_sspgvx_work)( matrix_layout, itype, jobz, range, uplo, n, ap, bp, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_sspgvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspgvx_work.c b/LAPACKE/src/lapacke_sspgvx_work.c index d53877948d..59aceee471 100644 --- a/LAPACKE/src/lapacke_sspgvx_work.c +++ b/LAPACKE/src/lapacke_sspgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspgvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_sspgvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* ap, float* bp, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, @@ -48,9 +48,9 @@ lapack_int LAPACKE_sspgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); float* z_t = NULL; float* ap_t = NULL; @@ -58,11 +58,11 @@ lapack_int LAPACKE_sspgvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -17; - LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -83,8 +83,8 @@ lapack_int LAPACKE_sspgvx_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_sspgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, @@ -93,27 +93,27 @@ lapack_int LAPACKE_sspgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssprfs.c b/LAPACKE/src/lapacke_ssprfs.c index bb61bf77d2..22f2840b8d 100644 --- a/LAPACKE/src/lapacke_ssprfs.c +++ b/LAPACKE/src/lapacke_ssprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const float* afp, const lapack_int* ipiv, const float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -42,22 +42,22 @@ lapack_int LAPACKE_ssprfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_ssprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssprfs_work.c b/LAPACKE/src/lapacke_ssprfs_work.c index f07a0848d8..03244a5286 100644 --- a/LAPACKE/src/lapacke_ssprfs_work.c +++ b/LAPACKE/src/lapacke_ssprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const float* afp, const lapack_int* ipiv, const float* b, lapack_int ldb, float* x, @@ -57,12 +57,12 @@ lapack_int LAPACKE_ssprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ssprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_ssprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_ssprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_ssprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -111,11 +111,11 @@ lapack_int LAPACKE_ssprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspsv.c b/LAPACKE/src/lapacke_sspsv.c index 667eadf934..a115c9a874 100644 --- a/LAPACKE/src/lapacke_sspsv.c +++ b/LAPACKE/src/lapacke_sspsv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* ap, lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_sspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_sspsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_sspsv_work.c b/LAPACKE/src/lapacke_sspsv_work.c index acba6a5393..b632c0263c 100644 --- a/LAPACKE/src/lapacke_sspsv_work.c +++ b/LAPACKE/src/lapacke_sspsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* ap, lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_sspsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_sspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,27 +66,27 @@ lapack_int LAPACKE_sspsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_sspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspsvx.c b/LAPACKE/src/lapacke_sspsvx.c index e89032b297..2a4469922b 100644 --- a/LAPACKE/src/lapacke_sspsvx.c +++ b/LAPACKE/src/lapacke_sspsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sspsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const float* ap, float* afp, lapack_int* ipiv, const float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* ferr, @@ -42,21 +42,21 @@ lapack_int LAPACKE_sspsvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sspsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_ssp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_sspsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sspsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_sspsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_sspsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sspsvx_work.c b/LAPACKE/src/lapacke_sspsvx_work.c index f4c2f5f38d..e68236fc8c 100644 --- a/LAPACKE/src/lapacke_sspsvx_work.c +++ b/LAPACKE/src/lapacke_sspsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sspsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_sspsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const float* ap, float* afp, lapack_int* ipiv, const float* b, lapack_int ldb, float* x, lapack_int ldx, @@ -57,12 +57,12 @@ lapack_int LAPACKE_sspsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_sspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -89,10 +89,10 @@ lapack_int LAPACKE_sspsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_ssp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_sspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -101,9 +101,9 @@ lapack_int LAPACKE_sspsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -115,11 +115,11 @@ lapack_int LAPACKE_sspsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sspsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssptrd.c b/LAPACKE/src/lapacke_ssptrd.c index e62b6aae9d..9f628ecb7d 100644 --- a/LAPACKE/src/lapacke_ssptrd.c +++ b/LAPACKE/src/lapacke_ssptrd.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrd( int matrix_layout, char uplo, lapack_int n, float* ap, +lapack_int API_SUFFIX(LAPACKE_ssptrd)( int matrix_layout, char uplo, lapack_int n, float* ap, float* d, float* e, float* tau ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssptrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_ssptrd_work( matrix_layout, uplo, n, ap, d, e, tau ); + return API_SUFFIX(LAPACKE_ssptrd_work)( matrix_layout, uplo, n, ap, d, e, tau ); } diff --git a/LAPACKE/src/lapacke_ssptrd_work.c b/LAPACKE/src/lapacke_ssptrd_work.c index a33db9917a..a0eefccb0c 100644 --- a/LAPACKE/src/lapacke_ssptrd_work.c +++ b/LAPACKE/src/lapacke_ssptrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssptrd_work)( int matrix_layout, char uplo, lapack_int n, float* ap, float* d, float* e, float* tau ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_ssptrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ssptrd( &uplo, &n, ap_t, d, e, tau, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssptrf.c b/LAPACKE/src/lapacke_ssptrf.c index 7b5d655bc0..10d16da5fb 100644 --- a/LAPACKE/src/lapacke_ssptrf.c +++ b/LAPACKE/src/lapacke_ssptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrf( int matrix_layout, char uplo, lapack_int n, float* ap, +lapack_int API_SUFFIX(LAPACKE_ssptrf)( int matrix_layout, char uplo, lapack_int n, float* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_ssptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_ssptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_ssptrf_work.c b/LAPACKE/src/lapacke_ssptrf_work.c index 7d4135f6a0..373732d7bf 100644 --- a/LAPACKE/src/lapacke_ssptrf_work.c +++ b/LAPACKE/src/lapacke_ssptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssptrf_work)( int matrix_layout, char uplo, lapack_int n, float* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_ssptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ssptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssptri.c b/LAPACKE/src/lapacke_ssptri.c index 7c1ead66a7..d2b65665eb 100644 --- a/LAPACKE/src/lapacke_ssptri.c +++ b/LAPACKE/src/lapacke_ssptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptri( int matrix_layout, char uplo, lapack_int n, float* ap, +lapack_int API_SUFFIX(LAPACKE_ssptri)( int matrix_layout, char uplo, lapack_int n, float* ap, const lapack_int* ipiv ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_ssptri( int matrix_layout, char uplo, lapack_int n, float* ap goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_ssptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssptri_work.c b/LAPACKE/src/lapacke_ssptri_work.c index e8caef5f8d..4fdb86af33 100644 --- a/LAPACKE/src/lapacke_ssptri_work.c +++ b/LAPACKE/src/lapacke_ssptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssptri_work)( int matrix_layout, char uplo, lapack_int n, float* ap, const lapack_int* ipiv, float* work ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_ssptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ssptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ssp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssptrs.c b/LAPACKE/src/lapacke_ssptrs.c index 8a306e74e1..9b692c464d 100644 --- a/LAPACKE/src/lapacke_ssptrs.c +++ b/LAPACKE/src/lapacke_ssptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_ssp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_ssptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_ssptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ssptrs_work.c b/LAPACKE/src/lapacke_ssptrs_work.c index 4987103173..3dcdcefb61 100644 --- a/LAPACKE/src/lapacke_ssptrs_work.c +++ b/LAPACKE/src/lapacke_ssptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* ap, const lapack_int* ipiv, float* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ssptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,26 +67,26 @@ lapack_int LAPACKE_ssptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_ssp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ssptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstebz.c b/LAPACKE/src/lapacke_sstebz.c index ffd4216d25..1ff2e920dd 100644 --- a/LAPACKE/src/lapacke_sstebz.c +++ b/LAPACKE/src/lapacke_sstebz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl, +lapack_int API_SUFFIX(LAPACKE_sstebz)( char range, char order, lapack_int n, float vl, float vu, lapack_int il, lapack_int iu, float abstol, const float* d, const float* e, lapack_int* m, lapack_int* nsplit, float* w, lapack_int* iblock, @@ -44,22 +44,22 @@ lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -8; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -9; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -4; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -5; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstebz_work( range, order, n, vl, vu, il, iu, abstol, d, e, + info = API_SUFFIX(LAPACKE_sstebz_work)( range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_sstebz( char range, char order, lapack_int n, float vl, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstebz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstebz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstebz_work.c b/LAPACKE/src/lapacke_sstebz_work.c index e625b551bf..33d30f2f1a 100644 --- a/LAPACKE/src/lapacke_sstebz_work.c +++ b/LAPACKE/src/lapacke_sstebz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstebz_work( char range, char order, lapack_int n, float vl, +lapack_int API_SUFFIX(LAPACKE_sstebz_work)( char range, char order, lapack_int n, float vl, float vu, lapack_int il, lapack_int iu, float abstol, const float* d, const float* e, lapack_int* m, lapack_int* nsplit, float* w, diff --git a/LAPACKE/src/lapacke_sstedc.c b/LAPACKE/src/lapacke_sstedc.c index b30f851502..2cfc1d2908 100644 --- a/LAPACKE/src/lapacke_sstedc.c +++ b/LAPACKE/src/lapacke_sstedc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_sstedc)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,27 +43,27 @@ lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstedc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstedc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sstedc_work( matrix_layout, compz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_sstedc_work)( matrix_layout, compz, n, d, e, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -82,7 +82,7 @@ lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstedc_work( matrix_layout, compz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_sstedc_work)( matrix_layout, compz, n, d, e, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstedc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstedc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstedc_work.c b/LAPACKE/src/lapacke_sstedc_work.c index 775dd89c51..374a33fe19 100644 --- a/LAPACKE/src/lapacke_sstedc_work.c +++ b/LAPACKE/src/lapacke_sstedc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstedc_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sstedc_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_sstedc_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstedc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_sstedc_work( int matrix_layout, char compz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -69,8 +69,8 @@ lapack_int LAPACKE_sstedc_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_sstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, iwork, @@ -79,20 +79,20 @@ lapack_int LAPACKE_sstedc_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstedc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstedc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstegr.c b/LAPACKE/src/lapacke_sstegr.c index 6711f9258d..0a15ad67a6 100644 --- a/LAPACKE/src/lapacke_sstegr.c +++ b/LAPACKE/src/lapacke_sstegr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstegr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstegr)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -46,35 +46,35 @@ lapack_int LAPACKE_sstegr( int matrix_layout, char jobz, char range, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstegr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstegr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_sstegr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_sstegr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstegr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstegr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstegr_work.c b/LAPACKE/src/lapacke_sstegr_work.c index 99060cc9f4..2b1916cbb7 100644 --- a/LAPACKE/src/lapacke_sstegr_work.c +++ b/LAPACKE/src/lapacke_sstegr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstegr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstegr_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, @@ -53,9 +53,9 @@ lapack_int LAPACKE_sstegr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ - if( ( LAPACKE_lsame( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { + if( ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstegr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_sstegr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { /* Let be always 'n' instead of 'm' */ z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { @@ -82,20 +82,20 @@ lapack_int LAPACKE_sstegr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstegr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstegr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstein.c b/LAPACKE/src/lapacke_sstein.c index cb6412a11a..053edbc95b 100644 --- a/LAPACKE/src/lapacke_sstein.c +++ b/LAPACKE/src/lapacke_sstein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstein( int matrix_layout, lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_sstein)( int matrix_layout, lapack_int n, const float* d, const float* e, lapack_int m, const float* w, const lapack_int* iblock, const lapack_int* isplit, float* z, lapack_int ldz, lapack_int* ifailv ) @@ -41,19 +41,19 @@ lapack_int LAPACKE_sstein( int matrix_layout, lapack_int n, const float* d, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, w, 1 ) ) { return -6; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_sstein( int matrix_layout, lapack_int n, const float* d, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstein_work( matrix_layout, n, d, e, m, w, iblock, isplit, z, + info = API_SUFFIX(LAPACKE_sstein_work)( matrix_layout, n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifailv ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_sstein( int matrix_layout, lapack_int n, const float* d, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstein_work.c b/LAPACKE/src/lapacke_sstein_work.c index 29c227b5f5..ce4053bab5 100644 --- a/LAPACKE/src/lapacke_sstein_work.c +++ b/LAPACKE/src/lapacke_sstein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstein_work( int matrix_layout, lapack_int n, const float* d, +lapack_int API_SUFFIX(LAPACKE_sstein_work)( int matrix_layout, lapack_int n, const float* d, const float* e, lapack_int m, const float* w, const lapack_int* iblock, const lapack_int* isplit, float* z, @@ -53,7 +53,7 @@ lapack_int LAPACKE_sstein_work( int matrix_layout, lapack_int n, const float* d, /* Check leading dimension(s) */ if( ldz < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_sstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,16 +69,16 @@ lapack_int LAPACKE_sstein_work( int matrix_layout, lapack_int n, const float* d, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstemr.c b/LAPACKE/src/lapacke_sstemr.c index 594d5944b3..e1fcfd61ed 100644 --- a/LAPACKE/src/lapacke_sstemr.c +++ b/LAPACKE/src/lapacke_sstemr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstemr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstemr)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* m, float* w, float* z, lapack_int ldz, lapack_int nzc, @@ -46,28 +46,28 @@ lapack_int LAPACKE_sstemr( int matrix_layout, char jobz, char range, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstemr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstemr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_sstemr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_sstemr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstemr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstemr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstemr_work.c b/LAPACKE/src/lapacke_sstemr_work.c index 09ed54b3e8..70dd064571 100644 --- a/LAPACKE/src/lapacke_sstemr_work.c +++ b/LAPACKE/src/lapacke_sstemr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstemr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstemr_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* m, float* w, float* z, @@ -54,9 +54,9 @@ lapack_int LAPACKE_sstemr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) { + if( ldz < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ldz < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_sstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstemr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_sstemr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -82,20 +82,20 @@ lapack_int LAPACKE_sstemr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstemr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstemr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssteqr.c b/LAPACKE/src/lapacke_ssteqr.c index 1ce7476c18..caba20e8f7 100644 --- a/LAPACKE/src/lapacke_ssteqr.c +++ b/LAPACKE/src/lapacke_ssteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssteqr( int matrix_layout, char compz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_ssteqr)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz ) { lapack_int info = 0; @@ -40,27 +40,27 @@ lapack_int LAPACKE_ssteqr( int matrix_layout, char compz, lapack_int n, float* d lapack_int lwork; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,2*n-2); @@ -72,12 +72,12 @@ lapack_int LAPACKE_ssteqr( int matrix_layout, char compz, lapack_int n, float* d goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_ssteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssteqr_work.c b/LAPACKE/src/lapacke_ssteqr_work.c index a76e306704..2be8193e5f 100644 --- a/LAPACKE/src/lapacke_ssteqr_work.c +++ b/LAPACKE/src/lapacke_ssteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssteqr_work)( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_ssteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -61,8 +61,8 @@ lapack_int LAPACKE_ssteqr_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_ssteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -70,20 +70,20 @@ lapack_int LAPACKE_ssteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssterf.c b/LAPACKE/src/lapacke_ssterf.c index a59d7fdb04..0e45e3438d 100644 --- a/LAPACKE/src/lapacke_ssterf.c +++ b/LAPACKE/src/lapacke_ssterf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssterf( lapack_int n, float* d, float* e ) +lapack_int API_SUFFIX(LAPACKE_ssterf)( lapack_int n, float* d, float* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_ssterf_work( n, d, e ); + return API_SUFFIX(LAPACKE_ssterf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_ssterf_work.c b/LAPACKE/src/lapacke_ssterf_work.c index f636a9c8e0..b3deea1cb0 100644 --- a/LAPACKE/src/lapacke_ssterf_work.c +++ b/LAPACKE/src/lapacke_ssterf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssterf_work( lapack_int n, float* d, float* e ) +lapack_int API_SUFFIX(LAPACKE_ssterf_work)( lapack_int n, float* d, float* e ) { lapack_int info = 0; /* Call LAPACK function and adjust info */ diff --git a/LAPACKE/src/lapacke_sstev.c b/LAPACKE/src/lapacke_sstev.c index 743793c0d1..12138ad7ea 100644 --- a/LAPACKE/src/lapacke_sstev.c +++ b/LAPACKE/src/lapacke_sstev.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstev( int matrix_layout, char jobz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_sstev)( int matrix_layout, char jobz, lapack_int n, float* d, float* e, float* z, lapack_int ldz ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n-2) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -61,14 +61,14 @@ lapack_int LAPACKE_sstev( int matrix_layout, char jobz, lapack_int n, float* d, } } /* Call middle-level interface */ - info = LAPACKE_sstev_work( matrix_layout, jobz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_sstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work ); /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstev_work.c b/LAPACKE/src/lapacke_sstev_work.c index 373d2b2217..ee7f6f3b5e 100644 --- a/LAPACKE/src/lapacke_sstev_work.c +++ b/LAPACKE/src/lapacke_sstev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstev_work( int matrix_layout, char jobz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sstev_work)( int matrix_layout, char jobz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_sstev_work( int matrix_layout, char jobz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -66,20 +66,20 @@ lapack_int LAPACKE_sstev_work( int matrix_layout, char jobz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevd.c b/LAPACKE/src/lapacke_sstevd.c index 8a47bb6b2b..def57215c8 100644 --- a/LAPACKE/src/lapacke_sstevd.c +++ b/LAPACKE/src/lapacke_sstevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevd( int matrix_layout, char jobz, lapack_int n, float* d, +lapack_int API_SUFFIX(LAPACKE_sstevd)( int matrix_layout, char jobz, lapack_int n, float* d, float* e, float* z, lapack_int ldz ) { lapack_int info = 0; @@ -43,22 +43,22 @@ lapack_int LAPACKE_sstevd( int matrix_layout, char jobz, lapack_int n, float* d, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sstevd_work( matrix_layout, jobz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_sstevd_work)( matrix_layout, jobz, n, d, e, z, ldz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -77,7 +77,7 @@ lapack_int LAPACKE_sstevd( int matrix_layout, char jobz, lapack_int n, float* d, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstevd_work( matrix_layout, jobz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_sstevd_work)( matrix_layout, jobz, n, d, e, z, ldz, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_sstevd( int matrix_layout, char jobz, lapack_int n, float* d, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevd_work.c b/LAPACKE/src/lapacke_sstevd_work.c index 41900bad9c..c184a2775c 100644 --- a/LAPACKE/src/lapacke_sstevd_work.c +++ b/LAPACKE/src/lapacke_sstevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevd_work( int matrix_layout, char jobz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_sstevd_work)( int matrix_layout, char jobz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_sstevd_work( int matrix_layout, char jobz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_sstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_sstevd_work( int matrix_layout, char jobz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -75,20 +75,20 @@ lapack_int LAPACKE_sstevd_work( int matrix_layout, char jobz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevr.c b/LAPACKE/src/lapacke_sstevr.c index 9908a60b6d..212b25a3ca 100644 --- a/LAPACKE/src/lapacke_sstevr.c +++ b/LAPACKE/src/lapacke_sstevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstevr)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -46,35 +46,35 @@ lapack_int LAPACKE_sstevr( int matrix_layout, char jobz, char range, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_sstevr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstevr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_sstevr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstevr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstevr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_sstevr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevr_work.c b/LAPACKE/src/lapacke_sstevr_work.c index 5ea804af06..0a1d0e9e65 100644 --- a/LAPACKE/src/lapacke_sstevr_work.c +++ b/LAPACKE/src/lapacke_sstevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstevr_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, @@ -50,15 +50,15 @@ lapack_int LAPACKE_sstevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_sstevr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -85,21 +85,21 @@ lapack_int LAPACKE_sstevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevx.c b/LAPACKE/src/lapacke_sstevx.c index 8e27018c90..5ddcd5fde3 100644 --- a/LAPACKE/src/lapacke_sstevx.c +++ b/LAPACKE/src/lapacke_sstevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevx( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstevx)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -42,28 +42,28 @@ lapack_int LAPACKE_sstevx( int matrix_layout, char jobz, char range, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_sstevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_s_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_s_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_sstevx( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_sstevx_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_sstevx_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail ); /* Release memory and exit */ LAPACKE_free( work ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_sstevx( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_sstevx_work.c b/LAPACKE/src/lapacke_sstevx_work.c index fa45159762..c9d9a18e4f 100644 --- a/LAPACKE/src/lapacke_sstevx_work.c +++ b/LAPACKE/src/lapacke_sstevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_sstevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_sstevx_work)( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, @@ -48,19 +48,19 @@ lapack_int LAPACKE_sstevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_sstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -75,21 +75,21 @@ lapack_int LAPACKE_sstevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_sstevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssycon.c b/LAPACKE/src/lapacke_ssycon.c index 0cb6e2ae79..a292b5eb83 100644 --- a/LAPACKE/src/lapacke_ssycon.c +++ b/LAPACKE/src/lapacke_ssycon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssycon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssycon)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_ssycon( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssycon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -66,7 +66,7 @@ lapack_int LAPACKE_ssycon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssycon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_ssycon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssycon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssycon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssycon_3.c b/LAPACKE/src/lapacke_ssycon_3.c index 7870924e78..9219634f4f 100644 --- a/LAPACKE/src/lapacke_ssycon_3.c +++ b/LAPACKE/src/lapacke_ssycon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssycon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssycon_3)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, const float* e, const lapack_int* ipiv, float anorm, float* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; float* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssycon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_ssycon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_ssycon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_ssycon_3( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssycon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssycon_3_work.c b/LAPACKE/src/lapacke_ssycon_3_work.c index db0a7df25f..e11ffa3311 100644 --- a/LAPACKE/src/lapacke_ssycon_3_work.c +++ b/LAPACKE/src/lapacke_ssycon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssycon_3_work)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, const float* e, const lapack_int* ipiv, float anorm, float* rcond, float* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssycon_work.c b/LAPACKE/src/lapacke_ssycon_work.c index afe14b5f77..fa86260505 100644 --- a/LAPACKE/src/lapacke_ssycon_work.c +++ b/LAPACKE/src/lapacke_ssycon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssycon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssycon_work)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, const lapack_int* ipiv, float anorm, float* rcond, float* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ssycon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_ssycon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_ssycon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssycon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyconv.c b/LAPACKE/src/lapacke_ssyconv.c index 9b0ebbddc2..5d18dd410c 100644 --- a/LAPACKE/src/lapacke_ssyconv.c +++ b/LAPACKE/src/lapacke_ssyconv.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyconv( int matrix_layout, char uplo, char way, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyconv)( int matrix_layout, char uplo, char way, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* e ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyconv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyconv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - return LAPACKE_ssyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, e ); + return API_SUFFIX(LAPACKE_ssyconv_work)( matrix_layout, uplo, way, n, a, lda, ipiv, e ); } diff --git a/LAPACKE/src/lapacke_ssyconv_work.c b/LAPACKE/src/lapacke_ssyconv_work.c index 668775f743..8189f85422 100644 --- a/LAPACKE/src/lapacke_ssyconv_work.c +++ b/LAPACKE/src/lapacke_ssyconv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, +lapack_int API_SUFFIX(LAPACKE_ssyconv_work)( int matrix_layout, char uplo, char way, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* e ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyconv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, e, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyconv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyconv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyequb.c b/LAPACKE/src/lapacke_ssyequb.c index 7784923ad5..cafd2ac6c0 100644 --- a/LAPACKE/src/lapacke_ssyequb.c +++ b/LAPACKE/src/lapacke_ssyequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyequb)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_ssyequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssyequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_ssyequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyequb_work.c b/LAPACKE/src/lapacke_ssyequb_work.c index 3979d6f79e..6bf7bd9ceb 100644 --- a/LAPACKE/src/lapacke_ssyequb_work.c +++ b/LAPACKE/src/lapacke_ssyequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyequb_work)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssyequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,7 +59,7 @@ lapack_int LAPACKE_ssyequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -69,11 +69,11 @@ lapack_int LAPACKE_ssyequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyev.c b/LAPACKE/src/lapacke_ssyev.c index 0bf5cf8311..d18786deba 100644 --- a/LAPACKE/src/lapacke_ssyev.c +++ b/LAPACKE/src/lapacke_ssyev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyev)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssyev( int matrix_layout, char jobz, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyev_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_ssyev_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssyev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssyev_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_ssyev_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyev_2stage.c b/LAPACKE/src/lapacke_ssyev_2stage.c index cc4ecc04ec..9b4150f56b 100644 --- a/LAPACKE/src/lapacke_ssyev_2stage.c +++ b/LAPACKE/src/lapacke_ssyev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssyev_2stage( int matrix_layout, char jobz, char uplo, lapack float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_ssyev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssyev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssyev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_ssyev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyev_2stage_work.c b/LAPACKE/src/lapacke_ssyev_2stage_work.c index 7c46efc8f1..f0310f85ee 100644 --- a/LAPACKE/src/lapacke_ssyev_2stage_work.c +++ b/LAPACKE/src/lapacke_ssyev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssyev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssyev_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyev_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyev_work.c b/LAPACKE/src/lapacke_ssyev_work.c index 259fd90d2d..8310227989 100644 --- a/LAPACKE/src/lapacke_ssyev_work.c +++ b/LAPACKE/src/lapacke_ssyev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssyev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_ssyev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { @@ -72,19 +72,19 @@ lapack_int LAPACKE_ssyev_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevd.c b/LAPACKE/src/lapacke_ssyevd.c index 317cd0cd0a..ee5a0da7f0 100644 --- a/LAPACKE/src/lapacke_ssyevd.c +++ b/LAPACKE/src/lapacke_ssyevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyevd)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyevd_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_ssyevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevd_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_ssyevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevd_2stage.c b/LAPACKE/src/lapacke_ssyevd_2stage.c index c723dd1261..e006ed5683 100644 --- a/LAPACKE/src/lapacke_ssyevd_2stage.c +++ b/LAPACKE/src/lapacke_ssyevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w ) { lapack_int info = 0; @@ -43,19 +43,19 @@ lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapac lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_ssyevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_ssyevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevd_2stage_work.c b/LAPACKE/src/lapacke_ssyevd_2stage_work.c index 6604d2a5f5..a06cc2c3b9 100644 --- a/LAPACKE/src/lapacke_ssyevd_2stage_work.c +++ b/LAPACKE/src/lapacke_ssyevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,19 +76,19 @@ lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevd_work.c b/LAPACKE/src/lapacke_ssyevd_work.c index 85679e6e46..87139c3973 100644 --- a/LAPACKE/src/lapacke_ssyevd_work.c +++ b/LAPACKE/src/lapacke_ssyevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,19 +76,19 @@ lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevr.c b/LAPACKE/src/lapacke_ssyevr.c index efbbaa73ae..27b94afc40 100644 --- a/LAPACKE/src/lapacke_ssyevr.c +++ b/LAPACKE/src/lapacke_ssyevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevr( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevr)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -46,32 +46,32 @@ lapack_int LAPACKE_ssyevr( int matrix_layout, char jobz, char range, char uplo, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_ssyevr( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_ssyevr( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevr_2stage.c b/LAPACKE/src/lapacke_ssyevr_2stage.c index c7f17378de..6421990222 100644 --- a/LAPACKE/src/lapacke_ssyevr_2stage.c +++ b/LAPACKE/src/lapacke_ssyevr_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevr_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevr_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -46,32 +46,32 @@ lapack_int LAPACKE_ssyevr_2stage( int matrix_layout, char jobz, char range, char lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssyevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_ssyevr_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -100,7 +100,7 @@ lapack_int LAPACKE_ssyevr_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevr_2stage_work.c b/LAPACKE/src/lapacke_ssyevr_2stage_work.c index cbb62d1954..ede8591666 100644 --- a/LAPACKE/src/lapacke_ssyevr_2stage_work.c +++ b/LAPACKE/src/lapacke_ssyevr_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssyevr_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -51,9 +51,9 @@ lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; @@ -61,12 +61,12 @@ lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevr_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -100,24 +100,24 @@ lapack_int LAPACKE_ssyevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevr_work.c b/LAPACKE/src/lapacke_ssyevr_work.c index c6e0e3a2e5..8792ae9137 100644 --- a/LAPACKE/src/lapacke_ssyevr_work.c +++ b/LAPACKE/src/lapacke_ssyevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssyevr_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -51,10 +51,10 @@ lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; @@ -62,12 +62,12 @@ lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,7 +83,7 @@ lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -101,24 +101,24 @@ lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevx.c b/LAPACKE/src/lapacke_ssyevx.c index 5b949d2c53..1bebf5f8dd 100644 --- a/LAPACKE/src/lapacke_ssyevx.c +++ b/LAPACKE/src/lapacke_ssyevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -44,25 +44,25 @@ lapack_int LAPACKE_ssyevx( int matrix_layout, char jobz, char range, char uplo, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssyevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ssyevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_ssyevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_ssyevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevx_2stage.c b/LAPACKE/src/lapacke_ssyevx_2stage.c index 2c5f4c7f37..b2fa28350e 100644 --- a/LAPACKE/src/lapacke_ssyevx_2stage.c +++ b/LAPACKE/src/lapacke_ssyevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssyevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, @@ -44,25 +44,25 @@ lapack_int LAPACKE_ssyevx_2stage( int matrix_layout, char jobz, char range, char float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssyevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ssyevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -89,7 +89,7 @@ lapack_int LAPACKE_ssyevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_ssyevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_ssyevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevx_2stage_work.c b/LAPACKE/src/lapacke_ssyevx_2stage_work.c index 3b8b08f436..ca64d1bde8 100644 --- a/LAPACKE/src/lapacke_ssyevx_2stage_work.c +++ b/LAPACKE/src/lapacke_ssyevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssyevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -50,9 +50,9 @@ lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; @@ -60,12 +60,12 @@ lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevx_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork, @@ -99,24 +99,24 @@ lapack_int LAPACKE_ssyevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyevx_work.c b/LAPACKE/src/lapacke_ssyevx_work.c index 45beee937a..a491134ae5 100644 --- a/LAPACKE/src/lapacke_ssyevx_work.c +++ b/LAPACKE/src/lapacke_ssyevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_ssyevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -50,10 +50,10 @@ lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; @@ -61,12 +61,12 @@ lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ssyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork, @@ -100,24 +100,24 @@ lapack_int LAPACKE_ssyevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygst.c b/LAPACKE/src/lapacke_ssygst.c index 267ca34b0e..fd1f110d4d 100644 --- a/LAPACKE/src/lapacke_ssygst.c +++ b/LAPACKE/src/lapacke_ssygst.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssygst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, float* a, lapack_int lda, const float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssygst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -7; } } #endif - return LAPACKE_ssygst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_ssygst_work)( matrix_layout, itype, uplo, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ssygst_work.c b/LAPACKE/src/lapacke_ssygst_work.c index 356079da46..85a956b015 100644 --- a/LAPACKE/src/lapacke_ssygst_work.c +++ b/LAPACKE/src/lapacke_ssygst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssygst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, float* a, lapack_int lda, const float* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_ssygst_work( int matrix_layout, lapack_int itype, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygst_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_ssygst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssygst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygv.c b/LAPACKE/src/lapacke_ssygv.c index 367c50c943..e3be454a19 100644 --- a/LAPACKE/src/lapacke_ssygv.c +++ b/LAPACKE/src/lapacke_ssygv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssygv( int matrix_layout, lapack_int itype, char jobz, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssygv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssygv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssygv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssygv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygv_2stage.c b/LAPACKE/src/lapacke_ssygv_2stage.c index 257aa83b6c..292e65de6d 100644 --- a/LAPACKE/src/lapacke_ssygv_2stage.c +++ b/LAPACKE/src/lapacke_ssygv_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygv_2stage( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygv_2stage)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssygv_2stage( int matrix_layout, lapack_int itype, char jobz, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssygv_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssygv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssygv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssygv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygv_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygv_2stage_work.c b/LAPACKE/src/lapacke_ssygv_2stage_work.c index d2bd07ac74..e01a68d06d 100644 --- a/LAPACKE/src/lapacke_ssygv_2stage_work.c +++ b/LAPACKE/src/lapacke_ssygv_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygv_2stage_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygv_2stage_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssygv_2stage_work( int matrix_layout, lapack_int itype, char /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssygv_2stage_work( int matrix_layout, lapack_int itype, char goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygv_2stage( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssygv_2stage_work( int matrix_layout, lapack_int itype, char info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssygv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygv_work.c b/LAPACKE/src/lapacke_ssygv_work.c index d5873d5bc5..ecc57e1332 100644 --- a/LAPACKE/src/lapacke_ssygv_work.c +++ b/LAPACKE/src/lapacke_ssygv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssygv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssygv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssygv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssygv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygvd.c b/LAPACKE/src/lapacke_ssygvd.c index 4fd120abdc..2ee675ee6b 100644 --- a/LAPACKE/src/lapacke_ssygvd.c +++ b/LAPACKE/src/lapacke_ssygvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w ) { @@ -44,22 +44,22 @@ lapack_int LAPACKE_ssygvd( int matrix_layout, lapack_int itype, char jobz, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssygvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssygvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -79,7 +79,7 @@ lapack_int LAPACKE_ssygvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssygvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ssygvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_ssygvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygvd_work.c b/LAPACKE/src/lapacke_ssygvd_work.c index 1cd9a3aa41..a76bad8948 100644 --- a/LAPACKE/src/lapacke_ssygvd_work.c +++ b/LAPACKE/src/lapacke_ssygvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* w, float* work, lapack_int lwork, @@ -54,12 +54,12 @@ lapack_int LAPACKE_ssygvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -80,8 +80,8 @@ lapack_int LAPACKE_ssygvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, iwork, &liwork, &info ); @@ -89,19 +89,19 @@ lapack_int LAPACKE_ssygvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssygvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygvx.c b/LAPACKE/src/lapacke_ssygvx.c index 9e8b63355d..c36df28a3b 100644 --- a/LAPACKE/src/lapacke_ssygvx.c +++ b/LAPACKE/src/lapacke_ssygvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float vl, float vu, lapack_int il, lapack_int iu, float abstol, @@ -45,28 +45,28 @@ lapack_int LAPACKE_ssygvx( int matrix_layout, lapack_int itype, char jobz, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssygvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -79,7 +79,7 @@ lapack_int LAPACKE_ssygvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ssygvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_ssygvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, iwork, ifail ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_ssygvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssygvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_ssygvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_ssygvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssygvx_work.c b/LAPACKE/src/lapacke_ssygvx_work.c index d17dd8da23..9a9a8b3fda 100644 --- a/LAPACKE/src/lapacke_ssygvx_work.c +++ b/LAPACKE/src/lapacke_ssygvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_ssygvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float vl, float vu, lapack_int il, @@ -51,9 +51,9 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -63,17 +63,17 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { @@ -103,8 +103,8 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, } } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_ssy_trans( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -113,14 +113,14 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -129,11 +129,11 @@ lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssygvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyrfs.c b/LAPACKE/src/lapacke_ssyrfs.c index 0fab0a7342..972b310fd6 100644 --- a/LAPACKE/src/lapacke_ssyrfs.c +++ b/LAPACKE/src/lapacke_ssyrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_ssyrfs( int matrix_layout, char uplo, lapack_int n, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_ssyrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyrfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_ssyrfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -83,7 +83,7 @@ lapack_int LAPACKE_ssyrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyrfs_work.c b/LAPACKE/src/lapacke_ssyrfs_work.c index 247b717a61..b77db74fff 100644 --- a/LAPACKE/src/lapacke_ssyrfs_work.c +++ b/LAPACKE/src/lapacke_ssyrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_ssyrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,10 +100,10 @@ lapack_int LAPACKE_ssyrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_ssy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_ssyrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_ssyrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyrfsx.c b/LAPACKE/src/lapacke_ssyrfsx.c index 10b855e5ea..9b5f46b638 100644 --- a/LAPACKE/src/lapacke_ssyrfsx.c +++ b/LAPACKE/src/lapacke_ssyrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyrfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_ssyrfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, const float* s, @@ -46,32 +46,32 @@ lapack_int LAPACKE_ssyrfsx( int matrix_layout, char uplo, char equed, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -88,7 +88,7 @@ lapack_int LAPACKE_ssyrfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssyrfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_ssyrfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_ssyrfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyrfsx_work.c b/LAPACKE/src/lapacke_ssyrfsx_work.c index 17dda3f41f..d99c851e29 100644 --- a/LAPACKE/src/lapacke_ssyrfsx_work.c +++ b/LAPACKE/src/lapacke_ssyrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyrfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_ssyrfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* af, lapack_int ldaf, const lapack_int* ipiv, @@ -67,22 +67,22 @@ lapack_int LAPACKE_ssyrfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,10 +119,10 @@ lapack_int LAPACKE_ssyrfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_ssy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyrfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -132,10 +132,10 @@ lapack_int LAPACKE_ssyrfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -151,11 +151,11 @@ lapack_int LAPACKE_ssyrfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv.c b/LAPACKE/src/lapacke_ssysv.c index 44c714e63d..8d01fc8491 100644 --- a/LAPACKE/src/lapacke_ssysv.c +++ b/LAPACKE/src/lapacke_ssysv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssysv( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssysv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_aa.c b/LAPACKE/src/lapacke_ssysv_aa.c index ab03c3bc6f..f2ac2a9653 100644 --- a/LAPACKE/src/lapacke_ssysv_aa.c +++ b/LAPACKE/src/lapacke_ssysv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssysv_aa( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssysv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_aa_2stage.c b/LAPACKE/src/lapacke_ssysv_aa_2stage.c index 3f9d8963bd..937786bb9e 100644 --- a/LAPACKE/src/lapacke_ssysv_aa_2stage.c +++ b/LAPACKE/src/lapacke_ssysv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int ldb ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_ssysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -75,14 +75,14 @@ lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_ssysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_aa_2stage_work.c b/LAPACKE/src/lapacke_ssysv_aa_2stage_work.c index 661bc80e54..a34247eaef 100644 --- a/LAPACKE/src/lapacke_ssysv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_ssysv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_aa_work.c b/LAPACKE/src/lapacke_ssysv_aa_work.c index 63aba3a6eb..a6da2e1ce0 100644 --- a/LAPACKE/src/lapacke_ssysv_aa_work.c +++ b/LAPACKE/src/lapacke_ssysv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssysv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssysv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssysv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_rk.c b/LAPACKE/src/lapacke_ssysv_rk.c index 2e8669c4ae..5c0b1f86ef 100644 --- a/LAPACKE/src/lapacke_ssysv_rk.c +++ b/LAPACKE/src/lapacke_ssysv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* e, lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssysv_rk( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssysv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_ssysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_rk_work.c b/LAPACKE/src/lapacke_ssysv_rk_work.c index a38699a40a..25fb739358 100644 --- a/LAPACKE/src/lapacke_ssysv_rk_work.c +++ b/LAPACKE/src/lapacke_ssysv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* e, lapack_int* ipiv, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_rook.c b/LAPACKE/src/lapacke_ssysv_rook.c index 361643d17e..e2f6b4787d 100644 --- a/LAPACKE/src/lapacke_ssysv_rook.c +++ b/LAPACKE/src/lapacke_ssysv_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssysv_rook( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,13 +69,13 @@ lapack_int LAPACKE_ssysv_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_rook_work.c b/LAPACKE/src/lapacke_ssysv_rook_work.c index c4b3984799..bd6bf5692d 100644 --- a/LAPACKE/src/lapacke_ssysv_rook_work.c +++ b/LAPACKE/src/lapacke_ssysv_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssysv_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssysv_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysv_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssysv_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysv_work.c b/LAPACKE/src/lapacke_ssysv_work.c index 28e164f5bc..2b8f3c46f4 100644 --- a/LAPACKE/src/lapacke_ssysv_work.c +++ b/LAPACKE/src/lapacke_ssysv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ssysv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,8 +79,8 @@ lapack_int LAPACKE_ssysv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -88,19 +88,19 @@ lapack_int LAPACKE_ssysv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysvx.c b/LAPACKE/src/lapacke_ssysvx.c index 3ffc65b367..e7b95d9313 100644 --- a/LAPACKE/src/lapacke_ssysvx.c +++ b/LAPACKE/src/lapacke_ssysvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssysvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, const float* b, lapack_int ldb, float* x, @@ -45,21 +45,21 @@ lapack_int LAPACKE_ssysvx( int matrix_layout, char fact, char uplo, lapack_int n float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_ssysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ssysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_ssysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, iwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_ssysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_ssysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, iwork ); /* Release memory and exit */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_ssysvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysvx_work.c b/LAPACKE/src/lapacke_ssysvx_work.c index b35ce341ff..1ccd58899e 100644 --- a/LAPACKE/src/lapacke_ssysvx_work.c +++ b/LAPACKE/src/lapacke_ssysvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssysvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, const float* b, @@ -62,22 +62,22 @@ lapack_int LAPACKE_ssysvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -109,11 +109,11 @@ lapack_int LAPACKE_ssysvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_ssy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -122,11 +122,11 @@ lapack_int LAPACKE_ssysvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -137,11 +137,11 @@ lapack_int LAPACKE_ssysvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysvxx.c b/LAPACKE/src/lapacke_ssysvxx.c index 3553e6073d..e85f8b1328 100644 --- a/LAPACKE/src/lapacke_ssysvxx.c +++ b/LAPACKE/src/lapacke_ssysvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssysvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, char* equed, float* s, float* b, @@ -46,30 +46,30 @@ lapack_int LAPACKE_ssysvxx( int matrix_layout, char fact, char uplo, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssysvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_s_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, s, 1 ) ) { return -12; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_ssysvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ssysvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_ssysvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork ); @@ -97,7 +97,7 @@ lapack_int LAPACKE_ssysvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssysvxx_work.c b/LAPACKE/src/lapacke_ssysvxx_work.c index 94a032d59a..1baefe958d 100644 --- a/LAPACKE/src/lapacke_ssysvxx_work.c +++ b/LAPACKE/src/lapacke_ssysvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssysvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_ssysvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, char* equed, float* s, @@ -67,22 +67,22 @@ lapack_int LAPACKE_ssysvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -119,11 +119,11 @@ lapack_int LAPACKE_ssysvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_ssy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssysvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -133,20 +133,20 @@ lapack_int LAPACKE_ssysvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -162,11 +162,11 @@ lapack_int LAPACKE_ssysvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssysvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssyswapr.c b/LAPACKE/src/lapacke_ssyswapr.c index 151f10ffb2..e9be1c5d55 100644 --- a/LAPACKE/src/lapacke_ssyswapr.c +++ b/LAPACKE/src/lapacke_ssyswapr.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_ssyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_ssyswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_ssyswapr_work.c b/LAPACKE/src/lapacke_ssyswapr_work.c index d12ca5fc15..f62950a79b 100644 --- a/LAPACKE/src/lapacke_ssyswapr_work.c +++ b/LAPACKE/src/lapacke_ssyswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssyswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssyswapr_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -53,21 +53,21 @@ lapack_int LAPACKE_ssyswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssyswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrd.c b/LAPACKE/src/lapacke_ssytrd.c index fa14112b74..5be16d6087 100644 --- a/LAPACKE/src/lapacke_ssytrd.c +++ b/LAPACKE/src/lapacke_ssytrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrd( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytrd)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* d, float* e, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytrd( int matrix_layout, char uplo, lapack_int n, float* a, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, + info = API_SUFFIX(LAPACKE_ssytrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssytrd( int matrix_layout, char uplo, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, work, + info = API_SUFFIX(LAPACKE_ssytrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrd_work.c b/LAPACKE/src/lapacke_ssytrd_work.c index 19bfb2a684..ad33e8c9ff 100644 --- a/LAPACKE/src/lapacke_ssytrd_work.c +++ b/LAPACKE/src/lapacke_ssytrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrd_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* d, float* e, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytrd_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_ssytrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf.c b/LAPACKE/src/lapacke_ssytrf.c index d5664ae127..d8671e7009 100644 --- a/LAPACKE/src/lapacke_ssytrf.c +++ b/LAPACKE/src/lapacke_ssytrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytrf)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytrf( int matrix_layout, char uplo, lapack_int n, float* a, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssytrf( int matrix_layout, char uplo, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_aa.c b/LAPACKE/src/lapacke_ssytrf_aa.c index 3f5cf78dbf..3a23a65e1e 100644 --- a/LAPACKE/src/lapacke_ssytrf_aa.c +++ b/LAPACKE/src/lapacke_ssytrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_aa( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytrf_aa)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytrf_aa( int matrix_layout, char uplo, lapack_int n, float* float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssytrf_aa( int matrix_layout, char uplo, lapack_int n, float* goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_aa_2stage.c b/LAPACKE/src/lapacke_ssytrf_aa_2stage.c index 8d3fba851e..a7e2b5dcfb 100644 --- a/LAPACKE/src/lapacke_ssytrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_ssytrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_ssytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_ssytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_aa_2stage_work.c b/LAPACKE/src/lapacke_ssytrf_aa_2stage_work.c index ba697fab50..f78b8d7da3 100644 --- a/LAPACKE/src/lapacke_ssytrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_ssytrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -90,18 +90,18 @@ lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_aa_work.c b/LAPACKE/src/lapacke_ssytrf_aa_work.c index 5931efb01b..beea261f03 100644 --- a/LAPACKE/src/lapacke_ssytrf_aa_work.c +++ b/LAPACKE/src/lapacke_ssytrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_aa_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssytrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_rk.c b/LAPACKE/src/lapacke_ssytrf_rk.c index 060c680120..40c36ef6c9 100644 --- a/LAPACKE/src/lapacke_ssytrf_rk.c +++ b/LAPACKE/src/lapacke_ssytrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytrf_rk)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* e, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_ssytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_rk_work.c b/LAPACKE/src/lapacke_ssytrf_rk_work.c index 07531d6ba4..a5b9b07be1 100644 --- a/LAPACKE/src/lapacke_ssytrf_rk_work.c +++ b/LAPACKE/src/lapacke_ssytrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_rk_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, float* e, lapack_int* ipiv, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssytrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_rook.c b/LAPACKE/src/lapacke_ssytrf_rook.c index 67ef606846..c1ea5bbf68 100644 --- a/LAPACKE/src/lapacke_ssytrf_rook.c +++ b/LAPACKE/src/lapacke_ssytrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_rook( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytrf_rook)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytrf_rook( int matrix_layout, char uplo, lapack_int n, floa float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,13 +65,13 @@ lapack_int LAPACKE_ssytrf_rook( int matrix_layout, char uplo, lapack_int n, floa goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_rook_work.c b/LAPACKE/src/lapacke_ssytrf_rook_work.c index aaa0c6057c..629f89ae2c 100644 --- a/LAPACKE/src/lapacke_ssytrf_rook_work.c +++ b/LAPACKE/src/lapacke_ssytrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_rook_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssytrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrf_work.c b/LAPACKE/src/lapacke_ssytrf_work.c index 0b78eaab3e..f2355ca154 100644 --- a/LAPACKE/src/lapacke_ssytrf_work.c +++ b/LAPACKE/src/lapacke_ssytrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrf_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, lapack_int* ipiv, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssytrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri.c b/LAPACKE/src/lapacke_ssytri.c index ac8ad22528..722dfbb63c 100644 --- a/LAPACKE/src/lapacke_ssytri.c +++ b/LAPACKE/src/lapacke_ssytri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytri)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -56,12 +56,12 @@ lapack_int LAPACKE_ssytri( int matrix_layout, char uplo, lapack_int n, float* a, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_ssytri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri2.c b/LAPACKE/src/lapacke_ssytri2.c index de321708c6..33ab53e759 100644 --- a/LAPACKE/src/lapacke_ssytri2.c +++ b/LAPACKE/src/lapacke_ssytri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytri2)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_ssytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -66,13 +66,13 @@ lapack_int LAPACKE_ssytri2( int matrix_layout, char uplo, lapack_int n, float* a goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri2_work.c b/LAPACKE/src/lapacke_ssytri2_work.c index 0f9f73d52a..888460ae6b 100644 --- a/LAPACKE/src/lapacke_ssytri2_work.c +++ b/LAPACKE/src/lapacke_ssytri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytri2_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_ssytri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_ssytri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri2x.c b/LAPACKE/src/lapacke_ssytri2x.c index 4702880f90..dc3c4955f1 100644 --- a/LAPACKE/src/lapacke_ssytri2x.c +++ b/LAPACKE/src/lapacke_ssytri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytri2x)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -57,13 +57,13 @@ lapack_int LAPACKE_ssytri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_ssytri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri2x_work.c b/LAPACKE/src/lapacke_ssytri2x_work.c index 33174aaa00..a61ee4e6ae 100644 --- a/LAPACKE/src/lapacke_ssytri2x_work.c +++ b/LAPACKE/src/lapacke_ssytri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytri2x_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_ssytri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_ssytri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri_3.c b/LAPACKE/src/lapacke_ssytri_3.c index 79dd0157d1..c2a706f267 100644 --- a/LAPACKE/src/lapacke_ssytri_3.c +++ b/LAPACKE/src/lapacke_ssytri_3.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri_3( int matrix_layout, char uplo, lapack_int n, float* a, +lapack_int API_SUFFIX(LAPACKE_ssytri_3)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const float* e, const lapack_int* ipiv ) { lapack_int info = 0; lapack_int lwork = -1; float* work = NULL; float work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_s_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_ssytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_ssytri_3( int matrix_layout, char uplo, lapack_int n, float* goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork); + info = API_SUFFIX(LAPACKE_ssytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri_3_work.c b/LAPACKE/src/lapacke_ssytri_3_work.c index c60c613e3f..ff13d5ca32 100644 --- a/LAPACKE/src/lapacke_ssytri_3_work.c +++ b/LAPACKE/src/lapacke_ssytri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytri_3_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const float* e, const lapack_int* ipiv, float* work, lapack_int lwork) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_ssytri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytri_work.c b/LAPACKE/src/lapacke_ssytri_work.c index 5cee20b5ed..30ca61499b 100644 --- a/LAPACKE/src/lapacke_ssytri_work.c +++ b/LAPACKE/src/lapacke_ssytri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytri_work)( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ssytri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ssytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_ssytri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs.c b/LAPACKE/src/lapacke_ssytrs.c index 8b84eccf41..a3016be032 100644 --- a/LAPACKE/src/lapacke_ssytrs.c +++ b/LAPACKE/src/lapacke_ssytrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_ssytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_ssytrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ssytrs2.c b/LAPACKE/src/lapacke_ssytrs2.c index 97325966d2..421f980915 100644 --- a/LAPACKE/src/lapacke_ssytrs2.c +++ b/LAPACKE/src/lapacke_ssytrs2.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_ssytrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssytrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs2_work.c b/LAPACKE/src/lapacke_ssytrs2_work.c index e8b50cf26d..1b3415676b 100644 --- a/LAPACKE/src/lapacke_ssytrs2_work.c +++ b/LAPACKE/src/lapacke_ssytrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb, float* work ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_3.c b/LAPACKE/src/lapacke_ssytrs_3.c index d0fd17a3cb..c84c1b0d4e 100644 --- a/LAPACKE/src/lapacke_ssytrs_3.c +++ b/LAPACKE/src/lapacke_ssytrs_3.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* e, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_s_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_ssytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_ssytrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ssytrs_3_work.c b/LAPACKE/src/lapacke_ssytrs_3_work.c index ad5dac9e6a..22534debc6 100644 --- a/LAPACKE/src/lapacke_ssytrs_3_work.c +++ b/LAPACKE/src/lapacke_ssytrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* e, const lapack_int* ipiv, float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_aa.c b/LAPACKE/src/lapacke_ssytrs_aa.c index 665e9ed988..d0c94ebbf8 100644 --- a/LAPACKE/src/lapacke_ssytrs_aa.c +++ b/LAPACKE/src/lapacke_ssytrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_ssytrs_aa( int matrix_layout, char uplo, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ssytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_ssytrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ssytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_ssytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_aa_2stage.c b/LAPACKE/src/lapacke_ssytrs_aa_2stage.c index d03def93ea..bbdc204453 100644 --- a/LAPACKE/src/lapacke_ssytrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_ssytrs_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -40,25 +40,25 @@ lapack_int LAPACKE_ssytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_ssytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_ssytrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb ); return info; diff --git a/LAPACKE/src/lapacke_ssytrs_aa_2stage_work.c b/LAPACKE/src/lapacke_ssytrs_aa_2stage_work.c index a2644029c3..3feac00264 100644 --- a/LAPACKE/src/lapacke_ssytrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_ssytrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int ldb ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_ssy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_aa_work.c b/LAPACKE/src/lapacke_ssytrs_aa_work.c index 7bfd6086aa..35b263d231 100644 --- a/LAPACKE/src/lapacke_ssytrs_aa_work.c +++ b/LAPACKE/src/lapacke_ssytrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb, float* work, lapack_int lwork ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_ssytrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_ssytrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_ssytrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_rook.c b/LAPACKE/src/lapacke_ssytrs_rook.c index bba3d2352e..812093dac8 100644 --- a/LAPACKE/src/lapacke_ssytrs_rook.c +++ b/LAPACKE/src/lapacke_ssytrs_rook.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ssy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_ssytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_ssytrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ssytrs_rook_work.c b/LAPACKE/src/lapacke_ssytrs_rook_work.c index 93d03e819c..ad0835553f 100644 --- a/LAPACKE/src/lapacke_ssytrs_rook_work.c +++ b/LAPACKE/src/lapacke_ssytrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_ssytrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_ssytrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_ssytrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ssytrs_work.c b/LAPACKE/src/lapacke_ssytrs_work.c index f98aa4ae6d..403a6f83b9 100644 --- a/LAPACKE/src/lapacke_ssytrs_work.c +++ b/LAPACKE/src/lapacke_ssytrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ssytrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ssytrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_ssytrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ssytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ssytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,8 +72,8 @@ lapack_int LAPACKE_ssytrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ssy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -81,18 +81,18 @@ lapack_int LAPACKE_ssytrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ssytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ssytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssytrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stbcon.c b/LAPACKE/src/lapacke_stbcon.c index 8c27b4b4aa..a219c494c1 100644 --- a/LAPACKE/src/lapacke_stbcon.c +++ b/LAPACKE/src/lapacke_stbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_stbcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_stbcon( int matrix_layout, char norm, char uplo, char diag, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_stb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -7; } } @@ -63,7 +63,7 @@ lapack_int LAPACKE_stbcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stbcon_work( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, + info = API_SUFFIX(LAPACKE_stbcon_work)( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -71,7 +71,7 @@ lapack_int LAPACKE_stbcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stbcon_work.c b/LAPACKE/src/lapacke_stbcon_work.c index d3ac7c80b8..9dcc7ddc5f 100644 --- a/LAPACKE/src/lapacke_stbcon_work.c +++ b/LAPACKE/src/lapacke_stbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_stbcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab, float* rcond, float* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_stbcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_stbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_stbcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_stb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_stb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_stbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work, @@ -73,11 +73,11 @@ lapack_int LAPACKE_stbcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stbrfs.c b/LAPACKE/src/lapacke_stbrfs.c index 860e66c5d9..8c58ce6d87 100644 --- a/LAPACKE/src/lapacke_stbrfs.c +++ b/LAPACKE/src/lapacke_stbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_stbrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, const float* b, lapack_int ldb, const float* x, lapack_int ldx, @@ -42,19 +42,19 @@ lapack_int LAPACKE_stbrfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_stb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_stbrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stbrfs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + info = API_SUFFIX(LAPACKE_stbrfs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_stbrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stbrfs_work.c b/LAPACKE/src/lapacke_stbrfs_work.c index 39d19f9e6d..a45aee240c 100644 --- a/LAPACKE/src/lapacke_stbrfs_work.c +++ b/LAPACKE/src/lapacke_stbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_stbrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, const float* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_stbrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,10 +87,10 @@ lapack_int LAPACKE_stbrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_stb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_stb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_stbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -105,11 +105,11 @@ lapack_int LAPACKE_stbrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stbtrs.c b/LAPACKE/src/lapacke_stbtrs.c index 3421eae3bb..39f6ff04c2 100644 --- a/LAPACKE/src/lapacke_stbtrs.c +++ b/LAPACKE/src/lapacke_stbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_stbtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_stb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_stbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + return API_SUFFIX(LAPACKE_stbtrs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_stbtrs_work.c b/LAPACKE/src/lapacke_stbtrs_work.c index 46ac0b0fcb..e6f66f9113 100644 --- a/LAPACKE/src/lapacke_stbtrs_work.c +++ b/LAPACKE/src/lapacke_stbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stbtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_stbtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, float* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_stbtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,9 +73,9 @@ lapack_int LAPACKE_stbtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_stb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_stb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -83,18 +83,18 @@ lapack_int LAPACKE_stbtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stfsm.c b/LAPACKE/src/lapacke_stfsm.c index 7f8a38da3e..890a5e5c2d 100644 --- a/LAPACKE/src/lapacke_stfsm.c +++ b/LAPACKE/src/lapacke_stfsm.c @@ -32,33 +32,33 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfsm( int matrix_layout, char transr, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, float alpha, const float* a, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stfsm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( IS_S_NONZERO(alpha) ) { - if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -10; } } - if( LAPACKE_s_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &alpha, 1 ) ) { return -9; } if( IS_S_NONZERO(alpha) ) { - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -11; } } } #endif - return LAPACKE_stfsm_work( matrix_layout, transr, side, uplo, trans, diag, m, + return API_SUFFIX(LAPACKE_stfsm_work)( matrix_layout, transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_stfsm_work.c b/LAPACKE/src/lapacke_stfsm_work.c index e6b14c960a..9687741f99 100644 --- a/LAPACKE/src/lapacke_stfsm_work.c +++ b/LAPACKE/src/lapacke_stfsm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side, +lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, float alpha, const float* a, float* b, lapack_int ldb ) @@ -52,7 +52,7 @@ lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side, /* Check leading dimension(s) */ if( ldb < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,17 +71,17 @@ lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side, } /* Transpose input matrices */ if( IS_S_NONZERO(alpha) ) { - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_S_NONZERO(alpha) ) { - LAPACKE_stf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_S_NONZERO(alpha) ) { LAPACKE_free( a_t ); @@ -90,11 +90,11 @@ lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stftri.c b/LAPACKE/src/lapacke_stftri.c index 33538a93b2..599df14941 100644 --- a/LAPACKE/src/lapacke_stftri.c +++ b/LAPACKE/src/lapacke_stftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stftri( int matrix_layout, char transr, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_stftri)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, float* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -6; } } #endif - return LAPACKE_stftri_work( matrix_layout, transr, uplo, diag, n, a ); + return API_SUFFIX(LAPACKE_stftri_work)( matrix_layout, transr, uplo, diag, n, a ); } diff --git a/LAPACKE/src/lapacke_stftri_work.c b/LAPACKE/src/lapacke_stftri_work.c index 5efc8b2878..a2f8152279 100644 --- a/LAPACKE/src/lapacke_stftri_work.c +++ b/LAPACKE/src/lapacke_stftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stftri_work)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, float* a ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_stftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_stf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_stftri( &transr, &uplo, &diag, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_stf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); + API_SUFFIX(LAPACKE_stf_trans)( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stfttp.c b/LAPACKE/src/lapacke_stfttp.c index 902b6dce01..87df8656e3 100644 --- a/LAPACKE/src/lapacke_stfttp.c +++ b/LAPACKE/src/lapacke_stfttp.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfttp( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stfttp)( int matrix_layout, char transr, char uplo, lapack_int n, const float* arf, float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stfttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_stfttp_work( matrix_layout, transr, uplo, n, arf, ap ); + return API_SUFFIX(LAPACKE_stfttp_work)( matrix_layout, transr, uplo, n, arf, ap ); } diff --git a/LAPACKE/src/lapacke_stfttp_work.c b/LAPACKE/src/lapacke_stfttp_work.c index 805fd07f19..3b2d6b03db 100644 --- a/LAPACKE/src/lapacke_stfttp_work.c +++ b/LAPACKE/src/lapacke_stfttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfttp_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stfttp_work)( int matrix_layout, char transr, char uplo, lapack_int n, const float* arf, float* ap ) { lapack_int info = 0; @@ -59,25 +59,25 @@ lapack_int LAPACKE_stfttp_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_stfttp( &transr, &uplo, &n, arf_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stfttr.c b/LAPACKE/src/lapacke_stfttr.c index 6a418f0fc8..2bd68ab6ca 100644 --- a/LAPACKE/src/lapacke_stfttr.c +++ b/LAPACKE/src/lapacke_stfttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfttr( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stfttr)( int matrix_layout, char transr, char uplo, lapack_int n, const float* arf, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stfttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_spf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_stfttr_work( matrix_layout, transr, uplo, n, arf, a, lda ); + return API_SUFFIX(LAPACKE_stfttr_work)( matrix_layout, transr, uplo, n, arf, a, lda ); } diff --git a/LAPACKE/src/lapacke_stfttr_work.c b/LAPACKE/src/lapacke_stfttr_work.c index a9fb091547..4da3ac767d 100644 --- a/LAPACKE/src/lapacke_stfttr_work.c +++ b/LAPACKE/src/lapacke_stfttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stfttr_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stfttr_work)( int matrix_layout, char transr, char uplo, lapack_int n, const float* arf, float* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_stfttr_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_stfttr_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_spf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_stfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgevc.c b/LAPACKE/src/lapacke_stgevc.c index 3e6fe851f6..d7c31ae91f 100644 --- a/LAPACKE/src/lapacke_stgevc.c +++ b/LAPACKE/src/lapacke_stgevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_stgevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const float* s, lapack_int lds, const float* p, lapack_int ldp, float* vl, lapack_int ldvl, @@ -42,25 +42,25 @@ lapack_int LAPACKE_stgevc( int matrix_layout, char side, char howmny, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, p, ldp ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, p, ldp ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, s, lds ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } @@ -73,13 +73,13 @@ lapack_int LAPACKE_stgevc( int matrix_layout, char side, char howmny, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stgevc_work( matrix_layout, side, howmny, select, n, s, lds, + info = API_SUFFIX(LAPACKE_stgevc_work)( matrix_layout, side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgevc_work.c b/LAPACKE/src/lapacke_stgevc_work.c index fd9f6ca029..12b37961da 100644 --- a/LAPACKE/src/lapacke_stgevc_work.c +++ b/LAPACKE/src/lapacke_stgevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_stgevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const float* s, lapack_int lds, const float* p, lapack_int ldp, float* vl, lapack_int ldvl, @@ -59,22 +59,22 @@ lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldp < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); return info; } if( lds < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,14 +88,14 @@ lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -103,15 +103,15 @@ lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, s, lds, s_t, lds_t ); - LAPACKE_sge_trans( matrix_layout, n, n, p, ldp, p_t, ldp_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, p, ldp, p_t, ldp_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t, @@ -120,20 +120,20 @@ lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -142,11 +142,11 @@ lapack_int LAPACKE_stgevc_work( int matrix_layout, char side, char howmny, LAPACKE_free( s_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgexc.c b/LAPACKE/src/lapacke_stgexc.c index 5b0fc4700f..f3efb0eadd 100644 --- a/LAPACKE/src/lapacke_stgexc.c +++ b/LAPACKE/src/lapacke_stgexc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgexc( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_stgexc)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, float* z, lapack_int ldz, @@ -43,32 +43,32 @@ lapack_int LAPACKE_stgexc( int matrix_layout, lapack_logical wantq, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } if( wantq ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -9; } } if( wantz ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_stgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_stgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, &work_query, lwork ); if( info != 0 ) { @@ -82,13 +82,13 @@ lapack_int LAPACKE_stgexc( int matrix_layout, lapack_logical wantq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_stgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgexc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgexc_work.c b/LAPACKE/src/lapacke_stgexc_work.c index aea9cbd29e..25be312af2 100644 --- a/LAPACKE/src/lapacke_stgexc_work.c +++ b/LAPACKE/src/lapacke_stgexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_stgexc_work)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, float* z, @@ -60,22 +60,22 @@ lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -110,13 +110,13 @@ lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t, @@ -125,13 +125,13 @@ lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -147,11 +147,11 @@ lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsen.c b/LAPACKE/src/lapacke_stgsen.c index db5b7e91c1..312ac5e430 100644 --- a/LAPACKE/src/lapacke_stgsen.c +++ b/LAPACKE/src/lapacke_stgsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsen( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_stgsen)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, @@ -48,32 +48,32 @@ lapack_int LAPACKE_stgsen( int matrix_layout, lapack_int ijob, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } if( wantq ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -14; } } if( wantz ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -16; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_stgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_stgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alphar, alphai, beta, q, ldq, z, ldz, m, pl, pr, dif, &work_query, lwork, &iwork_query, liwork ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_stgsen( int matrix_layout, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_stgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alphar, alphai, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_stgsen( int matrix_layout, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsen_work.c b/LAPACKE/src/lapacke_stgsen_work.c index 0d7eacb31a..e0a81174b1 100644 --- a/LAPACKE/src/lapacke_stgsen_work.c +++ b/LAPACKE/src/lapacke_stgsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsen_work( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_stgsen_work)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, float* a, lapack_int lda, float* b, @@ -64,22 +64,22 @@ lapack_int LAPACKE_stgsen_work( int matrix_layout, lapack_int ijob, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); return info; } if( ldq < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); return info; } if( ldz < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -116,13 +116,13 @@ lapack_int LAPACKE_stgsen_work( int matrix_layout, lapack_int ijob, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t, @@ -132,13 +132,13 @@ lapack_int LAPACKE_stgsen_work( int matrix_layout, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -154,11 +154,11 @@ lapack_int LAPACKE_stgsen_work( int matrix_layout, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsja.c b/LAPACKE/src/lapacke_stgsja.c index 24e5bcefa9..589297095c 100644 --- a/LAPACKE/src/lapacke_stgsja.c +++ b/LAPACKE/src/lapacke_stgsja.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsja( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_stgsja)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, float tolb, @@ -43,36 +43,36 @@ lapack_int LAPACKE_stgsja( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgsja", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -22; } } - if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tola, 1 ) ) { return -14; } - if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_s_nancheck)( 1, &tolb, 1 ) ) { return -15; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, m, m, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, u, ldu ) ) { return -18; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, p, p, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, p, p, v, ldv ) ) { return -20; } } @@ -85,14 +85,14 @@ lapack_int LAPACKE_stgsja( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stgsja_work( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, + info = API_SUFFIX(LAPACKE_stgsja_work)( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq, work, ncycle ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsja", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsja_work.c b/LAPACKE/src/lapacke_stgsja_work.c index 1cc98ce686..2ac6a97635 100644 --- a/LAPACKE/src/lapacke_stgsja_work.c +++ b/LAPACKE/src/lapacke_stgsja_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_stgsja_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, float* a, lapack_int lda, float* b, @@ -65,27 +65,27 @@ lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); return info; } if( ldq < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); return info; } if( ldu < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); return info; } if( ldv < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -99,21 +99,21 @@ lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { 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; } } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -121,16 +121,16 @@ lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( matrix_layout, m, m, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, m, u, ldu, u_t, ldu_t ); } - if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, p, p, v, ldv, v_t, ldv_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, p, p, v, ldv, v_t, ldv_t ); } - if( LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t, @@ -140,27 +140,27 @@ lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -169,11 +169,11 @@ lapack_int LAPACKE_stgsja_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsja_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsna.c b/LAPACKE/src/lapacke_stgsna.c index e8c6113188..d4223c3e08 100644 --- a/LAPACKE/src/lapacke_stgsna.c +++ b/LAPACKE/src/lapacke_stgsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_stgsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, const float* vl, lapack_int ldvl, @@ -45,32 +45,32 @@ lapack_int LAPACKE_stgsna( int matrix_layout, char job, char howmny, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+6) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -78,7 +78,7 @@ lapack_int LAPACKE_stgsna( int matrix_layout, char job, char howmny, } } /* Query optimal working array(s) size */ - info = LAPACKE_stgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_stgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, &work_query, lwork, iwork ); if( info != 0 ) { @@ -86,7 +86,7 @@ lapack_int LAPACKE_stgsna( int matrix_layout, char job, char howmny, } lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -94,20 +94,20 @@ lapack_int LAPACKE_stgsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_stgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_stgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsna_work.c b/LAPACKE/src/lapacke_stgsna_work.c index d10868305d..e66bd8a6c5 100644 --- a/LAPACKE/src/lapacke_stgsna_work.c +++ b/LAPACKE/src/lapacke_stgsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_stgsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, const float* vl, @@ -61,22 +61,22 @@ lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -97,14 +97,14 @@ lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -112,13 +112,13 @@ lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t, @@ -128,11 +128,11 @@ lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -141,11 +141,11 @@ lapack_int LAPACKE_stgsna_work( int matrix_layout, char job, char howmny, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsyl.c b/LAPACKE/src/lapacke_stgsyl.c index b7efeafb83..5d683479d5 100644 --- a/LAPACKE/src/lapacke_stgsyl.c +++ b/LAPACKE/src/lapacke_stgsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_stgsyl)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, const float* d, @@ -45,28 +45,28 @@ lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stgsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_sge_nancheck( matrix_layout, m, m, d, ldd ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, d, ldd ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, e, lde ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, e, lde ) ) { return -14; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -16; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_stgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_stgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, &work_query, lwork, iwork ); if( info != 0 ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_stgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsyl", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stgsyl_work.c b/LAPACKE/src/lapacke_stgsyl_work.c index 8b7ab8ae07..7694848040 100644 --- a/LAPACKE/src/lapacke_stgsyl_work.c +++ b/LAPACKE/src/lapacke_stgsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stgsyl_work( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_stgsyl_work)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, const float* d, @@ -66,32 +66,32 @@ lapack_int LAPACKE_stgsyl_work( int matrix_layout, char trans, lapack_int ijob, /* Check leading dimension(s) */ if( lda < m ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } if( ldd < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } if( lde < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } if( ldf < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -133,12 +133,12 @@ lapack_int LAPACKE_stgsyl_work( int matrix_layout, char trans, lapack_int ijob, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_sge_trans( matrix_layout, m, m, d, ldd, d_t, ldd_t ); - LAPACKE_sge_trans( matrix_layout, n, n, e, lde, e_t, lde_t ); - LAPACKE_sge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, m, d, ldd, d_t, ldd_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, e, lde, e_t, lde_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); /* Call LAPACK function and adjust info */ LAPACK_stgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale, @@ -147,8 +147,8 @@ lapack_int LAPACKE_stgsyl_work( int matrix_layout, char trans, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); /* Release memory and exit */ LAPACKE_free( f_t ); exit_level_5: @@ -163,11 +163,11 @@ lapack_int LAPACKE_stgsyl_work( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stgsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpcon.c b/LAPACKE/src/lapacke_stpcon.c index 04583cd185..a70dca4757 100644 --- a/LAPACKE/src/lapacke_stpcon.c +++ b/LAPACKE/src/lapacke_stpcon.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_stpcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const float* ap, float* rcond ) { lapack_int info = 0; lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_stp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -6; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_stpcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stpcon_work( matrix_layout, norm, uplo, diag, n, ap, rcond, + info = API_SUFFIX(LAPACKE_stpcon_work)( matrix_layout, norm, uplo, diag, n, ap, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -70,7 +70,7 @@ lapack_int LAPACKE_stpcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpcon_work.c b/LAPACKE/src/lapacke_stpcon_work.c index ef5c3fa840..1f716006e6 100644 --- a/LAPACKE/src/lapacke_stpcon_work.c +++ b/LAPACKE/src/lapacke_stpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_stpcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const float* ap, float* rcond, float* work, lapack_int* iwork ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_stpcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_stp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, iwork, &info ); @@ -64,11 +64,11 @@ lapack_int LAPACKE_stpcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpmqrt.c b/LAPACKE/src/lapacke_stpmqrt.c index be7c117b08..e00b4f7f17 100644 --- a/LAPACKE/src/lapacke_stpmqrt.c +++ b/LAPACKE/src/lapacke_stpmqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpmqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_stpmqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const float* v, lapack_int ldv, const float* t, lapack_int ldt, @@ -44,48 +44,48 @@ lapack_int LAPACKE_stpmqrt( int matrix_layout, char side, char trans, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpmqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - 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 ) ) { + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0 ); + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0 ); + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_sge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : - ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); + lwork = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stpmqrt_work( matrix_layout, side, trans, m, n, k, l, nb, v, + info = API_SUFFIX(LAPACKE_stpmqrt_work)( matrix_layout, side, trans, m, n, k, l, nb, v, ldv, t, ldt, a, lda, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpmqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpmqrt_work.c b/LAPACKE/src/lapacke_stpmqrt_work.c index c5a3a14965..47fdd32196 100644 --- a/LAPACKE/src/lapacke_stpmqrt_work.c +++ b/LAPACKE/src/lapacke_stpmqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_stpmqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const float* v, lapack_int ldv, const float* t, lapack_int ldt, @@ -49,11 +49,11 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); return info; } lapack_int lda_t = MAX(1,nrowsA); @@ -67,22 +67,22 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < ncolsA ) { info = -14; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); return info; } if( ldb < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); return info; } if( ldv < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info ); @@ -118,8 +118,8 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -130,11 +130,11 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpqrt.c b/LAPACKE/src/lapacke_stpqrt.c index 9df06332c2..620b75a76d 100644 --- a/LAPACKE/src/lapacke_stpqrt.c +++ b/LAPACKE/src/lapacke_stpqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stpqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_stpqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -8; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_stpqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stpqrt_work( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, + info = API_SUFFIX(LAPACKE_stpqrt_work)( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpqrt2.c b/LAPACKE/src/lapacke_stpqrt2.c index fc539ab4a2..be170aa564 100644 --- a/LAPACKE/src/lapacke_stpqrt2.c +++ b/LAPACKE/src/lapacke_stpqrt2.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt2( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_stpqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } #endif - return LAPACKE_stpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); + return API_SUFFIX(LAPACKE_stpqrt2_work)( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/LAPACKE/src/lapacke_stpqrt2_work.c b/LAPACKE/src/lapacke_stpqrt2_work.c index 7e8200e0dd..2747dbde92 100644 --- a/LAPACKE/src/lapacke_stpqrt2_work.c +++ b/LAPACKE/src/lapacke_stpqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt2_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_stpqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_stpqrt2_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2_work", info ); return info; } if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,17 +84,17 @@ lapack_int LAPACKE_stpqrt2_work( int matrix_layout, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_stpqrt2_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpqrt_work.c b/LAPACKE/src/lapacke_stpqrt_work.c index 9477607e36..7493b540a1 100644 --- a/LAPACKE/src/lapacke_stpqrt_work.c +++ b/LAPACKE/src/lapacke_stpqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stpqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt, float* work ) @@ -55,17 +55,17 @@ lapack_int LAPACKE_stpqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_stpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_stpqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, work, &info ); @@ -94,9 +94,9 @@ lapack_int LAPACKE_stpqrt_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_stpqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stprfb.c b/LAPACKE/src/lapacke_stprfb.c index 1146e40dcd..2c685ef920 100644 --- a/LAPACKE/src/lapacke_stprfb.c +++ b/LAPACKE/src/lapacke_stprfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_stprfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, @@ -44,7 +44,7 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct lapack_int work_size; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stprfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -59,32 +59,32 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct * or m-by-k (right) * B is m-by-n */ - if( LAPACKE_lsame( storev, 'C' ) ) { + if( API_SUFFIX(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 = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; + } else if( API_SUFFIX(LAPACKE_lsame)( storev, 'R' ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - nrows_a = LAPACKE_lsame( side, 'L' ) ? k : - LAPACKE_lsame( side, 'R' ) ? m : 0; - ncols_a = LAPACKE_lsame( side, 'L' ) ? n : - LAPACKE_lsame( side, 'R' ) ? k : 0; - if( LAPACKE_sge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0; + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0; + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } } @@ -105,14 +105,14 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stprfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_stprfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, a, lda, b, ldb, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stprfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stprfb_work.c b/LAPACKE/src/lapacke_stprfb_work.c index 06f9faa7c1..cfa0dc6f7a 100644 --- a/LAPACKE/src/lapacke_stprfb_work.c +++ b/LAPACKE/src/lapacke_stprfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_stprfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, @@ -60,22 +60,22 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -15; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); return info; } if( ldb < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); return info; } if( ldt < k ) { info = -13; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); return info; } if( ldv < k ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,18 +100,18 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_sge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); - LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -122,11 +122,11 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stprfs.c b/LAPACKE/src/lapacke_stprfs.c index 10f80b08bd..113f2e7cb8 100644 --- a/LAPACKE/src/lapacke_stprfs.c +++ b/LAPACKE/src/lapacke_stprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stprfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_stprfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* ap, const float* b, lapack_int ldb, const float* x, lapack_int ldx, float* ferr, float* berr ) @@ -41,19 +41,19 @@ lapack_int LAPACKE_stprfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_stp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -70,7 +70,7 @@ lapack_int LAPACKE_stprfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_stprfs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + info = API_SUFFIX(LAPACKE_stprfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_stprfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stprfs_work.c b/LAPACKE/src/lapacke_stprfs_work.c index fa8bb72b74..1977bfe193 100644 --- a/LAPACKE/src/lapacke_stprfs_work.c +++ b/LAPACKE/src/lapacke_stprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stprfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_stprfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* ap, const float* b, lapack_int ldb, const float* x, lapack_int ldx, float* ferr, @@ -55,12 +55,12 @@ lapack_int LAPACKE_stprfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_stprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,9 +81,9 @@ lapack_int LAPACKE_stprfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_stp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -98,11 +98,11 @@ lapack_int LAPACKE_stprfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stptri.c b/LAPACKE/src/lapacke_stptri.c index 052da0ec81..971705c141 100644 --- a/LAPACKE/src/lapacke_stptri.c +++ b/LAPACKE/src/lapacke_stptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stptri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stptri)( int matrix_layout, char uplo, char diag, lapack_int n, float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_stp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -5; } } #endif - return LAPACKE_stptri_work( matrix_layout, uplo, diag, n, ap ); + return API_SUFFIX(LAPACKE_stptri_work)( matrix_layout, uplo, diag, n, ap ); } diff --git a/LAPACKE/src/lapacke_stptri_work.c b/LAPACKE/src/lapacke_stptri_work.c index 6d2e43d003..a6916b5cf2 100644 --- a/LAPACKE/src/lapacke_stptri_work.c +++ b/LAPACKE/src/lapacke_stptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stptri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_stptri_work)( int matrix_layout, char uplo, char diag, lapack_int n, float* ap ) { lapack_int info = 0; @@ -52,23 +52,23 @@ lapack_int LAPACKE_stptri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_stp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stptri( &uplo, &diag, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_stp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); + API_SUFFIX(LAPACKE_stp_trans)( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stptrs.c b/LAPACKE/src/lapacke_stptrs.c index 98a7e825b3..d9e8af855d 100644 --- a/LAPACKE/src/lapacke_stptrs.c +++ b/LAPACKE/src/lapacke_stptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stptrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_stptrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* ap, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_stp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_stp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_stptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + return API_SUFFIX(LAPACKE_stptrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_stptrs_work.c b/LAPACKE/src/lapacke_stptrs_work.c index 46d74aa849..83b1ca141e 100644 --- a/LAPACKE/src/lapacke_stptrs_work.c +++ b/LAPACKE/src/lapacke_stptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stptrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_stptrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* ap, float* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_stptrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_stptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,8 +66,8 @@ lapack_int LAPACKE_stptrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_stp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); @@ -75,18 +75,18 @@ lapack_int LAPACKE_stptrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpttf.c b/LAPACKE/src/lapacke_stpttf.c index dd3ecc8828..cc40dfa61a 100644 --- a/LAPACKE/src/lapacke_stpttf.c +++ b/LAPACKE/src/lapacke_stpttf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stpttf)( int matrix_layout, char transr, char uplo, lapack_int n, const float* ap, float* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -5; } } #endif - return LAPACKE_stpttf_work( matrix_layout, transr, uplo, n, ap, arf ); + return API_SUFFIX(LAPACKE_stpttf_work)( matrix_layout, transr, uplo, n, ap, arf ); } diff --git a/LAPACKE/src/lapacke_stpttf_work.c b/LAPACKE/src/lapacke_stpttf_work.c index d534e65e58..d1d5e23773 100644 --- a/LAPACKE/src/lapacke_stpttf_work.c +++ b/LAPACKE/src/lapacke_stpttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_stpttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const float* ap, float* arf ) { lapack_int info = 0; @@ -59,25 +59,25 @@ lapack_int LAPACKE_stpttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stpttf( &transr, &uplo, &n, ap_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_spf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stpttr.c b/LAPACKE/src/lapacke_stpttr.c index f65504442b..093d4ba2eb 100644 --- a/LAPACKE/src/lapacke_stpttr.c +++ b/LAPACKE/src/lapacke_stpttr.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpttr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stpttr)( int matrix_layout, char uplo, lapack_int n, const float* ap, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stpttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_spp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_spp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_stpttr_work( matrix_layout, uplo, n, ap, a, lda ); + return API_SUFFIX(LAPACKE_stpttr_work)( matrix_layout, uplo, n, ap, a, lda ); } diff --git a/LAPACKE/src/lapacke_stpttr_work.c b/LAPACKE/src/lapacke_stpttr_work.c index 0604a21bd2..af61aa31a2 100644 --- a/LAPACKE/src/lapacke_stpttr_work.c +++ b/LAPACKE/src/lapacke_stpttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpttr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stpttr_work)( int matrix_layout, char uplo, lapack_int n, const float* ap, float* a, lapack_int lda ) { lapack_int info = 0; @@ -49,7 +49,7 @@ lapack_int LAPACKE_stpttr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_stpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,25 +65,25 @@ lapack_int LAPACKE_stpttr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_spp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_spp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stpttr( &uplo, &n, ap_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strcon.c b/LAPACKE/src/lapacke_strcon.c index a64ae67615..1f0788b2cb 100644 --- a/LAPACKE/src/lapacke_strcon.c +++ b/LAPACKE/src/lapacke_strcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_strcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const float* a, lapack_int lda, float* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_strcon( int matrix_layout, char norm, char uplo, char diag, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -6; } } @@ -63,7 +63,7 @@ lapack_int LAPACKE_strcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_strcon_work( matrix_layout, norm, uplo, diag, n, a, lda, + info = API_SUFFIX(LAPACKE_strcon_work)( matrix_layout, norm, uplo, diag, n, a, lda, rcond, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -71,7 +71,7 @@ lapack_int LAPACKE_strcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strcon_work.c b/LAPACKE/src/lapacke_strcon_work.c index 6b0c779b21..398211e601 100644 --- a/LAPACKE/src/lapacke_strcon_work.c +++ b/LAPACKE/src/lapacke_strcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_strcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const float* a, lapack_int lda, float* rcond, float* work, lapack_int* iwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_strcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_strcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_strcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_str_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_strcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, iwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_strcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strevc.c b/LAPACKE/src/lapacke_strevc.c index 4e9db85409..dd6ee6cab8 100644 --- a/LAPACKE/src/lapacke_strevc.c +++ b/LAPACKE/src/lapacke_strevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_strevc)( int matrix_layout, char side, char howmny, lapack_logical* select, lapack_int n, const float* t, lapack_int ldt, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, lapack_int mm, @@ -41,22 +41,22 @@ lapack_int LAPACKE_strevc( int matrix_layout, char side, char howmny, lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_strevc( int matrix_layout, char side, char howmny, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_strevc_work( matrix_layout, side, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_strevc_work)( matrix_layout, side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strevc_work.c b/LAPACKE/src/lapacke_strevc_work.c index e98496f874..a811b69ec5 100644 --- a/LAPACKE/src/lapacke_strevc_work.c +++ b/LAPACKE/src/lapacke_strevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_strevc_work)( int matrix_layout, char side, char howmny, lapack_logical* select, lapack_int n, const float* t, lapack_int ldt, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, @@ -56,17 +56,17 @@ lapack_int LAPACKE_strevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_strevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_strevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_strevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,14 +75,14 @@ lapack_int LAPACKE_strevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -90,14 +90,14 @@ lapack_int LAPACKE_strevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_strevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -106,31 +106,31 @@ lapack_int LAPACKE_strevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strexc.c b/LAPACKE/src/lapacke_strexc.c index 62e285e265..7aa84ad228 100644 --- a/LAPACKE/src/lapacke_strexc.c +++ b/LAPACKE/src/lapacke_strexc.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strexc( int matrix_layout, char compq, lapack_int n, float* t, +lapack_int API_SUFFIX(LAPACKE_strexc)( int matrix_layout, char compq, lapack_int n, float* t, lapack_int ldt, float* q, lapack_int ldq, lapack_int* ifst, lapack_int* ilst ) { lapack_int info = 0; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -6; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -4; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_strexc( int matrix_layout, char compq, lapack_int n, float* t goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_strexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst, + info = API_SUFFIX(LAPACKE_strexc_work)( matrix_layout, compq, n, t, ldt, q, ldq, ifst, ilst, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strexc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strexc_work.c b/LAPACKE/src/lapacke_strexc_work.c index cbbed9d8ba..02022e18cc 100644 --- a/LAPACKE/src/lapacke_strexc_work.c +++ b/LAPACKE/src/lapacke_strexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strexc_work( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_strexc_work)( int matrix_layout, char compq, lapack_int n, float* t, lapack_int ldt, float* q, lapack_int ldq, lapack_int* ifst, lapack_int* ilst, float* work ) @@ -50,14 +50,14 @@ lapack_int LAPACKE_strexc_work( int matrix_layout, char compq, lapack_int n, float* t_t = NULL; float* q_t = NULL; /* Check leading dimension(s) */ - if( ldq < n && LAPACKE_lsame( compq, 'v' ) ) { + if( ldq < n && API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { info = -7; - LAPACKE_xerbla( "LAPACKE_strexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc_work", info ); return info; } if( ldt < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_strexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,7 +66,7 @@ lapack_int LAPACKE_strexc_work( int matrix_layout, char compq, lapack_int n, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -74,9 +74,9 @@ lapack_int LAPACKE_strexc_work( int matrix_layout, char compq, lapack_int n, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_strexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work, @@ -85,23 +85,23 @@ lapack_int LAPACKE_strexc_work( int matrix_layout, char compq, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strrfs.c b/LAPACKE/src/lapacke_strrfs.c index 3370c20b3f..1d4fceb648 100644 --- a/LAPACKE/src/lapacke_strrfs.c +++ b/LAPACKE/src/lapacke_strrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_strrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* b, lapack_int ldb, const float* x, lapack_int ldx, float* ferr, @@ -42,19 +42,19 @@ lapack_int LAPACKE_strrfs( int matrix_layout, char uplo, char trans, char diag, lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_strrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_strrfs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + info = API_SUFFIX(LAPACKE_strrfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_strrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strrfs_work.c b/LAPACKE/src/lapacke_strrfs_work.c index 59305a96d5..2291334e09 100644 --- a/LAPACKE/src/lapacke_strrfs_work.c +++ b/LAPACKE/src/lapacke_strrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_strrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, const float* b, lapack_int ldb, const float* x, lapack_int ldx, @@ -57,17 +57,17 @@ lapack_int LAPACKE_strrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_strrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_strrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_strrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,9 +87,9 @@ lapack_int LAPACKE_strrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_str_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_strrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); @@ -104,11 +104,11 @@ lapack_int LAPACKE_strrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsen.c b/LAPACKE/src/lapacke_strsen.c index c9a5b845cc..547dd52df4 100644 --- a/LAPACKE/src/lapacke_strsen.c +++ b/LAPACKE/src/lapacke_strsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsen( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_strsen)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, float* t, lapack_int ldt, float* q, lapack_int ldq, float* wr, float* wi, lapack_int* m, float* s, float* sep ) @@ -45,24 +45,24 @@ lapack_int LAPACKE_strsen( int matrix_layout, char job, char compq, lapack_int iwork_query; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -8; } } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_strsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_strsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -71,7 +71,7 @@ lapack_int LAPACKE_strsen( int matrix_layout, char job, char compq, liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -84,18 +84,18 @@ lapack_int LAPACKE_strsen( int matrix_layout, char job, char compq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_strsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_strsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsen_work.c b/LAPACKE/src/lapacke_strsen_work.c index 6e0a48346c..92b11911c1 100644 --- a/LAPACKE/src/lapacke_strsen_work.c +++ b/LAPACKE/src/lapacke_strsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_strsen_work)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, float* t, lapack_int ldt, float* q, lapack_int ldq, float* wr, float* wi, @@ -56,12 +56,12 @@ lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldq < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_strsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_strsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen_work", info ); return info; } /* Allocate memory for temporary array T */ @@ -71,7 +71,7 @@ lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, goto exit_level_0; } /* Transpose input matrix T */ - LAPACKE_sge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q, &ldq_t, wr, @@ -80,7 +80,7 @@ lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -88,8 +88,8 @@ lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_strsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, wr, @@ -98,23 +98,23 @@ lapack_int LAPACKE_strsen_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsna.c b/LAPACKE/src/lapacke_strsna.c index 463a598d4b..4fe59d2db4 100644 --- a/LAPACKE/src/lapacke_strsna.c +++ b/LAPACKE/src/lapacke_strsna.c @@ -32,40 +32,40 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_strsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const float* t, lapack_int ldt, const float* vl, lapack_int ldvl, const float* vr, lapack_int ldvr, float* s, float* sep, lapack_int mm, lapack_int* m ) { lapack_int info = 0; - lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ; + lapack_int ldwork = API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ? 1 : MAX(1,n) ; lapack_int* iwork = NULL; float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_sge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*) LAPACKE_malloc( sizeof(lapack_int) * MAX(1,2*(n-1)) ); if( iwork == NULL ) { @@ -73,7 +73,7 @@ lapack_int LAPACKE_strsna( int matrix_layout, char job, char howmny, goto exit_level_0; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (float*)LAPACKE_malloc( sizeof(float) * ldwork * MAX(1,n+6) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -81,20 +81,20 @@ lapack_int LAPACKE_strsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_strsna_work( matrix_layout, job, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_strsna_work)( matrix_layout, job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsna_work.c b/LAPACKE/src/lapacke_strsna_work.c index 02c439405f..93a2605d4d 100644 --- a/LAPACKE/src/lapacke_strsna_work.c +++ b/LAPACKE/src/lapacke_strsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_strsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const float* t, lapack_int ldt, const float* vl, lapack_int ldvl, const float* vr, @@ -58,17 +58,17 @@ lapack_int LAPACKE_strsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_strsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_strsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_strsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,14 +77,14 @@ lapack_int LAPACKE_strsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) ); if( vr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -92,12 +92,12 @@ lapack_int LAPACKE_strsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_sge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_strsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -107,22 +107,22 @@ lapack_int LAPACKE_strsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsyl.c b/LAPACKE/src/lapacke_strsyl.c index 8bc1ea44f3..a10c2116d5 100644 --- a/LAPACKE/src/lapacke_strsyl.c +++ b/LAPACKE/src/lapacke_strsyl.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsyl( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_strsyl)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, float* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif - return LAPACKE_strsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + return API_SUFFIX(LAPACKE_strsyl_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale ); } diff --git a/LAPACKE/src/lapacke_strsyl3.c b/LAPACKE/src/lapacke_strsyl3.c index 1cfc626c22..620c1a74d0 100644 --- a/LAPACKE/src/lapacke_strsyl3.c +++ b/LAPACKE/src/lapacke_strsyl3.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsyl3( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_strsyl3)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, @@ -15,25 +15,25 @@ lapack_int LAPACKE_strsyl3( int matrix_layout, char trana, char tranb, lapack_int* iwork = NULL; lapack_int liwork = -1; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strsyl3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif /* Query optimal working array sizes */ - info = LAPACKE_strsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + info = API_SUFFIX(LAPACKE_strsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, &iwork_query, liwork, swork_query, ldswork ); if( info != 0 ) { @@ -53,7 +53,7 @@ lapack_int LAPACKE_strsyl3( int matrix_layout, char trana, char tranb, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_strsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, + info = API_SUFFIX(LAPACKE_strsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, iwork, liwork, swork, ldswork ); /* Release memory and exit */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_strsyl3( int matrix_layout, char trana, char tranb, LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsyl3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsyl3_work.c b/LAPACKE/src/lapacke_strsyl3_work.c index 3c50e4a451..a647a8747c 100644 --- a/LAPACKE/src/lapacke_strsyl3_work.c +++ b/LAPACKE/src/lapacke_strsyl3_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_strsyl3_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, @@ -26,17 +26,17 @@ lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_strsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_strsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_strsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -56,9 +56,9 @@ lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_strsyl3( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, iwork, &liwork, swork, &ldswork, @@ -67,7 +67,7 @@ lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -76,11 +76,11 @@ lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strsyl_work.c b/LAPACKE/src/lapacke_strsyl_work.c index 5f545df373..50c2cc9c0c 100644 --- a/LAPACKE/src/lapacke_strsyl_work.c +++ b/LAPACKE/src/lapacke_strsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strsyl_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_strsyl_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, @@ -56,17 +56,17 @@ lapack_int LAPACKE_strsyl_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,9 +86,9 @@ lapack_int LAPACKE_strsyl_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_strsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, &info ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_strsyl_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -105,11 +105,11 @@ lapack_int LAPACKE_strsyl_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strtri.c b/LAPACKE/src/lapacke_strtri.c index 4502bb515a..76bec882bc 100644 --- a/LAPACKE/src/lapacke_strtri.c +++ b/LAPACKE/src/lapacke_strtri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strtri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_strtri)( int matrix_layout, char uplo, char diag, lapack_int n, float* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strtri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_strtri_work( matrix_layout, uplo, diag, n, a, lda ); + return API_SUFFIX(LAPACKE_strtri_work)( matrix_layout, uplo, diag, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_strtri_work.c b/LAPACKE/src/lapacke_strtri_work.c index 237bf2101f..663e1bceac 100644 --- a/LAPACKE/src/lapacke_strtri_work.c +++ b/LAPACKE/src/lapacke_strtri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_strtri_work)( int matrix_layout, char uplo, char diag, lapack_int n, float* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_strtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,24 +58,24 @@ lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_str_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_strtri( &uplo, &diag, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_str_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, + API_SUFFIX(LAPACKE_str_trans)( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strtrs.c b/LAPACKE/src/lapacke_strtrs.c index eeb1e3fb17..a25e8b4e0a 100644 --- a/LAPACKE/src/lapacke_strtrs.c +++ b/LAPACKE/src/lapacke_strtrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_strtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_strtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + return API_SUFFIX(LAPACKE_strtrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_strtrs_work.c b/LAPACKE/src/lapacke_strtrs_work.c index fc02026c09..180ac7b7f7 100644 --- a/LAPACKE/src/lapacke_strtrs_work.c +++ b/LAPACKE/src/lapacke_strtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_strtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* a, lapack_int lda, float* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_strtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_strtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtrs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_strtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,8 +73,8 @@ lapack_int LAPACKE_strtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_str_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_strtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); @@ -82,18 +82,18 @@ lapack_int LAPACKE_strtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strttf.c b/LAPACKE/src/lapacke_strttf.c index 96b2d33855..8a0410ec00 100644 --- a/LAPACKE/src/lapacke_strttf.c +++ b/LAPACKE/src/lapacke_strttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_strttf)( int matrix_layout, char transr, char uplo, lapack_int n, const float* a, lapack_int lda, float* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -5; } } #endif - return LAPACKE_strttf_work( matrix_layout, transr, uplo, n, a, lda, arf ); + return API_SUFFIX(LAPACKE_strttf_work)( matrix_layout, transr, uplo, n, a, lda, arf ); } diff --git a/LAPACKE/src/lapacke_strttf_work.c b/LAPACKE/src/lapacke_strttf_work.c index cc00af6fa9..cd810133ef 100644 --- a/LAPACKE/src/lapacke_strttf_work.c +++ b/LAPACKE/src/lapacke_strttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_strttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const float* a, lapack_int lda, float* arf ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_strttf_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_strttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,25 +66,25 @@ lapack_int LAPACKE_strttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_strttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_spf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_strttp.c b/LAPACKE/src/lapacke_strttp.c index 6b5e5f00c9..14e421a551 100644 --- a/LAPACKE/src/lapacke_strttp.c +++ b/LAPACKE/src/lapacke_strttp.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strttp( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_strttp)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_strttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_str_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -4; } } #endif - return LAPACKE_strttp_work( matrix_layout, uplo, n, a, lda, ap ); + return API_SUFFIX(LAPACKE_strttp_work)( matrix_layout, uplo, n, a, lda, ap ); } diff --git a/LAPACKE/src/lapacke_strttp_work.c b/LAPACKE/src/lapacke_strttp_work.c index ca62cbf801..cc14087bf5 100644 --- a/LAPACKE/src/lapacke_strttp_work.c +++ b/LAPACKE/src/lapacke_strttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_strttp_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_strttp_work)( int matrix_layout, char uplo, lapack_int n, const float* a, lapack_int lda, float* ap ) { lapack_int info = 0; @@ -49,7 +49,7 @@ lapack_int LAPACKE_strttp_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_strttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,25 +65,25 @@ lapack_int LAPACKE_strttp_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_strttp( &uplo, &n, a_t, &lda_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_spp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_strttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_strttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_strttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stzrzf.c b/LAPACKE/src/lapacke_stzrzf.c index b7fe7ce85e..2d74e5cab7 100644 --- a/LAPACKE/src/lapacke_stzrzf.c +++ b/LAPACKE/src/lapacke_stzrzf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stzrzf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stzrzf)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau ) { lapack_int info = 0; @@ -40,19 +40,19 @@ lapack_int LAPACKE_stzrzf( int matrix_layout, lapack_int m, lapack_int n, float* work = NULL; float work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_stzrzf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stzrzf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_stzrzf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_stzrzf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -65,12 +65,12 @@ lapack_int LAPACKE_stzrzf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_stzrzf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_stzrzf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stzrzf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stzrzf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_stzrzf_work.c b/LAPACKE/src/lapacke_stzrzf_work.c index bbe3cb6e82..5851305e0d 100644 --- a/LAPACKE/src/lapacke_stzrzf_work.c +++ b/LAPACKE/src/lapacke_stzrzf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stzrzf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_stzrzf_work)( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* tau, float* work, lapack_int lwork ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_stzrzf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_stzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stzrzf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -64,23 +64,23 @@ lapack_int LAPACKE_stzrzf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_stzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_stzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stzrzf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_stzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stzrzf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zbbcsd.c b/LAPACKE/src/lapacke_zbbcsd.c index 6eda685f08..ea70e1473a 100644 --- a/LAPACKE/src/lapacke_zbbcsd.c +++ b/LAPACKE/src/lapacke_zbbcsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_zbbcsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double* theta, double* phi, lapack_complex_double* u1, @@ -49,10 +49,10 @@ lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, double rwork_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zbbcsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbbcsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -60,36 +60,36 @@ lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( q-1, phi, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( q-1, phi, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( q, theta, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( q, theta, 1 ) ) { return -10; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { - if( LAPACKE_zge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, p, p, u1, ldu1 ) ) { return -12; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-p, m-p, u2, ldu2 ) ) { return -14; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - if( LAPACKE_zge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, q, q, v1t, ldv1t ) ) { return -16; } } - if( LAPACKE_lsame( jobv2t, 'y' ) ) { - if( LAPACKE_zge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv2t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-q, m-q, v2t, ldv2t ) ) { return -18; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_zbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, &rwork_query, lrwork ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zbbcsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_zbbcsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, m, p, q, theta, phi, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e, rwork, lrwork ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zbbcsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbbcsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zbbcsd_work.c b/LAPACKE/src/lapacke_zbbcsd_work.c index 05d405ed4f..01c363a241 100644 --- a/LAPACKE/src/lapacke_zbbcsd_work.c +++ b/LAPACKE/src/lapacke_zbbcsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zbbcsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_zbbcsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double* theta, double* phi, @@ -63,7 +63,7 @@ lapack_int LAPACKE_zbbcsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -78,7 +78,7 @@ lapack_int LAPACKE_zbbcsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zbbcsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbbcsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zbdsqr.c b/LAPACKE/src/lapacke_zbdsqr.c index cc71ad977b..2b6783602d 100644 --- a/LAPACKE/src/lapacke_zbdsqr.c +++ b/LAPACKE/src/lapacke_zbdsqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zbdsqr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zbdsqr)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, double* d, double* e, lapack_complex_double* vt, lapack_int ldvt, lapack_complex_double* u, @@ -42,30 +42,30 @@ lapack_int LAPACKE_zbdsqr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zbdsqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( ncc != 0 ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, ncc, c, ldc ) ) { return -13; } } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -8; } if( nru != 0 ) { - if( LAPACKE_zge_nancheck( matrix_layout, nru, n, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nru, n, u, ldu ) ) { return -11; } } if( ncvt != 0 ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, ncvt, vt, ldvt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, ncvt, vt, ldvt ) ) { return -9; } } @@ -78,13 +78,13 @@ lapack_int LAPACKE_zbdsqr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zbdsqr_work( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, + info = API_SUFFIX(LAPACKE_zbdsqr_work)( matrix_layout, uplo, n, ncvt, nru, ncc, d, e, vt, ldvt, u, ldu, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zbdsqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zbdsqr_work.c b/LAPACKE/src/lapacke_zbdsqr_work.c index b54ccff929..4c143f0858 100644 --- a/LAPACKE/src/lapacke_zbdsqr_work.c +++ b/LAPACKE/src/lapacke_zbdsqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zbdsqr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zbdsqr_work)( int matrix_layout, char uplo, lapack_int n, lapack_int ncvt, lapack_int nru, lapack_int ncc, double* d, double* e, lapack_complex_double* vt, lapack_int ldvt, lapack_complex_double* u, @@ -57,17 +57,17 @@ lapack_int LAPACKE_zbdsqr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldc < ncc ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr_work", info ); return info; } if( ldu < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr_work", info ); return info; } if( ldvt < ncvt ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -100,13 +100,13 @@ lapack_int LAPACKE_zbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose input matrices */ if( ncvt != 0 ) { - LAPACKE_zge_trans( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t ); } if( nru != 0 ) { - LAPACKE_zge_trans( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, nru, n, u, ldu, u_t, ldu_t ); } if( ncc != 0 ) { - LAPACKE_zge_trans( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_zbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t, @@ -116,14 +116,14 @@ lapack_int LAPACKE_zbdsqr_work( int matrix_layout, char uplo, lapack_int n, } /* Transpose output matrices */ if( ncvt != 0 ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt, ldvt ); } if( nru != 0 ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu ); } if( ncc != 0 ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { @@ -139,11 +139,11 @@ lapack_int LAPACKE_zbdsqr_work( int matrix_layout, char uplo, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zbdsqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zbdsqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zcgesv.c b/LAPACKE/src/lapacke_zcgesv.c index 600f1d6175..c90580cf81 100644 --- a/LAPACKE/src/lapacke_zcgesv.c +++ b/LAPACKE/src/lapacke_zcgesv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zcgesv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zcgesv)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, @@ -43,16 +43,16 @@ lapack_int LAPACKE_zcgesv( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_float* swork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zcgesv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_zcgesv( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zcgesv_work( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb, x, + info = API_SUFFIX(LAPACKE_zcgesv_work)( matrix_layout, n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work, swork, rwork, iter ); /* Release memory and exit */ LAPACKE_free( work ); @@ -88,7 +88,7 @@ lapack_int LAPACKE_zcgesv( int matrix_layout, lapack_int n, lapack_int nrhs, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zcgesv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zcgesv_work.c b/LAPACKE/src/lapacke_zcgesv_work.c index 88ea127e6c..e3dd75848c 100644 --- a/LAPACKE/src/lapacke_zcgesv_work.c +++ b/LAPACKE/src/lapacke_zcgesv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zcgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zcgesv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, @@ -58,17 +58,17 @@ lapack_int LAPACKE_zcgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zcgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zcgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zcgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_zcgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zcgesv( &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, work, swork, rwork, iter, &info ); @@ -102,9 +102,9 @@ lapack_int LAPACKE_zcgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_zcgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zcgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zcgesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcgesv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zcposv.c b/LAPACKE/src/lapacke_zcposv.c index c5638dbc24..f2c716fb9d 100644 --- a/LAPACKE/src/lapacke_zcposv.c +++ b/LAPACKE/src/lapacke_zcposv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zcposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zcposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, @@ -43,16 +43,16 @@ lapack_int LAPACKE_zcposv( int matrix_layout, char uplo, lapack_int n, lapack_complex_float* swork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zcposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_zcposv( int matrix_layout, char uplo, lapack_int n, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zcposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb, x, + info = API_SUFFIX(LAPACKE_zcposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb, x, ldx, work, swork, rwork, iter ); /* Release memory and exit */ LAPACKE_free( work ); @@ -88,7 +88,7 @@ lapack_int LAPACKE_zcposv( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zcposv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zcposv_work.c b/LAPACKE/src/lapacke_zcposv_work.c index d6258ea5d3..c9fab2e309 100644 --- a/LAPACKE/src/lapacke_zcposv_work.c +++ b/LAPACKE/src/lapacke_zcposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zcposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zcposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, @@ -58,17 +58,17 @@ lapack_int LAPACKE_zcposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zcposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zcposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zcposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_zcposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zcposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, work, swork, rwork, iter, &info ); @@ -102,9 +102,9 @@ lapack_int LAPACKE_zcposv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_zcposv_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zcposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zcposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zcposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbbrd.c b/LAPACKE/src/lapacke_zgbbrd.c index 08ac86243a..2441ab4257 100644 --- a/LAPACKE/src/lapacke_zgbbrd.c +++ b/LAPACKE/src/lapacke_zgbbrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbbrd( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgbbrd)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, lapack_complex_double* ab, lapack_int ldab, double* d, double* e, @@ -44,17 +44,17 @@ lapack_int LAPACKE_zgbbrd( int matrix_layout, char vect, lapack_int m, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbbrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -8; } if( ncc != 0 ) { - if( LAPACKE_zge_nancheck( matrix_layout, m, ncc, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, ncc, c, ldc ) ) { return -16; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_zgbbrd( int matrix_layout, char vect, lapack_int m, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbbrd_work( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, + info = API_SUFFIX(LAPACKE_zgbbrd_work)( matrix_layout, vect, m, n, ncc, kl, ku, ab, ldab, d, e, q, ldq, pt, ldpt, c, ldc, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_zgbbrd( int matrix_layout, char vect, lapack_int m, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbbrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbbrd_work.c b/LAPACKE/src/lapacke_zgbbrd_work.c index 693cad63c1..5bedd1be60 100644 --- a/LAPACKE/src/lapacke_zgbbrd_work.c +++ b/LAPACKE/src/lapacke_zgbbrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgbbrd_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int ncc, lapack_int kl, lapack_int ku, lapack_complex_double* ab, lapack_int ldab, double* d, double* e, @@ -61,22 +61,22 @@ lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); return info; } if( ldc < ncc ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); return info; } if( ldpt < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); return info; } if( ldq < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,m) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, goto exit_level_1; } } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { pt_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldpt_t * MAX(1,n) ); @@ -114,9 +114,9 @@ lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); if( ncc != 0 ) { - LAPACKE_zge_trans( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, ncc, c, ldc, c_t, ldc_t ); } /* Call LAPACK function and adjust info */ LAPACK_zgbbrd( &vect, &m, &n, &ncc, &kl, &ku, ab_t, &ldab_t, d, e, q_t, @@ -125,38 +125,38 @@ lapack_int LAPACKE_zgbbrd_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, m, n, kl, ku, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, m, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, pt_t, ldpt_t, pt, ldpt ); } if( ncc != 0 ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, ncc, c_t, ldc_t, c, ldc ); } /* Release memory and exit */ if( ncc != 0 ) { LAPACKE_free( c_t ); } exit_level_3: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'p' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'p' ) ) { LAPACKE_free( pt_t ); } exit_level_2: - if( LAPACKE_lsame( vect, 'b' ) || LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'b' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbbrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbbrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbcon.c b/LAPACKE/src/lapacke_zgbcon.c index a3c1b267dd..e6f65c23c6 100644 --- a/LAPACKE/src/lapacke_zgbcon.c +++ b/LAPACKE/src/lapacke_zgbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbcon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbcon)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, const lapack_int* ipiv, double anorm, double* rcond ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_zgbcon( int matrix_layout, char norm, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -9; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_zgbcon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbcon_work( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, + info = API_SUFFIX(LAPACKE_zgbcon_work)( matrix_layout, norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_zgbcon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbcon_work.c b/LAPACKE/src/lapacke_zgbcon_work.c index bcac6fed9c..bc7c6217e9 100644 --- a/LAPACKE/src/lapacke_zgbcon_work.c +++ b/LAPACKE/src/lapacke_zgbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbcon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbcon_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, const lapack_int* ipiv, @@ -53,7 +53,7 @@ lapack_int LAPACKE_zgbcon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_zgbcon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbcon( &norm, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &anorm, rcond, @@ -76,11 +76,11 @@ lapack_int LAPACKE_zgbcon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbequ.c b/LAPACKE/src/lapacke_zgbequ.c index 805ced166f..69dab94eda 100644 --- a/LAPACKE/src/lapacke_zgbequ.c +++ b/LAPACKE/src/lapacke_zgbequ.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbequ)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_zgbequ_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_zgbequ_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_zgbequ_work.c b/LAPACKE/src/lapacke_zgbequ_work.c index 2e61d352d4..403e4c2b97 100644 --- a/LAPACKE/src/lapacke_zgbequ_work.c +++ b/LAPACKE/src/lapacke_zgbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbequ_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, double* r, double* c, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zgbequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_zgbequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbequ( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_zgbequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbequb.c b/LAPACKE/src/lapacke_zgbequb.c index 3bf1be924d..01e498a02b 100644 --- a/LAPACKE/src/lapacke_zgbequb.c +++ b/LAPACKE/src/lapacke_zgbequb.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbequb)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, m, n, kl, ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_zgbequb_work( matrix_layout, m, n, kl, ku, ab, ldab, r, c, + return API_SUFFIX(LAPACKE_zgbequb_work)( matrix_layout, m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_zgbequb_work.c b/LAPACKE/src/lapacke_zgbequb_work.c index e1a37683ef..1848b06b11 100644 --- a/LAPACKE/src/lapacke_zgbequb_work.c +++ b/LAPACKE/src/lapacke_zgbequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbequb_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, double* r, double* c, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zgbequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_zgbequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, m, n, kl, ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbequb( &m, &n, &kl, &ku, ab_t, &ldab_t, r, c, rowcnd, colcnd, amax, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_zgbequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbrfs.c b/LAPACKE/src/lapacke_zgbrfs.c index a4a4f33f21..3ae07434fc 100644 --- a/LAPACKE/src/lapacke_zgbrfs.c +++ b/LAPACKE/src/lapacke_zgbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbrfs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* afb, lapack_int ldafb, @@ -45,22 +45,22 @@ lapack_int LAPACKE_zgbrfs( int matrix_layout, char trans, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -7; } - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_zgbrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbrfs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_zgbrfs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_zgbrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbrfs_work.c b/LAPACKE/src/lapacke_zgbrfs_work.c index 28300861c3..2fc556e87a 100644 --- a/LAPACKE/src/lapacke_zgbrfs_work.c +++ b/LAPACKE/src/lapacke_zgbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, @@ -63,22 +63,22 @@ lapack_int LAPACKE_zgbrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,11 +110,11 @@ lapack_int LAPACKE_zgbrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbrfs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, @@ -123,7 +123,7 @@ lapack_int LAPACKE_zgbrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -134,11 +134,11 @@ lapack_int LAPACKE_zgbrfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbrfsx.c b/LAPACKE/src/lapacke_zgbrfsx.c index d08ec77a28..8fd8cdfa91 100644 --- a/LAPACKE/src/lapacke_zgbrfsx.c +++ b/LAPACKE/src/lapacke_zgbrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbrfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_zgbrfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* afb, @@ -48,37 +48,37 @@ lapack_int LAPACKE_zgbrfsx( int matrix_layout, char trans, char equed, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -15; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -14; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -13; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -17; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_zgbrfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbrfsx_work( matrix_layout, trans, equed, n, kl, ku, nrhs, + info = API_SUFFIX(LAPACKE_zgbrfsx_work)( matrix_layout, trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -106,7 +106,7 @@ lapack_int LAPACKE_zgbrfsx( int matrix_layout, char trans, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbrfsx_work.c b/LAPACKE/src/lapacke_zgbrfsx_work.c index 285f4a9b33..edb955ffe2 100644 --- a/LAPACKE/src/lapacke_zgbrfsx_work.c +++ b/LAPACKE/src/lapacke_zgbrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbrfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_zgbrfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, @@ -72,22 +72,22 @@ lapack_int LAPACKE_zgbrfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -18; - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -131,11 +131,11 @@ lapack_int LAPACKE_zgbrfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -145,10 +145,10 @@ lapack_int LAPACKE_zgbrfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -164,11 +164,11 @@ lapack_int LAPACKE_zgbrfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbsv.c b/LAPACKE/src/lapacke_zgbsv.c index 118473fd08..dee55c0a77 100644 --- a/LAPACKE/src/lapacke_zgbsv.c +++ b/LAPACKE/src/lapacke_zgbsv.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsv( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_zgbsv)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_zgbsv_work( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, + return API_SUFFIX(LAPACKE_zgbsv_work)( matrix_layout, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zgbsv_work.c b/LAPACKE/src/lapacke_zgbsv_work.c index 56bc1bb4b2..8d53374cc4 100644 --- a/LAPACKE/src/lapacke_zgbsv_work.c +++ b/LAPACKE/src/lapacke_zgbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_zgbsv_work)( int matrix_layout, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_int* ipiv, lapack_complex_double* b, @@ -53,12 +53,12 @@ lapack_int LAPACKE_zgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsv_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,9 +76,9 @@ lapack_int LAPACKE_zgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbsv( &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -86,20 +86,20 @@ lapack_int LAPACKE_zgbsv_work( int matrix_layout, lapack_int n, lapack_int kl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbsvx.c b/LAPACKE/src/lapacke_zgbsvx.c index 3b593d4792..84b65b4198 100644 --- a/LAPACKE/src/lapacke_zgbsvx.c +++ b/LAPACKE/src/lapacke_zgbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgbsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, @@ -46,33 +46,33 @@ lapack_int LAPACKE_zgbsvx( int matrix_layout, char fact, char trans, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -15; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -14; } } @@ -91,7 +91,7 @@ lapack_int LAPACKE_zgbsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbsvx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_zgbsvx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Backup significant data from working array(s) */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_zgbsvx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbsvx_work.c b/LAPACKE/src/lapacke_zgbsvx_work.c index fe7183c969..c5e7adb410 100644 --- a/LAPACKE/src/lapacke_zgbsvx_work.c +++ b/LAPACKE/src/lapacke_zgbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgbsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_zgbsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -111,12 +111,12 @@ lapack_int LAPACKE_zgbsvx_work( int matrix_layout, char fact, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbsvx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, @@ -125,20 +125,20 @@ lapack_int LAPACKE_zgbsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -149,11 +149,11 @@ lapack_int LAPACKE_zgbsvx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbsvxx.c b/LAPACKE/src/lapacke_zgbsvxx.c index de4a260e6c..30389445b7 100644 --- a/LAPACKE/src/lapacke_zgbsvxx.c +++ b/LAPACKE/src/lapacke_zgbsvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsvxx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgbsvxx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, @@ -48,38 +48,38 @@ lapack_int LAPACKE_zgbsvxx( int matrix_layout, char fact, char trans, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -15; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -27; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -14; } } @@ -98,7 +98,7 @@ lapack_int LAPACKE_zgbsvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgbsvxx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, + info = API_SUFFIX(LAPACKE_zgbsvxx_work)( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, @@ -109,7 +109,7 @@ lapack_int LAPACKE_zgbsvxx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbsvxx_work.c b/LAPACKE/src/lapacke_zgbsvxx_work.c index 8fec5ecb80..982c58aa71 100644 --- a/LAPACKE/src/lapacke_zgbsvxx_work.c +++ b/LAPACKE/src/lapacke_zgbsvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbsvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgbsvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, @@ -70,22 +70,22 @@ lapack_int LAPACKE_zgbsvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); return info; } if( ldafb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); return info; } if( ldb < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); return info; } if( ldx < nrhs ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -129,12 +129,12 @@ lapack_int LAPACKE_zgbsvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, ku, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, @@ -145,23 +145,23 @@ lapack_int LAPACKE_zgbsvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t, ldafb_t, afb, ldafb ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -177,11 +177,11 @@ lapack_int LAPACKE_zgbsvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbsvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbtrf.c b/LAPACKE/src/lapacke_zgbtrf.c index c325dad976..9abedb7590 100644 --- a/LAPACKE/src/lapacke_zgbtrf.c +++ b/LAPACKE/src/lapacke_zgbtrf.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbtrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbtrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, lapack_complex_double* ab, lapack_int ldab, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, m, n, kl, kl+ku, ab, ldab ) ) { return -6; } } #endif - return LAPACKE_zgbtrf_work( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); + return API_SUFFIX(LAPACKE_zgbtrf_work)( matrix_layout, m, n, kl, ku, ab, ldab, ipiv ); } diff --git a/LAPACKE/src/lapacke_zgbtrf_work.c b/LAPACKE/src/lapacke_zgbtrf_work.c index b0afaf92e9..2cee61b65e 100644 --- a/LAPACKE/src/lapacke_zgbtrf_work.c +++ b/LAPACKE/src/lapacke_zgbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbtrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, lapack_complex_double* ab, lapack_int ldab, lapack_int* ipiv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, m, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbtrf( &m, &n, &kl, &ku, ab_t, &ldab_t, ipiv, &info ); @@ -69,17 +69,17 @@ lapack_int LAPACKE_zgbtrf_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zgb_trans( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zgb_trans)( LAPACK_COL_MAJOR, m, n, kl, kl+ku, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgbtrs.c b/LAPACKE/src/lapacke_zgbtrs.c index cac06b206a..9382f1b255 100644 --- a/LAPACKE/src/lapacke_zgbtrs.c +++ b/LAPACKE/src/lapacke_zgbtrs.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbtrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbtrs)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, kl+ku, ab, ldab ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_zgbtrs_work( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, + return API_SUFFIX(LAPACKE_zgbtrs_work)( matrix_layout, trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zgbtrs_work.c b/LAPACKE/src/lapacke_zgbtrs_work.c index e4e9faf1f2..60943004e7 100644 --- a/LAPACKE/src/lapacke_zgbtrs_work.c +++ b/LAPACKE/src/lapacke_zgbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgbtrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgbtrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_int* ipiv, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zgbtrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,9 +77,9 @@ lapack_int LAPACKE_zgbtrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zgb_trans( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kl, kl+ku, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgbtrs( &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t, ipiv, b_t, &ldb_t, &info ); @@ -87,18 +87,18 @@ lapack_int LAPACKE_zgbtrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgebak.c b/LAPACKE/src/lapacke_zgebak.c index cd71fb0900..c420dc40c0 100644 --- a/LAPACKE/src/lapacke_zgebak.c +++ b/LAPACKE/src/lapacke_zgebak.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgebak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* scale, lapack_int m, lapack_complex_double* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgebak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, scale, 1 ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -9; } } #endif - return LAPACKE_zgebak_work( matrix_layout, job, side, n, ilo, ihi, scale, m, + return API_SUFFIX(LAPACKE_zgebak_work)( matrix_layout, job, side, n, ilo, ihi, scale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_zgebak_work.c b/LAPACKE/src/lapacke_zgebak_work.c index 724ae20f23..d6a97382e4 100644 --- a/LAPACKE/src/lapacke_zgebak_work.c +++ b/LAPACKE/src/lapacke_zgebak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_zgebak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* scale, lapack_int m, lapack_complex_double* v, lapack_int ldv ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgebak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zgebak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_zgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_zgebak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgebak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgebal.c b/LAPACKE/src/lapacke_zgebal.c index 5ccb858bc2..01179d5bc0 100644 --- a/LAPACKE/src/lapacke_zgebal.c +++ b/LAPACKE/src/lapacke_zgebal.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebal( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgebal)( int matrix_layout, char job, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, double* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgebal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } } #endif - return LAPACKE_zgebal_work( matrix_layout, job, n, a, lda, ilo, ihi, scale ); + return API_SUFFIX(LAPACKE_zgebal_work)( matrix_layout, job, n, a, lda, ilo, ihi, scale ); } diff --git a/LAPACKE/src/lapacke_zgebal_work.c b/LAPACKE/src/lapacke_zgebal_work.c index 0cdc764bea..20902a652c 100644 --- a/LAPACKE/src/lapacke_zgebal_work.c +++ b/LAPACKE/src/lapacke_zgebal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgebal_work)( int matrix_layout, char job, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, double* scale ) @@ -50,12 +50,12 @@ lapack_int LAPACKE_zgebal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); @@ -65,9 +65,9 @@ lapack_int LAPACKE_zgebal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } /* Call LAPACK function and adjust info */ LAPACK_zgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info ); @@ -75,22 +75,22 @@ lapack_int LAPACKE_zgebal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || - LAPACKE_lsame( job, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || + API_SUFFIX(LAPACKE_lsame)( job, 's' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgebal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgebrd.c b/LAPACKE/src/lapacke_zgebrd.c index 30fc46a436..9310f1ce38 100644 --- a/LAPACKE/src/lapacke_zgebrd.c +++ b/LAPACKE/src/lapacke_zgebrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebrd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgebrd)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* d, double* e, lapack_complex_double* tauq, lapack_complex_double* taup ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_zgebrd( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgebrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_zgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_zgebrd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgebrd_work( matrix_layout, m, n, a, lda, d, e, tauq, taup, + info = API_SUFFIX(LAPACKE_zgebrd_work)( matrix_layout, m, n, a, lda, d, e, tauq, taup, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgebrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgebrd_work.c b/LAPACKE/src/lapacke_zgebrd_work.c index 8f30dcba74..3f7a2fcd2e 100644 --- a/LAPACKE/src/lapacke_zgebrd_work.c +++ b/LAPACKE/src/lapacke_zgebrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgebrd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgebrd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* d, double* e, lapack_complex_double* tauq, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zgebrd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_zgebrd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgebrd( &m, &n, a_t, &lda_t, d, e, tauq, taup, work, &lwork, &info ); @@ -77,16 +77,16 @@ lapack_int LAPACKE_zgebrd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgebrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgebrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgecon.c b/LAPACKE/src/lapacke_zgecon.c index ca59138aa7..451970118b 100644 --- a/LAPACKE/src/lapacke_zgecon.c +++ b/LAPACKE/src/lapacke_zgecon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgecon( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgecon)( int matrix_layout, char norm, lapack_int n, const lapack_complex_double* a, lapack_int lda, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_zgecon( int matrix_layout, char norm, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgecon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgecon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_zgecon( int matrix_layout, char norm, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgecon_work( matrix_layout, norm, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_zgecon_work)( matrix_layout, norm, n, a, lda, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_zgecon( int matrix_layout, char norm, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgecon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgecon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgecon_work.c b/LAPACKE/src/lapacke_zgecon_work.c index b18dbf1845..d8c7cc0490 100644 --- a/LAPACKE/src/lapacke_zgecon_work.c +++ b/LAPACKE/src/lapacke_zgecon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgecon_work( int matrix_layout, char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgecon_work)( int matrix_layout, char norm, lapack_int n, const lapack_complex_double* a, lapack_int lda, double anorm, double* rcond, lapack_complex_double* work, double* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgecon_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgecon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zgecon_work( int matrix_layout, char norm, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgecon( &norm, &n, a_t, &lda_t, &anorm, rcond, work, rwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_zgecon_work( int matrix_layout, char norm, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgecon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgecon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgedmd.c b/LAPACKE/src/lapacke_zgedmd.c index e4ea4fe105..1c1d1ab749 100644 --- a/LAPACKE/src/lapacke_zgedmd.c +++ b/LAPACKE/src/lapacke_zgedmd.c @@ -32,17 +32,17 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgedmd( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_zgedmd)( int matrix_layout, char jobs, char jobz, char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_double* x, lapack_int ldx, lapack_complex_double* y, lapack_int ldy, lapack_int nrnk, double *tol, lapack_int k, - lapack_complex_double* eigs, lapack_complex_double* z, - lapack_int ldz, double* res, - lapack_complex_double* b, lapack_int ldb, - lapack_complex_double* zw, lapack_int lzw, - lapack_complex_double* w, lapack_int ldw, - lapack_complex_double* s, lapack_int lds) + lapack_complex_double* eigs, lapack_complex_double* z, + lapack_int ldz, double* res, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* zw, lapack_int lzw, + lapack_complex_double* w, lapack_int ldw, + lapack_complex_double* s, lapack_int lds) { lapack_int info = 0; lapack_int lwork = -1; @@ -55,34 +55,34 @@ lapack_int LAPACKE_zgedmd( int matrix_layout, char jobs, char jobz, char jobr, lapack_int iwork_query; lapack_complex_double zwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgedmd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -15; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -18; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -20; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, w, ldw ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, w, ldw ) ) { return -22; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_zgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, w, ldw, s, lds, &zwork_query, lzwork, &work_query, lwork, &iwork_query, liwork ); @@ -110,7 +110,7 @@ lapack_int LAPACKE_zgedmd( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgedmd_work( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, + info = API_SUFFIX(LAPACKE_zgedmd_work)( matrix_layout, jobs, jobz, jobr, jobf, whtsvd, m, n, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, w, ldw, s, lds, zwork, lzwork, work, lwork, iwork, liwork ); @@ -122,7 +122,7 @@ lapack_int LAPACKE_zgedmd( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( zwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgedmd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgedmd_work.c b/LAPACKE/src/lapacke_zgedmd_work.c index ebacfaa94d..c097385186 100644 --- a/LAPACKE/src/lapacke_zgedmd_work.c +++ b/LAPACKE/src/lapacke_zgedmd_work.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, - char jobr, char jobf, lapack_int whtsvd, +lapack_int API_SUFFIX(LAPACKE_zgedmd_work)( int matrix_layout, char jobs, char jobz, + char jobr, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_double* x, - lapack_int ldx, lapack_complex_double* y, - lapack_int ldy, lapack_int nrnk, double *tol, lapack_int k, - lapack_complex_double* eigs, lapack_complex_double* z, - lapack_int ldz, double* res, - lapack_complex_double* b, lapack_int ldb, - lapack_complex_double* w, lapack_int ldw, - lapack_complex_double* s, lapack_int lds, - lapack_complex_double* zwork, lapack_int lzwork, - double* work, lapack_int lwork, - lapack_int* iwork, lapack_int liwork ) + lapack_int ldx, lapack_complex_double* y, + lapack_int ldy, lapack_int nrnk, double *tol, lapack_int k, + lapack_complex_double* eigs, lapack_complex_double* z, + lapack_int ldz, double* res, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* w, lapack_int ldw, + lapack_complex_double* s, lapack_int lds, + lapack_complex_double* zwork, lapack_int lzwork, + double* work, lapack_int lwork, + lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { @@ -73,32 +73,32 @@ lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldx < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } if( ldy < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } if( ldb < n ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } if( ldw < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } if( lds < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -141,12 +141,12 @@ lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_zge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_zge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); - LAPACKE_zge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_zgedmd( &jobs, &jobz, &jobr, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, &ldy_t, &nrnk, tol, &k, eigs, z_t, &ldz_t, @@ -156,12 +156,12 @@ lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_5: @@ -176,11 +176,11 @@ lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgedmdq.c b/LAPACKE/src/lapacke_zgedmdq.c index dc71db4445..4cc2605b5a 100644 --- a/LAPACKE/src/lapacke_zgedmdq.c +++ b/LAPACKE/src/lapacke_zgedmdq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgedmdq( int matrix_layout, char jobs, char jobz, char jobr, +lapack_int API_SUFFIX(LAPACKE_zgedmdq)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_double* f, lapack_int ldf, lapack_complex_double* x, @@ -55,37 +55,37 @@ lapack_int LAPACKE_zgedmdq( int matrix_layout, char jobs, char jobz, char jobr, lapack_complex_double zwork_query; lapack_int iwork_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_cgedmdq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgedmdq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -11; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -13; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, y, ldy ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, y, ldy ) ) { return -15; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, z, ldz ) ) { return -22; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -25; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, v, ldv ) ) { return -27; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, s, lds ) ) { return -29; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_zgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, v, ldv, s, lds, &zwork_query, lzwork, @@ -114,7 +114,7 @@ lapack_int LAPACKE_zgedmdq( int matrix_layout, char jobs, char jobz, char jobr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, + info = API_SUFFIX(LAPACKE_zgedmdq_work)( matrix_layout, jobs, jobz, jobr, jobq, jobt, jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, nrnk, tol, k, eigs, z, ldz, res, b, ldb, v, ldv, s, lds, zwork, lzwork, @@ -127,7 +127,7 @@ lapack_int LAPACKE_zgedmdq( int matrix_layout, char jobs, char jobz, char jobr, LAPACKE_free( zwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgedmdq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgedmdq_work.c b/LAPACKE/src/lapacke_zgedmdq_work.c index 131e4f9ad6..318213ebd9 100644 --- a/LAPACKE/src/lapacke_zgedmdq_work.c +++ b/LAPACKE/src/lapacke_zgedmdq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, +lapack_int API_SUFFIX(LAPACKE_zgedmdq_work)( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, lapack_int whtsvd, lapack_int m, lapack_int n, lapack_complex_double* f, lapack_int ldf, @@ -78,37 +78,37 @@ lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, /* Check leading dimension(s) */ if( ldf < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( ldx < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( ldy < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( ldz < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( ldb < n ) { info = -26; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( ldv < n ) { info = -28; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } if( lds < n ) { info = -30; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -156,13 +156,13 @@ lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, goto exit_level_6; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); - LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); - LAPACKE_zge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); - LAPACKE_zge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, m, n, v, ldv, v_t, ldv_t ); - LAPACKE_zge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, s, lds, s_t, lds_t ); /* Call LAPACK function and adjust info */ LAPACK_zgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, tol, &k, eigs, @@ -172,13 +172,13 @@ lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); /* Release memory and exit */ LAPACKE_free( s_t ); exit_level_6: @@ -195,11 +195,11 @@ lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, LAPACKE_free( f_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgedmdq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeequ.c b/LAPACKE/src/lapacke_zgeequ.c index 297a76e1da..f8ac753ec1 100644 --- a/LAPACKE/src/lapacke_zgeequ.c +++ b/LAPACKE/src/lapacke_zgeequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeequ( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeequ)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgeequ_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_zgeequ_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_zgeequ_work.c b/LAPACKE/src/lapacke_zgeequ_work.c index 019fcac8f2..6593dfb8e4 100644 --- a/LAPACKE/src/lapacke_zgeequ_work.c +++ b/LAPACKE/src/lapacke_zgeequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeequ_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeequ_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeequ_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zgeequ_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_zgeequ_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeequb.c b/LAPACKE/src/lapacke_zgeequb.c index c565da024a..9d4fb3de63 100644 --- a/LAPACKE/src/lapacke_zgeequb.c +++ b/LAPACKE/src/lapacke_zgeequb.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeequb( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeequb)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgeequb_work( matrix_layout, m, n, a, lda, r, c, rowcnd, + return API_SUFFIX(LAPACKE_zgeequb_work)( matrix_layout, m, n, a, lda, r, c, rowcnd, colcnd, amax ); } diff --git a/LAPACKE/src/lapacke_zgeequb_work.c b/LAPACKE/src/lapacke_zgeequb_work.c index c28a31f925..dd6d4eb742 100644 --- a/LAPACKE/src/lapacke_zgeequb_work.c +++ b/LAPACKE/src/lapacke_zgeequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeequb_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeequb_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* r, double* c, double* rowcnd, double* colcnd, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeequb_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zgeequb_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeequb( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, amax, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_zgeequb_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgees.c b/LAPACKE/src/lapacke_zgees.c index b3ccd2ede5..441fbeb611 100644 --- a/LAPACKE/src/lapacke_zgees.c +++ b/LAPACKE/src/lapacke_zgees.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgees( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_zgees)( int matrix_layout, char jobvs, char sort, LAPACK_Z_SELECT1 select, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* sdim, lapack_complex_double* w, @@ -45,19 +45,19 @@ lapack_int LAPACKE_zgees( int matrix_layout, char jobvs, char sort, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgees", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -71,7 +71,7 @@ lapack_int LAPACKE_zgees( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_zgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, w, vs, ldvs, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -86,19 +86,19 @@ lapack_int LAPACKE_zgees( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgees_work( matrix_layout, jobvs, sort, select, n, a, lda, + info = API_SUFFIX(LAPACKE_zgees_work)( matrix_layout, jobvs, sort, select, n, a, lda, sdim, w, vs, ldvs, work, lwork, rwork, bwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgees", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgees_work.c b/LAPACKE/src/lapacke_zgees_work.c index 05685823de..7bed43e00d 100644 --- a/LAPACKE/src/lapacke_zgees_work.c +++ b/LAPACKE/src/lapacke_zgees_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgees_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_zgees_work)( int matrix_layout, char jobvs, char sort, LAPACK_Z_SELECT1 select, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* sdim, lapack_complex_double* w, @@ -56,12 +56,12 @@ lapack_int LAPACKE_zgees_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees_work", info ); return info; } if( ldvs < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -77,7 +77,7 @@ lapack_int LAPACKE_zgees_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvs_t * MAX(1,n) ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_zgees_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, w, vs_t, &ldvs_t, work, &lwork, rwork, bwork, &info ); @@ -95,23 +95,23 @@ lapack_int LAPACKE_zgees_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgees_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgees_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeesx.c b/LAPACKE/src/lapacke_zgeesx.c index c3756d90e9..a0a942e0c9 100644 --- a/LAPACKE/src/lapacke_zgeesx.c +++ b/LAPACKE/src/lapacke_zgeesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeesx( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_zgeesx)( int matrix_layout, char jobvs, char sort, LAPACK_Z_SELECT1 select, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* sdim, lapack_complex_double* w, @@ -46,19 +46,19 @@ lapack_int LAPACKE_zgeesx( int matrix_layout, char jobvs, char sort, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -72,7 +72,7 @@ lapack_int LAPACKE_zgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_zgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, w, vs, ldvs, rconde, rcondv, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_zgeesx( int matrix_layout, char jobvs, char sort, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgeesx_work( matrix_layout, jobvs, sort, select, sense, n, a, + info = API_SUFFIX(LAPACKE_zgeesx_work)( matrix_layout, jobvs, sort, select, sense, n, a, lda, sdim, w, vs, ldvs, rconde, rcondv, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -95,12 +95,12 @@ lapack_int LAPACKE_zgeesx( int matrix_layout, char jobvs, char sort, exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeesx_work.c b/LAPACKE/src/lapacke_zgeesx_work.c index b338f0f29e..c2843f05a6 100644 --- a/LAPACKE/src/lapacke_zgeesx_work.c +++ b/LAPACKE/src/lapacke_zgeesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeesx_work( int matrix_layout, char jobvs, char sort, +lapack_int API_SUFFIX(LAPACKE_zgeesx_work)( int matrix_layout, char jobvs, char sort, LAPACK_Z_SELECT1 select, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* sdim, @@ -59,12 +59,12 @@ lapack_int LAPACKE_zgeesx_work( int matrix_layout, char jobvs, char sort, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx_work", info ); return info; } if( ldvs < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_zgeesx_work( int matrix_layout, char jobvs, char sort, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { vs_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvs_t * MAX(1,n) ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_zgeesx_work( int matrix_layout, char jobvs, char sort, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeesx( &jobvs, &sort, select, &sense, &n, a_t, &lda_t, sdim, w, vs_t, &ldvs_t, rconde, rcondv, work, &lwork, rwork, @@ -100,23 +100,23 @@ lapack_int LAPACKE_zgeesx_work( int matrix_layout, char jobvs, char sort, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvs, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvs, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeev.c b/LAPACKE/src/lapacke_zgeev.c index 4ab99c3b7e..247f16c5cc 100644 --- a/LAPACKE/src/lapacke_zgeev.c +++ b/LAPACKE/src/lapacke_zgeev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_zgeev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* w, lapack_complex_double* vl, lapack_int ldvl, @@ -44,13 +44,13 @@ lapack_int LAPACKE_zgeev( int matrix_layout, char jobvl, char jobvr, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } @@ -62,7 +62,7 @@ lapack_int LAPACKE_zgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, + info = API_SUFFIX(LAPACKE_zgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -76,7 +76,7 @@ lapack_int LAPACKE_zgeev( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgeev_work( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, + info = API_SUFFIX(LAPACKE_zgeev_work)( matrix_layout, jobvl, jobvr, n, a, lda, w, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_zgeev( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeev_work.c b/LAPACKE/src/lapacke_zgeev_work.c index 445b9dc1c9..e2bb5022b1 100644 --- a/LAPACKE/src/lapacke_zgeev_work.c +++ b/LAPACKE/src/lapacke_zgeev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_zgeev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* w, lapack_complex_double* vl, lapack_int ldvl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,n) ); @@ -93,7 +93,7 @@ lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,n) ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeev( &jobvl, &jobvr, &n, a_t, &lda_t, w, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, rwork, &info ); @@ -111,30 +111,30 @@ lapack_int LAPACKE_zgeev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeevx.c b/LAPACKE/src/lapacke_zgeevx.c index 25d2e735d6..87f82afa63 100644 --- a/LAPACKE/src/lapacke_zgeevx.c +++ b/LAPACKE/src/lapacke_zgeevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_zgeevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* w, lapack_complex_double* vl, @@ -47,13 +47,13 @@ lapack_int LAPACKE_zgeevx( int matrix_layout, char balanc, char jobvl, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_zgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, w, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, &work_query, lwork, rwork ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_zgeevx( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgeevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_zgeevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, w, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_zgeevx( int matrix_layout, char balanc, char jobvl, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeevx_work.c b/LAPACKE/src/lapacke_zgeevx_work.c index 29dbf06f0d..89599c3d04 100644 --- a/LAPACKE/src/lapacke_zgeevx_work.c +++ b/LAPACKE/src/lapacke_zgeevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_zgeevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* w, @@ -62,17 +62,17 @@ lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx_work", info ); return info; } - if( ldvl < 1 || ( LAPACKE_lsame( jobvl, 'v' ) && ldvl < n ) ) { + if( ldvl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) && ldvl < n ) ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx_work", info ); return info; } - if( ldvr < 1 || ( LAPACKE_lsame( jobvr, 'v' ) && ldvr < n ) ) { + if( ldvr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) && ldvr < n ) ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,n) ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_1; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,n) ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, w, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm, @@ -117,30 +117,30 @@ lapack_int LAPACKE_zgeevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgehrd.c b/LAPACKE/src/lapacke_zgehrd.c index 82399abede..327091264b 100644 --- a/LAPACKE/src/lapacke_zgehrd.c +++ b/LAPACKE/src/lapacke_zgehrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgehrd( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_zgehrd)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgehrd( int matrix_layout, lapack_int n, lapack_int ilo, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgehrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgehrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_zgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zgehrd( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgehrd_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zgehrd_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgehrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgehrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgehrd_work.c b/LAPACKE/src/lapacke_zgehrd_work.c index c79ce4dba2..d0ab87150b 100644 --- a/LAPACKE/src/lapacke_zgehrd_work.c +++ b/LAPACKE/src/lapacke_zgehrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_zgehrd_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgehrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zgehrd_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgehrd( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgehrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgehrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgehrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgejsv.c b/LAPACKE/src/lapacke_zgejsv.c index ccada9404e..fcf0820233 100644 --- a/LAPACKE/src/lapacke_zgejsv.c +++ b/LAPACKE/src/lapacke_zgejsv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_zgejsv)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* sva, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* v, lapack_int ldv, @@ -41,96 +41,96 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, lapack_int info = 0; lapack_int lwork = ( // 1.1 - ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? 2*n+1 : + ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? 2*n+1 : //1.2 - ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? n*n+3*n : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? n*n+3*n : //2.1 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) )&& - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u') || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) )&& + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //2.2 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //3.1 - ( ( ( 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' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //3.2 - ( ( ( 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' ) ))? 3*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 3*n : //4.1 - ( ( ( 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' ) ))? 5*n+2*n*n : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 5*n+2*n*n : //4.2 - ( ( ( 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' ) ))? 4*n*n: + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? 4*n*n: 1) ) ) ) ) ) ) ); lapack_int lrwork = ( // 1.1 - ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,n+2*m) : + ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? MAX(7,n+2*m) : //1.2 - ( ( LAPACKE_lsame( jobu, 'n' ) && LAPACKE_lsame( jobv, 'n' ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) )) ? MAX(7,2*n) : + ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) && API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) )) ? MAX(7,2*n) : //2.1 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u') || LAPACKE_lsame( jobu, 'f' ) ) && - ( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u') || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //2.2 - ( ( ( LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' ) ) && - !( LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' ) ) && - !( LAPACKE_lsame( jobt, 't' ) || LAPACKE_lsame( joba, 'f' ) || LAPACKE_lsame( joba, 'g' ) ))? MAX(7,2*n) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + !( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : //3.1 - ( ( ( 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, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //3.2 - ( ( ( 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) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' )) && + !(API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : //4.1 - ( ( ( 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, n+ 2*m ) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX( 7, n+ 2*m ) : //4.2 - ( ( ( 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) : + ( ( ( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) ) && + ( API_SUFFIX(LAPACKE_lsame)( jobt, 't' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'f' ) || API_SUFFIX(LAPACKE_lsame)( joba, 'g' ) ))? MAX(7,2*n) : 7) ) ) ) ) ) ) ); lapack_int* iwork = NULL; double* rwork = NULL; lapack_complex_double* cwork = NULL; lapack_int i; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgejsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } } @@ -143,13 +143,13 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, } 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' ); + int want_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ); + int want_v = API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ); + int want_sce = API_SUFFIX(LAPACKE_lsame)( joba, 'e' ) || API_SUFFIX(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 + if( want_u && API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) lwork = MAX( lwork, 5*n+2*n*n ); // 4.1 + if( want_u && API_SUFFIX(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 ) { @@ -163,7 +163,7 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt, + info = API_SUFFIX(LAPACKE_zgejsv_work)( matrix_layout, joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork ); /* Backup significant data from working array(s) */ @@ -181,7 +181,7 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgejsv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgejsv_work.c b/LAPACKE/src/lapacke_zgejsv_work.c index 51d51023b9..1067a4ad8c 100644 --- a/LAPACKE/src/lapacke_zgejsv_work.c +++ b/LAPACKE/src/lapacke_zgejsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, +lapack_int API_SUFFIX(LAPACKE_zgejsv_work)( int matrix_layout, char joba, char jobu, char jobv, char jobr, char jobt, char jobp, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* sva, lapack_complex_double* u, @@ -51,10 +51,10 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } } 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 nu = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : m; + lapack_int nv = API_SUFFIX(LAPACKE_lsame)( jobv, 'n' ) ? 1 : n; + lapack_int ncols_u = API_SUFFIX(LAPACKE_lsame)( jobu, 'n' ) ? 1 : + API_SUFFIX(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); @@ -64,17 +64,17 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv_work", info ); return info; } if( ldu < ncols_u ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv_work", info ); return info; } if( ldv < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { @@ -93,8 +93,8 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, goto exit_level_1; } } - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) ); if( v_t == NULL ) { @@ -103,7 +103,7 @@ 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 ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_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, @@ -112,33 +112,33 @@ lapack_int LAPACKE_zgejsv_work( int matrix_layout, char joba, char jobu, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nu, ncols_u, u_t, ldu_t, u, ldu ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { + API_SUFFIX(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' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nv, n, v_t, ldv_t, v, ldv ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'j' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'j' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) || + API_SUFFIX(LAPACKE_lsame)( jobv, 'w' ) ) { LAPACKE_free( v_t ); } exit_level_2: - if( LAPACKE_lsame( jobu, 'f' ) || LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'w' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'f' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) || + API_SUFFIX(LAPACKE_lsame)( jobu, 'w' ) ) { LAPACKE_free( u_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgejsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgejsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelq.c b/LAPACKE/src/lapacke_zgelq.c index c5c2fa7195..75d899de1e 100644 --- a/LAPACKE/src/lapacke_zgelq.c +++ b/LAPACKE/src/lapacke_zgelq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelq)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_zgelq_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -69,12 +69,12 @@ lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_zgelq_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelq2.c b/LAPACKE/src/lapacke_zgelq2.c index 56cbec346e..f0787bf08b 100644 --- a/LAPACKE/src/lapacke_zgelq2.c +++ b/LAPACKE/src/lapacke_zgelq2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelq2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelq2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelq2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zgelq2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgelq2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_zgelq2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelq2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelq2_work.c b/LAPACKE/src/lapacke_zgelq2_work.c index 3146803c95..7a253f293d 100644 --- a/LAPACKE/src/lapacke_zgelq2_work.c +++ b/LAPACKE/src/lapacke_zgelq2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelq2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelq2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgelq2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zgelq2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelq2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelq2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelq_work.c b/LAPACKE/src/lapacke_zgelq_work.c index c395bc4138..39207c9c69 100644 --- a/LAPACKE/src/lapacke_zgelq_work.c +++ b/LAPACKE/src/lapacke_zgelq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int tsize, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,23 +65,23 @@ lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelqf.c b/LAPACKE/src/lapacke_zgelqf.c index d14cb5f3e0..cf02c42248 100644 --- a/LAPACKE/src/lapacke_zgelqf.c +++ b/LAPACKE/src/lapacke_zgelqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelqf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgelqf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgelqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zgelqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgelqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgelqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_zgelqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelqf_work.c b/LAPACKE/src/lapacke_zgelqf_work.c index ba4ccc273e..71467cd254 100644 --- a/LAPACKE/src/lapacke_zgelqf_work.c +++ b/LAPACKE/src/lapacke_zgelqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelqf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgelqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgelqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgels.c b/LAPACKE/src/lapacke_zgels.c index 8b72315411..47a3e39a66 100644 --- a/LAPACKE/src/lapacke_zgels.c +++ b/LAPACKE/src/lapacke_zgels.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgels( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgels)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zgels( int matrix_layout, char trans, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgels", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zgels( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgels_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zgels_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgels", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgels_work.c b/LAPACKE/src/lapacke_zgels_work.c index b7b434d7e7..731c60f5de 100644 --- a/LAPACKE/src/lapacke_zgels_work.c +++ b/LAPACKE/src/lapacke_zgels_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgels_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgels_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zgels_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zgels_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgels( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -92,8 +92,8 @@ lapack_int LAPACKE_zgels_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -101,11 +101,11 @@ lapack_int LAPACKE_zgels_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgels_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgels_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelsd.c b/LAPACKE/src/lapacke_zgelsd.c index 5635f8e6b9..56a887f01c 100644 --- a/LAPACKE/src/lapacke_zgelsd.c +++ b/LAPACKE/src/lapacke_zgelsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelsd)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* s, double rcond, @@ -50,25 +50,25 @@ lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_zgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, &rwork_query, &iwork_query ); if( info != 0 ) { @@ -95,7 +95,7 @@ lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgelsd_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_zgelsd_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -105,7 +105,7 @@ lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelsd_work.c b/LAPACKE/src/lapacke_zgelsd_work.c index 09004cc723..8aca905855 100644 --- a/LAPACKE/src/lapacke_zgelsd_work.c +++ b/LAPACKE/src/lapacke_zgelsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelsd_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelsd_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* s, double rcond, @@ -56,12 +56,12 @@ lapack_int LAPACKE_zgelsd_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_zgelsd_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelsd( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, rwork, iwork, &info ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_zgelsd_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -103,11 +103,11 @@ lapack_int LAPACKE_zgelsd_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelss.c b/LAPACKE/src/lapacke_zgelss.c index c3a70e664c..6ca68d064c 100644 --- a/LAPACKE/src/lapacke_zgelss.c +++ b/LAPACKE/src/lapacke_zgelss.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelss( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelss)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* s, double rcond, @@ -44,19 +44,19 @@ lapack_int LAPACKE_zgelss( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelss", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_zgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_zgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -82,7 +82,7 @@ lapack_int LAPACKE_zgelss( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgelss_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, + info = API_SUFFIX(LAPACKE_zgelss_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_zgelss( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelss", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelss_work.c b/LAPACKE/src/lapacke_zgelss_work.c index 92c5b8cccc..2a3d469a34 100644 --- a/LAPACKE/src/lapacke_zgelss_work.c +++ b/LAPACKE/src/lapacke_zgelss_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelss_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelss_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* s, double rcond, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zgelss_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zgelss_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelss( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, s, &rcond, rank, work, &lwork, rwork, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_zgelss_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -102,11 +102,11 @@ lapack_int LAPACKE_zgelss_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelss_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelss_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelsy.c b/LAPACKE/src/lapacke_zgelsy.c index e340d6d16d..fe4793baae 100644 --- a/LAPACKE/src/lapacke_zgelsy.c +++ b/LAPACKE/src/lapacke_zgelsy.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelsy( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelsy)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_int* jpvt, double rcond, @@ -44,19 +44,19 @@ lapack_int LAPACKE_zgelsy( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgelsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &rcond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &rcond, 1 ) ) { return -10; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_zgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_zgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -82,7 +82,7 @@ lapack_int LAPACKE_zgelsy( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgelsy_work( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, + info = API_SUFFIX(LAPACKE_zgelsy_work)( matrix_layout, m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_zgelsy( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgelsy_work.c b/LAPACKE/src/lapacke_zgelsy_work.c index 03ee8d0d50..9a2dad97b7 100644 --- a/LAPACKE/src/lapacke_zgelsy_work.c +++ b/LAPACKE/src/lapacke_zgelsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgelsy_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgelsy_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_int* jpvt, double rcond, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zgelsy_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zgelsy_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgelsy( &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, jpvt, &rcond, rank, work, &lwork, rwork, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_zgelsy_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -102,11 +102,11 @@ lapack_int LAPACKE_zgelsy_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgelsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgelsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemlq.c b/LAPACKE/src/lapacke_zgemlq.c index 8825594a2d..0a35828fa9 100644 --- a/LAPACKE/src/lapacke_zgemlq.c +++ b/LAPACKE/src/lapacke_zgemlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int tsize, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgemlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_zgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_zgemlq_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemlq_work.c b/LAPACKE/src/lapacke_zgemlq_work.c index 50261f10a9..36e6efa183 100644 --- a/LAPACKE/src/lapacke_zgemlq_work.c +++ b/LAPACKE/src/lapacke_zgemlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,k); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(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) ); @@ -87,8 +87,8 @@ lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -96,18 +96,18 @@ lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemqr.c b/LAPACKE/src/lapacke_zgemqr.c index c793ef34b8..ae2e6ec571 100644 --- a/LAPACKE/src/lapacke_zgemqr.c +++ b/LAPACKE/src/lapacke_zgemqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int tsize, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, lapack_complex_double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgemqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( tsize, t, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( tsize, t, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_zgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + info = API_SUFFIX(LAPACKE_zgemqr_work)( matrix_layout, side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemqr_work.c b/LAPACKE/src/lapacke_zgemqr_work.c index 88d06c2846..6f88e8c20f 100644 --- a/LAPACKE/src/lapacke_zgemqr_work.c +++ b/LAPACKE/src/lapacke_zgemqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int tsize, @@ -51,18 +51,18 @@ lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, c_t, &ldc_t, work, &lwork, &info ); @@ -94,18 +94,18 @@ lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemqrt.c b/LAPACKE/src/lapacke_zgemqrt.c index 65b4684050..00ebbf1f5d 100644 --- a/LAPACKE/src/lapacke_zgemqrt.c +++ b/LAPACKE/src/lapacke_zgemqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, @@ -43,21 +43,21 @@ lapack_int LAPACKE_zgemqrt( int matrix_layout, char side, char trans, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgemqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* 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 ) ) { + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -8; } } @@ -70,13 +70,13 @@ lapack_int LAPACKE_zgemqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgemqrt_work( matrix_layout, side, trans, m, n, k, nb, v, ldv, + info = API_SUFFIX(LAPACKE_zgemqrt_work)( matrix_layout, side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgemqrt_work.c b/LAPACKE/src/lapacke_zgemqrt_work.c index 734889efb5..cc2063529e 100644 --- a/LAPACKE/src/lapacke_zgemqrt_work.c +++ b/LAPACKE/src/lapacke_zgemqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgemqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zgemqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int nb, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, @@ -57,17 +57,17 @@ lapack_int LAPACKE_zgemqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt_work", info ); return info; } if( ldt < nb ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt_work", info ); return info; } if( ldv < k ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,9 +90,9 @@ lapack_int LAPACKE_zgemqrt_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_zge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zgemqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -109,11 +109,11 @@ lapack_int LAPACKE_zgemqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgemqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgemqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqlf.c b/LAPACKE/src/lapacke_zgeqlf.c index 499270f629..cd6e3ca6ba 100644 --- a/LAPACKE/src/lapacke_zgeqlf.c +++ b/LAPACKE/src/lapacke_zgeqlf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqlf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqlf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgeqlf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqlf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqlf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgeqlf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zgeqlf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgeqlf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqlf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_zgeqlf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqlf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqlf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqlf_work.c b/LAPACKE/src/lapacke_zgeqlf_work.c index fe10813a34..1ea6ba30dd 100644 --- a/LAPACKE/src/lapacke_zgeqlf_work.c +++ b/LAPACKE/src/lapacke_zgeqlf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqlf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqlf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgeqlf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqlf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqlf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqlf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqlf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqp3.c b/LAPACKE/src/lapacke_zgeqp3.c index 2aafafc869..0c40fe7771 100644 --- a/LAPACKE/src/lapacke_zgeqp3.c +++ b/LAPACKE/src/lapacke_zgeqp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqp3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqp3)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* jpvt, lapack_complex_double* tau ) { @@ -42,13 +42,13 @@ lapack_int LAPACKE_zgeqp3( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -60,7 +60,7 @@ lapack_int LAPACKE_zgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, + info = API_SUFFIX(LAPACKE_zgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -74,7 +74,7 @@ lapack_int LAPACKE_zgeqp3( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgeqp3_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_zgeqp3_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_zgeqp3( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqp3_work.c b/LAPACKE/src/lapacke_zgeqp3_work.c index 76d437f871..04b82c0c4a 100644 --- a/LAPACKE/src/lapacke_zgeqp3_work.c +++ b/LAPACKE/src/lapacke_zgeqp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqp3_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* jpvt, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_zgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqp3( &m, &n, a_t, &lda_t, jpvt, tau, work, &lwork, rwork, &info ); @@ -76,16 +76,16 @@ lapack_int LAPACKE_zgeqp3_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqpf.c b/LAPACKE/src/lapacke_zgeqpf.c index c5be1df529..df9361ac95 100644 --- a/LAPACKE/src/lapacke_zgeqpf.c +++ b/LAPACKE/src/lapacke_zgeqpf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqpf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqpf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* jpvt, lapack_complex_double* tau ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_zgeqpf( int matrix_layout, lapack_int m, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqpf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqpf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_zgeqpf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgeqpf_work( matrix_layout, m, n, a, lda, jpvt, tau, work, + info = API_SUFFIX(LAPACKE_zgeqpf_work)( matrix_layout, m, n, a, lda, jpvt, tau, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_zgeqpf( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqpf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqpf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqpf_work.c b/LAPACKE/src/lapacke_zgeqpf_work.c index 489805d388..ae653dbb62 100644 --- a/LAPACKE/src/lapacke_zgeqpf_work.c +++ b/LAPACKE/src/lapacke_zgeqpf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqpf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* jpvt, lapack_complex_double* tau, lapack_complex_double* work, double* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqpf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqpf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqpf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqpf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqr.c b/LAPACKE/src/lapacke_zgeqr.c index 78eca38e3b..621f51960c 100644 --- a/LAPACKE/src/lapacke_zgeqr.c +++ b/LAPACKE/src/lapacke_zgeqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int tsize ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + info = API_SUFFIX(LAPACKE_zgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,12 +70,12 @@ lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + info = API_SUFFIX(LAPACKE_zgeqr_work)( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqr2.c b/LAPACKE/src/lapacke_zgeqr2.c index eaa6adb093..13343ca94e 100644 --- a/LAPACKE/src/lapacke_zgeqr2.c +++ b/LAPACKE/src/lapacke_zgeqr2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqr2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqr2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zgeqr2( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqr2_work( matrix_layout, m, n, a, lda, tau, work ); + info = API_SUFFIX(LAPACKE_zgeqr2_work)( matrix_layout, m, n, a, lda, tau, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqr2_work.c b/LAPACKE/src/lapacke_zgeqr2_work.c index 7a428b49f5..573dfb7cb3 100644 --- a/LAPACKE/src/lapacke_zgeqr2_work.c +++ b/LAPACKE/src/lapacke_zgeqr2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqr2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zgeqr2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqr2( &m, &n, a_t, &lda_t, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqr2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqr_work.c b/LAPACKE/src/lapacke_zgeqr_work.c index 9a2ff6d4bc..cf1b9b9e9f 100644 --- a/LAPACKE/src/lapacke_zgeqr_work.c +++ b/LAPACKE/src/lapacke_zgeqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int tsize, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrf.c b/LAPACKE/src/lapacke_zgeqrf.c index 71b6341198..9f492359f0 100644 --- a/LAPACKE/src/lapacke_zgeqrf.c +++ b/LAPACKE/src/lapacke_zgeqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgeqrf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgeqrf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zgeqrf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgeqrf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqrf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_zgeqrf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrf_work.c b/LAPACKE/src/lapacke_zgeqrf_work.c index a13b9ecd6f..7463d5c834 100644 --- a/LAPACKE/src/lapacke_zgeqrf_work.c +++ b/LAPACKE/src/lapacke_zgeqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgeqrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqrf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrfp.c b/LAPACKE/src/lapacke_zgeqrfp.c index d1e64a3dfd..1b4e4c57f2 100644 --- a/LAPACKE/src/lapacke_zgeqrfp.c +++ b/LAPACKE/src/lapacke_zgeqrfp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrfp( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrfp)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgeqrfp( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrfp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrfp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgeqrfp_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zgeqrfp_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgeqrfp( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqrfp_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_zgeqrfp_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrfp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrfp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrfp_work.c b/LAPACKE/src/lapacke_zgeqrfp_work.c index 919e3a0cb7..8eea37babd 100644 --- a/LAPACKE/src/lapacke_zgeqrfp_work.c +++ b/LAPACKE/src/lapacke_zgeqrfp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrfp_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrfp_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgeqrfp_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqrfp( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrfp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqrfp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrfp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrt.c b/LAPACKE/src/lapacke_zgeqrt.c index 0612daee58..d230784eda 100644 --- a/LAPACKE/src/lapacke_zgeqrt.c +++ b/LAPACKE/src/lapacke_zgeqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) @@ -40,13 +40,13 @@ lapack_int LAPACKE_zgeqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } @@ -59,12 +59,12 @@ lapack_int LAPACKE_zgeqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgeqrt_work( matrix_layout, m, n, nb, a, lda, t, ldt, work ); + info = API_SUFFIX(LAPACKE_zgeqrt_work)( matrix_layout, m, n, nb, a, lda, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrt2.c b/LAPACKE/src/lapacke_zgeqrt2.c index 5209a41001..a0522c09b5 100644 --- a/LAPACKE/src/lapacke_zgeqrt2.c +++ b/LAPACKE/src/lapacke_zgeqrt2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgeqrt2_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_zgeqrt2_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_zgeqrt2_work.c b/LAPACKE/src/lapacke_zgeqrt2_work.c index 90f17f276d..718cdbeb03 100644 --- a/LAPACKE/src/lapacke_zgeqrt2_work.c +++ b/LAPACKE/src/lapacke_zgeqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_zgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt2_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,26 +73,26 @@ lapack_int LAPACKE_zgeqrt2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqrt2( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrt3.c b/LAPACKE/src/lapacke_zgeqrt3.c index 97a6ae71c6..7d26d0d14e 100644 --- a/LAPACKE/src/lapacke_zgeqrt3.c +++ b/LAPACKE/src/lapacke_zgeqrt3.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt3( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt3)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgeqrt3_work( matrix_layout, m, n, a, lda, t, ldt ); + return API_SUFFIX(LAPACKE_zgeqrt3_work)( matrix_layout, m, n, a, lda, t, ldt ); } diff --git a/LAPACKE/src/lapacke_zgeqrt3_work.c b/LAPACKE/src/lapacke_zgeqrt3_work.c index 048ec92d23..02f898a30d 100644 --- a/LAPACKE/src/lapacke_zgeqrt3_work.c +++ b/LAPACKE/src/lapacke_zgeqrt3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt3_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_zgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt3_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,26 +73,26 @@ lapack_int LAPACKE_zgeqrt3_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgeqrt_work.c b/LAPACKE/src/lapacke_zgeqrt_work.c index 633111533c..2ba60db2e3 100644 --- a/LAPACKE/src/lapacke_zgeqrt_work.c +++ b/LAPACKE/src/lapacke_zgeqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgeqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* work ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt_work", info ); return info; } if( ldt < MIN(m,n) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,15 +75,15 @@ lapack_int LAPACKE_zgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgeqrt( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nb, MIN(m,n), t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -91,11 +91,11 @@ lapack_int LAPACKE_zgeqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgeqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgeqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerfs.c b/LAPACKE/src/lapacke_zgerfs.c index 47e38aeeeb..dea0d804ff 100644 --- a/LAPACKE/src/lapacke_zgerfs.c +++ b/LAPACKE/src/lapacke_zgerfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgerfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zgerfs( int matrix_layout, char trans, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgerfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zgerfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgerfs_work( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_zgerfs_work)( matrix_layout, trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_zgerfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerfs_work.c b/LAPACKE/src/lapacke_zgerfs_work.c index b1804ddbf8..ac2cfb9a74 100644 --- a/LAPACKE/src/lapacke_zgerfs_work.c +++ b/LAPACKE/src/lapacke_zgerfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgerfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_zgerfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_zgerfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_zgerfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_zgerfs_work( int matrix_layout, char trans, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgerfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerfsx.c b/LAPACKE/src/lapacke_zgerfsx.c index de15f8d2bb..79c5e34350 100644 --- a/LAPACKE/src/lapacke_zgerfsx.c +++ b/LAPACKE/src/lapacke_zgerfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerfsx( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_zgerfsx)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, @@ -48,37 +48,37 @@ lapack_int LAPACKE_zgerfsx( int matrix_layout, char trans, char equed, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgerfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, af, ldaf ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'c' ) ) { - if( LAPACKE_d_nancheck( n, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'c' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, c, 1 ) ) { return -12; } } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( equed, 'b' ) || LAPACKE_lsame( equed, 'r' ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'b' ) || API_SUFFIX(LAPACKE_lsame)( equed, 'r' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -11; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -96,7 +96,7 @@ lapack_int LAPACKE_zgerfsx( int matrix_layout, char trans, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgerfsx_work( matrix_layout, trans, equed, n, nrhs, a, lda, + info = API_SUFFIX(LAPACKE_zgerfsx_work)( matrix_layout, trans, equed, n, nrhs, a, lda, af, ldaf, ipiv, r, c, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -106,7 +106,7 @@ lapack_int LAPACKE_zgerfsx( int matrix_layout, char trans, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerfsx_work.c b/LAPACKE/src/lapacke_zgerfsx_work.c index a56a5ae623..e58c8b93e5 100644 --- a/LAPACKE/src/lapacke_zgerfsx_work.c +++ b/LAPACKE/src/lapacke_zgerfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerfsx_work( int matrix_layout, char trans, char equed, +lapack_int API_SUFFIX(LAPACKE_zgerfsx_work)( int matrix_layout, char trans, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, @@ -70,22 +70,22 @@ lapack_int LAPACKE_zgerfsx_work( int matrix_layout, char trans, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -128,10 +128,10 @@ lapack_int LAPACKE_zgerfsx_work( int matrix_layout, char trans, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -141,10 +141,10 @@ lapack_int LAPACKE_zgerfsx_work( int matrix_layout, char trans, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -160,11 +160,11 @@ lapack_int LAPACKE_zgerfsx_work( int matrix_layout, char trans, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgerfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerqf.c b/LAPACKE/src/lapacke_zgerqf.c index e9629bb958..80e9277b05 100644 --- a/LAPACKE/src/lapacke_zgerqf.c +++ b/LAPACKE/src/lapacke_zgerqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerqf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgerqf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgerqf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgerqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgerqf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zgerqf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgerqf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgerqf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_zgerqf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgerqf_work.c b/LAPACKE/src/lapacke_zgerqf_work.c index 8a375832b4..5a2c50ef9e 100644 --- a/LAPACKE/src/lapacke_zgerqf_work.c +++ b/LAPACKE/src/lapacke_zgerqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgerqf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgerqf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgerqf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgerqf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgerqf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgerqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgerqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgesdd.c b/LAPACKE/src/lapacke_zgesdd.c index 1f465001ba..412690cf78 100644 --- a/LAPACKE/src/lapacke_zgesdd.c +++ b/LAPACKE/src/lapacke_zgesdd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgesdd( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgesdd)( int matrix_layout, char jobz, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, @@ -47,19 +47,19 @@ lapack_int LAPACKE_zgesdd( int matrix_layout, char jobz, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgesdd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( jobz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'n' ) ) { lrwork = MAX(1,7*MIN(m,n)); } else { lrwork = (size_t)MAX(1,MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1)); @@ -77,7 +77,7 @@ lapack_int LAPACKE_zgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_zgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, &work_query, lwork, rwork, iwork ); if( info != 0 ) { goto exit_level_2; @@ -91,7 +91,7 @@ lapack_int LAPACKE_zgesdd( int matrix_layout, char jobz, lapack_int m, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgesdd_work( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, + info = API_SUFFIX(LAPACKE_zgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -101,7 +101,7 @@ lapack_int LAPACKE_zgesdd( int matrix_layout, char jobz, lapack_int m, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgesdd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgesdd_work.c b/LAPACKE/src/lapacke_zgesdd_work.c index fc07fe9cbf..ad9745fd82 100644 --- a/LAPACKE/src/lapacke_zgesdd_work.c +++ b/LAPACKE/src/lapacke_zgesdd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgesdd_work)( int matrix_layout, char jobz, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, @@ -49,15 +49,15 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) || - LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && m=n) ) ? n : - ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_u = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m=n) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1); lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); @@ -67,17 +67,17 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd_work", info ); return info; } if( ldu < ncols_u ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd_work", info ); return info; } if( ldvt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { vt_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvt_t * MAX(1,n) ); @@ -114,7 +114,7 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, rwork, iwork, &info ); @@ -122,36 +122,36 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m=n) ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) || API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) || + ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_free( vt_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || - ( LAPACKE_lsame( jobz, 'o' ) && (m0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -25; } } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'r' ) ) ) { - if( LAPACKE_d_nancheck( n, r, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, r, 1 ) ) { return -12; } } @@ -97,7 +97,7 @@ lapack_int LAPACKE_zgesvxx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgesvxx_work( matrix_layout, fact, trans, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zgesvxx_work)( matrix_layout, fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -107,7 +107,7 @@ lapack_int LAPACKE_zgesvxx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgesvxx_work.c b/LAPACKE/src/lapacke_zgesvxx_work.c index bb03176913..8c1f55b84b 100644 --- a/LAPACKE/src/lapacke_zgesvxx_work.c +++ b/LAPACKE/src/lapacke_zgesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgesvxx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgesvxx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_zgesvxx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_zgesvxx_work( int matrix_layout, char fact, char trans, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgesvxx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -141,21 +141,21 @@ lapack_int LAPACKE_zgesvxx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || - LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && ( API_SUFFIX(LAPACKE_lsame)( *equed, 'b' ) || + API_SUFFIX(LAPACKE_lsame)( *equed, 'c' ) || API_SUFFIX(LAPACKE_lsame)( *equed, 'r' ) ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -171,11 +171,11 @@ lapack_int LAPACKE_zgesvxx_work( int matrix_layout, char fact, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetf2.c b/LAPACKE/src/lapacke_zgetf2.c index 967ffc7e3f..5625c2d634 100644 --- a/LAPACKE/src/lapacke_zgetf2.c +++ b/LAPACKE/src/lapacke_zgetf2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetf2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgetf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_zgetf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_zgetf2_work.c b/LAPACKE/src/lapacke_zgetf2_work.c index 20358b9d04..848293565b 100644 --- a/LAPACKE/src/lapacke_zgetf2_work.c +++ b/LAPACKE/src/lapacke_zgetf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetf2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zgetf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_zgetf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetrf.c b/LAPACKE/src/lapacke_zgetrf.c index a0233c9a17..87127eddbd 100644 --- a/LAPACKE/src/lapacke_zgetrf.c +++ b/LAPACKE/src/lapacke_zgetrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgetrf_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_zgetrf_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_zgetrf2.c b/LAPACKE/src/lapacke_zgetrf2.c index cb4824ce0c..3d1bb2f84a 100644 --- a/LAPACKE/src/lapacke_zgetrf2.c +++ b/LAPACKE/src/lapacke_zgetrf2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrf2( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrf2)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zgetrf2_work( matrix_layout, m, n, a, lda, ipiv ); + return API_SUFFIX(LAPACKE_zgetrf2_work)( matrix_layout, m, n, a, lda, ipiv ); } diff --git a/LAPACKE/src/lapacke_zgetrf2_work.c b/LAPACKE/src/lapacke_zgetrf2_work.c index 2597753285..5e810fe2b1 100644 --- a/LAPACKE/src/lapacke_zgetrf2_work.c +++ b/LAPACKE/src/lapacke_zgetrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrf2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_zgetrf2_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetrf2( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetrf_work.c b/LAPACKE/src/lapacke_zgetrf_work.c index 847cdaae74..eea2757180 100644 --- a/LAPACKE/src/lapacke_zgetrf_work.c +++ b/LAPACKE/src/lapacke_zgetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zgetrf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,23 +60,23 @@ lapack_int LAPACKE_zgetrf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetrf( &m, &n, a_t, &lda_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetri.c b/LAPACKE/src/lapacke_zgetri.c index 294e21fbac..0af2ecfd5a 100644 --- a/LAPACKE/src/lapacke_zgetri.c +++ b/LAPACKE/src/lapacke_zgetri.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetri( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetri)( int matrix_layout, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zgetri( int matrix_layout, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgetri_work( matrix_layout, n, a, lda, ipiv, &work_query, + info = API_SUFFIX(LAPACKE_zgetri_work)( matrix_layout, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_zgetri( int matrix_layout, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgetri_work( matrix_layout, n, a, lda, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_zgetri_work)( matrix_layout, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetri_work.c b/LAPACKE/src/lapacke_zgetri_work.c index bdad9cf474..93c19c59e8 100644 --- a/LAPACKE/src/lapacke_zgetri_work.c +++ b/LAPACKE/src/lapacke_zgetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetri_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetri_work)( int matrix_layout, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zgetri_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_zgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetri_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zgetri_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetri( &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetrs.c b/LAPACKE/src/lapacke_zgetrs.c index ad0799cdc3..d76e323c14 100644 --- a/LAPACKE/src/lapacke_zgetrs.c +++ b/LAPACKE/src/lapacke_zgetrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zgetrs_work( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_zgetrs_work)( matrix_layout, trans, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zgetrs_work.c b/LAPACKE/src/lapacke_zgetrs_work.c index ca0cb4ffbc..b9dde38658 100644 --- a/LAPACKE/src/lapacke_zgetrs_work.c +++ b/LAPACKE/src/lapacke_zgetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zgetrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zgetrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetrs( &trans, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_zgetrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetsls.c b/LAPACKE/src/lapacke_zgetsls.c index 0657bd9517..dc81633806 100644 --- a/LAPACKE/src/lapacke_zgetsls.c +++ b/LAPACKE/src/lapacke_zgetsls.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgetsls)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetsls", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zgetsls_work)( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetsls", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetsls_work.c b/LAPACKE/src/lapacke_zgetsls_work.c index 465dcc2371..431ac8ea68 100644 --- a/LAPACKE/src/lapacke_zgetsls_work.c +++ b/LAPACKE/src/lapacke_zgetsls_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zgetsls_work)( int matrix_layout, char trans, lapack_int m, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, &lwork, &info ); @@ -92,8 +92,8 @@ lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, MAX(m,n), nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); @@ -101,11 +101,11 @@ lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsls_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgetsqrhrt.c b/LAPACKE/src/lapacke_zgetsqrhrt.c index 53557c92d1..040c929310 100644 --- a/LAPACKE/src/lapacke_zgetsqrhrt.c +++ b/LAPACKE/src/lapacke_zgetsqrhrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetsqrhrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt ) @@ -42,19 +42,19 @@ lapack_int LAPACKE_zgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_zgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -68,13 +68,13 @@ lapack_int LAPACKE_zgetsqrhrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgetsqrhrt_work( matrix_layout, m, n, mb1, nb1, nb2, + info = API_SUFFIX(LAPACKE_zgetsqrhrt_work)( matrix_layout, m, n, mb1, nb1, nb2, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_zgetsqrhrt_work.c b/LAPACKE/src/lapacke_zgetsqrhrt_work.c index a6825df56d..3e2aa3b28c 100644 --- a/LAPACKE/src/lapacke_zgetsqrhrt_work.c +++ b/LAPACKE/src/lapacke_zgetsqrhrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgetsqrhrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb1, lapack_int nb1, lapack_int nb2, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt_work", info ); return info; } if( ldt < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_zgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgetsqrhrt( &m, &n, &mb1, &nb1, &nb2, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -90,19 +90,19 @@ lapack_int LAPACKE_zgetsqrhrt_work( int matrix_layout, lapack_int m, lapack_int info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nb2, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgetsqrhrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgetsqrhrt_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_zggbak.c b/LAPACKE/src/lapacke_zggbak.c index b87c132636..0af1c81a5a 100644 --- a/LAPACKE/src/lapacke_zggbak.c +++ b/LAPACKE/src/lapacke_zggbak.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggbak( int matrix_layout, char job, char side, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zggbak)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* lscale, const double* rscale, lapack_int m, lapack_complex_double* v, lapack_int ldv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggbak", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbak", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, lscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, lscale, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( n, rscale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, rscale, 1 ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, m, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, m, v, ldv ) ) { return -10; } } #endif - return LAPACKE_zggbak_work( matrix_layout, job, side, n, ilo, ihi, lscale, + return API_SUFFIX(LAPACKE_zggbak_work)( matrix_layout, job, side, n, ilo, ihi, lscale, rscale, m, v, ldv ); } diff --git a/LAPACKE/src/lapacke_zggbak_work.c b/LAPACKE/src/lapacke_zggbak_work.c index 128099db4c..8468360cfa 100644 --- a/LAPACKE/src/lapacke_zggbak_work.c +++ b/LAPACKE/src/lapacke_zggbak_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggbak_work( int matrix_layout, char job, char side, +lapack_int API_SUFFIX(LAPACKE_zggbak_work)( int matrix_layout, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const double* lscale, const double* rscale, lapack_int m, lapack_complex_double* v, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zggbak_work( int matrix_layout, char job, char side, /* Check leading dimension(s) */ if( ldv < m ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbak_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_zggbak_work( int matrix_layout, char job, char side, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, m, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_zggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t, &ldv_t, &info ); @@ -71,16 +71,16 @@ lapack_int LAPACKE_zggbak_work( int matrix_layout, char job, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbak_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggbak_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbak_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggbal.c b/LAPACKE/src/lapacke_zggbal.c index 0a180ecf01..df2526bc2b 100644 --- a/LAPACKE/src/lapacke_zggbal.c +++ b/LAPACKE/src/lapacke_zggbal.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggbal( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zggbal)( int matrix_layout, char job, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, double* lscale, @@ -43,28 +43,28 @@ lapack_int LAPACKE_zggbal( int matrix_layout, char job, lapack_int n, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggbal", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 's' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { lwork = MAX(1,6*n); } else { lwork = 1; @@ -76,13 +76,13 @@ lapack_int LAPACKE_zggbal( int matrix_layout, char job, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zggbal_work( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, + info = API_SUFFIX(LAPACKE_zggbal_work)( matrix_layout, job, n, a, lda, b, ldb, ilo, ihi, lscale, rscale, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggbal", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggbal_work.c b/LAPACKE/src/lapacke_zggbal_work.c index 2f4481c306..33b91dc0af 100644 --- a/LAPACKE/src/lapacke_zggbal_work.c +++ b/LAPACKE/src/lapacke_zggbal_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggbal_work( int matrix_layout, char job, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zggbal_work)( int matrix_layout, char job, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, @@ -54,17 +54,17 @@ lapack_int LAPACKE_zggbal_work( int matrix_layout, char job, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); @@ -73,8 +73,8 @@ lapack_int LAPACKE_zggbal_work( int matrix_layout, char job, lapack_int n, goto exit_level_0; } } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { b_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); @@ -84,13 +84,13 @@ lapack_int LAPACKE_zggbal_work( int matrix_layout, char job, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_zggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, @@ -99,31 +99,31 @@ lapack_int LAPACKE_zggbal_work( int matrix_layout, char job, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: - if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || - LAPACKE_lsame( job, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'p' ) || API_SUFFIX(LAPACKE_lsame)( job, 's' ) || + API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggbal_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggbal_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgges.c b/LAPACKE/src/lapacke_zgges.c index fbc1c5a87d..cc74f8d380 100644 --- a/LAPACKE/src/lapacke_zgges.c +++ b/LAPACKE/src/lapacke_zgges.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgges( int matrix_layout, char jobvsl, char jobvsr, char sort, +lapack_int API_SUFFIX(LAPACKE_zgges)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -48,22 +48,22 @@ lapack_int LAPACKE_zgges( int matrix_layout, char jobvsl, char jobvsr, char sort lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgges", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -77,7 +77,7 @@ lapack_int LAPACKE_zgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_zgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_zgges( int matrix_layout, char jobvsl, char jobvsr, char sort goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgges_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, + info = API_SUFFIX(LAPACKE_zgges_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -100,12 +100,12 @@ lapack_int LAPACKE_zgges( int matrix_layout, char jobvsl, char jobvsr, char sort exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgges", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgges3.c b/LAPACKE/src/lapacke_zgges3.c index 7f322c38fe..ac61448a3b 100644 --- a/LAPACKE/src/lapacke_zgges3.c +++ b/LAPACKE/src/lapacke_zgges3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgges3( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_zgges3)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -48,22 +48,22 @@ lapack_int LAPACKE_zgges3( int matrix_layout, char jobvsl, char jobvsr, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgges3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -77,7 +77,7 @@ lapack_int LAPACKE_zgges3( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, + info = API_SUFFIX(LAPACKE_zgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, &work_query, lwork, rwork, bwork ); if( info != 0 ) { @@ -92,7 +92,7 @@ lapack_int LAPACKE_zgges3( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zgges3_work( matrix_layout, jobvsl, jobvsr, sort, selctg, n, + info = API_SUFFIX(LAPACKE_zgges3_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, work, lwork, rwork, bwork ); /* Release memory and exit */ @@ -100,12 +100,12 @@ lapack_int LAPACKE_zgges3( int matrix_layout, char jobvsl, char jobvsr, exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgges3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgges3_work.c b/LAPACKE/src/lapacke_zgges3_work.c index 00677931d5..c8b5ac3fc3 100644 --- a/LAPACKE/src/lapacke_zgges3_work.c +++ b/LAPACKE/src/lapacke_zgges3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_zgges3_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, lapack_int n, lapack_complex_double* a, lapack_int lda, @@ -65,22 +65,22 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); return info; } if( ldvsl < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); return info; } if( ldvsr < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsl_t * MAX(1,n) ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsr_t * MAX(1,n) ); @@ -122,8 +122,8 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -132,22 +132,22 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -156,11 +156,11 @@ lapack_int LAPACKE_zgges3_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgges3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgges_work.c b/LAPACKE/src/lapacke_zgges_work.c index 13e2455c64..0fc31bbf2d 100644 --- a/LAPACKE/src/lapacke_zgges_work.c +++ b/LAPACKE/src/lapacke_zgges_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_zgges_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsl_t * MAX(1,n) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsr_t * MAX(1,n) ); @@ -121,8 +121,8 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgges( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -131,22 +131,22 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -155,11 +155,11 @@ lapack_int LAPACKE_zgges_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgges_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgges_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggesx.c b/LAPACKE/src/lapacke_zggesx.c index 05e7f902b7..f0542bed23 100644 --- a/LAPACKE/src/lapacke_zggesx.c +++ b/LAPACKE/src/lapacke_zggesx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_zggesx)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, @@ -53,22 +53,22 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, lapack_int iwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggesx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -10; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -82,7 +82,7 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_zggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, &work_query, lwork, rwork, &iwork_query, liwork, @@ -105,7 +105,7 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_zggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg, + info = API_SUFFIX(LAPACKE_zggesx_work)( matrix_layout, jobvsl, jobvsr, sort, selctg, sense, n, a, lda, b, ldb, sdim, alpha, beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work, lwork, rwork, iwork, liwork, bwork ); @@ -116,12 +116,12 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, exit_level_2: LAPACKE_free( rwork ); exit_level_1: - if( LAPACKE_lsame( sort, 's' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggesx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggesx_work.c b/LAPACKE/src/lapacke_zggesx_work.c index fe99949b70..08cf96a51a 100644 --- a/LAPACKE/src/lapacke_zggesx_work.c +++ b/LAPACKE/src/lapacke_zggesx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, +lapack_int API_SUFFIX(LAPACKE_zggesx_work)( int matrix_layout, char jobvsl, char jobvsr, char sort, LAPACK_Z_SELECT2 selctg, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, @@ -68,22 +68,22 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); return info; } - if( ldvsl < 1 || ( LAPACKE_lsame( jobvsl, 'v' ) && ldvsl < n ) ) { + if( ldvsl < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) && ldvsl < n ) ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); return info; } - if( ldvsr < 1 || ( LAPACKE_lsame( jobvsr, 'v' ) && ldvsr < n ) ) { + if( ldvsr < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) && ldvsr < n ) ) { info = -18; - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -107,7 +107,7 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { vsl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsl_t * MAX(1,n) ); @@ -116,7 +116,7 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { vsr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvsr_t * MAX(1,n) ); @@ -126,8 +126,8 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggesx( &jobvsl, &jobvsr, &sort, selctg, &sense, &n, a_t, &lda_t, b_t, &ldb_t, sdim, alpha, beta, vsl_t, &ldvsl_t, vsr_t, @@ -137,22 +137,22 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvsl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } - if( LAPACKE_lsame( jobvsr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr, ldvsr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvsr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsr, 'v' ) ) { LAPACKE_free( vsr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvsl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvsl, 'v' ) ) { LAPACKE_free( vsl_t ); } exit_level_2: @@ -161,11 +161,11 @@ lapack_int LAPACKE_zggesx_work( int matrix_layout, char jobvsl, char jobvsr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggesx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggesx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggev.c b/LAPACKE/src/lapacke_zggev.c index a92571b141..10a9469245 100644 --- a/LAPACKE/src/lapacke_zggev.c +++ b/LAPACKE/src/lapacke_zggev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggev( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_zggev)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* alpha, @@ -46,16 +46,16 @@ lapack_int LAPACKE_zggev( int matrix_layout, char jobvl, char jobvr, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_zggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -82,7 +82,7 @@ lapack_int LAPACKE_zggev( int matrix_layout, char jobvl, char jobvr, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zggev_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zggev_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_zggev( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggev3.c b/LAPACKE/src/lapacke_zggev3.c index fa5fbe0fef..d32dd1a563 100644 --- a/LAPACKE/src/lapacke_zggev3.c +++ b/LAPACKE/src/lapacke_zggev3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggev3( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_zggev3)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -47,16 +47,16 @@ lapack_int LAPACKE_zggev3( int matrix_layout, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggev3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_zggev3( int matrix_layout, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -83,7 +83,7 @@ lapack_int LAPACKE_zggev3( int matrix_layout, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zggev3_work( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zggev3_work)( matrix_layout, jobvl, jobvr, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, work, lwork, rwork ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_zggev3( int matrix_layout, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggev3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggev3_work.c b/LAPACKE/src/lapacke_zggev3_work.c index 21bcd61870..96e9fda9a4 100644 --- a/LAPACKE/src/lapacke_zggev3_work.c +++ b/LAPACKE/src/lapacke_zggev3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggev3_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_zggev3_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -52,10 +52,10 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -67,22 +67,22 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); return info; } if( ldvl < ncols_vl ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); return info; } if( ldvr < ncols_vr ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,ncols_vl) ); @@ -114,7 +114,7 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,ncols_vr) ); @@ -124,8 +124,8 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggev3( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, @@ -134,22 +134,22 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -158,11 +158,11 @@ lapack_int LAPACKE_zggev3_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggev3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggev_work.c b/LAPACKE/src/lapacke_zggev_work.c index 2c55e4f29b..6636ef8ad0 100644 --- a/LAPACKE/src/lapacke_zggev_work.c +++ b/LAPACKE/src/lapacke_zggev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, +lapack_int API_SUFFIX(LAPACKE_zggev_work)( int matrix_layout, char jobvl, char jobvr, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* alpha, @@ -51,10 +51,10 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; - lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; - lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; + lapack_int nrows_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int ncols_vl = API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ? n : 1; + lapack_int nrows_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; + lapack_int ncols_vr = API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); @@ -66,22 +66,22 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); return info; } if( ldvl < ncols_vl ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); return info; } if( ldvr < ncols_vr ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,ncols_vl) ); @@ -113,7 +113,7 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,ncols_vr) ); @@ -123,8 +123,8 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork, rwork, @@ -133,22 +133,22 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -157,11 +157,11 @@ lapack_int LAPACKE_zggev_work( int matrix_layout, char jobvl, char jobvr, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggevx.c b/LAPACKE/src/lapacke_zggevx.c index 451cd27903..050a5921f4 100644 --- a/LAPACKE/src/lapacke_zggevx.c +++ b/LAPACKE/src/lapacke_zggevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_zggevx)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -54,29 +54,29 @@ lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( balanc, 's' ) || LAPACKE_lsame( balanc, 'b' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( balanc, 's' ) || API_SUFFIX(LAPACKE_lsame)( balanc, 'b' ) ) { lrwork = MAX(1,6*n); } else { lrwork = MAX(1,2*n); } /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { bwork = (lapack_logical*) LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) ); if( bwork == NULL ) { @@ -84,8 +84,8 @@ lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_0; } } - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -98,7 +98,7 @@ lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } /* Query optimal working array(s) size */ - info = LAPACKE_zggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_zggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, &work_query, lwork, rwork, iwork, @@ -115,7 +115,7 @@ lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_zggevx_work( matrix_layout, balanc, jobvl, jobvr, sense, n, a, + info = API_SUFFIX(LAPACKE_zggevx_work)( matrix_layout, balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, rwork, iwork, bwork ); @@ -124,18 +124,18 @@ lapack_int LAPACKE_zggevx( int matrix_layout, char balanc, char jobvl, exit_level_3: LAPACKE_free( rwork ); exit_level_2: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'n' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_1: - if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) || - LAPACKE_lsame( sense, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( sense, 'b' ) || API_SUFFIX(LAPACKE_lsame)( sense, 'e' ) || + API_SUFFIX(LAPACKE_lsame)( sense, 'v' ) ) { LAPACKE_free( bwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggevx_work.c b/LAPACKE/src/lapacke_zggevx_work.c index 56a258b9df..8006710295 100644 --- a/LAPACKE/src/lapacke_zggevx_work.c +++ b/LAPACKE/src/lapacke_zggevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, +lapack_int API_SUFFIX(LAPACKE_zggevx_work)( int matrix_layout, char balanc, char jobvl, char jobvr, char sense, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -69,22 +69,22 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); return info; } if( ldvl < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); return info; } if( ldvr < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,n) ); @@ -117,7 +117,7 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, goto exit_level_2; } } - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,n) ); @@ -127,8 +127,8 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, b_t, &ldb_t, alpha, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, @@ -138,20 +138,20 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobvl, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( jobvr, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobvr, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( jobvl, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobvl, 'v' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -160,11 +160,11 @@ lapack_int LAPACKE_zggevx_work( int matrix_layout, char balanc, char jobvl, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggglm.c b/LAPACKE/src/lapacke_zggglm.c index 323d2ee309..dce791355b 100644 --- a/LAPACKE/src/lapacke_zggglm.c +++ b/LAPACKE/src/lapacke_zggglm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggglm( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zggglm)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* d, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zggglm( int matrix_layout, lapack_int n, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggglm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -7; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_zggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_zggglm( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zggglm_work( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, + info = API_SUFFIX(LAPACKE_zggglm_work)( matrix_layout, n, m, p, a, lda, b, ldb, d, x, y, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggglm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggglm_work.c b/LAPACKE/src/lapacke_zggglm_work.c index bc96333f14..3d767321a7 100644 --- a/LAPACKE/src/lapacke_zggglm_work.c +++ b/LAPACKE/src/lapacke_zggglm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggglm_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zggglm_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* d, @@ -56,12 +56,12 @@ lapack_int LAPACKE_zggglm_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm_work", info ); return info; } if( ldb < p ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zggglm_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_zggglm_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggglm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggglm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgghd3.c b/LAPACKE/src/lapacke_zgghd3.c index 3450167d1f..8470c89556 100644 --- a/LAPACKE/src/lapacke_zgghd3.c +++ b/LAPACKE/src/lapacke_zgghd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgghd3( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_zgghd3)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -45,32 +45,32 @@ lapack_int LAPACKE_zgghd3( int matrix_layout, char compq, char compz, lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgghd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_zgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, &work_query, lwork ); if( info != 0 ) { @@ -85,14 +85,14 @@ lapack_int LAPACKE_zgghd3( int matrix_layout, char compq, char compz, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgghd3_work( matrix_layout, compq, compz, n, ilo, ihi, + info = API_SUFFIX(LAPACKE_zgghd3_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgghd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgghd3_work.c b/LAPACKE/src/lapacke_zgghd3_work.c index d8d361a76f..e81f7c50c0 100644 --- a/LAPACKE/src/lapacke_zgghd3_work.c +++ b/LAPACKE/src/lapacke_zgghd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_zgghd3_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -67,22 +67,22 @@ lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -96,14 +96,14 @@ lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; @@ -111,13 +111,13 @@ lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zgghd3( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -126,20 +126,20 @@ lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -148,11 +148,11 @@ lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgghd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgghrd.c b/LAPACKE/src/lapacke_zgghrd.c index 27ab1f3d72..d11ef2b71b 100644 --- a/LAPACKE/src/lapacke_zgghrd.c +++ b/LAPACKE/src/lapacke_zgghrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgghrd( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_zgghrd)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -40,30 +40,30 @@ lapack_int LAPACKE_zgghrd( int matrix_layout, char compq, char compz, lapack_complex_double* z, lapack_int ldz ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgghrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -11; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -13; } } } #endif - return LAPACKE_zgghrd_work( matrix_layout, compq, compz, n, ilo, ihi, a, lda, + return API_SUFFIX(LAPACKE_zgghrd_work)( matrix_layout, compq, compz, n, ilo, ihi, a, lda, b, ldb, q, ldq, z, ldz ); } diff --git a/LAPACKE/src/lapacke_zgghrd_work.c b/LAPACKE/src/lapacke_zgghrd_work.c index 29f81b2fcb..d665016900 100644 --- a/LAPACKE/src/lapacke_zgghrd_work.c +++ b/LAPACKE/src/lapacke_zgghrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_zgghrd_work)( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -59,22 +59,22 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); return info; } if( ldq < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); return info; } if( ldz < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -99,7 +99,7 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -109,13 +109,13 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t, @@ -124,20 +124,20 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -146,11 +146,11 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgghrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgghrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgglse.c b/LAPACKE/src/lapacke_zgglse.c index 4477a874af..6c3b01a1a3 100644 --- a/LAPACKE/src/lapacke_zgglse.c +++ b/LAPACKE/src/lapacke_zgglse.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgglse( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgglse)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* c, @@ -43,28 +43,28 @@ lapack_int LAPACKE_zgglse( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgglse", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -7; } - if( LAPACKE_z_nancheck( m, c, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( m, c, 1 ) ) { return -9; } - if( LAPACKE_z_nancheck( p, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( p, d, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_zgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -78,13 +78,13 @@ lapack_int LAPACKE_zgglse( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgglse_work( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, + info = API_SUFFIX(LAPACKE_zgglse_work)( matrix_layout, m, n, p, a, lda, b, ldb, c, d, x, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgglse", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgglse_work.c b/LAPACKE/src/lapacke_zgglse_work.c index b8b41b1a1c..af6dbd2564 100644 --- a/LAPACKE/src/lapacke_zgglse_work.c +++ b/LAPACKE/src/lapacke_zgglse_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgglse_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgglse_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* c, @@ -56,12 +56,12 @@ lapack_int LAPACKE_zgglse_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zgglse_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgglse( &m, &n, &p, a_t, &lda_t, b_t, &ldb_t, c, d, x, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_zgglse_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgglse_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgglse_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggqrf.c b/LAPACKE/src/lapacke_zggqrf.c index 88b5e2a576..56a95cd61c 100644 --- a/LAPACKE/src/lapacke_zggqrf.c +++ b/LAPACKE/src/lapacke_zggqrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggqrf( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zggqrf)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* taua, lapack_complex_double* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_zggqrf( int matrix_layout, lapack_int n, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggqrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, m, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, p, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, p, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_zggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_zggqrf( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zggqrf_work( matrix_layout, n, m, p, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_zggqrf_work)( matrix_layout, n, m, p, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggqrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggqrf_work.c b/LAPACKE/src/lapacke_zggqrf_work.c index 27430b2f82..8567c6cbfc 100644 --- a/LAPACKE/src/lapacke_zggqrf_work.c +++ b/LAPACKE/src/lapacke_zggqrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggqrf_work( int matrix_layout, lapack_int n, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zggqrf_work)( int matrix_layout, lapack_int n, lapack_int m, lapack_int p, lapack_complex_double* a, lapack_int lda, lapack_complex_double* taua, lapack_complex_double* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zggqrf_work( int matrix_layout, lapack_int n, lapack_int m, /* Check leading dimension(s) */ if( lda < m ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf_work", info ); return info; } if( ldb < p ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zggqrf_work( int matrix_layout, lapack_int n, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, p, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggqrf( &n, &m, &p, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zggqrf_work( int matrix_layout, lapack_int n, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, p, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggqrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggqrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggrqf.c b/LAPACKE/src/lapacke_zggrqf.c index 0a3dad2e0f..0842ceca0a 100644 --- a/LAPACKE/src/lapacke_zggrqf.c +++ b/LAPACKE/src/lapacke_zggrqf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggrqf( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_zggrqf)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* taua, lapack_complex_double* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_zggrqf( int matrix_layout, lapack_int m, lapack_int p, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggrqf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_zggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -72,13 +72,13 @@ lapack_int LAPACKE_zggrqf( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zggrqf_work( matrix_layout, m, p, n, a, lda, taua, b, ldb, + info = API_SUFFIX(LAPACKE_zggrqf_work)( matrix_layout, m, p, n, a, lda, taua, b, ldb, taub, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggrqf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggrqf_work.c b/LAPACKE/src/lapacke_zggrqf_work.c index 12f03139e4..66268071ad 100644 --- a/LAPACKE/src/lapacke_zggrqf_work.c +++ b/LAPACKE/src/lapacke_zggrqf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggrqf_work( int matrix_layout, lapack_int m, lapack_int p, +lapack_int API_SUFFIX(LAPACKE_zggrqf_work)( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* taua, lapack_complex_double* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zggrqf_work( int matrix_layout, lapack_int m, lapack_int p, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zggrqf_work( int matrix_layout, lapack_int m, lapack_int p, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zggrqf_work( int matrix_layout, lapack_int m, lapack_int p, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggrqf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggrqf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvd.c b/LAPACKE/src/lapacke_zggsvd.c index 2e02383999..14b2794381 100644 --- a/LAPACKE/src/lapacke_zggsvd.c +++ b/LAPACKE/src/lapacke_zggsvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_zggsvd)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_double* a, lapack_int lda, @@ -47,16 +47,16 @@ lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zggsvd_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_zggsvd_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, rwork, iwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvd3.c b/LAPACKE/src/lapacke_zggsvd3.c index a342fd7798..dbb0d75d29 100644 --- a/LAPACKE/src/lapacke_zggsvd3.c +++ b/LAPACKE/src/lapacke_zggsvd3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_zggsvd3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_double* a, lapack_int lda, @@ -49,22 +49,22 @@ lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } } #endif /* Query optimal size for working array */ - info = LAPACKE_zggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_zggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, &work_query, lwork, rwork, iwork ); if( info != 0 ) @@ -83,7 +83,7 @@ lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + info = API_SUFFIX(LAPACKE_zggsvd3_work)( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work, lwork, rwork, iwork ); /* Release memory and exit */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvd3_work.c b/LAPACKE/src/lapacke_zggsvd3_work.c index 59401be961..0578a9857e 100644 --- a/LAPACKE/src/lapacke_zggsvd3_work.c +++ b/LAPACKE/src/lapacke_zggsvd3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_zggsvd3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_double* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -110,7 +110,7 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,m) ); @@ -119,7 +119,7 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,p) ); @@ -128,7 +128,7 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -138,8 +138,8 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -148,27 +148,27 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -177,11 +177,11 @@ lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvd_work.c b/LAPACKE/src/lapacke_zggsvd_work.c index 88ed68a154..5af8c1dd91 100644 --- a/LAPACKE/src/lapacke_zggsvd_work.c +++ b/LAPACKE/src/lapacke_zggsvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_zggsvd_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, lapack_complex_double* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,m) ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,p) ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -131,8 +131,8 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggsvd( &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, @@ -141,27 +141,27 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -170,11 +170,11 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggsvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvp.c b/LAPACKE/src/lapacke_zggsvp.c index 5b983dcf8a..e33f163e4d 100644 --- a/LAPACKE/src/lapacke_zggsvp.c +++ b/LAPACKE/src/lapacke_zggsvp.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_zggsvp)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -48,22 +48,22 @@ lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, lapack_complex_double* tau = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -13; } } @@ -92,7 +92,7 @@ lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_zggsvp_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_zggsvp_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, work ); /* Release memory and exit */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvp3.c b/LAPACKE/src/lapacke_zggsvp3.c index 94f97216eb..8bd3f72466 100644 --- a/LAPACKE/src/lapacke_zggsvp3.c +++ b/LAPACKE/src/lapacke_zggsvp3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_zggsvp3)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -50,28 +50,28 @@ lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, lapack_int lwork = -1; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -10; } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -12; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -13; } } #endif /* Query optimal size for working array */ - info = LAPACKE_zggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_zggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, &work_query, lwork ); if( info != 0 ) @@ -101,7 +101,7 @@ lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_3; } /* Call middle-level interface */ - info = LAPACKE_zggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + info = API_SUFFIX(LAPACKE_zggsvp3_work)( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork, tau, work, lwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvp3_work.c b/LAPACKE/src/lapacke_zggsvp3_work.c index a2c023d9fa..b24b4b684e 100644 --- a/LAPACKE/src/lapacke_zggsvp3_work.c +++ b/LAPACKE/src/lapacke_zggsvp3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_zggsvp3_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, @@ -68,27 +68,27 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); return info; } if( ldv < p ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -112,7 +112,7 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,m) ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,p) ); @@ -130,7 +130,7 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -140,8 +140,8 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ 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, @@ -150,27 +150,27 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -179,11 +179,11 @@ lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zggsvp_work.c b/LAPACKE/src/lapacke_zggsvp_work.c index 94287ede81..a48611e4a3 100644 --- a/LAPACKE/src/lapacke_zggsvp_work.c +++ b/LAPACKE/src/lapacke_zggsvp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_zggsvp_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, @@ -68,27 +68,27 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); return info; } if( ldb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); return info; } if( ldq < n ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); return info; } if( ldu < m ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); return info; } if( ldv < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,m) ); @@ -113,7 +113,7 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,m) ); @@ -122,7 +122,7 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -132,8 +132,8 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zggsvp( &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, @@ -142,27 +142,27 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, m, 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 ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -171,11 +171,11 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zggsvp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zggsvp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtcon.c b/LAPACKE/src/lapacke_zgtcon.c index e6a216a2cb..bee354be9d 100644 --- a/LAPACKE/src/lapacke_zgtcon.c +++ b/LAPACKE/src/lapacke_zgtcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtcon( char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgtcon)( char norm, lapack_int n, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, @@ -44,19 +44,19 @@ lapack_int LAPACKE_zgtcon( char norm, lapack_int n, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -8; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -3; } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-2, du2, 1 ) ) { return -6; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_zgtcon( char norm, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zgtcon_work( norm, n, dl, d, du, du2, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_zgtcon_work)( norm, n, dl, d, du, du2, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtcon_work.c b/LAPACKE/src/lapacke_zgtcon_work.c index 8b73db9c31..704a3404bd 100644 --- a/LAPACKE/src/lapacke_zgtcon_work.c +++ b/LAPACKE/src/lapacke_zgtcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtcon_work( char norm, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgtcon_work)( char norm, lapack_int n, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, diff --git a/LAPACKE/src/lapacke_zgtrfs.c b/LAPACKE/src/lapacke_zgtrfs.c index 3e82b8eaea..4be3ab999a 100644 --- a/LAPACKE/src/lapacke_zgtrfs.c +++ b/LAPACKE/src/lapacke_zgtrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtrfs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgtrfs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, @@ -49,37 +49,37 @@ lapack_int LAPACKE_zgtrfs( int matrix_layout, char trans, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgtrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_z_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, df, 1 ) ) { return -9; } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dlf, 1 ) ) { return -8; } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-2, du2, 1 ) ) { return -11; } - if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, duf, 1 ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -15; } } @@ -97,7 +97,7 @@ lapack_int LAPACKE_zgtrfs( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgtrfs_work( matrix_layout, trans, n, nrhs, dl, d, du, dlf, + info = API_SUFFIX(LAPACKE_zgtrfs_work)( matrix_layout, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -106,7 +106,7 @@ lapack_int LAPACKE_zgtrfs( int matrix_layout, char trans, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtrfs_work.c b/LAPACKE/src/lapacke_zgtrfs_work.c index e45fac1692..babe452a99 100644 --- a/LAPACKE/src/lapacke_zgtrfs_work.c +++ b/LAPACKE/src/lapacke_zgtrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtrfs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgtrfs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, @@ -63,12 +63,12 @@ lapack_int LAPACKE_zgtrfs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,8 +87,8 @@ lapack_int LAPACKE_zgtrfs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, @@ -97,18 +97,18 @@ lapack_int LAPACKE_zgtrfs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtsv.c b/LAPACKE/src/lapacke_zgtsv.c index 7f4afdba23..1c94f8ad51 100644 --- a/LAPACKE/src/lapacke_zgtsv.c +++ b/LAPACKE/src/lapacke_zgtsv.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zgtsv)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_double* dl, lapack_complex_double* d, lapack_complex_double* du, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgtsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -6; } } #endif - return LAPACKE_zgtsv_work( matrix_layout, n, nrhs, dl, d, du, b, ldb ); + return API_SUFFIX(LAPACKE_zgtsv_work)( matrix_layout, n, nrhs, dl, d, du, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zgtsv_work.c b/LAPACKE/src/lapacke_zgtsv_work.c index ef49ec2258..3b0516d5fd 100644 --- a/LAPACKE/src/lapacke_zgtsv_work.c +++ b/LAPACKE/src/lapacke_zgtsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zgtsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, lapack_complex_double* dl, lapack_complex_double* d, lapack_complex_double* du, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,23 +63,23 @@ lapack_int LAPACKE_zgtsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgtsv( &n, &nrhs, dl, d, du, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgtsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtsvx.c b/LAPACKE/src/lapacke_zgtsvx.c index 80ab003f45..f767106e46 100644 --- a/LAPACKE/src/lapacke_zgtsvx.c +++ b/LAPACKE/src/lapacke_zgtsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtsvx( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgtsvx)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, @@ -49,41 +49,41 @@ lapack_int LAPACKE_zgtsvx( int matrix_layout, char fact, char trans, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgtsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -14; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_z_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, df, 1 ) ) { return -10; } } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dlf, 1 ) ) { return -9; } } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -8; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-2, du2, 1 ) ) { return -12; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, duf, 1 ) ) { return -11; } } @@ -102,7 +102,7 @@ lapack_int LAPACKE_zgtsvx( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zgtsvx_work( matrix_layout, fact, trans, n, nrhs, dl, d, du, + info = API_SUFFIX(LAPACKE_zgtsvx_work)( matrix_layout, fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -111,7 +111,7 @@ lapack_int LAPACKE_zgtsvx( int matrix_layout, char fact, char trans, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgtsvx_work.c b/LAPACKE/src/lapacke_zgtsvx_work.c index b3f929e212..5569f418ae 100644 --- a/LAPACKE/src/lapacke_zgtsvx_work.c +++ b/LAPACKE/src/lapacke_zgtsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgtsvx_work( int matrix_layout, char fact, char trans, +lapack_int API_SUFFIX(LAPACKE_zgtsvx_work)( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, @@ -63,12 +63,12 @@ lapack_int LAPACKE_zgtsvx_work( int matrix_layout, char fact, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx_work", info ); return info; } if( ldx < nrhs ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -87,7 +87,7 @@ lapack_int LAPACKE_zgtsvx_work( int matrix_layout, char fact, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgtsvx( &fact, &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -96,18 +96,18 @@ lapack_int LAPACKE_zgtsvx_work( int matrix_layout, char fact, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgtsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgtsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zgttrf.c b/LAPACKE/src/lapacke_zgttrf.c index 7033b76db0..7647575208 100644 --- a/LAPACKE/src/lapacke_zgttrf.c +++ b/LAPACKE/src/lapacke_zgttrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgttrf( lapack_int n, lapack_complex_double* dl, +lapack_int API_SUFFIX(LAPACKE_zgttrf)( lapack_int n, lapack_complex_double* dl, lapack_complex_double* d, lapack_complex_double* du, lapack_complex_double* du2, lapack_int* ipiv ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -2; } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -4; } } #endif - return LAPACKE_zgttrf_work( n, dl, d, du, du2, ipiv ); + return API_SUFFIX(LAPACKE_zgttrf_work)( n, dl, d, du, du2, ipiv ); } diff --git a/LAPACKE/src/lapacke_zgttrf_work.c b/LAPACKE/src/lapacke_zgttrf_work.c index 1b6dc5d724..5fdd8666ee 100644 --- a/LAPACKE/src/lapacke_zgttrf_work.c +++ b/LAPACKE/src/lapacke_zgttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgttrf_work( lapack_int n, lapack_complex_double* dl, +lapack_int API_SUFFIX(LAPACKE_zgttrf_work)( lapack_int n, lapack_complex_double* dl, lapack_complex_double* d, lapack_complex_double* du, lapack_complex_double* du2, lapack_int* ipiv ) diff --git a/LAPACKE/src/lapacke_zgttrs.c b/LAPACKE/src/lapacke_zgttrs.c index 379b8e0f66..33fbd7e318 100644 --- a/LAPACKE/src/lapacke_zgttrs.c +++ b/LAPACKE/src/lapacke_zgttrs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgttrs( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgttrs)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, @@ -41,29 +41,29 @@ lapack_int LAPACKE_zgttrs( int matrix_layout, char trans, lapack_int n, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zgttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_z_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) ) { return -6; } - if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ) ) { return -7; } - if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-2, du2, 1 ) ) { return -8; } } #endif - return LAPACKE_zgttrs_work( matrix_layout, trans, n, nrhs, dl, d, du, du2, + return API_SUFFIX(LAPACKE_zgttrs_work)( matrix_layout, trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zgttrs_work.c b/LAPACKE/src/lapacke_zgttrs_work.c index d3d43cc088..9db6d357a0 100644 --- a/LAPACKE/src/lapacke_zgttrs_work.c +++ b/LAPACKE/src/lapacke_zgttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zgttrs_work( int matrix_layout, char trans, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zgttrs_work)( int matrix_layout, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, @@ -55,7 +55,7 @@ lapack_int LAPACKE_zgttrs_work( int matrix_layout, char trans, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_zgttrs_work( int matrix_layout, char trans, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zgttrs( &trans, &n, &nrhs, dl, d, du, du2, ipiv, b_t, &ldb_t, &info ); @@ -75,16 +75,16 @@ lapack_int LAPACKE_zgttrs_work( int matrix_layout, char trans, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zgttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbev.c b/LAPACKE/src/lapacke_zhbev.c index 23e9167a97..74cbe96f43 100644 --- a/LAPACKE/src/lapacke_zhbev.c +++ b/LAPACKE/src/lapacke_zhbev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -41,13 +41,13 @@ lapack_int LAPACKE_zhbev( int matrix_layout, char jobz, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zhbev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhbev_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbev_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_zhbev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbev_2stage.c b/LAPACKE/src/lapacke_zhbev_2stage.c index 993dcc17ed..5b26fc0e9e 100644 --- a/LAPACKE/src/lapacke_zhbev_2stage.c +++ b/LAPACKE/src/lapacke_zhbev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -43,19 +43,19 @@ lapack_int LAPACKE_zhbev_2stage( int matrix_layout, char jobz, char uplo, lapack lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_0; @@ -74,7 +74,7 @@ lapack_int LAPACKE_zhbev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhbev_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbev_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_zhbev_2stage( int matrix_layout, char jobz, char uplo, lapack LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbev_2stage_work.c b/LAPACKE/src/lapacke_zhbev_2stage_work.c index 931fe0529f..bd95ea15ee 100644 --- a/LAPACKE/src/lapacke_zhbev_2stage_work.c +++ b/LAPACKE/src/lapacke_zhbev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhbev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -76,7 +76,7 @@ lapack_int LAPACKE_zhbev_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_zhbev_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbev_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &info ); @@ -94,24 +94,24 @@ lapack_int LAPACKE_zhbev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbev_work.c b/LAPACKE/src/lapacke_zhbev_work.c index aa6a8ec54a..5b7af15568 100644 --- a/LAPACKE/src/lapacke_zhbev_work.c +++ b/LAPACKE/src/lapacke_zhbev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhbev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_zhbev_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -80,7 +80,7 @@ lapack_int LAPACKE_zhbev_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbev( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -88,24 +88,24 @@ lapack_int LAPACKE_zhbev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevd.c b/LAPACKE/src/lapacke_zhbevd.c index ea92e2a6db..4d003f73e2 100644 --- a/LAPACKE/src/lapacke_zhbevd.c +++ b/LAPACKE/src/lapacke_zhbevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -48,19 +48,19 @@ lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbevd_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbevd_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevd_2stage.c b/LAPACKE/src/lapacke_zhbevd_2stage.c index ba14fe2904..b878db9ff9 100644 --- a/LAPACKE/src/lapacke_zhbevd_2stage.c +++ b/LAPACKE/src/lapacke_zhbevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -48,19 +48,19 @@ lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapac double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbevd_2stage_work( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, + info = API_SUFFIX(LAPACKE_zhbevd_2stage_work)( matrix_layout, jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevd_2stage_work.c b/LAPACKE/src/lapacke_zhbevd_2stage_work.c index 18485312b2..ad5781a334 100644 --- a/LAPACKE/src/lapacke_zhbevd_2stage_work.c +++ b/LAPACKE/src/lapacke_zhbevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, @@ -57,12 +57,12 @@ lapack_int LAPACKE_zhbevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_zhbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_zhbevd_2stage_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbevd_2stage( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -97,24 +97,24 @@ lapack_int LAPACKE_zhbevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevd_work.c b/LAPACKE/src/lapacke_zhbevd_work.c index 7e1d07ac27..0dafc74fa4 100644 --- a/LAPACKE/src/lapacke_zhbevd_work.c +++ b/LAPACKE/src/lapacke_zhbevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* w, lapack_complex_double* z, @@ -57,12 +57,12 @@ lapack_int LAPACKE_zhbevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_work", info ); return info; } if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -79,7 +79,7 @@ lapack_int LAPACKE_zhbevd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_zhbevd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbevd( &jobz, &uplo, &n, &kd, ab_t, &ldab_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -97,24 +97,24 @@ lapack_int LAPACKE_zhbevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevx.c b/LAPACKE/src/lapacke_zhbevx.c index 3f2853ed5f..f839502bf5 100644 --- a/LAPACKE/src/lapacke_zhbevx.c +++ b/LAPACKE/src/lapacke_zhbevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* q, lapack_int ldq, double vl, @@ -46,25 +46,25 @@ lapack_int LAPACKE_zhbevx( int matrix_layout, char jobz, char range, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -88,7 +88,7 @@ lapack_int LAPACKE_zhbevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbevx_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_zhbevx_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -99,7 +99,7 @@ lapack_int LAPACKE_zhbevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevx_2stage.c b/LAPACKE/src/lapacke_zhbevx_2stage.c index 37a9c21b72..f4e8dc7904 100644 --- a/LAPACKE/src/lapacke_zhbevx_2stage.c +++ b/LAPACKE/src/lapacke_zhbevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* q, lapack_int ldq, double vl, @@ -48,32 +48,32 @@ lapack_int LAPACKE_zhbevx_2stage( int matrix_layout, char jobz, char range, char lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_zhbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -98,7 +98,7 @@ lapack_int LAPACKE_zhbevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, + info = API_SUFFIX(LAPACKE_zhbevx_2stage_work)( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -109,7 +109,7 @@ lapack_int LAPACKE_zhbevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevx_2stage_work.c b/LAPACKE/src/lapacke_zhbevx_2stage_work.c index 1801a6da62..dff171ede6 100644 --- a/LAPACKE/src/lapacke_zhbevx_2stage_work.c +++ b/LAPACKE/src/lapacke_zhbevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zhbevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* q, lapack_int ldq, @@ -53,9 +53,9 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbevx_2stage( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -120,32 +120,32 @@ lapack_int LAPACKE_zhbevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbevx_work.c b/LAPACKE/src/lapacke_zhbevx_work.c index 75ab852953..d8af48cdeb 100644 --- a/LAPACKE/src/lapacke_zhbevx_work.c +++ b/LAPACKE/src/lapacke_zhbevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zhbevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* q, lapack_int ldq, @@ -53,9 +53,9 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zhbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -113,32 +113,32 @@ lapack_int LAPACKE_zhbevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgst.c b/LAPACKE/src/lapacke_zhbgst.c index 607d7b0650..4361f0581d 100644 --- a/LAPACKE/src/lapacke_zhbgst.c +++ b/LAPACKE/src/lapacke_zhbgst.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgst( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbgst)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* bb, lapack_int ldbb, @@ -42,16 +42,16 @@ lapack_int LAPACKE_zhbgst( int matrix_layout, char vect, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_zhbgst( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhbgst_work( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_zhbgst_work)( matrix_layout, vect, uplo, n, ka, kb, ab, ldab, bb, ldbb, x, ldx, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -77,7 +77,7 @@ lapack_int LAPACKE_zhbgst( int matrix_layout, char vect, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgst", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgst_work.c b/LAPACKE/src/lapacke_zhbgst_work.c index 926ecd9a25..028e2935bf 100644 --- a/LAPACKE/src/lapacke_zhbgst_work.c +++ b/LAPACKE/src/lapacke_zhbgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbgst_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* bb, @@ -58,17 +58,17 @@ lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst_work", info ); return info; } if( ldx < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zhbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { x_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,n) ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_zhb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbgst( &vect, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, x_t, &ldx_t, work, rwork, &info ); @@ -103,13 +103,13 @@ lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, x_t, ldx_t, x, ldx ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( x_t ); } exit_level_2: @@ -118,11 +118,11 @@ lapack_int LAPACKE_zhbgst_work( int matrix_layout, char vect, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgv.c b/LAPACKE/src/lapacke_zhbgv.c index 7fb988abf7..0cbb2833a6 100644 --- a/LAPACKE/src/lapacke_zhbgv.c +++ b/LAPACKE/src/lapacke_zhbgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgv( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbgv)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, lapack_int ldbb, double* w, @@ -42,16 +42,16 @@ lapack_int LAPACKE_zhbgv( int matrix_layout, char jobz, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } @@ -69,7 +69,7 @@ lapack_int LAPACKE_zhbgv( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhbgv_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_zhbgv_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -77,7 +77,7 @@ lapack_int LAPACKE_zhbgv( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgv_work.c b/LAPACKE/src/lapacke_zhbgv_work.c index eb35499d71..b07229b135 100644 --- a/LAPACKE/src/lapacke_zhbgv_work.c +++ b/LAPACKE/src/lapacke_zhbgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbgv_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, lapack_int ldbb, @@ -58,17 +58,17 @@ lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zhbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -94,8 +94,8 @@ lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_zhb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbgv( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -103,15 +103,15 @@ lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -120,11 +120,11 @@ lapack_int LAPACKE_zhbgv_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgvd.c b/LAPACKE/src/lapacke_zhbgvd.c index 3fba8cd66b..43cdffb9bc 100644 --- a/LAPACKE/src/lapacke_zhbgvd.c +++ b/LAPACKE/src/lapacke_zhbgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbgvd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, lapack_int ldbb, @@ -49,22 +49,22 @@ lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -7; } - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_zhbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -91,7 +91,7 @@ lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbgvd_work( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, + info = API_SUFFIX(LAPACKE_zhbgvd_work)( matrix_layout, jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgvd_work.c b/LAPACKE/src/lapacke_zhbgvd_work.c index 6588e7368f..73203f23cf 100644 --- a/LAPACKE/src/lapacke_zhbgvd_work.c +++ b/LAPACKE/src/lapacke_zhbgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbgvd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, lapack_int ldbb, @@ -61,17 +61,17 @@ lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd_work", info ); return info; } if( ldbb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd_work", info ); return info; } if( ldz < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zhbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -94,7 +94,7 @@ lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -104,8 +104,8 @@ lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_zhb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbgvd( &jobz, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, @@ -114,15 +114,15 @@ lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -131,11 +131,11 @@ lapack_int LAPACKE_zhbgvd_work( int matrix_layout, char jobz, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgvx.c b/LAPACKE/src/lapacke_zhbgvx.c index 03f154180c..d39d0d71a1 100644 --- a/LAPACKE/src/lapacke_zhbgvx.c +++ b/LAPACKE/src/lapacke_zhbgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgvx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbgvx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, lapack_int ldbb, @@ -47,28 +47,28 @@ lapack_int LAPACKE_zhbgvx( int matrix_layout, char jobz, char range, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, ka, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, ka, ab, ldab ) ) { return -8; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -18; } - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -10; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -14; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -15; } } @@ -92,7 +92,7 @@ lapack_int LAPACKE_zhbgvx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhbgvx_work( matrix_layout, jobz, range, uplo, n, ka, kb, ab, + info = API_SUFFIX(LAPACKE_zhbgvx_work)( matrix_layout, jobz, range, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_zhbgvx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbgvx_work.c b/LAPACKE/src/lapacke_zhbgvx_work.c index 566ebe6be3..46b7abe197 100644 --- a/LAPACKE/src/lapacke_zhbgvx_work.c +++ b/LAPACKE/src/lapacke_zhbgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zhbgvx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* bb, @@ -65,22 +65,22 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); return info; } if( ldbb < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); return info; } if( ldq < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); return info; } if( ldz < n ) { info = -22; - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -105,7 +105,7 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, goto exit_level_2; } } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -115,8 +115,8 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); - LAPACKE_zhb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, @@ -125,22 +125,22 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -149,11 +149,11 @@ lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbtrd.c b/LAPACKE/src/lapacke_zhbtrd.c index 6205ee9ed0..26449cc617 100644 --- a/LAPACKE/src/lapacke_zhbtrd.c +++ b/LAPACKE/src/lapacke_zhbtrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbtrd( int matrix_layout, char vect, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhbtrd)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* d, double* e, lapack_complex_double* q, lapack_int ldq ) @@ -40,17 +40,17 @@ lapack_int LAPACKE_zhbtrd( int matrix_layout, char vect, char uplo, lapack_int n lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhbtrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_lsame( vect, 'u' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -10; } } @@ -64,13 +64,13 @@ lapack_int LAPACKE_zhbtrd( int matrix_layout, char vect, char uplo, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhbtrd_work( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, + info = API_SUFFIX(LAPACKE_zhbtrd_work)( matrix_layout, vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbtrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhbtrd_work.c b/LAPACKE/src/lapacke_zhbtrd_work.c index 71dbb8e1a5..6d331b9afc 100644 --- a/LAPACKE/src/lapacke_zhbtrd_work.c +++ b/LAPACKE/src/lapacke_zhbtrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhbtrd_work( int matrix_layout, char vect, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhbtrd_work)( int matrix_layout, char vect, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, double* d, double* e, lapack_complex_double* q, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhbtrd_work( int matrix_layout, char vect, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd_work", info ); return info; } if( ldq < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_zhbtrd_work( int matrix_layout, char vect, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -79,9 +79,9 @@ lapack_int LAPACKE_zhbtrd_work( int matrix_layout, char vect, char uplo, } } /* Transpose input matrices */ - LAPACKE_zhb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zhb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_zhbtrd( &vect, &uplo, &n, &kd, ab_t, &ldab_t, d, e, q_t, &ldq_t, @@ -90,24 +90,24 @@ lapack_int LAPACKE_zhbtrd_work( int matrix_layout, char vect, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zhb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( vect, 'u' ) || API_SUFFIX(LAPACKE_lsame)( vect, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhbtrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhbtrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhecon.c b/LAPACKE/src/lapacke_zhecon.c index 40b5950741..c268ce38ba 100644 --- a/LAPACKE/src/lapacke_zhecon.c +++ b/LAPACKE/src/lapacke_zhecon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhecon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhecon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhecon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_zhecon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhecon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_zhecon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhecon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhecon_3.c b/LAPACKE/src/lapacke_zhecon_3.c index f696ae3708..3307d77362 100644 --- a/LAPACKE/src/lapacke_zhecon_3.c +++ b/LAPACKE/src/lapacke_zhecon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhecon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhecon_3)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhecon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -66,13 +66,13 @@ lapack_int LAPACKE_zhecon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhecon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_zhecon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhecon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhecon_3_work.c b/LAPACKE/src/lapacke_zhecon_3_work.c index 2064e4fb47..63800491b3 100644 --- a/LAPACKE/src/lapacke_zhecon_3_work.c +++ b/LAPACKE/src/lapacke_zhecon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhecon_3_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, double anorm, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhecon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhecon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhecon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhecon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhecon_work.c b/LAPACKE/src/lapacke_zhecon_work.c index e7209e47d3..cb3b94eb05 100644 --- a/LAPACKE/src/lapacke_zhecon_work.c +++ b/LAPACKE/src/lapacke_zhecon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhecon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhecon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhecon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zhecon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhecon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_zhecon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhecon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhecon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheequb.c b/LAPACKE/src/lapacke_zheequb.c index a9d03590d8..3b025bec94 100644 --- a/LAPACKE/src/lapacke_zheequb.c +++ b/LAPACKE/src/lapacke_zheequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheequb)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_zheequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zheequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_zheequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheequb_work.c b/LAPACKE/src/lapacke_zheequb_work.c index 62d9712509..206f518694 100644 --- a/LAPACKE/src/lapacke_zheequb_work.c +++ b/LAPACKE/src/lapacke_zheequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheequb_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zheequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zheequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_zheequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheev.c b/LAPACKE/src/lapacke_zheev.c index 0126e3d14b..b1fe9c6530 100644 --- a/LAPACKE/src/lapacke_zheev.c +++ b/LAPACKE/src/lapacke_zheev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -41,13 +41,13 @@ lapack_int LAPACKE_zheev( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -59,7 +59,7 @@ lapack_int LAPACKE_zheev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zheev_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_zheev_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -73,7 +73,7 @@ lapack_int LAPACKE_zheev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zheev_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_zheev_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_zheev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheev_2stage.c b/LAPACKE/src/lapacke_zheev_2stage.c index 889ff0e15a..999b95768f 100644 --- a/LAPACKE/src/lapacke_zheev_2stage.c +++ b/LAPACKE/src/lapacke_zheev_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheev_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheev_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -41,13 +41,13 @@ lapack_int LAPACKE_zheev_2stage( int matrix_layout, char jobz, char uplo, lapack lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheev_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -59,7 +59,7 @@ lapack_int LAPACKE_zheev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zheev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_zheev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -73,7 +73,7 @@ lapack_int LAPACKE_zheev_2stage( int matrix_layout, char jobz, char uplo, lapack goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zheev_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_zheev_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_zheev_2stage( int matrix_layout, char jobz, char uplo, lapack LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheev_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheev_2stage_work.c b/LAPACKE/src/lapacke_zheev_2stage_work.c index 11246e1966..2a3dfd5785 100644 --- a/LAPACKE/src/lapacke_zheev_2stage_work.c +++ b/LAPACKE/src/lapacke_zheev_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheev_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheev_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w, lapack_complex_double* work, lapack_int lwork, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zheev_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_zheev_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheev_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -77,16 +77,16 @@ lapack_int LAPACKE_zheev_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheev_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheev_work.c b/LAPACKE/src/lapacke_zheev_work.c index 43d33eb2e4..1f321214ba 100644 --- a/LAPACKE/src/lapacke_zheev_work.c +++ b/LAPACKE/src/lapacke_zheev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w, lapack_complex_double* work, lapack_int lwork, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -69,7 +69,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -78,19 +78,19 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevd.c b/LAPACKE/src/lapacke_zheevd.c index da5df1de42..a70e26e10b 100644 --- a/LAPACKE/src/lapacke_zheevd.c +++ b/LAPACKE/src/lapacke_zheevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -46,19 +46,19 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zheevd_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_zheevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevd_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_zheevd_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevd_2stage.c b/LAPACKE/src/lapacke_zheevd_2stage.c index 2d747f8d08..34ce0c1714 100644 --- a/LAPACKE/src/lapacke_zheevd_2stage.c +++ b/LAPACKE/src/lapacke_zheevd_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheevd_2stage)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w ) { lapack_int info = 0; @@ -46,19 +46,19 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevd_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zheevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, + info = API_SUFFIX(LAPACKE_zheevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -85,7 +85,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevd_2stage_work( matrix_layout, jobz, uplo, n, a, lda, w, work, + info = API_SUFFIX(LAPACKE_zheevd_2stage_work)( matrix_layout, jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevd_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevd_2stage_work.c b/LAPACKE/src/lapacke_zheevd_2stage_work.c index 0538eefbbc..fc1105bafd 100644 --- a/LAPACKE/src/lapacke_zheevd_2stage_work.c +++ b/LAPACKE/src/lapacke_zheevd_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevd_2stage_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w, lapack_complex_double* work, lapack_int lwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,19 +79,19 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevd_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevd_work.c b/LAPACKE/src/lapacke_zheevd_work.c index 086df88e74..f3ae213337 100644 --- a/LAPACKE/src/lapacke_zheevd_work.c +++ b/LAPACKE/src/lapacke_zheevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* w, lapack_complex_double* work, lapack_int lwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -70,7 +70,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,19 +79,19 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, } /* Transpose output matrices */ if ( jobz == 'V' || jobz == 'v' ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } else { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevr.c b/LAPACKE/src/lapacke_zheevr.c index a8f6078ded..aecaaca9d1 100644 --- a/LAPACKE/src/lapacke_zheevr.c +++ b/LAPACKE/src/lapacke_zheevr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevr)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -50,32 +50,32 @@ lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zheevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevr_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevr_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevr_2stage.c b/LAPACKE/src/lapacke_zheevr_2stage.c index 7931822627..63505da134 100644 --- a/LAPACKE/src/lapacke_zheevr_2stage.c +++ b/LAPACKE/src/lapacke_zheevr_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevr_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -50,32 +50,32 @@ lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevr_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zheevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); @@ -103,7 +103,7 @@ lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevr_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevr_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevr_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevr_2stage_work.c b/LAPACKE/src/lapacke_zheevr_2stage_work.c index 73b2edbd5c..8bd70ad5ef 100644 --- a/LAPACKE/src/lapacke_zheevr_2stage_work.c +++ b/LAPACKE/src/lapacke_zheevr_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zheevr_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, @@ -53,9 +53,9 @@ lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_double* a_t = NULL; @@ -63,12 +63,12 @@ lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevr_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -104,24 +104,24 @@ lapack_int LAPACKE_zheevr_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevr_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevr_work.c b/LAPACKE/src/lapacke_zheevr_work.c index ef405f1b50..e5413aef6b 100644 --- a/LAPACKE/src/lapacke_zheevr_work.c +++ b/LAPACKE/src/lapacke_zheevr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zheevr_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, @@ -53,10 +53,10 @@ lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_double* a_t = NULL; @@ -64,12 +64,12 @@ lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, @@ -105,24 +105,24 @@ lapack_int LAPACKE_zheevr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevx.c b/LAPACKE/src/lapacke_zheevx.c index 731dbab297..d85dacf26a 100644 --- a/LAPACKE/src/lapacke_zheevx.c +++ b/LAPACKE/src/lapacke_zheevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -46,25 +46,25 @@ lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -97,7 +97,7 @@ lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevx_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevx_2stage.c b/LAPACKE/src/lapacke_zheevx_2stage.c index cb95285acb..af10b885bf 100644 --- a/LAPACKE/src/lapacke_zheevx_2stage.c +++ b/LAPACKE/src/lapacke_zheevx_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevx_2stage( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zheevx_2stage)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, @@ -46,25 +46,25 @@ lapack_int LAPACKE_zheevx_2stage( int matrix_layout, char jobz, char range, char lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zheevx_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -12; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -8; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -9; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_zheevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zheevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -97,7 +97,7 @@ lapack_int LAPACKE_zheevx_2stage( int matrix_layout, char jobz, char range, char goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zheevx_2stage_work( matrix_layout, jobz, range, uplo, n, a, lda, vl, + info = API_SUFFIX(LAPACKE_zheevx_2stage_work)( matrix_layout, jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -108,7 +108,7 @@ lapack_int LAPACKE_zheevx_2stage( int matrix_layout, char jobz, char range, char LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevx_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevx_2stage_work.c b/LAPACKE/src/lapacke_zheevx_2stage_work.c index c9bdd88062..b78acad82d 100644 --- a/LAPACKE/src/lapacke_zheevx_2stage_work.c +++ b/LAPACKE/src/lapacke_zheevx_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zheevx_2stage_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, @@ -52,9 +52,9 @@ lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_double* a_t = NULL; @@ -62,12 +62,12 @@ lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -94,7 +94,7 @@ lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevx_2stage( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, rwork, @@ -103,24 +103,24 @@ lapack_int LAPACKE_zheevx_2stage_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevx_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheevx_work.c b/LAPACKE/src/lapacke_zheevx_work.c index 1a61928cfc..7aea466267 100644 --- a/LAPACKE/src/lapacke_zheevx_work.c +++ b/LAPACKE/src/lapacke_zheevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zheevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double vl, double vu, lapack_int il, @@ -52,10 +52,10 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( !LAPACKE_lsame( jobz, 'v' ) ) ? 1 : - ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( !API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) ? 1 : + ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_double* a_t = NULL; @@ -63,12 +63,12 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_work", info ); return info; } if( ldz < ncols_z ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,7 +85,7 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, } } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevx( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, rwork, @@ -104,24 +104,24 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegst.c b/LAPACKE/src/lapacke_zhegst.c index 7ca618ba2d..ede99efb40 100644 --- a/LAPACKE/src/lapacke_zhegst.c +++ b/LAPACKE/src/lapacke_zhegst.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhegst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhegst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zhegst_work( matrix_layout, itype, uplo, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_zhegst_work)( matrix_layout, itype, uplo, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhegst_work.c b/LAPACKE/src/lapacke_zhegst_work.c index a87d663a4d..5fd2361ff9 100644 --- a/LAPACKE/src/lapacke_zhegst_work.c +++ b/LAPACKE/src/lapacke_zhegst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhegst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegst_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegst_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,26 +74,26 @@ lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhegst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegv.c b/LAPACKE/src/lapacke_zhegv.c index 2f8964783b..987fe9659d 100644 --- a/LAPACKE/src/lapacke_zhegv.c +++ b/LAPACKE/src/lapacke_zhegv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* w ) @@ -43,16 +43,16 @@ lapack_int LAPACKE_zhegv( int matrix_layout, lapack_int itype, char jobz, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhegv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_zhegv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zhegv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -78,7 +78,7 @@ lapack_int LAPACKE_zhegv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhegv_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegv_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_zhegv( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegv_2stage.c b/LAPACKE/src/lapacke_zhegv_2stage.c index 1d540a56df..fb737bf9e8 100644 --- a/LAPACKE/src/lapacke_zhegv_2stage.c +++ b/LAPACKE/src/lapacke_zhegv_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegv_2stage( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegv_2stage)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* w ) @@ -43,16 +43,16 @@ lapack_int LAPACKE_zhegv_2stage( int matrix_layout, lapack_int itype, char jobz, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhegv_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_zhegv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zhegv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; @@ -78,7 +78,7 @@ lapack_int LAPACKE_zhegv_2stage( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhegv_2stage_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegv_2stage_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -86,7 +86,7 @@ lapack_int LAPACKE_zhegv_2stage( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegv_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegv_2stage_work.c b/LAPACKE/src/lapacke_zhegv_2stage_work.c index 6a808e2a03..348b6abdf6 100644 --- a/LAPACKE/src/lapacke_zhegv_2stage_work.c +++ b/LAPACKE/src/lapacke_zhegv_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegv_2stage_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegv_2stage_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhegv_2stage_work( int matrix_layout, lapack_int itype, char /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zhegv_2stage_work( int matrix_layout, lapack_int itype, char goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegv_2stage( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zhegv_2stage_work( int matrix_layout, lapack_int itype, char info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhegv_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegv_work.c b/LAPACKE/src/lapacke_zhegv_work.c index ca4ebf70c2..a2c3c03bd6 100644 --- a/LAPACKE/src/lapacke_zhegv_work.c +++ b/LAPACKE/src/lapacke_zhegv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhegv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zhegv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegv( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zhegv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhegv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegvd.c b/LAPACKE/src/lapacke_zhegvd.c index 33bffeca8f..ad069803f6 100644 --- a/LAPACKE/src/lapacke_zhegvd.c +++ b/LAPACKE/src/lapacke_zhegvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double* w ) @@ -48,22 +48,22 @@ lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhegvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhegvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhegvd_work( matrix_layout, itype, jobz, uplo, n, a, lda, b, + info = API_SUFFIX(LAPACKE_zhegvd_work)( matrix_layout, itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegvd_work.c b/LAPACKE/src/lapacke_zhegvd_work.c index 6e0ea7c48e..edf99fb047 100644 --- a/LAPACKE/src/lapacke_zhegvd_work.c +++ b/LAPACKE/src/lapacke_zhegvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -57,12 +57,12 @@ lapack_int LAPACKE_zhegvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -86,8 +86,8 @@ lapack_int LAPACKE_zhegvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegvd( &itype, &jobz, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -95,19 +95,19 @@ lapack_int LAPACKE_zhegvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhegvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegvx.c b/LAPACKE/src/lapacke_zhegvx.c index 8227832e10..6edc074d20 100644 --- a/LAPACKE/src/lapacke_zhegvx.c +++ b/LAPACKE/src/lapacke_zhegvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, double vl, @@ -48,28 +48,28 @@ lapack_int LAPACKE_zhegvx( int matrix_layout, lapack_int itype, char jobz, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhegvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -15; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, b, ldb ) ) { return -9; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -11; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -12; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_zhegvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Query optimal working array(s) size */ - info = LAPACKE_zhegvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_zhegvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { @@ -102,7 +102,7 @@ lapack_int LAPACKE_zhegvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhegvx_work( matrix_layout, itype, jobz, range, uplo, n, a, + info = API_SUFFIX(LAPACKE_zhegvx_work)( matrix_layout, itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* Release memory and exit */ @@ -113,7 +113,7 @@ lapack_int LAPACKE_zhegvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhegvx_work.c b/LAPACKE/src/lapacke_zhegvx_work.c index eb29c34d41..39e3596992 100644 --- a/LAPACKE/src/lapacke_zhegvx_work.c +++ b/LAPACKE/src/lapacke_zhegvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhegvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -53,9 +53,9 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); @@ -65,17 +65,17 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; - LAPACKE_xerbla( "LAPACKE_zhegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -98,7 +98,7 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -108,8 +108,8 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, } } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zhe_trans( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhegvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, @@ -118,14 +118,14 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_2: @@ -134,11 +134,11 @@ lapack_int LAPACKE_zhegvx_work( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhegvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhegvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zherfs.c b/LAPACKE/src/lapacke_zherfs.c index 1d9c9dac2b..c40294f5e5 100644 --- a/LAPACKE/src/lapacke_zherfs.c +++ b/LAPACKE/src/lapacke_zherfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zherfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zherfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zherfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zherfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zherfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zherfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_zherfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_zherfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zherfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zherfs_work.c b/LAPACKE/src/lapacke_zherfs_work.c index d14783756f..40ede52cad 100644 --- a/LAPACKE/src/lapacke_zherfs_work.c +++ b/LAPACKE/src/lapacke_zherfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zherfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zherfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_zherfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_zherfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zhe_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zherfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_zherfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_zherfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zherfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zherfsx.c b/LAPACKE/src/lapacke_zherfsx.c index 9da13b03f1..88326f37c6 100644 --- a/LAPACKE/src/lapacke_zherfsx.c +++ b/LAPACKE/src/lapacke_zherfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zherfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zherfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_zherfsx( int matrix_layout, char uplo, char equed, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zherfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zherfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zherfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zherfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zherfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zherfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zherfsx_work.c b/LAPACKE/src/lapacke_zherfsx_work.c index 125092eb5e..198b750b69 100644 --- a/LAPACKE/src/lapacke_zherfsx_work.c +++ b/LAPACKE/src/lapacke_zherfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zherfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zherfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, @@ -70,22 +70,22 @@ lapack_int LAPACKE_zherfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -128,10 +128,10 @@ lapack_int LAPACKE_zherfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zhe_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zherfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -141,10 +141,10 @@ lapack_int LAPACKE_zherfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -160,11 +160,11 @@ lapack_int LAPACKE_zherfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zherfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zherfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv.c b/LAPACKE/src/lapacke_zhesv.c index 10239198b1..21d1c9dc55 100644 --- a/LAPACKE/src/lapacke_zhesv.c +++ b/LAPACKE/src/lapacke_zhesv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zhesv( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhesv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zhesv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhesv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_aa.c b/LAPACKE/src/lapacke_zhesv_aa.c index 2fdd82c2fa..e3186a9e0c 100644 --- a/LAPACKE/src/lapacke_zhesv_aa.c +++ b/LAPACKE/src/lapacke_zhesv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zhesv_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhesv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zhesv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhesv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_aa_2stage.c b/LAPACKE/src/lapacke_zhesv_aa_2stage.c index e0a00d7eae..bb2c87f19d 100644 --- a/LAPACKE/src/lapacke_zhesv_aa_2stage.c +++ b/LAPACKE/src/lapacke_zhesv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zhesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhesv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zhesv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -76,14 +76,14 @@ lapack_int LAPACKE_zhesv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhesv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zhesv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_aa_2stage_work.c b/LAPACKE/src/lapacke_zhesv_aa_2stage_work.c index 16b79add48..b3da163f68 100644 --- a/LAPACKE/src/lapacke_zhesv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zhesv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_aa_work.c b/LAPACKE/src/lapacke_zhesv_aa_work.c index cd3e1de09d..e94bdc12d0 100644 --- a/LAPACKE/src/lapacke_zhesv_aa_work.c +++ b/LAPACKE/src/lapacke_zhesv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhesv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zhesv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zhesv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_rk.c b/LAPACKE/src/lapacke_zhesv_rk.c index 00ab102023..0057a8a9b1 100644 --- a/LAPACKE/src/lapacke_zhesv_rk.c +++ b/LAPACKE/src/lapacke_zhesv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zhesv_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zhesv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_zhesv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_rk_work.c b/LAPACKE/src/lapacke_zhesv_rk_work.c index 790e75ad94..0b099d4f36 100644 --- a/LAPACKE/src/lapacke_zhesv_rk_work.c +++ b/LAPACKE/src/lapacke_zhesv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesv_work.c b/LAPACKE/src/lapacke_zhesv_work.c index e0d4882543..9a1d4b7cab 100644 --- a/LAPACKE/src/lapacke_zhesv_work.c +++ b/LAPACKE/src/lapacke_zhesv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhesv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zhesv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zhesv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesvx.c b/LAPACKE/src/lapacke_zhesvx.c index a1cf5be4e5..e17c7ab27a 100644 --- a/LAPACKE/src/lapacke_zhesvx.c +++ b/LAPACKE/src/lapacke_zhesvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhesvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, lapack_int* ipiv, @@ -46,21 +46,21 @@ lapack_int LAPACKE_zhesvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -72,7 +72,7 @@ lapack_int LAPACKE_zhesvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zhesvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zhesvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_zhesvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhesvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zhesvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_zhesvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesvx_work.c b/LAPACKE/src/lapacke_zhesvx_work.c index e372cd3abd..fa20778f26 100644 --- a/LAPACKE/src/lapacke_zhesvx_work.c +++ b/LAPACKE/src/lapacke_zhesvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhesvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -64,22 +64,22 @@ lapack_int LAPACKE_zhesvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -117,11 +117,11 @@ lapack_int LAPACKE_zhesvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zhe_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -130,11 +130,11 @@ lapack_int LAPACKE_zhesvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -145,11 +145,11 @@ lapack_int LAPACKE_zhesvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesvxx.c b/LAPACKE/src/lapacke_zhesvxx.c index 0b14784e5e..b0911bbb27 100644 --- a/LAPACKE/src/lapacke_zhesvxx.c +++ b/LAPACKE/src/lapacke_zhesvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhesvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -48,30 +48,30 @@ lapack_int LAPACKE_zhesvxx( int matrix_layout, char fact, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhesvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -12; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zhesvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhesvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zhesvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zhesvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhesvxx_work.c b/LAPACKE/src/lapacke_zhesvxx_work.c index 052e2c687c..079ebf7f1e 100644 --- a/LAPACKE/src/lapacke_zhesvxx_work.c +++ b/LAPACKE/src/lapacke_zhesvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhesvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zhe_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhesvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -141,20 +141,20 @@ lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -170,11 +170,11 @@ lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhesvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zheswapr.c b/LAPACKE/src/lapacke_zheswapr.c index 17ca30fab2..ec01630e6d 100644 --- a/LAPACKE/src/lapacke_zheswapr.c +++ b/LAPACKE/src/lapacke_zheswapr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zheswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_zheswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_zheswapr_work.c b/LAPACKE/src/lapacke_zheswapr_work.c index a89e12d481..2268f9958b 100644 --- a/LAPACKE/src/lapacke_zheswapr_work.c +++ b/LAPACKE/src/lapacke_zheswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zheswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zheswapr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -54,21 +54,21 @@ lapack_int LAPACKE_zheswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zheswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zheswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zheswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrd.c b/LAPACKE/src/lapacke_zhetrd.c index af7338d28e..9f6e1d07d8 100644 --- a/LAPACKE/src/lapacke_zhetrd.c +++ b/LAPACKE/src/lapacke_zhetrd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrd( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrd)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* d, double* e, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetrd( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, + info = API_SUFFIX(LAPACKE_zhetrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetrd( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrd_work( matrix_layout, uplo, n, a, lda, d, e, tau, work, + info = API_SUFFIX(LAPACKE_zhetrd_work)( matrix_layout, uplo, n, a, lda, d, e, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrd_work.c b/LAPACKE/src/lapacke_zhetrd_work.c index 7822019905..57845c1267 100644 --- a/LAPACKE/src/lapacke_zhetrd_work.c +++ b/LAPACKE/src/lapacke_zhetrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrd_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, double* d, double* e, lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zhetrd_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,23 +68,23 @@ lapack_int LAPACKE_zhetrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrd( &uplo, &n, a_t, &lda_t, d, e, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf.c b/LAPACKE/src/lapacke_zhetrf.c index 543b8bffd3..20fe528510 100644 --- a/LAPACKE/src/lapacke_zhetrf.c +++ b/LAPACKE/src/lapacke_zhetrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetrf( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zhetrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_aa.c b/LAPACKE/src/lapacke_zhetrf_aa.c index d9df39f7c5..1fff2819ff 100644 --- a/LAPACKE/src/lapacke_zhetrf_aa.c +++ b/LAPACKE/src/lapacke_zhetrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_aa)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetrf_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zhetrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetrf_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_aa_2stage.c b/LAPACKE/src/lapacke_zhetrf_aa_2stage.c index b93a365bb2..c27a91a554 100644 --- a/LAPACKE/src/lapacke_zhetrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_zhetrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zhetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_zhetrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_zhetrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_zhetrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_aa_2stage_work.c b/LAPACKE/src/lapacke_zhetrf_aa_2stage_work.c index 10d7a5c393..b810b03859 100644 --- a/LAPACKE/src/lapacke_zhetrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zhetrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -90,18 +90,18 @@ lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_aa_work.c b/LAPACKE/src/lapacke_zhetrf_aa_work.c index 93fd5e704f..ec4ae96f4e 100644 --- a/LAPACKE/src/lapacke_zhetrf_aa_work.c +++ b/LAPACKE/src/lapacke_zhetrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zhetrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_rk.c b/LAPACKE/src/lapacke_zhetrf_rk.c index 9212a0840f..f09094a537 100644 --- a/LAPACKE/src/lapacke_zhetrf_rk.c +++ b/LAPACKE/src/lapacke_zhetrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_rk)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetrf_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_zhetrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetrf_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_rk_work.c b/LAPACKE/src/lapacke_zhetrf_rk_work.c index 3a87509665..985a575246 100644 --- a/LAPACKE/src/lapacke_zhetrf_rk_work.c +++ b/LAPACKE/src/lapacke_zhetrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, lapack_complex_double* work, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_rook.c b/LAPACKE/src/lapacke_zhetrf_rook.c index f6680928bc..7535fe5801 100644 --- a/LAPACKE/src/lapacke_zhetrf_rook.c +++ b/LAPACKE/src/lapacke_zhetrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_rook)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetrf_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zhetrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetrf_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_rook_work.c b/LAPACKE/src/lapacke_zhetrf_rook_work.c index 5baa68b3b6..e653ab3a4b 100644 --- a/LAPACKE/src/lapacke_zhetrf_rook_work.c +++ b/LAPACKE/src/lapacke_zhetrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zhetrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrf_work.c b/LAPACKE/src/lapacke_zhetrf_work.c index bef9a1ef5a..49389ff4e6 100644 --- a/LAPACKE/src/lapacke_zhetrf_work.c +++ b/LAPACKE/src/lapacke_zhetrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zhetrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri.c b/LAPACKE/src/lapacke_zhetri.c index aa56a4bd8a..b6d87fa722 100644 --- a/LAPACKE/src/lapacke_zhetri.c +++ b/LAPACKE/src/lapacke_zhetri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zhetri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_zhetri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri2.c b/LAPACKE/src/lapacke_zhetri2.c index 9109f05426..61b0c73324 100644 --- a/LAPACKE/src/lapacke_zhetri2.c +++ b/LAPACKE/src/lapacke_zhetri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zhetri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zhetri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zhetri2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri2_work.c b/LAPACKE/src/lapacke_zhetri2_work.c index 262c1cea64..eda5ad607a 100644 --- a/LAPACKE/src/lapacke_zhetri2_work.c +++ b/LAPACKE/src/lapacke_zhetri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zhetri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri2x.c b/LAPACKE/src/lapacke_zhetri2x.c index d8b56f5dda..9f0340045a 100644 --- a/LAPACKE/src/lapacke_zhetri2x.c +++ b/LAPACKE/src/lapacke_zhetri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri2x)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_zhetri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zhetri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri2x_work.c b/LAPACKE/src/lapacke_zhetri2x_work.c index 297a299bef..8a607272e5 100644 --- a/LAPACKE/src/lapacke_zhetri2x_work.c +++ b/LAPACKE/src/lapacke_zhetri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri2x_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zhetri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri_3.c b/LAPACKE/src/lapacke_zhetri_3.c index 69b0f4e527..4694fb99a9 100644 --- a/LAPACKE/src/lapacke_zhetri_3.c +++ b/LAPACKE/src/lapacke_zhetri_3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri_3)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv ) { @@ -40,24 +40,24 @@ lapack_int LAPACKE_zhetri_3( int matrix_layout, char uplo, lapack_int n, lapack_int lwork = -1; lapack_complex_double* work = NULL; lapack_complex_double work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_zhetri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,12 +71,12 @@ lapack_int LAPACKE_zhetri_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_zhetri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri_3_work.c b/LAPACKE/src/lapacke_zhetri_3_work.c index 6acfad8e17..24a4f1b4ee 100644 --- a/LAPACKE/src/lapacke_zhetri_3_work.c +++ b/LAPACKE/src/lapacke_zhetri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zhetri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetri_work.c b/LAPACKE/src/lapacke_zhetri_work.c index 1ebb544c6d..77c2c0ff12 100644 --- a/LAPACKE/src/lapacke_zhetri_work.c +++ b/LAPACKE/src/lapacke_zhetri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zhetri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zhetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zhetri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs.c b/LAPACKE/src/lapacke_zhetrs.c index 87a1207fda..8f9b4ffb5a 100644 --- a/LAPACKE/src/lapacke_zhetrs.c +++ b/LAPACKE/src/lapacke_zhetrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zhetrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_zhetrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhetrs2.c b/LAPACKE/src/lapacke_zhetrs2.c index fefb1de101..69a7e7cea6 100644 --- a/LAPACKE/src/lapacke_zhetrs2.c +++ b/LAPACKE/src/lapacke_zhetrs2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_zhetrs2( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_zhetrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhetrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs2_work.c b/LAPACKE/src/lapacke_zhetrs2_work.c index 8b1afe196a..5eecbdc670 100644 --- a/LAPACKE/src/lapacke_zhetrs2_work.c +++ b/LAPACKE/src/lapacke_zhetrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhetrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,8 +77,8 @@ lapack_int LAPACKE_zhetrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -86,18 +86,18 @@ lapack_int LAPACKE_zhetrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_3.c b/LAPACKE/src/lapacke_zhetrs_3.c index 59fdcd9c89..3a782cbd71 100644 --- a/LAPACKE/src/lapacke_zhetrs_3.c +++ b/LAPACKE/src/lapacke_zhetrs_3.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_zhetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_zhetrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhetrs_3_work.c b/LAPACKE/src/lapacke_zhetrs_3_work.c index fe8ca713ea..0cea5cdbe5 100644 --- a/LAPACKE/src/lapacke_zhetrs_3_work.c +++ b/LAPACKE/src/lapacke_zhetrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, @@ -53,12 +53,12 @@ lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_aa.c b/LAPACKE/src/lapacke_zhetrs_aa.c index f39b99ecd4..971206754f 100644 --- a/LAPACKE/src/lapacke_zhetrs_aa.c +++ b/LAPACKE/src/lapacke_zhetrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zhetrs_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhetrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhetrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zhetrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhetrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zhetrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_aa_2stage.c b/LAPACKE/src/lapacke_zhetrs_aa_2stage.c index f071cb21ce..f63c9be895 100644 --- a/LAPACKE/src/lapacke_zhetrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_zhetrs_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -40,25 +40,25 @@ lapack_int LAPACKE_zhetrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_zhetrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zhetrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb); return info; diff --git a/LAPACKE/src/lapacke_zhetrs_aa_2stage_work.c b/LAPACKE/src/lapacke_zhetrs_aa_2stage_work.c index 8286569d2a..7b93629056 100644 --- a/LAPACKE/src/lapacke_zhetrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zhetrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhe_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_aa_work.c b/LAPACKE/src/lapacke_zhetrs_aa_work.c index c8a9ed1606..179abeb018 100644 --- a/LAPACKE/src/lapacke_zhetrs_aa_work.c +++ b/LAPACKE/src/lapacke_zhetrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,8 +77,8 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -86,18 +86,18 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_rook.c b/LAPACKE/src/lapacke_zhetrs_rook.c index 3ce8160d57..436e7b4f1d 100644 --- a/LAPACKE/src/lapacke_zhetrs_rook.c +++ b/LAPACKE/src/lapacke_zhetrs_rook.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zhetrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_zhetrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhetrs_rook_work.c b/LAPACKE/src/lapacke_zhetrs_rook_work.c index 7ffe68bf14..36b0bec4a2 100644 --- a/LAPACKE/src/lapacke_zhetrs_rook_work.c +++ b/LAPACKE/src/lapacke_zhetrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zhetrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zhetrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_zhetrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhetrs_work.c b/LAPACKE/src/lapacke_zhetrs_work.c index 07dddf07c7..2a373935ac 100644 --- a/LAPACKE/src/lapacke_zhetrs_work.c +++ b/LAPACKE/src/lapacke_zhetrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhetrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhetrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zhetrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zhetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zhetrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zhetrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_zhetrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhetrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhetrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhfrk.c b/LAPACKE/src/lapacke_zhfrk.c index 6db0dbc29e..16f40a14ff 100644 --- a/LAPACKE/src/lapacke_zhfrk.c +++ b/LAPACKE/src/lapacke_zhfrk.c @@ -32,35 +32,35 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhfrk( int matrix_layout, char transr, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_zhfrk)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, double alpha, const lapack_complex_double* a, lapack_int lda, double beta, lapack_complex_double* c ) { lapack_int ka, na; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhfrk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhfrk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - if( LAPACKE_zge_nancheck( matrix_layout, na, ka, a, lda ) ) { + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, na, ka, a, lda ) ) { return -8; } - if( LAPACKE_d_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &alpha, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &beta, 1 ) ) { return -10; } - if( LAPACKE_zpf_nancheck( n, c ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, c ) ) { return -11; } } #endif - return LAPACKE_zhfrk_work( matrix_layout, transr, uplo, trans, n, k, alpha, + return API_SUFFIX(LAPACKE_zhfrk_work)( matrix_layout, transr, uplo, trans, n, k, alpha, a, lda, beta, c ); } diff --git a/LAPACKE/src/lapacke_zhfrk_work.c b/LAPACKE/src/lapacke_zhfrk_work.c index e308eba1e0..2971d6a6a5 100644 --- a/LAPACKE/src/lapacke_zhfrk_work.c +++ b/LAPACKE/src/lapacke_zhfrk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhfrk_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhfrk_work)( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, double alpha, const lapack_complex_double* a, lapack_int lda, double beta, @@ -49,13 +49,13 @@ lapack_int LAPACKE_zhfrk_work( int matrix_layout, char transr, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - na = LAPACKE_lsame( trans, 'n' ) ? n : k; - ka = LAPACKE_lsame( trans, 'n' ) ? k : n; + na = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? n : k; + ka = API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) ? k : n; lda_t = MAX(1,na); /* Check leading dimension(s) */ if( lda < ka ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,25 +73,25 @@ lapack_int LAPACKE_zhfrk_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, na, ka, a, lda, a_t, lda_t ); - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, c, c_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, na, ka, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_zhfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); + API_SUFFIX(LAPACKE_zpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhfrk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhfrk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhfrk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhgeqz.c b/LAPACKE/src/lapacke_zhgeqz.c index 7737253f41..df5ab32730 100644 --- a/LAPACKE/src/lapacke_zhgeqz.c +++ b/LAPACKE/src/lapacke_zhgeqz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhgeqz( int matrix_layout, char job, char compq, char compz, +lapack_int API_SUFFIX(LAPACKE_zhgeqz)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* h, lapack_int ldh, lapack_complex_double* t, lapack_int ldt, @@ -47,25 +47,25 @@ lapack_int LAPACKE_zhgeqz( int matrix_layout, char job, char compq, char compz, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhgeqz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -8; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -14; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -10; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -16; } } @@ -78,7 +78,7 @@ lapack_int LAPACKE_zhgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zhgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_zhgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, &work_query, lwork, rwork ); if( info != 0 ) { @@ -93,7 +93,7 @@ lapack_int LAPACKE_zhgeqz( int matrix_layout, char job, char compq, char compz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhgeqz_work( matrix_layout, job, compq, compz, n, ilo, ihi, h, + info = API_SUFFIX(LAPACKE_zhgeqz_work)( matrix_layout, job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work, lwork, rwork ); /* Release memory and exit */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_zhgeqz( int matrix_layout, char job, char compq, char compz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhgeqz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhgeqz_work.c b/LAPACKE/src/lapacke_zhgeqz_work.c index 867e458a72..26defa0725 100644 --- a/LAPACKE/src/lapacke_zhgeqz_work.c +++ b/LAPACKE/src/lapacke_zhgeqz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_zhgeqz_work)( int matrix_layout, char job, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* h, lapack_int ldh, lapack_complex_double* t, @@ -64,22 +64,22 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldh < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); return info; } if( ldq < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); return info; } if( ldz < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, goto exit_level_2; } } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -121,13 +121,13 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - LAPACKE_zge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zhgeqz( &job, &compq, &compz, &n, &ilo, &ihi, h_t, &ldh_t, t_t, @@ -137,20 +137,20 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: - if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: @@ -159,11 +159,11 @@ lapack_int LAPACKE_zhgeqz_work( int matrix_layout, char job, char compq, LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhgeqz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhgeqz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpcon.c b/LAPACKE/src/lapacke_zhpcon.c index 636509f4a2..ec80aac186 100644 --- a/LAPACKE/src/lapacke_zhpcon.c +++ b/LAPACKE/src/lapacke_zhpcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -4; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_zhpcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhpcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_zhpcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpcon_work.c b/LAPACKE/src/lapacke_zhpcon_work.c index 5578f9019c..fd3f8f0894 100644 --- a/LAPACKE/src/lapacke_zhpcon_work.c +++ b/LAPACKE/src/lapacke_zhpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_int* ipiv, double anorm, double* rcond, lapack_complex_double* work ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_zhpcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_zhpcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpev.c b/LAPACKE/src/lapacke_zhpev.c index 003071d667..dee3cbe66c 100644 --- a/LAPACKE/src/lapacke_zhpev.c +++ b/LAPACKE/src/lapacke_zhpev.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpev( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpev)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, double* w, lapack_complex_double* z, lapack_int ldz ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_zhpev( int matrix_layout, char jobz, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpev", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpev", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_zhpev( int matrix_layout, char jobz, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhpev_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, + info = API_SUFFIX(LAPACKE_zhpev_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_zhpev( int matrix_layout, char jobz, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpev", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpev", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpev_work.c b/LAPACKE/src/lapacke_zhpev_work.c index 9cca2e602b..cc44b1eb65 100644 --- a/LAPACKE/src/lapacke_zhpev_work.c +++ b/LAPACKE/src/lapacke_zhpev_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpev_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpev_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, double* w, lapack_complex_double* z, lapack_int ldz, lapack_complex_double* work, @@ -52,11 +52,11 @@ lapack_int LAPACKE_zhpev_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpev_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_zhpev_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpev( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -81,23 +81,23 @@ lapack_int LAPACKE_zhpev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpev_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpev_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpev_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpevd.c b/LAPACKE/src/lapacke_zhpevd.c index 742ca5f285..53f6ae4414 100644 --- a/LAPACKE/src/lapacke_zhpevd.c +++ b/LAPACKE/src/lapacke_zhpevd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpevd)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, double* w, lapack_complex_double* z, lapack_int ldz ) { @@ -47,19 +47,19 @@ lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpevd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhpevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_zhpevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -86,7 +86,7 @@ lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhpevd_work( matrix_layout, jobz, uplo, n, ap, w, z, ldz, + info = API_SUFFIX(LAPACKE_zhpevd_work)( matrix_layout, jobz, uplo, n, ap, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -96,7 +96,7 @@ lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpevd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpevd_work.c b/LAPACKE/src/lapacke_zhpevd_work.c index 9facb86cec..42c690df3f 100644 --- a/LAPACKE/src/lapacke_zhpevd_work.c +++ b/LAPACKE/src/lapacke_zhpevd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpevd_work)( int matrix_layout, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, double* w, lapack_complex_double* z, lapack_int ldz, lapack_complex_double* work, @@ -55,7 +55,7 @@ lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo, /* Check leading dimension(s) */ if( ldz < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -65,7 +65,7 @@ lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -82,7 +82,7 @@ lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -90,23 +90,23 @@ lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpevd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpevx.c b/LAPACKE/src/lapacke_zhpevx.c index 2ab91431b2..50aa0ded63 100644 --- a/LAPACKE/src/lapacke_zhpevx.c +++ b/LAPACKE/src/lapacke_zhpevx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpevx( int matrix_layout, char jobz, char range, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpevx)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* ap, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -44,25 +44,25 @@ lapack_int LAPACKE_zhpevx( int matrix_layout, char jobz, char range, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpevx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } @@ -86,7 +86,7 @@ lapack_int LAPACKE_zhpevx( int matrix_layout, char jobz, char range, char uplo, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhpevx_work( matrix_layout, jobz, range, uplo, n, ap, vl, vu, + info = API_SUFFIX(LAPACKE_zhpevx_work)( matrix_layout, jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -97,7 +97,7 @@ lapack_int LAPACKE_zhpevx( int matrix_layout, char jobz, char range, char uplo, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpevx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpevx_work.c b/LAPACKE/src/lapacke_zhpevx_work.c index c5890175c0..15cdd218bc 100644 --- a/LAPACKE/src/lapacke_zhpevx_work.c +++ b/LAPACKE/src/lapacke_zhpevx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpevx_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zhpevx_work)( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* ap, double vl, double vu, lapack_int il, lapack_int iu, double abstol, @@ -51,20 +51,20 @@ lapack_int LAPACKE_zhpevx_work( int matrix_layout, char jobz, char range, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); lapack_complex_double* z_t = NULL; lapack_complex_double* ap_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zhpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_zhpevx_work( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpevx( &jobz, &range, &uplo, &n, ap_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, rwork, iwork, ifail, @@ -90,24 +90,24 @@ lapack_int LAPACKE_zhpevx_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpevx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpevx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgst.c b/LAPACKE/src/lapacke_zhpgst.c index b5b80d869c..d2c3e78bd9 100644 --- a/LAPACKE/src/lapacke_zhpgst.c +++ b/LAPACKE/src/lapacke_zhpgst.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgst( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpgst)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_complex_double* bp ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpgst", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgst", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zhp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, bp ) ) { return -6; } } #endif - return LAPACKE_zhpgst_work( matrix_layout, itype, uplo, n, ap, bp ); + return API_SUFFIX(LAPACKE_zhpgst_work)( matrix_layout, itype, uplo, n, ap, bp ); } diff --git a/LAPACKE/src/lapacke_zhpgst_work.c b/LAPACKE/src/lapacke_zhpgst_work.c index d2d52a0b25..dafce7408c 100644 --- a/LAPACKE/src/lapacke_zhpgst_work.c +++ b/LAPACKE/src/lapacke_zhpgst_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgst_work( int matrix_layout, lapack_int itype, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpgst_work)( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_complex_double* bp ) { @@ -62,26 +62,26 @@ lapack_int LAPACKE_zhpgst_work( int matrix_layout, lapack_int itype, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpgst( &itype, &uplo, &n, ap_t, bp_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgst_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpgst_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgst_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgv.c b/LAPACKE/src/lapacke_zhpgv.c index 128b7b28e3..f762dd1056 100644 --- a/LAPACKE/src/lapacke_zhpgv.c +++ b/LAPACKE/src/lapacke_zhpgv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgv( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgv)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -41,16 +41,16 @@ lapack_int LAPACKE_zhpgv( int matrix_layout, lapack_int itype, char jobz, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpgv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_zhp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, bp ) ) { return -7; } } @@ -68,7 +68,7 @@ lapack_int LAPACKE_zhpgv( int matrix_layout, lapack_int itype, char jobz, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhpgv_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, + info = API_SUFFIX(LAPACKE_zhpgv_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_zhpgv( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgv_work.c b/LAPACKE/src/lapacke_zhpgv_work.c index e97bdadb0f..4064d312b1 100644 --- a/LAPACKE/src/lapacke_zhpgv_work.c +++ b/LAPACKE/src/lapacke_zhpgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgv_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgv_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double* w, @@ -55,11 +55,11 @@ lapack_int LAPACKE_zhpgv_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgv_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -83,8 +83,8 @@ lapack_int LAPACKE_zhpgv_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpgv( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, rwork, &info ); @@ -92,26 +92,26 @@ lapack_int LAPACKE_zhpgv_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpgv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgvd.c b/LAPACKE/src/lapacke_zhpgvd.c index cb90e86cf7..ac35a46aba 100644 --- a/LAPACKE/src/lapacke_zhpgvd.c +++ b/LAPACKE/src/lapacke_zhpgvd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgvd)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double* w, lapack_complex_double* z, lapack_int ldz ) @@ -48,22 +48,22 @@ lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_zhp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, bp ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhpgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_zhpgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -90,7 +90,7 @@ lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhpgvd_work( matrix_layout, itype, jobz, uplo, n, ap, bp, w, + info = API_SUFFIX(LAPACKE_zhpgvd_work)( matrix_layout, itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgvd_work.c b/LAPACKE/src/lapacke_zhpgvd_work.c index df0fdcc930..ccc8df1dd2 100644 --- a/LAPACKE/src/lapacke_zhpgvd_work.c +++ b/LAPACKE/src/lapacke_zhpgvd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgvd_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgvd_work)( int matrix_layout, lapack_int itype, char jobz, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double* w, @@ -57,7 +57,7 @@ lapack_int LAPACKE_zhpgvd_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvd_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_zhpgvd_work( int matrix_layout, lapack_int itype, char jobz, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -91,8 +91,8 @@ lapack_int LAPACKE_zhpgvd_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpgvd( &itype, &jobz, &uplo, &n, ap_t, bp_t, w, z_t, &ldz_t, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -100,26 +100,26 @@ lapack_int LAPACKE_zhpgvd_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpgvd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgvx.c b/LAPACKE/src/lapacke_zhpgvx.c index fd2b6b69cc..efec2e91d6 100644 --- a/LAPACKE/src/lapacke_zhpgvx.c +++ b/LAPACKE/src/lapacke_zhpgvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgvx( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgvx)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double vl, double vu, lapack_int il, lapack_int iu, @@ -45,28 +45,28 @@ lapack_int LAPACKE_zhpgvx( int matrix_layout, lapack_int itype, char jobz, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -13; } - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -7; } - if( LAPACKE_zhp_nancheck( n, bp ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, bp ) ) { return -8; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -9; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -10; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zhpgvx( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zhpgvx_work( matrix_layout, itype, jobz, range, uplo, n, ap, + info = API_SUFFIX(LAPACKE_zhpgvx_work)( matrix_layout, itype, jobz, range, uplo, n, ap, bp, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail ); /* Release memory and exit */ @@ -101,7 +101,7 @@ lapack_int LAPACKE_zhpgvx( int matrix_layout, lapack_int itype, char jobz, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpgvx_work.c b/LAPACKE/src/lapacke_zhpgvx_work.c index 2888b4723c..73c210b240 100644 --- a/LAPACKE/src/lapacke_zhpgvx_work.c +++ b/LAPACKE/src/lapacke_zhpgvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpgvx_work( int matrix_layout, lapack_int itype, char jobz, +lapack_int API_SUFFIX(LAPACKE_zhpgvx_work)( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, lapack_complex_double* ap, lapack_complex_double* bp, double vl, double vu, @@ -52,9 +52,9 @@ lapack_int LAPACKE_zhpgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || - LAPACKE_lsame( range, 'v' ) ) ? n : - ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); + lapack_int ncols_z = ( API_SUFFIX(LAPACKE_lsame)( range, 'a' ) || + API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); lapack_complex_double* z_t = NULL; lapack_complex_double* ap_t = NULL; @@ -62,11 +62,11 @@ lapack_int LAPACKE_zhpgvx_work( int matrix_layout, lapack_int itype, char jobz, /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -17; - LAPACKE_xerbla( "LAPACKE_zhpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,ncols_z) ); @@ -90,8 +90,8 @@ lapack_int LAPACKE_zhpgvx_work( int matrix_layout, lapack_int itype, char jobz, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, bp, bp_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, rwork, iwork, @@ -100,27 +100,27 @@ lapack_int LAPACKE_zhpgvx_work( int matrix_layout, lapack_int itype, char jobz, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpgvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpgvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhprfs.c b/LAPACKE/src/lapacke_zhprfs.c index 412dd2f9c0..3f3a098283 100644 --- a/LAPACKE/src/lapacke_zhprfs.c +++ b/LAPACKE/src/lapacke_zhprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zhprfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zhprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_zhprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_zhprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhprfs_work.c b/LAPACKE/src/lapacke_zhprfs_work.c index bb527472a2..b4ac0f42c8 100644 --- a/LAPACKE/src/lapacke_zhprfs_work.c +++ b/LAPACKE/src/lapacke_zhprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, @@ -60,12 +60,12 @@ lapack_int LAPACKE_zhprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zhprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,10 +98,10 @@ lapack_int LAPACKE_zhprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_zhprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -109,7 +109,7 @@ lapack_int LAPACKE_zhprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -120,11 +120,11 @@ lapack_int LAPACKE_zhprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpsv.c b/LAPACKE/src/lapacke_zhpsv.c index 1318212094..63e8bcc373 100644 --- a/LAPACKE/src/lapacke_zhpsv.c +++ b/LAPACKE/src/lapacke_zhpsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zhpsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_zhpsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhpsv_work.c b/LAPACKE/src/lapacke_zhpsv_work.c index 3b4a880ec3..92ffdcad46 100644 --- a/LAPACKE/src/lapacke_zhpsv_work.c +++ b/LAPACKE/src/lapacke_zhpsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_zhpsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,27 +70,27 @@ lapack_int LAPACKE_zhpsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhpsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpsvx.c b/LAPACKE/src/lapacke_zhpsvx.c index aa4bd89d8f..ebda9a1f93 100644 --- a/LAPACKE/src/lapacke_zhpsvx.c +++ b/LAPACKE/src/lapacke_zhpsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhpsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* afp, lapack_int* ipiv, const lapack_complex_double* b, lapack_int ldb, @@ -43,21 +43,21 @@ lapack_int LAPACKE_zhpsvx( int matrix_layout, char fact, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhpsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zhp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_zhpsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhpsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_zhpsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zhpsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhpsvx_work.c b/LAPACKE/src/lapacke_zhpsvx_work.c index 77afd7ea17..17b283e6bf 100644 --- a/LAPACKE/src/lapacke_zhpsvx_work.c +++ b/LAPACKE/src/lapacke_zhpsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhpsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zhpsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* afp, lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_zhpsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zhpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zhpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_zhpsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zhp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_zhpsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -109,9 +109,9 @@ lapack_int LAPACKE_zhpsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -123,11 +123,11 @@ lapack_int LAPACKE_zhpsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhpsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhpsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhptrd.c b/LAPACKE/src/lapacke_zhptrd.c index a31a3b74cf..bdac9da9cf 100644 --- a/LAPACKE/src/lapacke_zhptrd.c +++ b/LAPACKE/src/lapacke_zhptrd.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrd( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrd)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, double* d, double* e, lapack_complex_double* tau ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhptrd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrd", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zhptrd_work( matrix_layout, uplo, n, ap, d, e, tau ); + return API_SUFFIX(LAPACKE_zhptrd_work)( matrix_layout, uplo, n, ap, d, e, tau ); } diff --git a/LAPACKE/src/lapacke_zhptrd_work.c b/LAPACKE/src/lapacke_zhptrd_work.c index 05fd25699a..36b7622115 100644 --- a/LAPACKE/src/lapacke_zhptrd_work.c +++ b/LAPACKE/src/lapacke_zhptrd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrd_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrd_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, double* d, double* e, lapack_complex_double* tau ) { @@ -54,23 +54,23 @@ lapack_int LAPACKE_zhptrd_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhptrd( &uplo, &n, ap_t, d, e, tau, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrd_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhptrd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhptrf.c b/LAPACKE/src/lapacke_zhptrf.c index 0716852122..9676d41a3a 100644 --- a/LAPACKE/src/lapacke_zhptrf.c +++ b/LAPACKE/src/lapacke_zhptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zhptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_zhptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_zhptrf_work.c b/LAPACKE/src/lapacke_zhptrf_work.c index c48c34ab80..a00b655427 100644 --- a/LAPACKE/src/lapacke_zhptrf_work.c +++ b/LAPACKE/src/lapacke_zhptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zhptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhptri.c b/LAPACKE/src/lapacke_zhptri.c index 1acd04c64d..c77476c32d 100644 --- a/LAPACKE/src/lapacke_zhptri.c +++ b/LAPACKE/src/lapacke_zhptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_zhptri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_zhptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhptri_work.c b/LAPACKE/src/lapacke_zhptri_work.c index 394ad141b1..0704df2173 100644 --- a/LAPACKE/src/lapacke_zhptri_work.c +++ b/LAPACKE/src/lapacke_zhptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_int* ipiv, lapack_complex_double* work ) @@ -55,23 +55,23 @@ lapack_int LAPACKE_zhptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zhp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhptrs.c b/LAPACKE/src/lapacke_zhptrs.c index b75e45e3bb..e1339188d9 100644 --- a/LAPACKE/src/lapacke_zhptrs.c +++ b/LAPACKE/src/lapacke_zhptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zhp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zhptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_zhptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zhptrs_work.c b/LAPACKE/src/lapacke_zhptrs_work.c index eb085ba7e3..c0d034e65e 100644 --- a/LAPACKE/src/lapacke_zhptrs_work.c +++ b/LAPACKE/src/lapacke_zhptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_int* ipiv, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zhptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_zhptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zhp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zhp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zhptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhsein.c b/LAPACKE/src/lapacke_zhsein.c index f64e0ea675..218876e6da 100644 --- a/LAPACKE/src/lapacke_zhsein.c +++ b/LAPACKE/src/lapacke_zhsein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhsein( int matrix_layout, char job, char eigsrc, char initv, +lapack_int API_SUFFIX(LAPACKE_zhsein)( int matrix_layout, char job, char eigsrc, char initv, const lapack_logical* select, lapack_int n, const lapack_complex_double* h, lapack_int ldh, lapack_complex_double* w, lapack_complex_double* vl, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zhsein( int matrix_layout, char job, char eigsrc, char initv, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhsein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } - if( LAPACKE_z_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, w, 1 ) ) { return -9; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_zhsein( int matrix_layout, char job, char eigsrc, char initv, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zhsein_work( matrix_layout, job, eigsrc, initv, select, n, h, + info = API_SUFFIX(LAPACKE_zhsein_work)( matrix_layout, job, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_zhsein( int matrix_layout, char job, char eigsrc, char initv, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhsein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhsein_work.c b/LAPACKE/src/lapacke_zhsein_work.c index 37258d3517..68e2996f48 100644 --- a/LAPACKE/src/lapacke_zhsein_work.c +++ b/LAPACKE/src/lapacke_zhsein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, +lapack_int API_SUFFIX(LAPACKE_zhsein_work)( int matrix_layout, char job, char eigsrc, char initv, const lapack_logical* select, lapack_int n, const lapack_complex_double* h, lapack_int ldh, lapack_complex_double* w, @@ -60,17 +60,17 @@ lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -80,7 +80,7 @@ lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,mm) ); @@ -89,7 +89,7 @@ lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,mm) ); @@ -99,14 +99,14 @@ lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'l' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) && - LAPACKE_lsame( initv, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( job, 'r' ) || API_SUFFIX(LAPACKE_lsame)( job, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( initv, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_zhsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, w, vl_t, @@ -116,31 +116,31 @@ lapack_int LAPACKE_zhsein_work( int matrix_layout, char job, char eigsrc, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhsein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhsein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhseqr.c b/LAPACKE/src/lapacke_zhseqr.c index 64dbbb5e63..489b0b3f39 100644 --- a/LAPACKE/src/lapacke_zhseqr.c +++ b/LAPACKE/src/lapacke_zhseqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhseqr( int matrix_layout, char job, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zhseqr)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* h, lapack_int ldh, lapack_complex_double* w, lapack_complex_double* z, @@ -43,24 +43,24 @@ lapack_int LAPACKE_zhseqr( int matrix_layout, char job, char compz, lapack_int n lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zhseqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, h, ldh ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, h, ldh ) ) { return -7; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -10; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zhseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_zhseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, w, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -74,13 +74,13 @@ lapack_int LAPACKE_zhseqr( int matrix_layout, char job, char compz, lapack_int n goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zhseqr_work( matrix_layout, job, compz, n, ilo, ihi, h, ldh, + info = API_SUFFIX(LAPACKE_zhseqr_work)( matrix_layout, job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhseqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zhseqr_work.c b/LAPACKE/src/lapacke_zhseqr_work.c index 05c33615eb..1944b80595 100644 --- a/LAPACKE/src/lapacke_zhseqr_work.c +++ b/LAPACKE/src/lapacke_zhseqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zhseqr_work( int matrix_layout, char job, char compz, +lapack_int API_SUFFIX(LAPACKE_zhseqr_work)( int matrix_layout, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* h, lapack_int ldh, lapack_complex_double* w, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zhseqr_work( int matrix_layout, char job, char compz, /* Check leading dimension(s) */ if( ldh < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr_work", info ); return info; } if( ldz < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -76,7 +76,7 @@ lapack_int LAPACKE_zhseqr_work( int matrix_layout, char job, char compz, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -86,9 +86,9 @@ lapack_int LAPACKE_zhseqr_work( int matrix_layout, char job, char compz, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, h, ldh, h_t, ldh_t ); - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, h, ldh, h_t, ldh_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zhseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, w, z_t, @@ -97,23 +97,23 @@ lapack_int LAPACKE_zhseqr_work( int matrix_layout, char job, char compz, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zhseqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zhseqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlacgv.c b/LAPACKE/src/lapacke_zlacgv.c index cbfa99f51f..d9b937e4b1 100644 --- a/LAPACKE/src/lapacke_zlacgv.c +++ b/LAPACKE/src/lapacke_zlacgv.c @@ -32,16 +32,16 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacgv( lapack_int n, lapack_complex_double* x, +lapack_int API_SUFFIX(LAPACKE_zlacgv)( lapack_int n, lapack_complex_double* x, lapack_int incx ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_z_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, x, incx ) ) { return -2; } } #endif - return LAPACKE_zlacgv_work( n, x, incx ); + return API_SUFFIX(LAPACKE_zlacgv_work)( n, x, incx ); } diff --git a/LAPACKE/src/lapacke_zlacgv_work.c b/LAPACKE/src/lapacke_zlacgv_work.c index c4dbd02b61..7a727af286 100644 --- a/LAPACKE/src/lapacke_zlacgv_work.c +++ b/LAPACKE/src/lapacke_zlacgv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacgv_work( lapack_int n, lapack_complex_double* x, +lapack_int API_SUFFIX(LAPACKE_zlacgv_work)( lapack_int n, lapack_complex_double* x, lapack_int incx ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_zlacn2.c b/LAPACKE/src/lapacke_zlacn2.c index 38a5bb4a41..a086f24563 100644 --- a/LAPACKE/src/lapacke_zlacn2.c +++ b/LAPACKE/src/lapacke_zlacn2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacn2( lapack_int n, lapack_complex_double* v, +lapack_int API_SUFFIX(LAPACKE_zlacn2)( lapack_int n, lapack_complex_double* v, lapack_complex_double* x, double* est, lapack_int* kase, lapack_int* isave ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, est, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, est, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, x, 1 ) ) { return -3; } } #endif - return LAPACKE_zlacn2_work( n, v, x, est, kase, isave ); + return API_SUFFIX(LAPACKE_zlacn2_work)( n, v, x, est, kase, isave ); } diff --git a/LAPACKE/src/lapacke_zlacn2_work.c b/LAPACKE/src/lapacke_zlacn2_work.c index 820e88a15d..cb24ad0aba 100644 --- a/LAPACKE/src/lapacke_zlacn2_work.c +++ b/LAPACKE/src/lapacke_zlacn2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacn2_work( lapack_int n, lapack_complex_double* v, +lapack_int API_SUFFIX(LAPACKE_zlacn2_work)( lapack_int n, lapack_complex_double* v, lapack_complex_double* x, double* est, lapack_int* kase, lapack_int* isave ) diff --git a/LAPACKE/src/lapacke_zlacp2.c b/LAPACKE/src/lapacke_zlacp2.c index 1c76b70f69..fb0f13ab52 100644 --- a/LAPACKE/src/lapacke_zlacp2.c +++ b/LAPACKE/src/lapacke_zlacp2.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacp2( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlacp2)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlacp2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacp2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_zlacp2_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_zlacp2_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zlacp2_work.c b/LAPACKE/src/lapacke_zlacp2_work.c index f5b3a229ae..790b762fde 100644 --- a/LAPACKE/src/lapacke_zlacp2_work.c +++ b/LAPACKE/src/lapacke_zlacp2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacp2_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlacp2_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_zlacp2_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacp2_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacp2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -72,23 +72,23 @@ lapack_int LAPACKE_zlacp2_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlacp2( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacp2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlacp2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacp2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlacpy.c b/LAPACKE/src/lapacke_zlacpy.c index 4e77c110c7..71ce082ecb 100644 --- a/LAPACKE/src/lapacke_zlacpy.c +++ b/LAPACKE/src/lapacke_zlacpy.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacpy( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlacpy)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlacpy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacpy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_zlacpy_work( matrix_layout, uplo, m, n, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_zlacpy_work)( matrix_layout, uplo, m, n, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zlacpy_work.c b/LAPACKE/src/lapacke_zlacpy_work.c index e61bed6da6..e3bb79c9f1 100644 --- a/LAPACKE/src/lapacke_zlacpy_work.c +++ b/LAPACKE/src/lapacke_zlacpy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacpy_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlacpy_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -49,12 +49,12 @@ lapack_int LAPACKE_zlacpy_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacpy_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacpy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,23 +71,23 @@ lapack_int LAPACKE_zlacpy_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacpy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlacpy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacpy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlacrm.c b/LAPACKE/src/lapacke_zlacrm.c index 974fc07cdf..4a029f9814 100644 --- a/LAPACKE/src/lapacke_zlacrm.c +++ b/LAPACKE/src/lapacke_zlacrm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacrm(int matrix_layout, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlacrm)(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const double* b, lapack_int ldb, lapack_complex_double* c, lapack_int ldc) @@ -41,16 +41,16 @@ lapack_int LAPACKE_zlacrm(int matrix_layout, lapack_int m, double* rwork = NULL; if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) { - LAPACKE_xerbla("LAPACKE_zlacrm", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_zlacrm", -1); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if ( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } - if( LAPACKE_dge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -6; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_zlacrm(int matrix_layout, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlacrm_work(matrix_layout, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zlacrm_work)(matrix_layout, m, n, a, lda, b, ldb, c, ldc, rwork); /* Release memory and exit */ LAPACKE_free(rwork); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlacrm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacrm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlacrm_work.c b/LAPACKE/src/lapacke_zlacrm_work.c index ed110cd72b..295fa9aefa 100644 --- a/LAPACKE/src/lapacke_zlacrm_work.c +++ b/LAPACKE/src/lapacke_zlacrm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlacrm_work(int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlacrm_work)(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const double* b, lapack_int ldb, lapack_complex_double* c, lapack_int ldc, @@ -52,17 +52,17 @@ lapack_int LAPACKE_zlacrm_work(int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zlacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacrm_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zlacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacrm_work", info ); return info; } if( ldc < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zlacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacrm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,12 +85,12 @@ lapack_int LAPACKE_zlacrm_work(int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans(matrix_layout, m, n, a, lda, a_t, lda_t); - LAPACKE_dge_trans(matrix_layout, n, n, b, ldb, b_t, ldb_t); + API_SUFFIX(LAPACKE_zge_trans)(matrix_layout, m, n, a, lda, a_t, lda_t); + API_SUFFIX(LAPACKE_dge_trans)(matrix_layout, n, n, b, ldb, b_t, ldb_t); /* Call LAPACK function */ LAPACK_zlacrm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork); /* Transpose output matrices */ - LAPACKE_zge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); + API_SUFFIX(LAPACKE_zge_trans)(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); /* Release memory and exit */ LAPACKE_free(c_t); exit_level_2: @@ -99,11 +99,11 @@ lapack_int LAPACKE_zlacrm_work(int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free(a_t); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlacrm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlacrm_work", info ); } } else { info = -1; - LAPACKE_xerbla("LAPACKE_zlacrm_work", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_zlacrm_work", -1); } return info; } diff --git a/LAPACKE/src/lapacke_zlag2c.c b/LAPACKE/src/lapacke_zlag2c.c index 56220d44f4..4235b21fbb 100644 --- a/LAPACKE/src/lapacke_zlag2c.c +++ b/LAPACKE/src/lapacke_zlag2c.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlag2c( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlag2c)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_float* sa, lapack_int ldsa ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlag2c", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlag2c", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zlag2c_work( matrix_layout, m, n, a, lda, sa, ldsa ); + return API_SUFFIX(LAPACKE_zlag2c_work)( matrix_layout, m, n, a, lda, sa, ldsa ); } diff --git a/LAPACKE/src/lapacke_zlag2c_work.c b/LAPACKE/src/lapacke_zlag2c_work.c index da5dd512c9..a294cfb96f 100644 --- a/LAPACKE/src/lapacke_zlag2c_work.c +++ b/LAPACKE/src/lapacke_zlag2c_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlag2c_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlag2c_work)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_float* sa, lapack_int ldsa ) { @@ -51,12 +51,12 @@ lapack_int LAPACKE_zlag2c_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zlag2c_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlag2c_work", info ); return info; } if( ldsa < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zlag2c_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlag2c_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,25 +73,25 @@ lapack_int LAPACKE_zlag2c_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlag2c( &m, &n, a_t, &lda_t, sa_t, &ldsa_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, sa_t, ldsa_t, sa, ldsa ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, m, n, sa_t, ldsa_t, sa, ldsa ); /* Release memory and exit */ LAPACKE_free( sa_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlag2c_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlag2c_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlag2c_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlag2c_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlagge.c b/LAPACKE/src/lapacke_zlagge.c index b7c5554f20..657e364c08 100644 --- a/LAPACKE/src/lapacke_zlagge.c +++ b/LAPACKE/src/lapacke_zlagge.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlagge( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlagge)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed ) @@ -40,13 +40,13 @@ lapack_int LAPACKE_zlagge( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlagge", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagge", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( MIN(m,n), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(m,n), d, 1 ) ) { return -6; } } @@ -59,13 +59,13 @@ lapack_int LAPACKE_zlagge( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlagge_work( matrix_layout, m, n, kl, ku, d, a, lda, iseed, + info = API_SUFFIX(LAPACKE_zlagge_work)( matrix_layout, m, n, kl, ku, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlagge", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagge", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlagge_work.c b/LAPACKE/src/lapacke_zlagge_work.c index 92583bb639..b7ab378211 100644 --- a/LAPACKE/src/lapacke_zlagge_work.c +++ b/LAPACKE/src/lapacke_zlagge_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlagge_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlagge_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zlagge_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagge_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_zlagge_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagge_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlagge_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagge_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlaghe.c b/LAPACKE/src/lapacke_zlaghe.c index 74b5925d96..484e059914 100644 --- a/LAPACKE/src/lapacke_zlaghe.c +++ b/LAPACKE/src/lapacke_zlaghe.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaghe( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_zlaghe)( int matrix_layout, lapack_int n, lapack_int k, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlaghe", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaghe", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zlaghe( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlaghe_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_zlaghe_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlaghe", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaghe", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlaghe_work.c b/LAPACKE/src/lapacke_zlaghe_work.c index 0bc1ac22ec..38b855c61b 100644 --- a/LAPACKE/src/lapacke_zlaghe_work.c +++ b/LAPACKE/src/lapacke_zlaghe_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaghe_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_zlaghe_work)( int matrix_layout, lapack_int n, lapack_int k, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zlaghe_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlaghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaghe_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_zlaghe_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlaghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaghe_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlaghe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaghe_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlagsy.c b/LAPACKE/src/lapacke_zlagsy.c index 0f6f700648..ed652946ef 100644 --- a/LAPACKE/src/lapacke_zlagsy.c +++ b/LAPACKE/src/lapacke_zlagsy.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlagsy( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_zlagsy)( int matrix_layout, lapack_int n, lapack_int k, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlagsy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagsy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zlagsy( int matrix_layout, lapack_int n, lapack_int k, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlagsy_work( matrix_layout, n, k, d, a, lda, iseed, work ); + info = API_SUFFIX(LAPACKE_zlagsy_work)( matrix_layout, n, k, d, a, lda, iseed, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlagsy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagsy", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlagsy_work.c b/LAPACKE/src/lapacke_zlagsy_work.c index 9fbe94f7f7..d980fc3c2a 100644 --- a/LAPACKE/src/lapacke_zlagsy_work.c +++ b/LAPACKE/src/lapacke_zlagsy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlagsy_work( int matrix_layout, lapack_int n, lapack_int k, +lapack_int API_SUFFIX(LAPACKE_zlagsy_work)( int matrix_layout, lapack_int n, lapack_int k, const double* d, lapack_complex_double* a, lapack_int lda, lapack_int* iseed, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zlagsy_work( int matrix_layout, lapack_int n, lapack_int k, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagsy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -66,16 +66,16 @@ lapack_int LAPACKE_zlagsy_work( int matrix_layout, lapack_int n, lapack_int k, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagsy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlagsy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlagsy_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlangb.c b/LAPACKE/src/lapacke_zlangb.c index 3a22ad9822..ccc8eb4b5b 100644 --- a/LAPACKE/src/lapacke_zlangb.c +++ b/LAPACKE/src/lapacke_zlangb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlangb( int matrix_layout, char norm, lapack_int n, +double API_SUFFIX(LAPACKE_zlangb)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab ) { @@ -40,19 +40,19 @@ double LAPACKE_zlangb( int matrix_layout, char norm, lapack_int n, double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlangb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlangb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -6; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ double LAPACKE_zlangb( int matrix_layout, char norm, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_zlangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work ); + res = API_SUFFIX(LAPACKE_zlangb_work)( matrix_layout, norm, n, kl, ku, ab, ldab, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlangb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlangb", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlangb_work.c b/LAPACKE/src/lapacke_zlangb_work.c index d64fb482d5..6b491ef0db 100644 --- a/LAPACKE/src/lapacke_zlangb_work.c +++ b/LAPACKE/src/lapacke_zlangb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlangb_work( int matrix_layout, char norm, lapack_int n, +double API_SUFFIX(LAPACKE_zlangb_work)( int matrix_layout, char norm, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double* ab, lapack_int ldab, double* work ) @@ -48,18 +48,18 @@ double LAPACKE_zlangb_work( int matrix_layout, char norm, lapack_int n, /* Check leading dimension(s) */ if( ldab < kl+ku+1 ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlangb_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -74,11 +74,11 @@ double LAPACKE_zlangb_work( int matrix_layout, char norm, lapack_int n, } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlangb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlangb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlangb_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlange.c b/LAPACKE/src/lapacke_zlange.c index 75b76b00ee..5d18349e57 100644 --- a/LAPACKE/src/lapacke_zlange.c +++ b/LAPACKE/src/lapacke_zlange.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlange( int matrix_layout, char norm, lapack_int m, +double API_SUFFIX(LAPACKE_zlange)( int matrix_layout, char norm, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda ) { @@ -40,19 +40,19 @@ double LAPACKE_zlange( int matrix_layout, char norm, lapack_int m, double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlange", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlange", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,14 +60,14 @@ double LAPACKE_zlange( int matrix_layout, char norm, lapack_int m, } } /* Call middle-level interface */ - res = LAPACKE_zlange_work( matrix_layout, norm, m, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_zlange_work)( matrix_layout, norm, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlange", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlange", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlange_work.c b/LAPACKE/src/lapacke_zlange_work.c index 217ae074c8..cb4292dbd6 100644 --- a/LAPACKE/src/lapacke_zlange_work.c +++ b/LAPACKE/src/lapacke_zlange_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlange_work( int matrix_layout, char norm, lapack_int m, +double API_SUFFIX(LAPACKE_zlange_work)( int matrix_layout, char norm, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* work ) { @@ -47,18 +47,18 @@ double LAPACKE_zlange_work( int matrix_layout, char norm, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlange_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -73,11 +73,11 @@ double LAPACKE_zlange_work( int matrix_layout, char norm, lapack_int m, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlange_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlange_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlange_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlanhe.c b/LAPACKE/src/lapacke_zlanhe.c index 78468e5e12..b82375be48 100644 --- a/LAPACKE/src/lapacke_zlanhe.c +++ b/LAPACKE/src/lapacke_zlanhe.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -double LAPACKE_zlanhe( int matrix_layout, char norm, char uplo, lapack_int n, +double API_SUFFIX(LAPACKE_zlanhe)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlanhe", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlanhe", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ double LAPACKE_zlanhe( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_zlanhe_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_zlanhe_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlanhe", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlanhe", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlanhe_work.c b/LAPACKE/src/lapacke_zlanhe_work.c index 899f3b13a8..d81617a9b4 100644 --- a/LAPACKE/src/lapacke_zlanhe_work.c +++ b/LAPACKE/src/lapacke_zlanhe_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlanhe_work( int matrix_layout, char norm, char uplo, +double API_SUFFIX(LAPACKE_zlanhe_work)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* work ) { @@ -50,7 +50,7 @@ double LAPACKE_zlanhe_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlanhe_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ double LAPACKE_zlanhe_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zhe_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_zlanhe( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -69,11 +69,11 @@ double LAPACKE_zlanhe_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlanhe_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlanhe_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlanhe_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlansy.c b/LAPACKE/src/lapacke_zlansy.c index c7f878a90f..b620da70af 100644 --- a/LAPACKE/src/lapacke_zlansy.c +++ b/LAPACKE/src/lapacke_zlansy.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -double LAPACKE_zlansy( int matrix_layout, char norm, char uplo, lapack_int n, +double API_SUFFIX(LAPACKE_zlansy)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlansy", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlansy", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ double LAPACKE_zlansy( int matrix_layout, char norm, char uplo, lapack_int n, } } /* Call middle-level interface */ - res = LAPACKE_zlansy_work( matrix_layout, norm, uplo, n, a, lda, work ); + res = API_SUFFIX(LAPACKE_zlansy_work)( matrix_layout, norm, uplo, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) || LAPACKE_lsame( norm, '1' ) || - LAPACKE_lsame( norm, 'O' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) || API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || + API_SUFFIX(LAPACKE_lsame)( norm, 'O' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlansy", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlansy", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlansy_work.c b/LAPACKE/src/lapacke_zlansy_work.c index 4e05b0fae1..7b66c0f23d 100644 --- a/LAPACKE/src/lapacke_zlansy_work.c +++ b/LAPACKE/src/lapacke_zlansy_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlansy_work( int matrix_layout, char norm, char uplo, +double API_SUFFIX(LAPACKE_zlansy_work)( int matrix_layout, char norm, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* work ) { @@ -50,7 +50,7 @@ double LAPACKE_zlansy_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlansy_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ double LAPACKE_zlansy_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_zlansy( &norm, &uplo, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ @@ -69,11 +69,11 @@ double LAPACKE_zlansy_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlansy_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlansy_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlansy_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlantr.c b/LAPACKE/src/lapacke_zlantr.c index 4c078b9b0f..73607a0959 100644 --- a/LAPACKE/src/lapacke_zlantr.c +++ b/LAPACKE/src/lapacke_zlantr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlantr( int matrix_layout, char norm, char uplo, char diag, +double API_SUFFIX(LAPACKE_zlantr)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda ) { @@ -40,19 +40,19 @@ double LAPACKE_zlantr( int matrix_layout, char norm, char uplo, char diag, double res = 0.; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlantr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlantr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztz_nancheck)( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) { return -7; } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,MAX(m,n)) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -60,15 +60,15 @@ double LAPACKE_zlantr( int matrix_layout, char norm, char uplo, char diag, } } /* Call middle-level interface */ - res = LAPACKE_zlantr_work( matrix_layout, norm, uplo, diag, m, n, a, lda, + res = API_SUFFIX(LAPACKE_zlantr_work)( matrix_layout, norm, uplo, diag, m, n, a, lda, work ); /* Release memory and exit */ - if( LAPACKE_lsame( norm, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { LAPACKE_free( work ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlantr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlantr", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlantr_work.c b/LAPACKE/src/lapacke_zlantr_work.c index f57911967e..b063492970 100644 --- a/LAPACKE/src/lapacke_zlantr_work.c +++ b/LAPACKE/src/lapacke_zlantr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, +double API_SUFFIX(LAPACKE_zlantr_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* work ) @@ -49,23 +49,23 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlantr_work", info ); return info; } - if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm, '1' ) || API_SUFFIX(LAPACKE_lsame)( norm, 'o' ) ) { norm_lapack = 'i'; - } else if( LAPACKE_lsame( norm, 'i' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( norm, 'i' ) ) { norm_lapack = '1'; } else { norm_lapack = norm; } - if( LAPACKE_lsame( uplo, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { uplo_lapack = 'l'; } else { uplo_lapack = 'u'; } /* Allocate memory for work array(s) */ - if( LAPACKE_lsame( norm_lapack, 'i' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( norm_lapack, 'i' ) ) { work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( work_lapack == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -80,11 +80,11 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlantr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlantr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlantr_work", info ); } return res; } diff --git a/LAPACKE/src/lapacke_zlapmr.c b/LAPACKE/src/lapacke_zlapmr.c index 35086aa926..3edf7b9e0f 100644 --- a/LAPACKE/src/lapacke_zlapmr.c +++ b/LAPACKE/src/lapacke_zlapmr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlapmr( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_zlapmr)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_double* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlapmr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_zlapmr_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_zlapmr_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_zlapmr_work.c b/LAPACKE/src/lapacke_zlapmr_work.c index 909065eb33..ff401306a2 100644 --- a/LAPACKE/src/lapacke_zlapmr_work.c +++ b/LAPACKE/src/lapacke_zlapmr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlapmr_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_zlapmr_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_double* x, lapack_int ldx, lapack_int* k ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zlapmr_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,21 +61,21 @@ lapack_int LAPACKE_zlapmr_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zlapmr( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlapmr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlapmt.c b/LAPACKE/src/lapacke_zlapmt.c index 95e3b42f4e..983bc08c3f 100644 --- a/LAPACKE/src/lapacke_zlapmt.c +++ b/LAPACKE/src/lapacke_zlapmt.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlapmt( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_zlapmt)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_double* x, lapack_int ldx, lapack_int* k ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlapmt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, x, ldx ) ) { return -5; } } #endif - return LAPACKE_zlapmt_work( matrix_layout, forwrd, m, n, x, ldx, k ); + return API_SUFFIX(LAPACKE_zlapmt_work)( matrix_layout, forwrd, m, n, x, ldx, k ); } diff --git a/LAPACKE/src/lapacke_zlapmt_work.c b/LAPACKE/src/lapacke_zlapmt_work.c index 70f604741a..73b804114e 100644 --- a/LAPACKE/src/lapacke_zlapmt_work.c +++ b/LAPACKE/src/lapacke_zlapmt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlapmt_work( int matrix_layout, lapack_logical forwrd, +lapack_int API_SUFFIX(LAPACKE_zlapmt_work)( int matrix_layout, lapack_logical forwrd, lapack_int m, lapack_int n, lapack_complex_double* x, lapack_int ldx, lapack_int* k ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zlapmt_work( int matrix_layout, lapack_logical forwrd, /* Check leading dimension(s) */ if( ldx < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,21 +61,21 @@ lapack_int LAPACKE_zlapmt_work( int matrix_layout, lapack_logical forwrd, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zlapmt( &forwrd, &m, &n, x_t, &ldx_t, k ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlapmt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlapmt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarcm.c b/LAPACKE/src/lapacke_zlarcm.c index c8ca160594..942524132d 100644 --- a/LAPACKE/src/lapacke_zlarcm.c +++ b/LAPACKE/src/lapacke_zlarcm.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarcm(int matrix_layout, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlarcm)(int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, lapack_complex_double* c, lapack_int ldc) @@ -41,16 +41,16 @@ lapack_int LAPACKE_zlarcm(int matrix_layout, lapack_int m, double* rwork = NULL; if (matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR) { - LAPACKE_xerbla("LAPACKE_zlarcm", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_zlarcm", -1); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if ( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -4; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_zlarcm(int matrix_layout, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlarcm_work(matrix_layout, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_zlarcm_work)(matrix_layout, m, n, a, lda, b, ldb, c, ldc, rwork); /* Release memory and exit */ LAPACKE_free(rwork); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarcm", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarcm", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarcm_work.c b/LAPACKE/src/lapacke_zlarcm_work.c index d4e31299ea..8f919ead97 100644 --- a/LAPACKE/src/lapacke_zlarcm_work.c +++ b/LAPACKE/src/lapacke_zlarcm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarcm_work(int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlarcm_work)(int matrix_layout, lapack_int m, lapack_int n, const double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, lapack_complex_double* c, lapack_int ldc, @@ -52,17 +52,17 @@ lapack_int LAPACKE_zlarcm_work(int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < m ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zlarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarcm_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zlarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarcm_work", info ); return info; } if( ldc < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zlarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarcm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -85,12 +85,12 @@ lapack_int LAPACKE_zlarcm_work(int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_dge_trans(matrix_layout, m, m, a, lda, a_t, lda_t); - LAPACKE_zge_trans(matrix_layout, m, n, b, ldb, b_t, ldb_t); + API_SUFFIX(LAPACKE_dge_trans)(matrix_layout, m, m, a, lda, a_t, lda_t); + API_SUFFIX(LAPACKE_zge_trans)(matrix_layout, m, n, b, ldb, b_t, ldb_t); /* Call LAPACK function */ LAPACK_zlarcm(&m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, rwork); /* Transpose output matrices */ - LAPACKE_zge_trans(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); + API_SUFFIX(LAPACKE_zge_trans)(LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc); /* Release memory and exit */ LAPACKE_free(c_t); exit_level_2: @@ -99,11 +99,11 @@ lapack_int LAPACKE_zlarcm_work(int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free(a_t); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarcm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarcm_work", info ); } } else { info = -1; - LAPACKE_xerbla("LAPACKE_zlarcm_work", -1); + API_SUFFIX(LAPACKE_xerbla)("LAPACKE_zlarcm_work", -1); } return info; } diff --git a/LAPACKE/src/lapacke_zlarfb.c b/LAPACKE/src/lapacke_zlarfb.c index c5edbbc0ed..722759d45c 100644 --- a/LAPACKE/src/lapacke_zlarfb.c +++ b/LAPACKE/src/lapacke_zlarfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_zlarfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, @@ -46,39 +46,39 @@ lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct lapack_logical left, col, forward; char uplo; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlarfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); uplo = ( ( forward && col ) || !( forward || col ) ) ? 'l' : 'u'; if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { - LAPACKE_xerbla( "LAPACKE_zlarfb", -8 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb", -8 ); return -8; } - if( LAPACKE_ztz_nancheck( matrix_layout, direct, uplo, 'u', + if( API_SUFFIX(LAPACKE_ztz_nancheck)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -11; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -13; } } #endif - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { ldwork = n; - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { ldwork = m; } else { ldwork = 1; @@ -91,13 +91,13 @@ lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlarfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_zlarfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarfb_work.c b/LAPACKE/src/lapacke_zlarfb_work.c index 232c8ef585..89c5b73867 100644 --- a/LAPACKE/src/lapacke_zlarfb_work.c +++ b/LAPACKE/src/lapacke_zlarfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zlarfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* v, lapack_int ldv, @@ -54,9 +54,9 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - left = LAPACKE_lsame( side, 'l' ); - col = LAPACKE_lsame( storev, 'c' ); - forward = LAPACKE_lsame( direct, 'f' ); + left = API_SUFFIX(LAPACKE_lsame)( side, 'l' ); + col = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ); + forward = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) ); ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) ); @@ -68,22 +68,22 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( ldc < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); return info; } if( ldv < ncols_v ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); return info; } if( ( col && k > nrows_v ) || ( !col && k > ncols_v ) ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,16 +107,16 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ztz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, + API_SUFFIX(LAPACKE_ztz_trans)( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v, v, ldv, v_t, ldv_t ); - LAPACKE_zge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zlarfb( &side, &trans, &direct, &storev, &m, &n, &k, v_t, &ldv_t, t_t, &ldt_t, c_t, &ldc_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -125,11 +125,11 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlarfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarfg.c b/LAPACKE/src/lapacke_zlarfg.c index 4b96733df3..6e300379ae 100644 --- a/LAPACKE/src/lapacke_zlarfg.c +++ b/LAPACKE/src/lapacke_zlarfg.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfg( lapack_int n, lapack_complex_double* alpha, +lapack_int API_SUFFIX(LAPACKE_zlarfg)( lapack_int n, lapack_complex_double* alpha, lapack_complex_double* x, lapack_int incx, lapack_complex_double* tau ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_z_nancheck( 1, alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, alpha, 1 ) ) { return -2; } - if( LAPACKE_z_nancheck( n-1, x, incx ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, x, incx ) ) { return -3; } } #endif - return LAPACKE_zlarfg_work( n, alpha, x, incx, tau ); + return API_SUFFIX(LAPACKE_zlarfg_work)( n, alpha, x, incx, tau ); } diff --git a/LAPACKE/src/lapacke_zlarfg_work.c b/LAPACKE/src/lapacke_zlarfg_work.c index 2d1e7ae27a..b16c0dbe5c 100644 --- a/LAPACKE/src/lapacke_zlarfg_work.c +++ b/LAPACKE/src/lapacke_zlarfg_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfg_work( lapack_int n, lapack_complex_double* alpha, +lapack_int API_SUFFIX(LAPACKE_zlarfg_work)( lapack_int n, lapack_complex_double* alpha, lapack_complex_double* x, lapack_int incx, lapack_complex_double* tau ) { diff --git a/LAPACKE/src/lapacke_zlarft.c b/LAPACKE/src/lapacke_zlarft.c index d99a8c8f80..ec52b5c704 100644 --- a/LAPACKE/src/lapacke_zlarft.c +++ b/LAPACKE/src/lapacke_zlarft.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarft( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_zlarft)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* tau, @@ -40,24 +40,24 @@ lapack_int LAPACKE_zlarft( int matrix_layout, char direct, char storev, { lapack_int ncols_v, nrows_v; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlarft", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarft", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -6; } } #endif - return LAPACKE_zlarft_work( matrix_layout, direct, storev, n, k, v, ldv, tau, + return API_SUFFIX(LAPACKE_zlarft_work)( matrix_layout, direct, storev, n, k, v, ldv, tau, t, ldt ); } diff --git a/LAPACKE/src/lapacke_zlarft_work.c b/LAPACKE/src/lapacke_zlarft_work.c index b352b6aaf3..37280cf042 100644 --- a/LAPACKE/src/lapacke_zlarft_work.c +++ b/LAPACKE/src/lapacke_zlarft_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarft_work( int matrix_layout, char direct, char storev, +lapack_int API_SUFFIX(LAPACKE_zlarft_work)( int matrix_layout, char direct, char storev, lapack_int n, lapack_int k, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* tau, @@ -49,21 +49,21 @@ lapack_int LAPACKE_zlarft_work( int matrix_layout, char direct, char storev, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - nrows_v = LAPACKE_lsame( storev, 'c' ) ? n : - ( LAPACKE_lsame( storev, 'r' ) ? k : 1); - ncols_v = LAPACKE_lsame( storev, 'c' ) ? k : - ( LAPACKE_lsame( storev, 'r' ) ? n : 1); + nrows_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? k : 1); + ncols_v = API_SUFFIX(LAPACKE_lsame)( storev, 'c' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( storev, 'r' ) ? n : 1); ldt_t = MAX(1,k); ldv_t = MAX(1,nrows_v); /* Check leading dimension(s) */ if( ldt < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarft_work", info ); return info; } if( ldv < ncols_v ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarft_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,24 +81,24 @@ lapack_int LAPACKE_zlarft_work( int matrix_layout, char direct, char storev, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, nrows_v, ncols_v, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_zlarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t, &ldt_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarft_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlarft_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarft_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarfx.c b/LAPACKE/src/lapacke_zlarfx.c index 489eb623be..984c4c95c8 100644 --- a/LAPACKE/src/lapacke_zlarfx.c +++ b/LAPACKE/src/lapacke_zlarfx.c @@ -32,31 +32,31 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfx( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlarfx)( int matrix_layout, char side, lapack_int m, lapack_int n, const lapack_complex_double* v, lapack_complex_double tau, lapack_complex_double* c, lapack_int ldc, lapack_complex_double* work ) { lapack_int lv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlarfx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -7; } - if( LAPACKE_z_nancheck( 1, &tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, &tau, 1 ) ) { return -6; } - lv = (LAPACKE_lsame( side, 'l' ) ? m : n); - if( LAPACKE_z_nancheck( lv, v, 1 ) ) { + lv = (API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n); + if( API_SUFFIX(LAPACKE_z_nancheck)( lv, v, 1 ) ) { return -5; } } #endif - return LAPACKE_zlarfx_work( matrix_layout, side, m, n, v, tau, c, ldc, + return API_SUFFIX(LAPACKE_zlarfx_work)( matrix_layout, side, m, n, v, tau, c, ldc, work ); } diff --git a/LAPACKE/src/lapacke_zlarfx_work.c b/LAPACKE/src/lapacke_zlarfx_work.c index 18f2a0646f..56ce2cfdaa 100644 --- a/LAPACKE/src/lapacke_zlarfx_work.c +++ b/LAPACKE/src/lapacke_zlarfx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarfx_work( int matrix_layout, char side, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlarfx_work)( int matrix_layout, char side, lapack_int m, lapack_int n, const lapack_complex_double* v, lapack_complex_double tau, lapack_complex_double* c, lapack_int ldc, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zlarfx_work( int matrix_layout, char side, lapack_int m, /* Check leading dimension(s) */ if( ldc < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,21 +62,21 @@ lapack_int LAPACKE_zlarfx_work( int matrix_layout, char side, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zlarfx( &side, &m, &n, v, &tau, c_t, &ldc_t, work ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlarfx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlarfx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlarnv.c b/LAPACKE/src/lapacke_zlarnv.c index 377e83f971..599a246565 100644 --- a/LAPACKE/src/lapacke_zlarnv.c +++ b/LAPACKE/src/lapacke_zlarnv.c @@ -32,8 +32,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarnv( lapack_int idist, lapack_int* iseed, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlarnv)( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_double* x ) { - return LAPACKE_zlarnv_work( idist, iseed, n, x ); + return API_SUFFIX(LAPACKE_zlarnv_work)( idist, iseed, n, x ); } diff --git a/LAPACKE/src/lapacke_zlarnv_work.c b/LAPACKE/src/lapacke_zlarnv_work.c index 6912d591fe..ab57ccc293 100644 --- a/LAPACKE/src/lapacke_zlarnv_work.c +++ b/LAPACKE/src/lapacke_zlarnv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlarnv_work( lapack_int idist, lapack_int* iseed, +lapack_int API_SUFFIX(LAPACKE_zlarnv_work)( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_double* x ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_zlascl.c b/LAPACKE/src/lapacke_zlascl.c index 9f18448c0c..fb25dd173d 100644 --- a/LAPACKE/src/lapacke_zlascl.c +++ b/LAPACKE/src/lapacke_zlascl.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_zlascl)( int matrix_layout, char type, lapack_int kl, lapack_int ku, double cfrom, double cto, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlascl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlascl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -46,68 +46,68 @@ lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, /* Optionally check input matrices for NaNs */ switch (type) { case 'G': - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -9; } break; case 'L': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_zgb_nancheck)( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) { return -9; } break; case 'U': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_zgb_nancheck)( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) { return -9; } break; case 'H': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(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 ) ) { + if( API_SUFFIX(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 ) ) { + if( API_SUFFIX(LAPACKE_zhb_nancheck)( matrix_layout, 'U', n, ku, a, lda ) ) { return -9; } break; case 'Z': // 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 ) ) { + API_SUFFIX(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 ) ) { + API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) { return -9; } break; } } #endif - return LAPACKE_zlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); + return API_SUFFIX(LAPACKE_zlascl_work)( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_zlascl_work.c b/LAPACKE/src/lapacke_zlascl_work.c index 631c0df46d..0c19f5108e 100644 --- a/LAPACKE/src/lapacke_zlascl_work.c +++ b/LAPACKE/src/lapacke_zlascl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl, +lapack_int API_SUFFIX(LAPACKE_zlascl_work)( int matrix_layout, char type, lapack_int kl, lapack_int ku, double cfrom, double cto, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda ) @@ -45,15 +45,15 @@ 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 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 nrows_a = API_SUFFIX(LAPACKE_lsame)(type, 'b') ? kl + 1 : + API_SUFFIX(LAPACKE_lsame)(type, 'q') ? ku + 1 : + API_SUFFIX(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 ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlascl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,23 +64,23 @@ 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, nrows_a, n, a, lda, a_t, lda_t ); + API_SUFFIX(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); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlascl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlascl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlaset.c b/LAPACKE/src/lapacke_zlaset.c index e0973be12c..80f426ce2d 100644 --- a/LAPACKE/src/lapacke_zlaset.c +++ b/LAPACKE/src/lapacke_zlaset.c @@ -32,14 +32,14 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaset( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlaset)( int matrix_layout, char uplo, lapack_int m, lapack_int n, lapack_complex_double alpha, lapack_complex_double beta, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlaset", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaset", -1 ); return -1; } @@ -52,14 +52,14 @@ lapack_int LAPACKE_zlaset( int matrix_layout, char uplo, lapack_int m, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, &alpha, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( 1, &beta, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, &beta, 1 ) ) { return -6; } } #endif - return LAPACKE_zlaset_work( matrix_layout, uplo, m, n, alpha, beta, a, lda ); + return API_SUFFIX(LAPACKE_zlaset_work)( matrix_layout, uplo, m, n, alpha, beta, a, lda ); } diff --git a/LAPACKE/src/lapacke_zlaset_work.c b/LAPACKE/src/lapacke_zlaset_work.c index 62b6b59a11..b6e2027cb3 100644 --- a/LAPACKE/src/lapacke_zlaset_work.c +++ b/LAPACKE/src/lapacke_zlaset_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaset_work( int matrix_layout, char uplo, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zlaset_work)( int matrix_layout, char uplo, lapack_int m, lapack_int n, lapack_complex_double alpha, lapack_complex_double beta, lapack_complex_double* a, lapack_int lda ) @@ -47,7 +47,7 @@ lapack_int LAPACKE_zlaset_work( int matrix_layout, char uplo, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaset_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -58,21 +58,21 @@ lapack_int LAPACKE_zlaset_work( int matrix_layout, char uplo, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlaset( &uplo, &m, &n, &alpha, &beta, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaset_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlaset_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaset_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlassq.c b/LAPACKE/src/lapacke_zlassq.c index 3b68d12ccc..2870bca85e 100644 --- a/LAPACKE/src/lapacke_zlassq.c +++ b/LAPACKE/src/lapacke_zlassq.c @@ -32,22 +32,22 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlassq( lapack_int n, lapack_complex_double* x, +lapack_int API_SUFFIX(LAPACKE_zlassq)( lapack_int n, lapack_complex_double* x, lapack_int incx, double* scale, double* sumsq ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */ - if( LAPACKE_z_nancheck( n, x, incx ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, x, incx ) ) { return -2; } - if( LAPACKE_d_nancheck( 1, scale, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, scale, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, sumsq, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, sumsq, 1 ) ) { return -5; } } #endif - return LAPACKE_zlassq_work( n, x, incx, scale, sumsq ); + return API_SUFFIX(LAPACKE_zlassq_work)( n, x, incx, scale, sumsq ); } diff --git a/LAPACKE/src/lapacke_zlassq_work.c b/LAPACKE/src/lapacke_zlassq_work.c index 625844de72..89310c79b7 100644 --- a/LAPACKE/src/lapacke_zlassq_work.c +++ b/LAPACKE/src/lapacke_zlassq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlassq_work( lapack_int n, lapack_complex_double* x, +lapack_int API_SUFFIX(LAPACKE_zlassq_work)( lapack_int n, lapack_complex_double* x, lapack_int incx, double* scale, double* sumsq ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_zlaswp.c b/LAPACKE/src/lapacke_zlaswp.c index e166400b01..654400edbd 100644 --- a/LAPACKE/src/lapacke_zlaswp.c +++ b/LAPACKE/src/lapacke_zlaswp.c @@ -32,13 +32,13 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaswp( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlaswp)( int matrix_layout, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlaswp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaswp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -48,15 +48,15 @@ lapack_int LAPACKE_zlaswp( int matrix_layout, lapack_int n, * Disable the check as is below, the check below was checking for NaN * from lda to n since there is no (obvious) way to knowing m. This is not * a good idea. We could get a lower bound of m by scanning from ipiv. Or - * we could pass on the NaN check to LAPACKE_dlaswp_work. For now disable + * we could pass on the NaN check to API_SUFFIX(LAPACKE_dlaswp_work). For now disable * the buggy Nan check. * See forum: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?t=4827 *****************************************************************************/ - /* if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) { + /* if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, lda, n, a, lda ) ) { * return -3; * } */ } #endif - return LAPACKE_zlaswp_work( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); + return API_SUFFIX(LAPACKE_zlaswp_work)( matrix_layout, n, a, lda, k1, k2, ipiv, incx ); } diff --git a/LAPACKE/src/lapacke_zlaswp_work.c b/LAPACKE/src/lapacke_zlaswp_work.c index 573fe9e9b5..76d21b33d2 100644 --- a/LAPACKE/src/lapacke_zlaswp_work.c +++ b/LAPACKE/src/lapacke_zlaswp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlaswp_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlaswp_work)( int matrix_layout, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) @@ -54,7 +54,7 @@ lapack_int LAPACKE_zlaswp_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_zlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaswp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -65,21 +65,21 @@ lapack_int LAPACKE_zlaswp_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, lda_t, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, lda_t, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaswp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlaswp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlaswp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlatms.c b/LAPACKE/src/lapacke_zlatms.c index c5fc346b67..5fa3d0dc4c 100644 --- a/LAPACKE/src/lapacke_zlatms.c +++ b/LAPACKE/src/lapacke_zlatms.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlatms( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlatms)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, double* d, lapack_int mode, double cond, double dmax, lapack_int kl, lapack_int ku, char pack, @@ -41,22 +41,22 @@ lapack_int LAPACKE_zlatms( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlatms", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlatms", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -14; } - if( LAPACKE_d_nancheck( 1, &cond, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &cond, 1 ) ) { return -9; } - if( LAPACKE_d_nancheck( MIN(n,m), d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( MIN(n,m), d, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &dmax, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &dmax, 1 ) ) { return -10; } } @@ -69,13 +69,13 @@ lapack_int LAPACKE_zlatms( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zlatms_work( matrix_layout, m, n, dist, iseed, sym, d, mode, + info = API_SUFFIX(LAPACKE_zlatms_work)( matrix_layout, m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlatms", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlatms", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlatms_work.c b/LAPACKE/src/lapacke_zlatms_work.c index 1677896bee..0576a1aaf2 100644 --- a/LAPACKE/src/lapacke_zlatms_work.c +++ b/LAPACKE/src/lapacke_zlatms_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlatms_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlatms_work)( int matrix_layout, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, double* d, lapack_int mode, double cond, double dmax, lapack_int kl, lapack_int ku, @@ -53,7 +53,7 @@ lapack_int LAPACKE_zlatms_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlatms_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -64,7 +64,7 @@ lapack_int LAPACKE_zlatms_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a_t, &lda_t, work, &info ); @@ -72,16 +72,16 @@ lapack_int LAPACKE_zlatms_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlatms_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlatms_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlatms_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zlauum.c b/LAPACKE/src/lapacke_zlauum.c index 3f081f3c7a..2bbef1365e 100644 --- a/LAPACKE/src/lapacke_zlauum.c +++ b/LAPACKE/src/lapacke_zlauum.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlauum( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlauum)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zlauum", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlauum", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zlauum_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_zlauum_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_zlauum_work.c b/LAPACKE/src/lapacke_zlauum_work.c index c4e64dfaa7..16d38dd7ac 100644 --- a/LAPACKE/src/lapacke_zlauum_work.c +++ b/LAPACKE/src/lapacke_zlauum_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zlauum_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zlauum_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_zlauum_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlauum_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_zlauum_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zlauum( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlauum_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zlauum_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zlauum_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbcon.c b/LAPACKE/src/lapacke_zpbcon.c index fe6f218fdb..3d709fb6fd 100644 --- a/LAPACKE/src/lapacke_zpbcon.c +++ b/LAPACKE/src/lapacke_zpbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbcon)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_zpbcon( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_zpbcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zpbcon_work( matrix_layout, uplo, n, kd, ab, ldab, anorm, + info = API_SUFFIX(LAPACKE_zpbcon_work)( matrix_layout, uplo, n, kd, ab, ldab, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_zpbcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbcon_work.c b/LAPACKE/src/lapacke_zpbcon_work.c index 8d05985a52..2df50ba9fd 100644 --- a/LAPACKE/src/lapacke_zpbcon_work.c +++ b/LAPACKE/src/lapacke_zpbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbcon_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double anorm, double* rcond, lapack_complex_double* work, double* rwork ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_zpbcon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_zpbcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbcon( &uplo, &n, &kd, ab_t, &ldab_t, &anorm, rcond, work, rwork, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_zpbcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbequ.c b/LAPACKE/src/lapacke_zpbequ.c index eceb7071d6..fc0a27bd53 100644 --- a/LAPACKE/src/lapacke_zpbequ.c +++ b/LAPACKE/src/lapacke_zpbequ.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbequ)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_zpbequ_work( matrix_layout, uplo, n, kd, ab, ldab, s, scond, + return API_SUFFIX(LAPACKE_zpbequ_work)( matrix_layout, uplo, n, kd, ab, ldab, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_zpbequ_work.c b/LAPACKE/src/lapacke_zpbequ_work.c index 59d9449fe6..fbf1256501 100644 --- a/LAPACKE/src/lapacke_zpbequ_work.c +++ b/LAPACKE/src/lapacke_zpbequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbequ_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double* s, double* scond, double* amax ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zpbequ_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zpbequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbequ( &uplo, &n, &kd, ab_t, &ldab_t, s, scond, amax, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_zpbequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbrfs.c b/LAPACKE/src/lapacke_zpbrfs.c index d6702ab239..1b456a8d7b 100644 --- a/LAPACKE/src/lapacke_zpbrfs.c +++ b/LAPACKE/src/lapacke_zpbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* afb, lapack_int ldafb, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zpbrfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zpbrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zpbrfs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, + info = API_SUFFIX(LAPACKE_zpbrfs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -86,7 +86,7 @@ lapack_int LAPACKE_zpbrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbrfs_work.c b/LAPACKE/src/lapacke_zpbrfs_work.c index f5539608e2..2cc2cddaea 100644 --- a/LAPACKE/src/lapacke_zpbrfs_work.c +++ b/LAPACKE/src/lapacke_zpbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, @@ -63,22 +63,22 @@ lapack_int LAPACKE_zpbrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); return info; } if( ldafb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,11 +110,11 @@ lapack_int LAPACKE_zpbrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbrfs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, @@ -123,7 +123,7 @@ lapack_int LAPACKE_zpbrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -134,11 +134,11 @@ lapack_int LAPACKE_zpbrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbstf.c b/LAPACKE/src/lapacke_zpbstf.c index 32d199b8ff..93fd39b09a 100644 --- a/LAPACKE/src/lapacke_zpbstf.c +++ b/LAPACKE/src/lapacke_zpbstf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbstf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbstf)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, lapack_complex_double* bb, lapack_int ldbb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbstf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbstf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kb, bb, ldbb ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kb, bb, ldbb ) ) { return -5; } } #endif - return LAPACKE_zpbstf_work( matrix_layout, uplo, n, kb, bb, ldbb ); + return API_SUFFIX(LAPACKE_zpbstf_work)( matrix_layout, uplo, n, kb, bb, ldbb ); } diff --git a/LAPACKE/src/lapacke_zpbstf_work.c b/LAPACKE/src/lapacke_zpbstf_work.c index 50a951a5f5..8b77947b8f 100644 --- a/LAPACKE/src/lapacke_zpbstf_work.c +++ b/LAPACKE/src/lapacke_zpbstf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbstf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbstf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kb, lapack_complex_double* bb, lapack_int ldbb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zpbstf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldbb < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbstf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_zpbstf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbstf( &uplo, &n, &kb, bb_t, &ldbb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, + API_SUFFIX(LAPACKE_zpb_trans)( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); /* Release memory and exit */ LAPACKE_free( bb_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbstf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbstf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbstf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbsv.c b/LAPACKE/src/lapacke_zpbsv.c index 681f01cdfc..5f673fa44d 100644 --- a/LAPACKE/src/lapacke_zpbsv.c +++ b/LAPACKE/src/lapacke_zpbsv.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbsv)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zpbsv_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_zpbsv_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpbsv_work.c b/LAPACKE/src/lapacke_zpbsv_work.c index 4625c0e88a..c8ca2d22b2 100644 --- a/LAPACKE/src/lapacke_zpbsv_work.c +++ b/LAPACKE/src/lapacke_zpbsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zpbsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zpbsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbsv( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -84,20 +84,20 @@ lapack_int LAPACKE_zpbsv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbsvx.c b/LAPACKE/src/lapacke_zpbsvx.c index ee5549f657..a1a5be262c 100644 --- a/LAPACKE/src/lapacke_zpbsvx.c +++ b/LAPACKE/src/lapacke_zpbsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, lapack_int ldafb, @@ -45,25 +45,25 @@ lapack_int LAPACKE_zpbsvx( int matrix_layout, char fact, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, afb, ldafb ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, afb, ldafb ) ) { return -9; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -12; } } @@ -82,7 +82,7 @@ lapack_int LAPACKE_zpbsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zpbsvx_work( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, + info = API_SUFFIX(LAPACKE_zpbsvx_work)( matrix_layout, fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -91,7 +91,7 @@ lapack_int LAPACKE_zpbsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbsvx_work.c b/LAPACKE/src/lapacke_zpbsvx_work.c index 946f914b46..e382e7022c 100644 --- a/LAPACKE/src/lapacke_zpbsvx_work.c +++ b/LAPACKE/src/lapacke_zpbsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpbsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* afb, lapack_int ldafb, @@ -63,22 +63,22 @@ lapack_int LAPACKE_zpbsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); return info; } if( ldafb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,12 +110,12 @@ lapack_int LAPACKE_zpbsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, afb, ldafb, afb_t, ldafb_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbsvx( &fact, &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, afb_t, &ldafb_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, @@ -124,16 +124,16 @@ lapack_int LAPACKE_zpbsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, afb_t, ldafb_t, afb, ldafb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -144,11 +144,11 @@ lapack_int LAPACKE_zpbsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbtrf.c b/LAPACKE/src/lapacke_zpbtrf.c index 964968e527..825c59cc7e 100644 --- a/LAPACKE/src/lapacke_zpbtrf.c +++ b/LAPACKE/src/lapacke_zpbtrf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbtrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbtrf)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbtrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -5; } } #endif - return LAPACKE_zpbtrf_work( matrix_layout, uplo, n, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_zpbtrf_work)( matrix_layout, uplo, n, kd, ab, ldab ); } diff --git a/LAPACKE/src/lapacke_zpbtrf_work.c b/LAPACKE/src/lapacke_zpbtrf_work.c index 8d47cdb9db..95713cab0c 100644 --- a/LAPACKE/src/lapacke_zpbtrf_work.c +++ b/LAPACKE/src/lapacke_zpbtrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbtrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbtrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zpbtrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_zpbtrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbtrf( &uplo, &n, &kd, ab_t, &ldab_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, + API_SUFFIX(LAPACKE_zpb_trans)( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); /* Release memory and exit */ LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbtrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpbtrs.c b/LAPACKE/src/lapacke_zpbtrs.c index 8c9cda0895..0ccc7a8b00 100644 --- a/LAPACKE/src/lapacke_zpbtrs.c +++ b/LAPACKE/src/lapacke_zpbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbtrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbtrs)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_zpb_nancheck)( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zpbtrs_work( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, + return API_SUFFIX(LAPACKE_zpbtrs_work)( matrix_layout, uplo, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpbtrs_work.c b/LAPACKE/src/lapacke_zpbtrs_work.c index ebd9943a12..101966b1bf 100644 --- a/LAPACKE/src/lapacke_zpbtrs_work.c +++ b/LAPACKE/src/lapacke_zpbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpbtrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpbtrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* b, @@ -53,12 +53,12 @@ lapack_int LAPACKE_zpbtrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldab < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_zpbtrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpb_trans)( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_zpbtrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpftrf.c b/LAPACKE/src/lapacke_zpftrf.c index 4fd8523d72..4503697f89 100644 --- a/LAPACKE/src/lapacke_zpftrf.c +++ b/LAPACKE/src/lapacke_zpftrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftrf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftrf)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpftrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_zpftrf_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_zpftrf_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_zpftrf_work.c b/LAPACKE/src/lapacke_zpftrf_work.c index 489da172c0..efc780cc47 100644 --- a/LAPACKE/src/lapacke_zpftrf_work.c +++ b/LAPACKE/src/lapacke_zpftrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftrf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftrf_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_double* a ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zpftrf_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_zpftrf( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_zpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpftrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpftri.c b/LAPACKE/src/lapacke_zpftri.c index 6e814d7d3e..d57b698f50 100644 --- a/LAPACKE/src/lapacke_zpftri.c +++ b/LAPACKE/src/lapacke_zpftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftri( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftri)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, a ) ) { return -5; } } #endif - return LAPACKE_zpftri_work( matrix_layout, transr, uplo, n, a ); + return API_SUFFIX(LAPACKE_zpftri_work)( matrix_layout, transr, uplo, n, a ); } diff --git a/LAPACKE/src/lapacke_zpftri_work.c b/LAPACKE/src/lapacke_zpftri_work.c index c4bc00b8de..f7038632dc 100644 --- a/LAPACKE/src/lapacke_zpftri_work.c +++ b/LAPACKE/src/lapacke_zpftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftri_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_complex_double* a ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zpftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_zpftri( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); + API_SUFFIX(LAPACKE_zpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpftrs.c b/LAPACKE/src/lapacke_zpftrs.c index 824aab248f..42d0324dd9 100644 --- a/LAPACKE/src/lapacke_zpftrs.c +++ b/LAPACKE/src/lapacke_zpftrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftrs( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftrs)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpftrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpf_nancheck( n, a ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, a ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zpftrs_work( matrix_layout, transr, uplo, n, nrhs, a, b, + return API_SUFFIX(LAPACKE_zpftrs_work)( matrix_layout, transr, uplo, n, nrhs, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpftrs_work.c b/LAPACKE/src/lapacke_zpftrs_work.c index 5aaf0f5c1c..422d4801a4 100644 --- a/LAPACKE/src/lapacke_zpftrs_work.c +++ b/LAPACKE/src/lapacke_zpftrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpftrs_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_zpftrs_work)( int matrix_layout, char transr, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_complex_double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_zpftrs_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,26 +70,26 @@ lapack_int LAPACKE_zpftrs_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, a, a_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_zpftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpftrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpftrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpocon.c b/LAPACKE/src/lapacke_zpocon.c index fb676a767f..cba501bda9 100644 --- a/LAPACKE/src/lapacke_zpocon.c +++ b/LAPACKE/src/lapacke_zpocon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpocon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpocon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_zpocon( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpocon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpocon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_zpocon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zpocon_work( matrix_layout, uplo, n, a, lda, anorm, rcond, + info = API_SUFFIX(LAPACKE_zpocon_work)( matrix_layout, uplo, n, a, lda, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_zpocon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpocon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpocon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpocon_work.c b/LAPACKE/src/lapacke_zpocon_work.c index 558b99d039..09f528bd6e 100644 --- a/LAPACKE/src/lapacke_zpocon_work.c +++ b/LAPACKE/src/lapacke_zpocon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpocon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpocon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double anorm, double* rcond, lapack_complex_double* work, double* rwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zpocon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpocon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zpocon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpocon( &uplo, &n, a_t, &lda_t, &anorm, rcond, work, rwork, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_zpocon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpocon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpocon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpocon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpoequ.c b/LAPACKE/src/lapacke_zpoequ.c index 4fc645abe6..07ce40f177 100644 --- a/LAPACKE/src/lapacke_zpoequ.c +++ b/LAPACKE/src/lapacke_zpoequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpoequ( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpoequ)( int matrix_layout, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpoequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_zpoequ_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_zpoequ_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_zpoequ_work.c b/LAPACKE/src/lapacke_zpoequ_work.c index b1daf19216..2bb8f177fd 100644 --- a/LAPACKE/src/lapacke_zpoequ_work.c +++ b/LAPACKE/src/lapacke_zpoequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpoequ_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpoequ_work)( int matrix_layout, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zpoequ_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_zpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequ_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_zpoequ_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpoequ( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_zpoequ_work( int matrix_layout, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpoequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpoequb.c b/LAPACKE/src/lapacke_zpoequb.c index bacffa4bc8..84e0fc025f 100644 --- a/LAPACKE/src/lapacke_zpoequb.c +++ b/LAPACKE/src/lapacke_zpoequb.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpoequb( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpoequb)( int matrix_layout, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpoequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -3; } } #endif - return LAPACKE_zpoequb_work( matrix_layout, n, a, lda, s, scond, amax ); + return API_SUFFIX(LAPACKE_zpoequb_work)( matrix_layout, n, a, lda, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_zpoequb_work.c b/LAPACKE/src/lapacke_zpoequb_work.c index a7c68feffb..1355a0e203 100644 --- a/LAPACKE/src/lapacke_zpoequb_work.c +++ b/LAPACKE/src/lapacke_zpoequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpoequb_work( int matrix_layout, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpoequb_work)( int matrix_layout, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zpoequb_work( int matrix_layout, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -4; - LAPACKE_xerbla( "LAPACKE_zpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,7 +60,7 @@ lapack_int LAPACKE_zpoequb_work( int matrix_layout, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpoequb( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { @@ -70,11 +70,11 @@ lapack_int LAPACKE_zpoequb_work( int matrix_layout, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpoequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpoequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zporfs.c b/LAPACKE/src/lapacke_zporfs.c index abcb405dbd..df6f7b490e 100644 --- a/LAPACKE/src/lapacke_zporfs.c +++ b/LAPACKE/src/lapacke_zporfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zporfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zporfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_complex_double* b, @@ -43,22 +43,22 @@ lapack_int LAPACKE_zporfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zporfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -76,7 +76,7 @@ lapack_int LAPACKE_zporfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zporfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_zporfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_zporfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zporfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zporfs_work.c b/LAPACKE/src/lapacke_zporfs_work.c index 4717b5ba38..ac1bcb7a82 100644 --- a/LAPACKE/src/lapacke_zporfs_work.c +++ b/LAPACKE/src/lapacke_zporfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zporfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zporfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_complex_double* b, @@ -60,22 +60,22 @@ lapack_int LAPACKE_zporfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -106,10 +106,10 @@ lapack_int LAPACKE_zporfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zporfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -117,7 +117,7 @@ lapack_int LAPACKE_zporfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -128,11 +128,11 @@ lapack_int LAPACKE_zporfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zporfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zporfsx.c b/LAPACKE/src/lapacke_zporfsx.c index d27145f371..5f253a4296 100644 --- a/LAPACKE/src/lapacke_zporfsx.c +++ b/LAPACKE/src/lapacke_zporfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zporfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zporfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_zporfsx( int matrix_layout, char uplo, char equed, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zporfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -21; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -10; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -13; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zporfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zporfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zporfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zporfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zporfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zporfsx_work.c b/LAPACKE/src/lapacke_zporfsx_work.c index f6f4a606cb..f71cf47fdb 100644 --- a/LAPACKE/src/lapacke_zporfsx_work.c +++ b/LAPACKE/src/lapacke_zporfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zporfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zporfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, @@ -68,22 +68,22 @@ lapack_int LAPACKE_zporfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -126,10 +126,10 @@ lapack_int LAPACKE_zporfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zporfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, &n_err_bnds, @@ -139,10 +139,10 @@ lapack_int LAPACKE_zporfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -158,11 +158,11 @@ lapack_int LAPACKE_zporfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zporfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zporfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zposv.c b/LAPACKE/src/lapacke_zposv.c index 5f52c3fff6..d3e5ffe922 100644 --- a/LAPACKE/src/lapacke_zposv.c +++ b/LAPACKE/src/lapacke_zposv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zposv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zposv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zposv_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_zposv_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zposv_work.c b/LAPACKE/src/lapacke_zposv_work.c index 350cf575c0..b990b5f1b2 100644 --- a/LAPACKE/src/lapacke_zposv_work.c +++ b/LAPACKE/src/lapacke_zposv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zposv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zposv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposv_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,27 +75,27 @@ lapack_int LAPACKE_zposv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zposv( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zposv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zposvx.c b/LAPACKE/src/lapacke_zposvx.c index 256b116322..9cf2519d03 100644 --- a/LAPACKE/src/lapacke_zposvx.c +++ b/LAPACKE/src/lapacke_zposvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zposvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, char* equed, double* s, @@ -44,25 +44,25 @@ lapack_int LAPACKE_zposvx( int matrix_layout, char fact, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zposvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_zposvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zposvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zposvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_zposvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zposvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zposvx_work.c b/LAPACKE/src/lapacke_zposvx_work.c index 227109c102..e1b6b580d6 100644 --- a/LAPACKE/src/lapacke_zposvx_work.c +++ b/LAPACKE/src/lapacke_zposvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zposvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -62,22 +62,22 @@ lapack_int LAPACKE_zposvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -108,11 +108,11 @@ lapack_int LAPACKE_zposvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, @@ -121,15 +121,15 @@ lapack_int LAPACKE_zposvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -140,11 +140,11 @@ lapack_int LAPACKE_zposvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zposvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zposvxx.c b/LAPACKE/src/lapacke_zposvxx.c index 842dbf4ba0..8d5c3d7019 100644 --- a/LAPACKE/src/lapacke_zposvxx.c +++ b/LAPACKE/src/lapacke_zposvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zposvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -47,30 +47,30 @@ lapack_int LAPACKE_zposvxx( int matrix_layout, char fact, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zposvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -23; } } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } @@ -89,7 +89,7 @@ lapack_int LAPACKE_zposvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zposvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zposvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -99,7 +99,7 @@ lapack_int LAPACKE_zposvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zposvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zposvxx_work.c b/LAPACKE/src/lapacke_zposvxx_work.c index 1b2d3df52b..4c932b45dc 100644 --- a/LAPACKE/src/lapacke_zposvxx_work.c +++ b/LAPACKE/src/lapacke_zposvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zposvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zposvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_zposvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_zposvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr, @@ -141,18 +141,18 @@ lapack_int LAPACKE_zposvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -168,11 +168,11 @@ lapack_int LAPACKE_zposvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zposvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zposvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpotrf.c b/LAPACKE/src/lapacke_zpotrf.c index eef672e917..0e100c62a9 100644 --- a/LAPACKE/src/lapacke_zpotrf.c +++ b/LAPACKE/src/lapacke_zpotrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpotrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zpotrf_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_zpotrf_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_zpotrf2.c b/LAPACKE/src/lapacke_zpotrf2.c index 0aee853387..aaec221d46 100644 --- a/LAPACKE/src/lapacke_zpotrf2.c +++ b/LAPACKE/src/lapacke_zpotrf2.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrf2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrf2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpotrf2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zpotrf2_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_zpotrf2_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_zpotrf2_work.c b/LAPACKE/src/lapacke_zpotrf2_work.c index e0cf84abe0..60300e5fc6 100644 --- a/LAPACKE/src/lapacke_zpotrf2_work.c +++ b/LAPACKE/src/lapacke_zpotrf2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrf2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrf2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_zpotrf2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_zpotrf2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpotrf2( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpotrf2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpotrf_work.c b/LAPACKE/src/lapacke_zpotrf_work.c index 1d4c6990cd..a490213a9a 100644 --- a/LAPACKE/src/lapacke_zpotrf_work.c +++ b/LAPACKE/src/lapacke_zpotrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_zpotrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_zpotrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpotrf( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpotrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpotri.c b/LAPACKE/src/lapacke_zpotri.c index 05ff05eeb2..9af91455a4 100644 --- a/LAPACKE/src/lapacke_zpotri.c +++ b/LAPACKE/src/lapacke_zpotri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpotri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zpotri_work( matrix_layout, uplo, n, a, lda ); + return API_SUFFIX(LAPACKE_zpotri_work)( matrix_layout, uplo, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_zpotri_work.c b/LAPACKE/src/lapacke_zpotri_work.c index fe30a7d3cf..f98a8467f2 100644 --- a/LAPACKE/src/lapacke_zpotri_work.c +++ b/LAPACKE/src/lapacke_zpotri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda ) { lapack_int info = 0; @@ -48,7 +48,7 @@ lapack_int LAPACKE_zpotri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,23 +59,23 @@ lapack_int LAPACKE_zpotri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpotri( &uplo, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpotri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpotrs.c b/LAPACKE/src/lapacke_zpotrs.c index 797153256d..a2a8628348 100644 --- a/LAPACKE/src/lapacke_zpotrs.c +++ b/LAPACKE/src/lapacke_zpotrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpotrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zpotrs_work( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); + return API_SUFFIX(LAPACKE_zpotrs_work)( matrix_layout, uplo, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpotrs_work.c b/LAPACKE/src/lapacke_zpotrs_work.c index abfbf98ea6..d6e43a69c4 100644 --- a/LAPACKE/src/lapacke_zpotrs_work.c +++ b/LAPACKE/src/lapacke_zpotrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpotrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpotrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zpotrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrs_work", info ); return info; } if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,26 +75,26 @@ lapack_int LAPACKE_zpotrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpotrs( &uplo, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpotrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpotrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppcon.c b/LAPACKE/src/lapacke_zppcon.c index 285be70c30..4aba6651c3 100644 --- a/LAPACKE/src/lapacke_zppcon.c +++ b/LAPACKE/src/lapacke_zppcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, double anorm, double* rcond ) { @@ -40,16 +40,16 @@ lapack_int LAPACKE_zppcon( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zppcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -5; } - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } } @@ -67,7 +67,7 @@ lapack_int LAPACKE_zppcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zppcon_work( matrix_layout, uplo, n, ap, anorm, rcond, work, + info = API_SUFFIX(LAPACKE_zppcon_work)( matrix_layout, uplo, n, ap, anorm, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -75,7 +75,7 @@ lapack_int LAPACKE_zppcon( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppcon_work.c b/LAPACKE/src/lapacke_zppcon_work.c index eb4d7856bd..390feff62a 100644 --- a/LAPACKE/src/lapacke_zppcon_work.c +++ b/LAPACKE/src/lapacke_zppcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, double anorm, double* rcond, lapack_complex_double* work, double* rwork ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_zppcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zppcon( &uplo, &n, ap_t, &anorm, rcond, work, rwork, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_zppcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zppcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppequ.c b/LAPACKE/src/lapacke_zppequ.c index 1e333d5d59..1a31f832b0 100644 --- a/LAPACKE/src/lapacke_zppequ.c +++ b/LAPACKE/src/lapacke_zppequ.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppequ( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppequ)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, double* s, double* scond, double* amax ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zppequ", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppequ", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zppequ_work( matrix_layout, uplo, n, ap, s, scond, amax ); + return API_SUFFIX(LAPACKE_zppequ_work)( matrix_layout, uplo, n, ap, s, scond, amax ); } diff --git a/LAPACKE/src/lapacke_zppequ_work.c b/LAPACKE/src/lapacke_zppequ_work.c index bf14edd174..e4398b4e28 100644 --- a/LAPACKE/src/lapacke_zppequ_work.c +++ b/LAPACKE/src/lapacke_zppequ_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppequ_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppequ_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, double* s, double* scond, double* amax ) { @@ -54,7 +54,7 @@ lapack_int LAPACKE_zppequ_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zppequ( &uplo, &n, ap_t, s, scond, amax, &info ); if( info < 0 ) { @@ -64,11 +64,11 @@ lapack_int LAPACKE_zppequ_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppequ_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zppequ_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppequ_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpprfs.c b/LAPACKE/src/lapacke_zpprfs.c index 11f501b041..c8b891f87b 100644 --- a/LAPACKE/src/lapacke_zpprfs.c +++ b/LAPACKE/src/lapacke_zpprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, const lapack_complex_double* b, lapack_int ldb, @@ -43,22 +43,22 @@ lapack_int LAPACKE_zpprfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -9; } } @@ -76,7 +76,7 @@ lapack_int LAPACKE_zpprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zpprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, + info = API_SUFFIX(LAPACKE_zpprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -84,7 +84,7 @@ lapack_int LAPACKE_zpprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpprfs_work.c b/LAPACKE/src/lapacke_zpprfs_work.c index 1393d5d0ef..4709ae68a5 100644 --- a/LAPACKE/src/lapacke_zpprfs_work.c +++ b/LAPACKE/src/lapacke_zpprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, @@ -59,12 +59,12 @@ lapack_int LAPACKE_zpprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs_work", info ); return info; } if( ldx < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_zpprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_zpprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -108,7 +108,7 @@ lapack_int LAPACKE_zpprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -119,11 +119,11 @@ lapack_int LAPACKE_zpprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppsv.c b/LAPACKE/src/lapacke_zppsv.c index c4073fe792..e299106864 100644 --- a/LAPACKE/src/lapacke_zppsv.c +++ b/LAPACKE/src/lapacke_zppsv.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zppsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_zppsv_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_zppsv_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zppsv_work.c b/LAPACKE/src/lapacke_zppsv_work.c index 93e740ae33..1a67f1da23 100644 --- a/LAPACKE/src/lapacke_zppsv_work.c +++ b/LAPACKE/src/lapacke_zppsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_zppsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -69,27 +69,27 @@ lapack_int LAPACKE_zppsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zppsv( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zppsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppsvx.c b/LAPACKE/src/lapacke_zppsvx.c index 0bf8297526..0842f30249 100644 --- a/LAPACKE/src/lapacke_zppsvx.c +++ b/LAPACKE/src/lapacke_zppsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zppsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_complex_double* afp, char* equed, double* s, lapack_complex_double* b, lapack_int ldb, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zppsvx( int matrix_layout, char fact, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zppsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zpp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -9; } } @@ -80,7 +80,7 @@ lapack_int LAPACKE_zppsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zppsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_zppsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -89,7 +89,7 @@ lapack_int LAPACKE_zppsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zppsvx_work.c b/LAPACKE/src/lapacke_zppsvx_work.c index 2ef652358b..437cc90d20 100644 --- a/LAPACKE/src/lapacke_zppsvx_work.c +++ b/LAPACKE/src/lapacke_zppsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zppsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_complex_double* afp, char* equed, @@ -60,12 +60,12 @@ lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,10 +98,10 @@ lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zpp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_zppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t, @@ -111,13 +111,13 @@ lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -129,11 +129,11 @@ lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zppsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpptrf.c b/LAPACKE/src/lapacke_zpptrf.c index abe8ae40b4..c8c53ef6ba 100644 --- a/LAPACKE/src/lapacke_zpptrf.c +++ b/LAPACKE/src/lapacke_zpptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zpptrf_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_zpptrf_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_zpptrf_work.c b/LAPACKE/src/lapacke_zpptrf_work.c index 1d6ae2bb1d..504fe22963 100644 --- a/LAPACKE/src/lapacke_zpptrf_work.c +++ b/LAPACKE/src/lapacke_zpptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zpptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zpptrf( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpptri.c b/LAPACKE/src/lapacke_zpptri.c index 6e992e5219..1855c0d9f1 100644 --- a/LAPACKE/src/lapacke_zpptri.c +++ b/LAPACKE/src/lapacke_zpptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zpptri_work( matrix_layout, uplo, n, ap ); + return API_SUFFIX(LAPACKE_zpptri_work)( matrix_layout, uplo, n, ap ); } diff --git a/LAPACKE/src/lapacke_zpptri_work.c b/LAPACKE/src/lapacke_zpptri_work.c index 991d6357b3..9e7b8a6c9e 100644 --- a/LAPACKE/src/lapacke_zpptri_work.c +++ b/LAPACKE/src/lapacke_zpptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zpptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zpptri( &uplo, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpptrs.c b/LAPACKE/src/lapacke_zpptrs.c index c379b51efa..61c9489529 100644 --- a/LAPACKE/src/lapacke_zpptrs.c +++ b/LAPACKE/src/lapacke_zpptrs.c @@ -32,24 +32,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } } #endif - return LAPACKE_zpptrs_work( matrix_layout, uplo, n, nrhs, ap, b, ldb ); + return API_SUFFIX(LAPACKE_zpptrs_work)( matrix_layout, uplo, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpptrs_work.c b/LAPACKE/src/lapacke_zpptrs_work.c index 867417cd44..24aac47e5c 100644 --- a/LAPACKE/src/lapacke_zpptrs_work.c +++ b/LAPACKE/src/lapacke_zpptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_zpptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,26 +70,26 @@ lapack_int LAPACKE_zpptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zpptrs( &uplo, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpstrf.c b/LAPACKE/src/lapacke_zpstrf.c index dac94f5e50..777d99a518 100644 --- a/LAPACKE/src/lapacke_zpstrf.c +++ b/LAPACKE/src/lapacke_zpstrf.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpstrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpstrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* piv, lapack_int* rank, double tol ) { lapack_int info = 0; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpstrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpstrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpo_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zpo_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &tol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tol, 1 ) ) { return -8; } } @@ -60,13 +60,13 @@ lapack_int LAPACKE_zpstrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zpstrf_work( matrix_layout, uplo, n, a, lda, piv, rank, tol, + info = API_SUFFIX(LAPACKE_zpstrf_work)( matrix_layout, uplo, n, a, lda, piv, rank, tol, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpstrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpstrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpstrf_work.c b/LAPACKE/src/lapacke_zpstrf_work.c index a79a19d4ff..e9f76b5a4c 100644 --- a/LAPACKE/src/lapacke_zpstrf_work.c +++ b/LAPACKE/src/lapacke_zpstrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpstrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpstrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* piv, lapack_int* rank, double tol, double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zpstrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpstrf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zpstrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zpo_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zpstrf( &uplo, &n, a_t, &lda_t, piv, rank, &tol, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zpo_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpstrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpstrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpstrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptcon.c b/LAPACKE/src/lapacke_zptcon.c index f3b72dea05..e54caa0b93 100644 --- a/LAPACKE/src/lapacke_zptcon.c +++ b/LAPACKE/src/lapacke_zptcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptcon( lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_zptcon)( lapack_int n, const double* d, const lapack_complex_double* e, double anorm, double* rcond ) { @@ -41,13 +41,13 @@ lapack_int LAPACKE_zptcon( lapack_int n, const double* d, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -3; } } @@ -59,12 +59,12 @@ lapack_int LAPACKE_zptcon( lapack_int n, const double* d, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zptcon_work( n, d, e, anorm, rcond, work ); + info = API_SUFFIX(LAPACKE_zptcon_work)( n, d, e, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptcon_work.c b/LAPACKE/src/lapacke_zptcon_work.c index 6638cdc441..cdd84c0e5c 100644 --- a/LAPACKE/src/lapacke_zptcon_work.c +++ b/LAPACKE/src/lapacke_zptcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptcon_work( lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_zptcon_work)( lapack_int n, const double* d, const lapack_complex_double* e, double anorm, double* rcond, double* work ) { diff --git a/LAPACKE/src/lapacke_zpteqr.c b/LAPACKE/src/lapacke_zpteqr.c index ac55c13099..1195a4b171 100644 --- a/LAPACKE/src/lapacke_zpteqr.c +++ b/LAPACKE/src/lapacke_zpteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpteqr( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpteqr)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz ) { @@ -41,27 +41,27 @@ lapack_int LAPACKE_zpteqr( int matrix_layout, char compz, lapack_int n, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,4*n-4); @@ -73,12 +73,12 @@ lapack_int LAPACKE_zpteqr( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zpteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_zpteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpteqr_work.c b/LAPACKE/src/lapacke_zpteqr_work.c index 47bae4e796..4c8d2124e5 100644 --- a/LAPACKE/src/lapacke_zpteqr_work.c +++ b/LAPACKE/src/lapacke_zpteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpteqr_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz, double* work ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zpteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,8 +60,8 @@ lapack_int LAPACKE_zpteqr_work( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zpteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -69,16 +69,16 @@ lapack_int LAPACKE_zpteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptrfs.c b/LAPACKE/src/lapacke_zptrfs.c index 5e05c1b58c..cd243bbf1b 100644 --- a/LAPACKE/src/lapacke_zptrfs.c +++ b/LAPACKE/src/lapacke_zptrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zptrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, const double* df, const lapack_complex_double* ef, @@ -44,28 +44,28 @@ lapack_int LAPACKE_zptrfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zptrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -7; } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, ef, 1 ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -83,7 +83,7 @@ lapack_int LAPACKE_zptrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zptrfs_work( matrix_layout, uplo, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_zptrfs_work)( matrix_layout, uplo, n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -91,7 +91,7 @@ lapack_int LAPACKE_zptrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptrfs_work.c b/LAPACKE/src/lapacke_zptrfs_work.c index 29a561f87b..ca5b882fcd 100644 --- a/LAPACKE/src/lapacke_zptrfs_work.c +++ b/LAPACKE/src/lapacke_zptrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zptrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, const double* df, @@ -58,12 +58,12 @@ lapack_int LAPACKE_zptrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -82,8 +82,8 @@ lapack_int LAPACKE_zptrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zptrfs( &uplo, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -91,18 +91,18 @@ lapack_int LAPACKE_zptrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zptrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptsv.c b/LAPACKE/src/lapacke_zptsv.c index 4de2c96241..136e6c7fdd 100644 --- a/LAPACKE/src/lapacke_zptsv.c +++ b/LAPACKE/src/lapacke_zptsv.c @@ -32,27 +32,27 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptsv( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zptsv)( int matrix_layout, lapack_int n, lapack_int nrhs, double* d, lapack_complex_double* e, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zptsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -6; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -5; } } #endif - return LAPACKE_zptsv_work( matrix_layout, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_zptsv_work)( matrix_layout, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zptsv_work.c b/LAPACKE/src/lapacke_zptsv_work.c index d530af267a..ab3ee730ce 100644 --- a/LAPACKE/src/lapacke_zptsv_work.c +++ b/LAPACKE/src/lapacke_zptsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, +lapack_int API_SUFFIX(LAPACKE_zptsv_work)( int matrix_layout, lapack_int n, lapack_int nrhs, double* d, lapack_complex_double* e, lapack_complex_double* b, lapack_int ldb ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_zptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zptsv_work( int matrix_layout, lapack_int n, lapack_int nrhs, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zptsv( &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zptsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptsvx.c b/LAPACKE/src/lapacke_zptsvx.c index cbdf9ac763..875d23b63d 100644 --- a/LAPACKE/src/lapacke_zptsvx.c +++ b/LAPACKE/src/lapacke_zptsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptsvx( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zptsvx)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, double* df, lapack_complex_double* ef, @@ -44,28 +44,28 @@ lapack_int LAPACKE_zptsvx( int matrix_layout, char fact, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zptsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, df, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, df, 1 ) ) { return -7; } } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_z_nancheck( n-1, ef, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, ef, 1 ) ) { return -8; } } @@ -84,7 +84,7 @@ lapack_int LAPACKE_zptsvx( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zptsvx_work( matrix_layout, fact, n, nrhs, d, e, df, ef, b, + info = API_SUFFIX(LAPACKE_zptsvx_work)( matrix_layout, fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -92,7 +92,7 @@ lapack_int LAPACKE_zptsvx( int matrix_layout, char fact, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zptsvx_work.c b/LAPACKE/src/lapacke_zptsvx_work.c index ac1354097f..b4a16f35d3 100644 --- a/LAPACKE/src/lapacke_zptsvx_work.c +++ b/LAPACKE/src/lapacke_zptsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zptsvx_work( int matrix_layout, char fact, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zptsvx_work)( int matrix_layout, char fact, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, double* df, lapack_complex_double* ef, @@ -57,12 +57,12 @@ lapack_int LAPACKE_zptsvx_work( int matrix_layout, char fact, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_zptsvx_work( int matrix_layout, char fact, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, rwork, &info ); @@ -89,18 +89,18 @@ lapack_int LAPACKE_zptsvx_work( int matrix_layout, char fact, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zptsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zptsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zpttrf.c b/LAPACKE/src/lapacke_zpttrf.c index 7b9d45494e..2e02ac63c3 100644 --- a/LAPACKE/src/lapacke_zpttrf.c +++ b/LAPACKE/src/lapacke_zpttrf.c @@ -32,18 +32,18 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpttrf( lapack_int n, double* d, lapack_complex_double* e ) +lapack_int API_SUFFIX(LAPACKE_zpttrf)( lapack_int n, double* d, lapack_complex_double* e ) { #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -2; } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -3; } } #endif - return LAPACKE_zpttrf_work( n, d, e ); + return API_SUFFIX(LAPACKE_zpttrf_work)( n, d, e ); } diff --git a/LAPACKE/src/lapacke_zpttrf_work.c b/LAPACKE/src/lapacke_zpttrf_work.c index faf867a4eb..089e3db77b 100644 --- a/LAPACKE/src/lapacke_zpttrf_work.c +++ b/LAPACKE/src/lapacke_zpttrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpttrf_work( lapack_int n, double* d, +lapack_int API_SUFFIX(LAPACKE_zpttrf_work)( lapack_int n, double* d, lapack_complex_double* e ) { lapack_int info = 0; diff --git a/LAPACKE/src/lapacke_zpttrs.c b/LAPACKE/src/lapacke_zpttrs.c index 14a42672b0..a307f27649 100644 --- a/LAPACKE/src/lapacke_zpttrs.c +++ b/LAPACKE/src/lapacke_zpttrs.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpttrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpttrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zpttrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpttrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_z_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ) ) { return -6; } } #endif - return LAPACKE_zpttrs_work( matrix_layout, uplo, n, nrhs, d, e, b, ldb ); + return API_SUFFIX(LAPACKE_zpttrs_work)( matrix_layout, uplo, n, nrhs, d, e, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zpttrs_work.c b/LAPACKE/src/lapacke_zpttrs_work.c index 5a7c2650fb..ba8d1cda97 100644 --- a/LAPACKE/src/lapacke_zpttrs_work.c +++ b/LAPACKE/src/lapacke_zpttrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zpttrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zpttrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const double* d, const lapack_complex_double* e, lapack_complex_double* b, lapack_int ldb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zpttrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpttrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,23 +62,23 @@ lapack_int LAPACKE_zpttrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zpttrs( &uplo, &n, &nrhs, d, e, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpttrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zpttrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zpttrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zspcon.c b/LAPACKE/src/lapacke_zspcon.c index 25c2a1f587..7f438b07f1 100644 --- a/LAPACKE/src/lapacke_zspcon.c +++ b/LAPACKE/src/lapacke_zspcon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspcon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zspcon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zspcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -6; } - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -4; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_zspcon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zspcon_work( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, + info = API_SUFFIX(LAPACKE_zspcon_work)( matrix_layout, uplo, n, ap, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zspcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zspcon_work.c b/LAPACKE/src/lapacke_zspcon_work.c index 8cb520cf36..8801ee9a2c 100644 --- a/LAPACKE/src/lapacke_zspcon_work.c +++ b/LAPACKE/src/lapacke_zspcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspcon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zspcon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_int* ipiv, double anorm, double* rcond, lapack_complex_double* work ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_zspcon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zspcon( &uplo, &n, ap_t, ipiv, &anorm, rcond, work, &info ); if( info < 0 ) { @@ -65,11 +65,11 @@ lapack_int LAPACKE_zspcon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zspcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsprfs.c b/LAPACKE/src/lapacke_zsprfs.c index 0f55ffa57c..b92b61fc96 100644 --- a/LAPACKE/src/lapacke_zsprfs.c +++ b/LAPACKE/src/lapacke_zsprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsprfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsprfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zsprfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, afp ) ) { return -6; } - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zsprfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zsprfs_work( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, + info = API_SUFFIX(LAPACKE_zsprfs_work)( matrix_layout, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_zsprfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsprfs_work.c b/LAPACKE/src/lapacke_zsprfs_work.c index 633aed68f2..23bd66dded 100644 --- a/LAPACKE/src/lapacke_zsprfs_work.c +++ b/LAPACKE/src/lapacke_zsprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsprfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsprfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* afp, @@ -60,12 +60,12 @@ lapack_int LAPACKE_zsprfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -98,10 +98,10 @@ lapack_int LAPACKE_zsprfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); - LAPACKE_zsp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_zsprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -109,7 +109,7 @@ lapack_int LAPACKE_zsprfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: @@ -120,11 +120,11 @@ lapack_int LAPACKE_zsprfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zspsv.c b/LAPACKE/src/lapacke_zspsv.c index 89cf95ccfa..03a3ea3f34 100644 --- a/LAPACKE/src/lapacke_zspsv.c +++ b/LAPACKE/src/lapacke_zspsv.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspsv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zspsv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zspsv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zspsv_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_zspsv_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zspsv_work.c b/LAPACKE/src/lapacke_zspsv_work.c index 819f2b665e..79706bee9e 100644 --- a/LAPACKE/src/lapacke_zspsv_work.c +++ b/LAPACKE/src/lapacke_zspsv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspsv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zspsv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_zspsv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,27 +70,27 @@ lapack_int LAPACKE_zspsv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zspsv( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); - LAPACKE_zsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zspsv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zspsvx.c b/LAPACKE/src/lapacke_zspsvx.c index 025a121962..33a2721b0a 100644 --- a/LAPACKE/src/lapacke_zspsvx.c +++ b/LAPACKE/src/lapacke_zspsvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspsvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zspsvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* afp, lapack_int* ipiv, const lapack_complex_double* b, lapack_int ldb, @@ -43,21 +43,21 @@ lapack_int LAPACKE_zspsvx( int matrix_layout, char fact, char uplo, lapack_int n double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zspsvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zsp_nancheck( n, afp ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, afp ) ) { return -7; } } - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } @@ -75,7 +75,7 @@ lapack_int LAPACKE_zspsvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zspsvx_work( matrix_layout, fact, uplo, n, nrhs, ap, afp, + info = API_SUFFIX(LAPACKE_zspsvx_work)( matrix_layout, fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -84,7 +84,7 @@ lapack_int LAPACKE_zspsvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zspsvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zspsvx_work.c b/LAPACKE/src/lapacke_zspsvx_work.c index 4f986f58fd..5c034d66d7 100644 --- a/LAPACKE/src/lapacke_zspsvx_work.c +++ b/LAPACKE/src/lapacke_zspsvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zspsvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zspsvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* afp, lapack_int* ipiv, @@ -59,12 +59,12 @@ lapack_int LAPACKE_zspsvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -97,10 +97,10 @@ lapack_int LAPACKE_zspsvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zsp_trans( matrix_layout, uplo, n, afp, afp_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_zspsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, @@ -109,9 +109,9 @@ lapack_int LAPACKE_zspsvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zsp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zsp_trans)( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); @@ -123,11 +123,11 @@ lapack_int LAPACKE_zspsvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zspsvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zspsvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsptrf.c b/LAPACKE/src/lapacke_zsptrf.c index 70356d3410..1fcf9e4fcf 100644 --- a/LAPACKE/src/lapacke_zsptrf.c +++ b/LAPACKE/src/lapacke_zsptrf.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, lapack_int* ipiv ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsptrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_zsptrf_work( matrix_layout, uplo, n, ap, ipiv ); + return API_SUFFIX(LAPACKE_zsptrf_work)( matrix_layout, uplo, n, ap, ipiv ); } diff --git a/LAPACKE/src/lapacke_zsptrf_work.c b/LAPACKE/src/lapacke_zsptrf_work.c index 3823e89427..c8ae5ba91c 100644 --- a/LAPACKE/src/lapacke_zsptrf_work.c +++ b/LAPACKE/src/lapacke_zsptrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, lapack_int* ipiv ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_zsptrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zsptrf( &uplo, &n, ap_t, ipiv, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsptrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsptri.c b/LAPACKE/src/lapacke_zsptri.c index 7bb4734532..022c4a7ec8 100644 --- a/LAPACKE/src/lapacke_zsptri.c +++ b/LAPACKE/src/lapacke_zsptri.c @@ -32,19 +32,19 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -4; } } @@ -57,12 +57,12 @@ lapack_int LAPACKE_zsptri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsptri_work( matrix_layout, uplo, n, ap, ipiv, work ); + info = API_SUFFIX(LAPACKE_zsptri_work)( matrix_layout, uplo, n, ap, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsptri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsptri_work.c b/LAPACKE/src/lapacke_zsptri_work.c index 231026ad77..04f731c475 100644 --- a/LAPACKE/src/lapacke_zsptri_work.c +++ b/LAPACKE/src/lapacke_zsptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* ap, const lapack_int* ipiv, lapack_complex_double* work ) @@ -55,23 +55,23 @@ lapack_int LAPACKE_zsptri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zsptri( &uplo, &n, ap_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zsp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsptrs.c b/LAPACKE/src/lapacke_zsptrs.c index 5e99f48d96..7b55aeaf67 100644 --- a/LAPACKE/src/lapacke_zsptrs.c +++ b/LAPACKE/src/lapacke_zsptrs.c @@ -32,25 +32,25 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zsp_nancheck)( n, ap ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -7; } } #endif - return LAPACKE_zsptrs_work( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); + return API_SUFFIX(LAPACKE_zsptrs_work)( matrix_layout, uplo, n, nrhs, ap, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zsptrs_work.c b/LAPACKE/src/lapacke_zsptrs_work.c index 9bea788d3d..166b6989b5 100644 --- a/LAPACKE/src/lapacke_zsptrs_work.c +++ b/LAPACKE/src/lapacke_zsptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsptrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsptrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_int* ipiv, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zsptrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,26 +71,26 @@ lapack_int LAPACKE_zsptrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zsptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstedc.c b/LAPACKE/src/lapacke_zstedc.c index 29f2ca56cc..3e056521c4 100644 --- a/LAPACKE/src/lapacke_zstedc.c +++ b/LAPACKE/src/lapacke_zstedc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zstedc)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz ) { @@ -47,27 +47,27 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, double rwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zstedc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstedc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zstedc_work( matrix_layout, compz, n, d, e, z, ldz, + info = API_SUFFIX(LAPACKE_zstedc_work)( matrix_layout, compz, n, d, e, z, ldz, &work_query, lwork, &rwork_query, lrwork, &iwork_query, liwork ); if( info != 0 ) { @@ -94,7 +94,7 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zstedc_work( matrix_layout, compz, n, d, e, z, ldz, work, + info = API_SUFFIX(LAPACKE_zstedc_work)( matrix_layout, compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -104,7 +104,7 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstedc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstedc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstedc_work.c b/LAPACKE/src/lapacke_zstedc_work.c index 3c6a07f19f..a12e9b6ddb 100644 --- a/LAPACKE/src/lapacke_zstedc_work.c +++ b/LAPACKE/src/lapacke_zstedc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstedc_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zstedc_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz, lapack_complex_double* work, lapack_int lwork, double* rwork, @@ -53,7 +53,7 @@ lapack_int LAPACKE_zstedc_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstedc_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_zstedc_work( int matrix_layout, char compz, lapack_int n, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -73,8 +73,8 @@ lapack_int LAPACKE_zstedc_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, rwork, @@ -83,20 +83,20 @@ lapack_int LAPACKE_zstedc_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstedc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zstedc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstedc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstegr.c b/LAPACKE/src/lapacke_zstegr.c index d744040441..7b124b7749 100644 --- a/LAPACKE/src/lapacke_zstegr.c +++ b/LAPACKE/src/lapacke_zstegr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zstegr)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -47,35 +47,35 @@ lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zstegr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstegr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &abstol, 1 ) ) { return -11; } - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } } - if( LAPACKE_lsame( range, 'v' ) ) { - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( range, 'v' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_zstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -95,7 +95,7 @@ lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zstegr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_zstegr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -104,7 +104,7 @@ lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstegr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstegr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstegr_work.c b/LAPACKE/src/lapacke_zstegr_work.c index a2de0f62b7..ca1d1d5044 100644 --- a/LAPACKE/src/lapacke_zstegr_work.c +++ b/LAPACKE/src/lapacke_zstegr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstegr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zstegr_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, @@ -54,9 +54,9 @@ lapack_int LAPACKE_zstegr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); lapack_complex_double* z_t = NULL; /* Check leading dimension(s) */ - if( ( LAPACKE_lsame( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { + if( ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ( ldz < ldz_t ) ) || ( ldz < 1 ) ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstegr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_zstegr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { /* Let be always 'n' instead of 'm' */ z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * @@ -85,20 +85,20 @@ lapack_int LAPACKE_zstegr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, *m, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstegr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zstegr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstegr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstein.c b/LAPACKE/src/lapacke_zstein.c index ccad9fc385..2100e834a0 100644 --- a/LAPACKE/src/lapacke_zstein.c +++ b/LAPACKE/src/lapacke_zstein.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstein( int matrix_layout, lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_zstein)( int matrix_layout, lapack_int n, const double* d, const double* e, lapack_int m, const double* w, const lapack_int* iblock, const lapack_int* isplit, lapack_complex_double* z, lapack_int ldz, @@ -42,19 +42,19 @@ lapack_int LAPACKE_zstein( int matrix_layout, lapack_int n, const double* d, lapack_int* iwork = NULL; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zstein", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstein", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -3; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n, w, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, w, 1 ) ) { return -6; } } @@ -71,7 +71,7 @@ lapack_int LAPACKE_zstein( int matrix_layout, lapack_int n, const double* d, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zstein_work( matrix_layout, n, d, e, m, w, iblock, isplit, z, + info = API_SUFFIX(LAPACKE_zstein_work)( matrix_layout, n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifailv ); /* Release memory and exit */ LAPACKE_free( work ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_zstein( int matrix_layout, lapack_int n, const double* d, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstein", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstein", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstein_work.c b/LAPACKE/src/lapacke_zstein_work.c index c651215767..e2fcae42c5 100644 --- a/LAPACKE/src/lapacke_zstein_work.c +++ b/LAPACKE/src/lapacke_zstein_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstein_work( int matrix_layout, lapack_int n, const double* d, +lapack_int API_SUFFIX(LAPACKE_zstein_work)( int matrix_layout, lapack_int n, const double* d, const double* e, lapack_int m, const double* w, const lapack_int* iblock, const lapack_int* isplit, @@ -54,7 +54,7 @@ lapack_int LAPACKE_zstein_work( int matrix_layout, lapack_int n, const double* d /* Check leading dimension(s) */ if( ldz < m ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstein_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -71,16 +71,16 @@ lapack_int LAPACKE_zstein_work( int matrix_layout, lapack_int n, const double* d info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, m, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstein_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zstein_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstein_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstemr.c b/LAPACKE/src/lapacke_zstemr.c index d64fb290cb..c068168092 100644 --- a/LAPACKE/src/lapacke_zstemr.c +++ b/LAPACKE/src/lapacke_zstemr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zstemr)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* m, double* w, lapack_complex_double* z, @@ -47,28 +47,28 @@ lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, lapack_int iwork_query; double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zstemr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstemr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -5; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vl, 1 ) ) { return -7; } - if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &vu, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_zstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, &work_query, lwork, &iwork_query, liwork ); if( info != 0 ) { @@ -88,7 +88,7 @@ lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il, + info = API_SUFFIX(LAPACKE_zstemr_work)( matrix_layout, jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -97,7 +97,7 @@ lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstemr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstemr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zstemr_work.c b/LAPACKE/src/lapacke_zstemr_work.c index b87018178b..eb4dee7cf3 100644 --- a/LAPACKE/src/lapacke_zstemr_work.c +++ b/LAPACKE/src/lapacke_zstemr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zstemr_work( int matrix_layout, char jobz, char range, +lapack_int API_SUFFIX(LAPACKE_zstemr_work)( int matrix_layout, char jobz, char range, lapack_int n, double* d, double* e, double vl, double vu, lapack_int il, lapack_int iu, lapack_int* m, double* w, @@ -55,9 +55,9 @@ lapack_int LAPACKE_zstemr_work( int matrix_layout, char jobz, char range, lapack_int ldz_t = MAX(1,n); lapack_complex_double* z_t = NULL; /* Check leading dimension(s) */ - if( ldz < 1 || ( LAPACKE_lsame( jobz, 'v' ) && ldz < n ) ) { + if( ldz < 1 || ( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) && ldz < n ) ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstemr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_zstemr_work( int matrix_layout, char jobz, char range, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -85,20 +85,20 @@ lapack_int LAPACKE_zstemr_work( int matrix_layout, char jobz, char range, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( jobz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstemr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zstemr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zstemr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsteqr.c b/LAPACKE/src/lapacke_zsteqr.c index 0337fe5ab9..8599a898b5 100644 --- a/LAPACKE/src/lapacke_zsteqr.c +++ b/LAPACKE/src/lapacke_zsteqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsteqr( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsteqr)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz ) { @@ -41,27 +41,27 @@ lapack_int LAPACKE_zsteqr( int matrix_layout, char compz, lapack_int n, lapack_int lwork; double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsteqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsteqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_d_nancheck( n, d, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) ) { return -4; } - if( LAPACKE_d_nancheck( n-1, e, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ) ) { return -5; } - if( LAPACKE_lsame( compz, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -6; } } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( compz, 'n' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) { lwork = 1; } else { lwork = MAX(1,2*n-2); @@ -73,12 +73,12 @@ lapack_int LAPACKE_zsteqr( int matrix_layout, char compz, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsteqr_work( matrix_layout, compz, n, d, e, z, ldz, work ); + info = API_SUFFIX(LAPACKE_zsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsteqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsteqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsteqr_work.c b/LAPACKE/src/lapacke_zsteqr_work.c index b4db37210e..c9dc772e42 100644 --- a/LAPACKE/src/lapacke_zsteqr_work.c +++ b/LAPACKE/src/lapacke_zsteqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsteqr_work( int matrix_layout, char compz, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsteqr_work)( int matrix_layout, char compz, lapack_int n, double* d, double* e, lapack_complex_double* z, lapack_int ldz, double* work ) { @@ -49,11 +49,11 @@ lapack_int LAPACKE_zsteqr_work( int matrix_layout, char compz, lapack_int n, /* Check leading dimension(s) */ if( ldz < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { z_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); @@ -63,8 +63,8 @@ lapack_int LAPACKE_zsteqr_work( int matrix_layout, char compz, lapack_int n, } } /* Transpose input matrices */ - if( LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_zsteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); @@ -72,20 +72,20 @@ lapack_int LAPACKE_zsteqr_work( int matrix_layout, char compz, lapack_int n, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ - if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compz, 'i' ) || API_SUFFIX(LAPACKE_lsame)( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsteqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsteqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsteqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsycon.c b/LAPACKE/src/lapacke_zsycon.c index 22c07e9de3..e0966f4521 100644 --- a/LAPACKE/src/lapacke_zsycon.c +++ b/LAPACKE/src/lapacke_zsycon.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsycon( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsycon)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsycon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -7; } } @@ -61,13 +61,13 @@ lapack_int LAPACKE_zsycon( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsycon_work( matrix_layout, uplo, n, a, lda, ipiv, anorm, + info = API_SUFFIX(LAPACKE_zsycon_work)( matrix_layout, uplo, n, a, lda, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsycon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsycon_3.c b/LAPACKE/src/lapacke_zsycon_3.c index c7d22234db..b144a90863 100644 --- a/LAPACKE/src/lapacke_zsycon_3.c +++ b/LAPACKE/src/lapacke_zsycon_3.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsycon_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsycon_3)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, double anorm, double* rcond ) { lapack_int info = 0; lapack_complex_double* work = NULL; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsycon_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } - if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &anorm, 1 ) ) { return -8; } } @@ -66,13 +66,13 @@ lapack_int LAPACKE_zsycon_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + info = API_SUFFIX(LAPACKE_zsycon_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, rcond, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsycon_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsycon_3_work.c b/LAPACKE/src/lapacke_zsycon_3_work.c index 7dbf7f9a99..5911a1e277 100644 --- a/LAPACKE/src/lapacke_zsycon_3_work.c +++ b/LAPACKE/src/lapacke_zsycon_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsycon_3_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, double anorm, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,7 +62,7 @@ lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, &info ); @@ -73,11 +73,11 @@ lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsycon_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsycon_work.c b/LAPACKE/src/lapacke_zsycon_work.c index 1a2c7b4c2f..947fbe369e 100644 --- a/LAPACKE/src/lapacke_zsycon_work.c +++ b/LAPACKE/src/lapacke_zsycon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsycon_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsycon_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, double anorm, double* rcond, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsycon_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zsycon_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsycon( &uplo, &n, a_t, &lda_t, ipiv, &anorm, rcond, work, &info ); @@ -72,11 +72,11 @@ lapack_int LAPACKE_zsycon_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsycon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsycon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyconv.c b/LAPACKE/src/lapacke_zsyconv.c index 58856b9584..6fc7989eb0 100644 --- a/LAPACKE/src/lapacke_zsyconv.c +++ b/LAPACKE/src/lapacke_zsyconv.c @@ -32,23 +32,23 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyconv( int matrix_layout, char uplo, char way, lapack_int n, +lapack_int API_SUFFIX(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* e ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsyconv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyconv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - return LAPACKE_zsyconv_work( matrix_layout, uplo, way, n, a, lda, ipiv, e ); + return API_SUFFIX(LAPACKE_zsyconv_work)( matrix_layout, uplo, way, n, a, lda, ipiv, e ); } diff --git a/LAPACKE/src/lapacke_zsyconv_work.c b/LAPACKE/src/lapacke_zsyconv_work.c index 776e834872..b97a8b430e 100644 --- a/LAPACKE/src/lapacke_zsyconv_work.c +++ b/LAPACKE/src/lapacke_zsyconv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, +lapack_int API_SUFFIX(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* e ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyconv_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, e, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyconv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyconv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyconv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyequb.c b/LAPACKE/src/lapacke_zsyequb.c index 5d8d109652..7c3bacedee 100644 --- a/LAPACKE/src/lapacke_zsyequb.c +++ b/LAPACKE/src/lapacke_zsyequb.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyequb( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyequb)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsyequb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyequb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_zsyequb( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsyequb_work( matrix_layout, uplo, n, a, lda, s, scond, amax, + info = API_SUFFIX(LAPACKE_zsyequb_work)( matrix_layout, uplo, n, a, lda, s, scond, amax, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyequb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyequb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyequb_work.c b/LAPACKE/src/lapacke_zsyequb_work.c index c306735287..d26fec8c05 100644 --- a/LAPACKE/src/lapacke_zsyequb_work.c +++ b/LAPACKE/src/lapacke_zsyequb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyequb_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyequb_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* s, double* scond, double* amax, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsyequb_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyequb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,7 +61,7 @@ lapack_int LAPACKE_zsyequb_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsyequb( &uplo, &n, a_t, &lda_t, s, scond, amax, work, &info ); if( info < 0 ) { @@ -71,11 +71,11 @@ lapack_int LAPACKE_zsyequb_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyequb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyequb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyequb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyr.c b/LAPACKE/src/lapacke_zsyr.c index c4bbe51c96..3703e60cd3 100644 --- a/LAPACKE/src/lapacke_zsyr.c +++ b/LAPACKE/src/lapacke_zsyr.c @@ -32,29 +32,29 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyr)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double alpha, const lapack_complex_double* x, lapack_int incx, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsyr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -7; } - if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, &alpha, 1 ) ) { return -4; } - if( LAPACKE_z_nancheck( n, x, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, x, 1 ) ) { return -5; } } #endif - return LAPACKE_zsyr_work( matrix_layout, uplo, n, alpha, x, incx, a, + return API_SUFFIX(LAPACKE_zsyr_work)( matrix_layout, uplo, n, alpha, x, incx, a, lda ); } diff --git a/LAPACKE/src/lapacke_zsyr_work.c b/LAPACKE/src/lapacke_zsyr_work.c index 743db8fb89..118e0a5ba1 100644 --- a/LAPACKE/src/lapacke_zsyr_work.c +++ b/LAPACKE/src/lapacke_zsyr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double alpha, const lapack_complex_double* x, lapack_int incx, lapack_complex_double* a, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zsyr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -62,21 +62,21 @@ lapack_int LAPACKE_zsyr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsyr( &uplo, &n, &alpha, x, &incx, a_t, &lda_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyrfs.c b/LAPACKE/src/lapacke_zsyrfs.c index 60cb9176ab..caa47b6413 100644 --- a/LAPACKE/src/lapacke_zsyrfs.c +++ b/LAPACKE/src/lapacke_zsyrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyrfs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyrfs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -44,22 +44,22 @@ lapack_int LAPACKE_zsyrfs( int matrix_layout, char uplo, lapack_int n, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_zsyrfs( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zsyrfs_work( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, + info = API_SUFFIX(LAPACKE_zsyrfs_work)( matrix_layout, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_zsyrfs( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyrfs_work.c b/LAPACKE/src/lapacke_zsyrfs_work.c index daf6cca028..6d530132ac 100644 --- a/LAPACKE/src/lapacke_zsyrfs_work.c +++ b/LAPACKE/src/lapacke_zsyrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyrfs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyrfs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, const lapack_int* ipiv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_zsyrfs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); return info; } if( ldaf < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -107,10 +107,10 @@ lapack_int LAPACKE_zsyrfs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zsyrfs( &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -118,7 +118,7 @@ lapack_int LAPACKE_zsyrfs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -129,11 +129,11 @@ lapack_int LAPACKE_zsyrfs_work( int matrix_layout, char uplo, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyrfsx.c b/LAPACKE/src/lapacke_zsyrfsx.c index 13479d7323..78092e0e81 100644 --- a/LAPACKE/src/lapacke_zsyrfsx.c +++ b/LAPACKE/src/lapacke_zsyrfsx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyrfsx( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zsyrfsx)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, lapack_int ldaf, @@ -47,32 +47,32 @@ lapack_int LAPACKE_zsyrfsx( int matrix_layout, char uplo, char equed, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfsx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -12; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -22; } } - if( LAPACKE_lsame( equed, 'y' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( equed, 'y' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -11; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -14; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zsyrfsx( int matrix_layout, char uplo, char equed, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zsyrfsx_work( matrix_layout, uplo, equed, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zsyrfsx_work)( matrix_layout, uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zsyrfsx( int matrix_layout, char uplo, char equed, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfsx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyrfsx_work.c b/LAPACKE/src/lapacke_zsyrfsx_work.c index 8d47f5cefa..d3113fcb69 100644 --- a/LAPACKE/src/lapacke_zsyrfsx_work.c +++ b/LAPACKE/src/lapacke_zsyrfsx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyrfsx_work( int matrix_layout, char uplo, char equed, +lapack_int API_SUFFIX(LAPACKE_zsyrfsx_work)( int matrix_layout, char uplo, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* af, @@ -70,22 +70,22 @@ lapack_int LAPACKE_zsyrfsx_work( int matrix_layout, char uplo, char equed, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); return info; } if( ldb < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); return info; } if( ldx < nrhs ) { info = -15; - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -128,10 +128,10 @@ lapack_int LAPACKE_zsyrfsx_work( int matrix_layout, char uplo, char equed, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zsyrfsx( &uplo, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, s, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, @@ -141,10 +141,10 @@ lapack_int LAPACKE_zsyrfsx_work( int matrix_layout, char uplo, char equed, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -160,11 +160,11 @@ lapack_int LAPACKE_zsyrfsx_work( int matrix_layout, char uplo, char equed, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyrfsx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyrfsx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv.c b/LAPACKE/src/lapacke_zsysv.c index 71ef168a83..88fbc23442 100644 --- a/LAPACKE/src/lapacke_zsysv.c +++ b/LAPACKE/src/lapacke_zsysv.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsysv( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysv", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zsysv( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsysv_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_aa.c b/LAPACKE/src/lapacke_zsysv_aa.c index ac9a75c2a4..eb605401e5 100644 --- a/LAPACKE/src/lapacke_zsysv_aa.c +++ b/LAPACKE/src/lapacke_zsysv_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsysv_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zsysv_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsysv_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_aa_2stage.c b/LAPACKE/src/lapacke_zsysv_aa_2stage.c index 05ee3f0189..debdd9e944 100644 --- a/LAPACKE/src/lapacke_zsysv_aa_2stage.c +++ b/LAPACKE/src/lapacke_zsysv_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ) @@ -42,25 +42,25 @@ lapack_int LAPACKE_zsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zsysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, &work_query, lwork ); if( info != 0 ) { @@ -75,14 +75,14 @@ lapack_int LAPACKE_zsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsysv_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zsysv_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_aa_2stage_work.c b/LAPACKE/src/lapacke_zsysv_aa_2stage_work.c index 37e8d6c254..acf3c2dd36 100644 --- a/LAPACKE/src/lapacke_zsysv_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zsysv_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb, @@ -56,17 +56,17 @@ lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -93,8 +93,8 @@ lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysv_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, work, @@ -103,8 +103,8 @@ lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -113,11 +113,11 @@ lapack_int LAPACKE_zsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_aa_work.c b/LAPACKE/src/lapacke_zsysv_aa_work.c index 637f6033ea..64a430a883 100644 --- a/LAPACKE/src/lapacke_zsysv_aa_work.c +++ b/LAPACKE/src/lapacke_zsysv_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysv_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zsysv_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysv_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_rk.c b/LAPACKE/src/lapacke_zsysv_rk.c index 137a3d26a5..1b5650b155 100644 --- a/LAPACKE/src/lapacke_zsysv_rk.c +++ b/LAPACKE/src/lapacke_zsysv_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_rk)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsysv_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zsysv_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + info = API_SUFFIX(LAPACKE_zsysv_rk_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_rk_work.c b/LAPACKE/src/lapacke_zsysv_rk_work.c index 349388a591..55f295d3f8 100644 --- a/LAPACKE/src/lapacke_zsysv_rk_work.c +++ b/LAPACKE/src/lapacke_zsysv_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_rook.c b/LAPACKE/src/lapacke_zsysv_rook.c index e24d53395b..0bdc4fb362 100644 --- a/LAPACKE/src/lapacke_zsysv_rook.c +++ b/LAPACKE/src/lapacke_zsysv_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsysv_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zsysv_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsysv_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsysv_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_rook_work.c b/LAPACKE/src/lapacke_zsysv_rook_work.c index b383ec4670..f1b3f4ba10 100644 --- a/LAPACKE/src/lapacke_zsysv_rook_work.c +++ b/LAPACKE/src/lapacke_zsysv_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zsysv_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zsysv_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysv_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -93,19 +93,19 @@ lapack_int LAPACKE_zsysv_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysv_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysv_work.c b/LAPACKE/src/lapacke_zsysv_work.c index eece455ce9..bb371d8ac7 100644 --- a/LAPACKE/src/lapacke_zsysv_work.c +++ b/LAPACKE/src/lapacke_zsysv_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysv_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysv_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zsysv_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zsysv_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -92,19 +92,19 @@ lapack_int LAPACKE_zsysv_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysv_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysv_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysvx.c b/LAPACKE/src/lapacke_zsysvx.c index abff21f160..050795b809 100644 --- a/LAPACKE/src/lapacke_zsysvx.c +++ b/LAPACKE/src/lapacke_zsysvx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysvx( int matrix_layout, char fact, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsysvx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, lapack_int* ipiv, @@ -46,21 +46,21 @@ lapack_int LAPACKE_zsysvx( int matrix_layout, char fact, char uplo, lapack_int n lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysvx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } @@ -72,7 +72,7 @@ lapack_int LAPACKE_zsysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zsysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zsysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, rwork ); if( info != 0 ) { @@ -87,7 +87,7 @@ lapack_int LAPACKE_zsysvx( int matrix_layout, char fact, char uplo, lapack_int n goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zsysvx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zsysvx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork ); /* Release memory and exit */ @@ -96,7 +96,7 @@ lapack_int LAPACKE_zsysvx( int matrix_layout, char fact, char uplo, lapack_int n LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysvx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysvx_work.c b/LAPACKE/src/lapacke_zsysvx_work.c index 44e88b13bb..7c5141723b 100644 --- a/LAPACKE/src/lapacke_zsysvx_work.c +++ b/LAPACKE/src/lapacke_zsysvx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysvx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zsysvx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -64,22 +64,22 @@ lapack_int LAPACKE_zsysvx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); return info; } if( ldx < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -117,11 +117,11 @@ lapack_int LAPACKE_zsysvx_work( int matrix_layout, char fact, char uplo, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, @@ -130,11 +130,11 @@ lapack_int LAPACKE_zsysvx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: @@ -145,11 +145,11 @@ lapack_int LAPACKE_zsysvx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysvx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysvxx.c b/LAPACKE/src/lapacke_zsysvxx.c index a39552e661..ad80139cd5 100644 --- a/LAPACKE/src/lapacke_zsysvxx.c +++ b/LAPACKE/src/lapacke_zsysvxx.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysvxx( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zsysvxx)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -48,30 +48,30 @@ lapack_int LAPACKE_zsysvxx( int matrix_layout, char fact, char uplo, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsysvxx", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -6; } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, af, ldaf ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, af, ldaf ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -13; } if( nparams>0 ) { - if( LAPACKE_d_nancheck( nparams, params, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( nparams, params, 1 ) ) { return -24; } } - if( LAPACKE_lsame( fact, 'f' ) ) { - if( LAPACKE_d_nancheck( n, s, 1 ) ) { + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( n, s, 1 ) ) { return -12; } } @@ -90,7 +90,7 @@ lapack_int LAPACKE_zsysvxx( int matrix_layout, char fact, char uplo, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_zsysvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af, + info = API_SUFFIX(LAPACKE_zsysvxx_work)( matrix_layout, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_zsysvxx( int matrix_layout, char fact, char uplo, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysvxx", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsysvxx_work.c b/LAPACKE/src/lapacke_zsysvxx_work.c index 31730a3431..8c168b4f4e 100644 --- a/LAPACKE/src/lapacke_zsysvxx_work.c +++ b/LAPACKE/src/lapacke_zsysvxx_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsysvxx_work( int matrix_layout, char fact, char uplo, +lapack_int API_SUFFIX(LAPACKE_zsysvxx_work)( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, @@ -69,22 +69,22 @@ lapack_int LAPACKE_zsysvxx_work( int matrix_layout, char fact, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); return info; } if( ldaf < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); return info; } if( ldb < nrhs ) { info = -14; - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); return info; } if( ldx < nrhs ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -127,11 +127,11 @@ lapack_int LAPACKE_zsysvxx_work( int matrix_layout, char fact, char uplo, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - if( LAPACKE_lsame( fact, 'f' ) ) { - LAPACKE_zsy_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) ) { + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsysvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, @@ -141,20 +141,20 @@ lapack_int LAPACKE_zsysvxx_work( int matrix_layout, char fact, char uplo, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } - if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, + if( API_SUFFIX(LAPACKE_lsame)( fact, 'e' ) || API_SUFFIX(LAPACKE_lsame)( fact, 'n' ) ) { + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } - if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( fact, 'f' ) && API_SUFFIX(LAPACKE_lsame)( *equed, 'y' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, n_err_bnds ); - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); @@ -170,11 +170,11 @@ lapack_int LAPACKE_zsysvxx_work( int matrix_layout, char fact, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsysvxx_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsysvxx_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsyswapr.c b/LAPACKE/src/lapacke_zsyswapr.c index 1af377bca0..874cea7de4 100644 --- a/LAPACKE/src/lapacke_zsyswapr.c +++ b/LAPACKE/src/lapacke_zsyswapr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyswapr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyswapr)( int matrix_layout, char uplo, lapack_int n, 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 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyswapr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif - return LAPACKE_zsyswapr_work( matrix_layout, uplo, n, a, lda, i1, i2 ); + return API_SUFFIX(LAPACKE_zsyswapr_work)( matrix_layout, uplo, n, a, lda, i1, i2 ); } diff --git a/LAPACKE/src/lapacke_zsyswapr_work.c b/LAPACKE/src/lapacke_zsyswapr_work.c index 22a5984bbb..b81e8ec4c5 100644 --- a/LAPACKE/src/lapacke_zsyswapr_work.c +++ b/LAPACKE/src/lapacke_zsyswapr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsyswapr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsyswapr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int i1, lapack_int i2 ) { @@ -54,21 +54,21 @@ lapack_int LAPACKE_zsyswapr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(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, &lda_t, &i1, &i2 ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyswapr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsyswapr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsyswapr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf.c b/LAPACKE/src/lapacke_zsytrf.c index daf980366e..fef1732095 100644 --- a/LAPACKE/src/lapacke_zsytrf.c +++ b/LAPACKE/src/lapacke_zsytrf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zsytrf( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrf_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zsytrf( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrf_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytrf_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_aa.c b/LAPACKE/src/lapacke_zsytrf_aa.c index aab51a50f7..c87ff57b09 100644 --- a/LAPACKE/src/lapacke_zsytrf_aa.c +++ b/LAPACKE/src/lapacke_zsytrf_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_aa)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zsytrf_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zsytrf_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrf_aa_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytrf_aa_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_aa_2stage.c b/LAPACKE/src/lapacke_zsytrf_aa_2stage.c index 4e61bdee6a..1b6a1bf79c 100644 --- a/LAPACKE/src/lapacke_zsytrf_aa_2stage.c +++ b/LAPACKE/src/lapacke_zsytrf_aa_2stage.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_zsytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, &work_query, lwork ); if( info != 0 ) { @@ -72,14 +72,14 @@ lapack_int LAPACKE_zsytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrf_aa_2stage_work( matrix_layout, uplo, n, + info = API_SUFFIX(LAPACKE_zsytrf_aa_2stage_work)( matrix_layout, uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_aa_2stage_work.c b/LAPACKE/src/lapacke_zsytrf_aa_2stage_work.c index 386a50ac1e..fe8baa4fd4 100644 --- a/LAPACKE/src/lapacke_zsytrf_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zsytrf_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrf_aa_2stage( &uplo, &n, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, work, @@ -90,18 +90,18 @@ lapack_int LAPACKE_zsytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( tb_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_aa_work.c b/LAPACKE/src/lapacke_zsytrf_aa_work.c index 7f09d29da2..699c46cf38 100644 --- a/LAPACKE/src/lapacke_zsytrf_aa_work.c +++ b/LAPACKE/src/lapacke_zsytrf_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytrf_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrf_aa( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrf_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_rk.c b/LAPACKE/src/lapacke_zsytrf_rk.c index f7a2afca80..faecb28096 100644 --- a/LAPACKE/src/lapacke_zsytrf_rk.c +++ b/LAPACKE/src/lapacke_zsytrf_rk.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_rk( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_rk)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zsytrf_rk( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rk", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rk", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_zsytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zsytrf_rk( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytrf_rk_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rk", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rk", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_rk_work.c b/LAPACKE/src/lapacke_zsytrf_rk_work.c index f9ce392062..0e1eaab3c7 100644 --- a/LAPACKE/src/lapacke_zsytrf_rk_work.c +++ b/LAPACKE/src/lapacke_zsytrf_rk_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_rk_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rk_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rk_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rk_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_rook.c b/LAPACKE/src/lapacke_zsytrf_rook.c index 7af47a0be6..9b6e5f3bc6 100644 --- a/LAPACKE/src/lapacke_zsytrf_rook.c +++ b/LAPACKE/src/lapacke_zsytrf_rook.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_rook)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zsytrf_rook( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zsytrf_rook( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrf_rook_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytrf_rook_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rook", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rook", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_rook_work.c b/LAPACKE/src/lapacke_zsytrf_rook_work.c index f9af65ca6c..cdcb05f338 100644 --- a/LAPACKE/src/lapacke_zsytrf_rook_work.c +++ b/LAPACKE/src/lapacke_zsytrf_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rook_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytrf_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrf_rook( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrf_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrf_work.c b/LAPACKE/src/lapacke_zsytrf_work.c index 273adbd570..2e1c41e2b7 100644 --- a/LAPACKE/src/lapacke_zsytrf_work.c +++ b/LAPACKE/src/lapacke_zsytrf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrf_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrf_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytrf_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytrf_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrf( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri.c b/LAPACKE/src/lapacke_zsytri.c index c9f6341938..44adb66caf 100644 --- a/LAPACKE/src/lapacke_zsytri.c +++ b/LAPACKE/src/lapacke_zsytri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,12 +58,12 @@ lapack_int LAPACKE_zsytri( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytri_work( matrix_layout, uplo, n, a, lda, ipiv, work ); + info = API_SUFFIX(LAPACKE_zsytri_work)( matrix_layout, uplo, n, a, lda, ipiv, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri2.c b/LAPACKE/src/lapacke_zsytri2.c index 4672151997..6f87982e92 100644 --- a/LAPACKE/src/lapacke_zsytri2.c +++ b/LAPACKE/src/lapacke_zsytri2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri2)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_zsytri2( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytri2_work( matrix_layout, uplo, n, a, lda, ipiv, + info = API_SUFFIX(LAPACKE_zsytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,13 +67,13 @@ lapack_int LAPACKE_zsytri2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytri2_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytri2_work)( matrix_layout, uplo, n, a, lda, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri2_work.c b/LAPACKE/src/lapacke_zsytri2_work.c index b22d41edb6..22a072d0b7 100644 --- a/LAPACKE/src/lapacke_zsytri2_work.c +++ b/LAPACKE/src/lapacke_zsytri2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri2_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytri2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytri2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytri2( &uplo, &n, a_t, &lda_t, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytri2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri2x.c b/LAPACKE/src/lapacke_zsytri2x.c index e510790b0c..b181e913bf 100644 --- a/LAPACKE/src/lapacke_zsytri2x.c +++ b/LAPACKE/src/lapacke_zsytri2x.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri2x( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri2x)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_int nb ) { lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2x", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2x", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } } @@ -58,13 +58,13 @@ lapack_int LAPACKE_zsytri2x( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytri2x_work( matrix_layout, uplo, n, a, lda, ipiv, work, + info = API_SUFFIX(LAPACKE_zsytri2x_work)( matrix_layout, uplo, n, a, lda, ipiv, work, nb ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2x", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2x", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri2x_work.c b/LAPACKE/src/lapacke_zsytri2x_work.c index c7b6727090..fd8e00c804 100644 --- a/LAPACKE/src/lapacke_zsytri2x_work.c +++ b/LAPACKE/src/lapacke_zsytri2x_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri2x_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri2x_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work, lapack_int nb ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytri2x_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2x_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zsytri2x_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytri2x( &uplo, &n, a_t, &lda_t, ipiv, work, &nb, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2x_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytri2x_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri2x_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri_3.c b/LAPACKE/src/lapacke_zsytri_3.c index 2a9f1bb798..23426041fa 100644 --- a/LAPACKE/src/lapacke_zsytri_3.c +++ b/LAPACKE/src/lapacke_zsytri_3.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri_3)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv ) { @@ -40,24 +40,24 @@ lapack_int LAPACKE_zsytri_3( int matrix_layout, char uplo, lapack_int n, lapack_int lwork = -1; lapack_complex_double* work = NULL; lapack_complex_double work_query; - lapack_int e_start = LAPACKE_lsame( uplo, 'U' ) ? 1 : 0; + lapack_int e_start = API_SUFFIX(LAPACKE_lsame)( uplo, 'U' ) ? 1 : 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytri_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, e + e_start, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, e + e_start, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + info = API_SUFFIX(LAPACKE_zsytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,12 +71,12 @@ lapack_int LAPACKE_zsytri_3( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + info = API_SUFFIX(LAPACKE_zsytri_3_work)( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri_3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri_3_work.c b/LAPACKE/src/lapacke_zsytri_3_work.c index 02caa21bda..a30cc6e740 100644 --- a/LAPACKE/src/lapacke_zsytri_3_work.c +++ b/LAPACKE/src/lapacke_zsytri_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, lapack_complex_double* work, lapack_int lwork) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytri_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_3_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zsytri_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytri_work.c b/LAPACKE/src/lapacke_zsytri_work.c index 2f869b9429..b9012ac791 100644 --- a/LAPACKE/src/lapacke_zsytri_work.c +++ b/LAPACKE/src/lapacke_zsytri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytri_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytri_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* work ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zsytri_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -61,23 +61,23 @@ lapack_int LAPACKE_zsytri_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytri( &uplo, &n, a_t, &lda_t, ipiv, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(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: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs.c b/LAPACKE/src/lapacke_zsytrs.c index d6fff75dae..ef82e58ebc 100644 --- a/LAPACKE/src/lapacke_zsytrs.c +++ b/LAPACKE/src/lapacke_zsytrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zsytrs_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_zsytrs_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zsytrs2.c b/LAPACKE/src/lapacke_zsytrs2.c index f1999d368e..4c5aac092b 100644 --- a/LAPACKE/src/lapacke_zsytrs2.c +++ b/LAPACKE/src/lapacke_zsytrs2.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs2)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } @@ -62,13 +62,13 @@ lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrs2_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsytrs2_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs2", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs2_work.c b/LAPACKE/src/lapacke_zsytrs2_work.c index c12c50fd8c..28b2419e7d 100644 --- a/LAPACKE/src/lapacke_zsytrs2_work.c +++ b/LAPACKE/src/lapacke_zsytrs2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs2_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,8 +77,8 @@ lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs2( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &info ); @@ -86,18 +86,18 @@ lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_3.c b/LAPACKE/src/lapacke_zsytrs_3.c index cce73232a6..fe3ec24567 100644 --- a/LAPACKE/src/lapacke_zsytrs_3.c +++ b/LAPACKE/src/lapacke_zsytrs_3.c @@ -32,30 +32,30 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_3( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_3)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( n, e ,1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n, e ,1 ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_zsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + return API_SUFFIX(LAPACKE_zsytrs_3_work)( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zsytrs_3_work.c b/LAPACKE/src/lapacke_zsytrs_3_work.c index 60c6390836..07d3a36069 100644 --- a/LAPACKE/src/lapacke_zsytrs_3_work.c +++ b/LAPACKE/src/lapacke_zsytrs_3_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_3_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* e, const lapack_int* ipiv, @@ -53,12 +53,12 @@ lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_3_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_aa.c b/LAPACKE/src/lapacke_zsytrs_aa.c index 617dcc1f7b..64da43a30d 100644 --- a/LAPACKE/src/lapacke_zsytrs_aa.c +++ b/LAPACKE/src/lapacke_zsytrs_aa.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_aa( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_aa)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zsytrs_aa( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_aa", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zsytrs_aa( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zsytrs_aa_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + info = API_SUFFIX(LAPACKE_zsytrs_aa_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_aa", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_aa_2stage.c b/LAPACKE/src/lapacke_zsytrs_aa_2stage.c index c62e2893b4..142d117a7d 100644 --- a/LAPACKE/src/lapacke_zsytrs_aa_2stage.c +++ b/LAPACKE/src/lapacke_zsytrs_aa_2stage.c @@ -32,32 +32,32 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_aa_2stage)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, 4*n, 1, tb, ltb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, 4*n, 1, tb, ltb ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -11; } } #endif /* Call middle-level interface */ - info = LAPACKE_zsytrs_aa_2stage_work( matrix_layout, uplo, n, nrhs, + info = API_SUFFIX(LAPACKE_zsytrs_aa_2stage_work)( matrix_layout, uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb ); return info; diff --git a/LAPACKE/src/lapacke_zsytrs_aa_2stage_work.c b/LAPACKE/src/lapacke_zsytrs_aa_2stage_work.c index a46fd59e85..233d415ce4 100644 --- a/LAPACKE/src/lapacke_zsytrs_aa_2stage_work.c +++ b/LAPACKE/src/lapacke_zsytrs_aa_2stage_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_aa_2stage_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ) @@ -54,17 +54,17 @@ lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage_work", info ); return info; } if( ltb < 4*n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage_work", info ); return info; } if( ldb < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs_aa_2stage( &uplo, &n, &nrhs, a_t, &lda_t, tb_t, <b, ipiv, ipiv2, b_t, &ldb_t, &info ); @@ -93,8 +93,8 @@ lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i info = info - 1; } /* Transpose output matrices */ - LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zsy_trans)( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_2: @@ -103,11 +103,11 @@ lapack_int LAPACKE_zsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_2stage_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_2stage_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_aa_work.c b/LAPACKE/src/lapacke_zsytrs_aa_work.c index 48b2f45acc..cacc55894c 100644 --- a/LAPACKE/src/lapacke_zsytrs_aa_work.c +++ b/LAPACKE/src/lapacke_zsytrs_aa_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_aa_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, @@ -54,12 +54,12 @@ lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -77,8 +77,8 @@ lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs_aa( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work, &lwork, &info ); @@ -86,18 +86,18 @@ lapack_int LAPACKE_zsytrs_aa_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs_aa_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_aa_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_rook.c b/LAPACKE/src/lapacke_zsytrs_rook.c index bb76714777..3da6471f66 100644 --- a/LAPACKE/src/lapacke_zsytrs_rook.c +++ b/LAPACKE/src/lapacke_zsytrs_rook.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_rook( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_rook)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_rook", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_rook", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zsy_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_zsytrs_rook_work( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, + return API_SUFFIX(LAPACKE_zsytrs_rook_work)( matrix_layout, uplo, n, nrhs, a, lda, ipiv, b, ldb ); } diff --git a/LAPACKE/src/lapacke_zsytrs_rook_work.c b/LAPACKE/src/lapacke_zsytrs_rook_work.c index 871b7df020..a23165d0d8 100644 --- a/LAPACKE/src/lapacke_zsytrs_rook_work.c +++ b/LAPACKE/src/lapacke_zsytrs_rook_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_rook_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_rook_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_rook_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs_rook( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_zsytrs_rook_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_rook_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs_rook_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_rook_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zsytrs_work.c b/LAPACKE/src/lapacke_zsytrs_work.c index 8500ab13f6..9fdec7e67d 100644 --- a/LAPACKE/src/lapacke_zsytrs_work.c +++ b/LAPACKE/src/lapacke_zsytrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zsytrs_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zsytrs_work)( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) @@ -52,12 +52,12 @@ lapack_int LAPACKE_zsytrs_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -75,8 +75,8 @@ lapack_int LAPACKE_zsytrs_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zsy_trans)( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_zsytrs( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, &info ); @@ -84,18 +84,18 @@ lapack_int LAPACKE_zsytrs_work( int matrix_layout, char uplo, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zsytrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zsytrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztbcon.c b/LAPACKE/src/lapacke_ztbcon.c index 28a25e1a80..57fcbad616 100644 --- a/LAPACKE/src/lapacke_ztbcon.c +++ b/LAPACKE/src/lapacke_ztbcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztbcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double* rcond ) @@ -41,13 +41,13 @@ lapack_int LAPACKE_ztbcon( int matrix_layout, char norm, char uplo, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztbcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ztb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -7; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_ztbcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztbcon_work( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, + info = API_SUFFIX(LAPACKE_ztbcon_work)( matrix_layout, norm, uplo, diag, n, kd, ab, ldab, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -73,7 +73,7 @@ lapack_int LAPACKE_ztbcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztbcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztbcon_work.c b/LAPACKE/src/lapacke_ztbcon_work.c index e2225fa3ec..f2869207b2 100644 --- a/LAPACKE/src/lapacke_ztbcon_work.c +++ b/LAPACKE/src/lapacke_ztbcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztbcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab, double* rcond, @@ -52,7 +52,7 @@ lapack_int LAPACKE_ztbcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( ldab < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_ztbcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ztb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ztbcon( &norm, &uplo, &diag, &n, &kd, ab_t, &ldab_t, rcond, work, @@ -75,11 +75,11 @@ lapack_int LAPACKE_ztbcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztbcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztbrfs.c b/LAPACKE/src/lapacke_ztbrfs.c index a42bd1c083..de53f32763 100644 --- a/LAPACKE/src/lapacke_ztbrfs.c +++ b/LAPACKE/src/lapacke_ztbrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztbrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, const lapack_complex_double* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ztbrfs( int matrix_layout, char uplo, char trans, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztbrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ztb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -12; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ztbrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztbrfs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + info = API_SUFFIX(LAPACKE_ztbrfs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ @@ -82,7 +82,7 @@ lapack_int LAPACKE_ztbrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztbrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztbrfs_work.c b/LAPACKE/src/lapacke_ztbrfs_work.c index 2eb7d602bd..396ab1f372 100644 --- a/LAPACKE/src/lapacke_ztbrfs_work.c +++ b/LAPACKE/src/lapacke_ztbrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztbrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, @@ -59,17 +59,17 @@ lapack_int LAPACKE_ztbrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs_work", info ); return info; } if( ldx < nrhs ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -94,10 +94,10 @@ lapack_int LAPACKE_ztbrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ztb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ztb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ztbrfs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -112,11 +112,11 @@ lapack_int LAPACKE_ztbrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztbrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztbtrs.c b/LAPACKE/src/lapacke_ztbtrs.c index 6d587c996b..1b1c7add02 100644 --- a/LAPACKE/src/lapacke_ztbtrs.c +++ b/LAPACKE/src/lapacke_ztbtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztbtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztbtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztb_nancheck( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { + if( API_SUFFIX(LAPACKE_ztb_nancheck)( matrix_layout, uplo, diag, n, kd, ab, ldab ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -10; } } #endif - return LAPACKE_ztbtrs_work( matrix_layout, uplo, trans, diag, n, kd, nrhs, + return API_SUFFIX(LAPACKE_ztbtrs_work)( matrix_layout, uplo, trans, diag, n, kd, nrhs, ab, ldab, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ztbtrs_work.c b/LAPACKE/src/lapacke_ztbtrs_work.c index fd157c8132..b9ef913dfa 100644 --- a/LAPACKE/src/lapacke_ztbtrs_work.c +++ b/LAPACKE/src/lapacke_ztbtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztbtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztbtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int kd, lapack_int nrhs, const lapack_complex_double* ab, @@ -55,12 +55,12 @@ lapack_int LAPACKE_ztbtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldab < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,9 +78,9 @@ lapack_int LAPACKE_ztbtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ztb_trans( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, + API_SUFFIX(LAPACKE_ztb_trans)( matrix_layout, uplo, diag, n, kd, ab, ldab, ab_t, ldab_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztbtrs( &uplo, &trans, &diag, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); @@ -88,18 +88,18 @@ lapack_int LAPACKE_ztbtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztbtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztbtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztfsm.c b/LAPACKE/src/lapacke_ztfsm.c index e05579d220..e20bca24b7 100644 --- a/LAPACKE/src/lapacke_ztfsm.c +++ b/LAPACKE/src/lapacke_ztfsm.c @@ -32,34 +32,34 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfsm( int matrix_layout, char transr, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, lapack_complex_double alpha, const lapack_complex_double* a, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztfsm", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( IS_Z_NONZERO(alpha) ) { - if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -10; } } - if( LAPACKE_z_nancheck( 1, &alpha, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( 1, &alpha, 1 ) ) { return -9; } if( IS_Z_NONZERO(alpha) ) { - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -11; } } } #endif - return LAPACKE_ztfsm_work( matrix_layout, transr, side, uplo, trans, diag, m, + return API_SUFFIX(LAPACKE_ztfsm_work)( matrix_layout, transr, side, uplo, trans, diag, m, n, alpha, a, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index d8962f8f49..00b0917cb3 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfsm_work( int matrix_layout, char transr, char side, +lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char side, char uplo, char trans, char diag, lapack_int m, lapack_int n, lapack_complex_double alpha, const lapack_complex_double* a, @@ -53,7 +53,7 @@ lapack_int LAPACKE_ztfsm_work( int matrix_layout, char transr, char side, /* Check leading dimension(s) */ if( ldb < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -74,17 +74,17 @@ lapack_int LAPACKE_ztfsm_work( int matrix_layout, char transr, char side, } /* Transpose input matrices */ if( IS_Z_NONZERO(alpha) ) { - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_Z_NONZERO(alpha) ) { - LAPACKE_ztf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_Z_NONZERO(alpha) ) { LAPACKE_free( a_t ); @@ -93,11 +93,11 @@ lapack_int LAPACKE_ztfsm_work( int matrix_layout, char transr, char side, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztfsm_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztftri.c b/LAPACKE/src/lapacke_ztftri.c index 69f1d5eea4..d66d0fad67 100644 --- a/LAPACKE/src/lapacke_ztftri.c +++ b/LAPACKE/src/lapacke_ztftri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztftri( int matrix_layout, char transr, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztftri)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, lapack_complex_double* a ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztftri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztftri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztf_nancheck( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { return -6; } } #endif - return LAPACKE_ztftri_work( matrix_layout, transr, uplo, diag, n, a ); + return API_SUFFIX(LAPACKE_ztftri_work)( matrix_layout, transr, uplo, diag, n, a ); } diff --git a/LAPACKE/src/lapacke_ztftri_work.c b/LAPACKE/src/lapacke_ztftri_work.c index 314717c502..3f4f40948a 100644 --- a/LAPACKE/src/lapacke_ztftri_work.c +++ b/LAPACKE/src/lapacke_ztftri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztftri_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztftri_work)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, lapack_complex_double* a ) { @@ -54,23 +54,23 @@ lapack_int LAPACKE_ztftri_work( int matrix_layout, char transr, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztf_trans( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_ztftri( &transr, &uplo, &diag, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ztf_trans( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); + API_SUFFIX(LAPACKE_ztf_trans)( LAPACK_COL_MAJOR, transr, uplo, diag, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztftri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztftri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztftri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztfttp.c b/LAPACKE/src/lapacke_ztfttp.c index 06142e1f82..8a3a4bb0d8 100644 --- a/LAPACKE/src/lapacke_ztfttp.c +++ b/LAPACKE/src/lapacke_ztfttp.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfttp( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztfttp)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* arf, lapack_complex_double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztfttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_ztfttp_work( matrix_layout, transr, uplo, n, arf, ap ); + return API_SUFFIX(LAPACKE_ztfttp_work)( matrix_layout, transr, uplo, n, arf, ap ); } diff --git a/LAPACKE/src/lapacke_ztfttp_work.c b/LAPACKE/src/lapacke_ztfttp_work.c index 935b0e1d88..2d7824b2fa 100644 --- a/LAPACKE/src/lapacke_ztfttp_work.c +++ b/LAPACKE/src/lapacke_ztfttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfttp_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztfttp_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* arf, lapack_complex_double* ap ) { @@ -62,25 +62,25 @@ lapack_int LAPACKE_ztfttp_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_ztfttp( &transr, &uplo, &n, arf_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztfttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztfttr.c b/LAPACKE/src/lapacke_ztfttr.c index e896dd0fa0..b2720956c7 100644 --- a/LAPACKE/src/lapacke_ztfttr.c +++ b/LAPACKE/src/lapacke_ztfttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfttr( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztfttr)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* arf, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztfttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpf_nancheck( n, arf ) ) { + if( API_SUFFIX(LAPACKE_zpf_nancheck)( n, arf ) ) { return -5; } } #endif - return LAPACKE_ztfttr_work( matrix_layout, transr, uplo, n, arf, a, lda ); + return API_SUFFIX(LAPACKE_ztfttr_work)( matrix_layout, transr, uplo, n, arf, a, lda ); } diff --git a/LAPACKE/src/lapacke_ztfttr_work.c b/LAPACKE/src/lapacke_ztfttr_work.c index 6314538530..90fe9b5a74 100644 --- a/LAPACKE/src/lapacke_ztfttr_work.c +++ b/LAPACKE/src/lapacke_ztfttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztfttr_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztfttr_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* arf, lapack_complex_double* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ztfttr_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ztfttr_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpf_trans( matrix_layout, transr, uplo, n, arf, arf_t ); + API_SUFFIX(LAPACKE_zpf_trans)( matrix_layout, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_ztfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztfttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgevc.c b/LAPACKE/src/lapacke_ztgevc.c index 574b8b461e..fc9ce425ae 100644 --- a/LAPACKE/src/lapacke_ztgevc.c +++ b/LAPACKE/src/lapacke_ztgevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztgevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* s, lapack_int lds, const lapack_complex_double* p, lapack_int ldp, @@ -44,25 +44,25 @@ lapack_int LAPACKE_ztgevc( int matrix_layout, char side, char howmny, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, p, ldp ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, p, ldp ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, s, lds ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, s, lds ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_ztgevc( int matrix_layout, char side, char howmny, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztgevc_work( matrix_layout, side, howmny, select, n, s, lds, + info = API_SUFFIX(LAPACKE_ztgevc_work)( matrix_layout, side, howmny, select, n, s, lds, p, ldp, vl, ldvl, vr, ldvr, mm, m, work, rwork ); /* Release memory and exit */ @@ -90,7 +90,7 @@ lapack_int LAPACKE_ztgevc( int matrix_layout, char side, char howmny, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgevc_work.c b/LAPACKE/src/lapacke_ztgevc_work.c index b066714294..3855883e47 100644 --- a/LAPACKE/src/lapacke_ztgevc_work.c +++ b/LAPACKE/src/lapacke_ztgevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztgevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* s, lapack_int lds, const lapack_complex_double* p, lapack_int ldp, @@ -61,22 +61,22 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldp < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); return info; } if( lds < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -92,7 +92,7 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,mm) ); @@ -101,7 +101,7 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,mm) ); @@ -111,15 +111,15 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, s, lds, s_t, lds_t ); - LAPACKE_zge_trans( matrix_layout, n, n, p, ldp, p_t, ldp_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, s, lds, s_t, lds_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, p, ldp, p_t, ldp_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztgevc( &side, &howmny, select, &n, s_t, &lds_t, p_t, &ldp_t, @@ -129,20 +129,20 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -151,11 +151,11 @@ lapack_int LAPACKE_ztgevc_work( int matrix_layout, char side, char howmny, LAPACKE_free( s_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgexc.c b/LAPACKE/src/lapacke_ztgexc.c index 56d7d861e7..1782cf4706 100644 --- a/LAPACKE/src/lapacke_ztgexc.c +++ b/LAPACKE/src/lapacke_ztgexc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgexc( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_ztgexc)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -41,30 +41,30 @@ lapack_int LAPACKE_ztgexc( int matrix_layout, lapack_logical wantq, lapack_int ifst, lapack_int ilst ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -7; } if( wantq ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -9; } } if( wantz ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -11; } } } #endif - return LAPACKE_ztgexc_work( matrix_layout, wantq, wantz, n, a, lda, b, ldb, + return API_SUFFIX(LAPACKE_ztgexc_work)( matrix_layout, wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst ); } diff --git a/LAPACKE/src/lapacke_ztgexc_work.c b/LAPACKE/src/lapacke_ztgexc_work.c index 333e1d3f89..021fd0b2f3 100644 --- a/LAPACKE/src/lapacke_ztgexc_work.c +++ b/LAPACKE/src/lapacke_ztgexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgexc_work( int matrix_layout, lapack_logical wantq, +lapack_int API_SUFFIX(LAPACKE_ztgexc_work)( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -60,22 +60,22 @@ lapack_int LAPACKE_ztgexc_work( int matrix_layout, lapack_logical wantq, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); return info; } if( ldb < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); return info; } if( ldq < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); return info; } if( ldz < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -110,13 +110,13 @@ lapack_int LAPACKE_ztgexc_work( int matrix_layout, lapack_logical wantq, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t, @@ -125,13 +125,13 @@ lapack_int LAPACKE_ztgexc_work( int matrix_layout, lapack_logical wantq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -147,11 +147,11 @@ lapack_int LAPACKE_ztgexc_work( int matrix_layout, lapack_logical wantq, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsen.c b/LAPACKE/src/lapacke_ztgsen.c index 039da18b48..7ce499a763 100644 --- a/LAPACKE/src/lapacke_ztgsen.c +++ b/LAPACKE/src/lapacke_ztgsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ztgsen)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, lapack_complex_double* a, lapack_int lda, @@ -51,32 +51,32 @@ lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, lapack_int iwork_query; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } if( wantq ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -13; } } if( wantz ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, z, ldz ) ) { return -15; } } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ztgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_ztgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, q, ldq, z, ldz, m, pl, pr, dif, &work_query, lwork, &iwork_query, liwork ); @@ -98,7 +98,7 @@ lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztgsen_work( matrix_layout, ijob, wantq, wantz, select, n, a, + info = API_SUFFIX(LAPACKE_ztgsen_work)( matrix_layout, ijob, wantq, wantz, select, n, a, lda, b, ldb, alpha, beta, q, ldq, z, ldz, m, pl, pr, dif, work, lwork, iwork, liwork ); /* Release memory and exit */ @@ -107,7 +107,7 @@ lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsen_work.c b/LAPACKE/src/lapacke_ztgsen_work.c index ffdcb1d11d..d70332be55 100644 --- a/LAPACKE/src/lapacke_ztgsen_work.c +++ b/LAPACKE/src/lapacke_ztgsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsen_work( int matrix_layout, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ztgsen_work)( int matrix_layout, lapack_int ijob, lapack_logical wantq, lapack_logical wantz, const lapack_logical* select, lapack_int n, lapack_complex_double* a, lapack_int lda, @@ -67,22 +67,22 @@ lapack_int LAPACKE_ztgsen_work( int matrix_layout, lapack_int ijob, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); return info; } if( ldq < n ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); return info; } if( ldz < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -124,13 +124,13 @@ lapack_int LAPACKE_ztgsen_work( int matrix_layout, lapack_int ijob, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { - LAPACKE_zge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztgsen( &ijob, &wantq, &wantz, select, &n, a_t, &lda_t, b_t, @@ -140,13 +140,13 @@ lapack_int LAPACKE_ztgsen_work( int matrix_layout, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { @@ -162,11 +162,11 @@ lapack_int LAPACKE_ztgsen_work( int matrix_layout, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsja.c b/LAPACKE/src/lapacke_ztgsja.c index 61f83e283a..9554b36d50 100644 --- a/LAPACKE/src/lapacke_ztgsja.c +++ b/LAPACKE/src/lapacke_ztgsja.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsja( int matrix_layout, char jobu, char jobv, char jobq, +lapack_int API_SUFFIX(LAPACKE_ztgsja)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, @@ -46,36 +46,36 @@ lapack_int LAPACKE_ztgsja( int matrix_layout, char jobu, char jobv, char jobq, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgsja", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, n, b, ldb ) ) { return -12; } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -22; } } - if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tola, 1 ) ) { return -14; } - if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + if( API_SUFFIX(LAPACKE_d_nancheck)( 1, &tolb, 1 ) ) { return -15; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, m, m, u, ldu ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, m, u, ldu ) ) { return -18; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, p, p, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, p, p, v, ldv ) ) { return -20; } } @@ -89,14 +89,14 @@ lapack_int LAPACKE_ztgsja( int matrix_layout, char jobu, char jobv, char jobq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztgsja_work( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, + info = API_SUFFIX(LAPACKE_ztgsja_work)( matrix_layout, jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb, tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq, work, ncycle ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsja", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsja_work.c b/LAPACKE/src/lapacke_ztgsja_work.c index 6ae35663aa..e012a3a12b 100644 --- a/LAPACKE/src/lapacke_ztgsja_work.c +++ b/LAPACKE/src/lapacke_ztgsja_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, +lapack_int API_SUFFIX(LAPACKE_ztgsja_work)( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, lapack_int k, lapack_int l, lapack_complex_double* a, lapack_int lda, @@ -67,27 +67,27 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, /* Check leading dimension(s) */ if( lda < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); return info; } if( ldb < n ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); return info; } if( ldq < n ) { info = -23; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); return info; } if( ldu < m ) { info = -19; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); return info; } if( ldv < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -103,7 +103,7 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,m) ); @@ -112,7 +112,7 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, goto exit_level_2; } } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { v_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,p) ); @@ -121,7 +121,7 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, goto exit_level_3; } } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -131,16 +131,16 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( matrix_layout, m, m, u, ldu, u_t, ldu_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, m, u, ldu, u_t, ldu_t ); } - if( LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, p, p, v, ldv, v_t, ldv_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, p, p, v, ldv, v_t, ldv_t ); } - if( LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztgsja( &jobu, &jobv, &jobq, &m, &p, &n, &k, &l, a_t, &lda_t, @@ -150,27 +150,27 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobq, 'i' ) || LAPACKE_lsame( jobq, 'q' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobq, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: - if( LAPACKE_lsame( jobv, 'i' ) || LAPACKE_lsame( jobv, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: - if( LAPACKE_lsame( jobu, 'i' ) || LAPACKE_lsame( jobu, 'u' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu, 'i' ) || API_SUFFIX(LAPACKE_lsame)( jobu, 'u' ) ) { LAPACKE_free( u_t ); } exit_level_2: @@ -179,11 +179,11 @@ lapack_int LAPACKE_ztgsja_work( int matrix_layout, char jobu, char jobv, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgsja_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsja_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsna.c b/LAPACKE/src/lapacke_ztgsna.c index d1c01a0686..d28e9cb5af 100644 --- a/LAPACKE/src/lapacke_ztgsna.c +++ b/LAPACKE/src/lapacke_ztgsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztgsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -47,32 +47,32 @@ lapack_int LAPACKE_ztgsna( int matrix_layout, char job, char howmny, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -10; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -12; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; @@ -80,7 +80,7 @@ lapack_int LAPACKE_ztgsna( int matrix_layout, char job, char howmny, } } /* Query optimal working array(s) size */ - info = LAPACKE_ztgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ztgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, &work_query, lwork, iwork ); if( info != 0 ) { @@ -88,7 +88,7 @@ lapack_int LAPACKE_ztgsna( int matrix_layout, char job, char howmny, } lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( work == NULL ) { @@ -97,20 +97,20 @@ lapack_int LAPACKE_ztgsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_ztgsna_work( matrix_layout, job, howmny, select, n, a, lda, b, + info = API_SUFFIX(LAPACKE_ztgsna_work)( matrix_layout, job, howmny, select, n, a, lda, b, ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work, lwork, iwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( iwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsna_work.c b/LAPACKE/src/lapacke_ztgsna_work.c index 4ef9e3f6b9..86c1d25db6 100644 --- a/LAPACKE/src/lapacke_ztgsna_work.c +++ b/LAPACKE/src/lapacke_ztgsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztgsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -64,22 +64,22 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); return info; } if( ldvl < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); return info; } if( ldvr < mm ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -102,7 +102,7 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,mm) ); @@ -111,7 +111,7 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, goto exit_level_2; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,mm) ); @@ -121,13 +121,13 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztgsna( &job, &howmny, select, &n, a_t, &lda_t, b_t, &ldb_t, @@ -137,11 +137,11 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_3: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_2: @@ -150,11 +150,11 @@ lapack_int LAPACKE_ztgsna_work( int matrix_layout, char job, char howmny, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsyl.c b/LAPACKE/src/lapacke_ztgsyl.c index 944a0228dd..ab0ef7ae42 100644 --- a/LAPACKE/src/lapacke_ztgsyl.c +++ b/LAPACKE/src/lapacke_ztgsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsyl( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ztgsyl)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -48,28 +48,28 @@ lapack_int LAPACKE_ztgsyl( int matrix_layout, char trans, lapack_int ijob, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztgsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_zge_nancheck( matrix_layout, m, m, d, ldd ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, m, d, ldd ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, e, lde ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, e, lde ) ) { return -14; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, f, ldf ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, f, ldf ) ) { return -16; } } @@ -81,7 +81,7 @@ lapack_int LAPACKE_ztgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_ztgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_ztgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, &work_query, lwork, iwork ); if( info != 0 ) { @@ -96,7 +96,7 @@ lapack_int LAPACKE_ztgsyl( int matrix_layout, char trans, lapack_int ijob, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, + info = API_SUFFIX(LAPACKE_ztgsyl_work)( matrix_layout, trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, dif, work, lwork, iwork ); /* Release memory and exit */ @@ -105,7 +105,7 @@ lapack_int LAPACKE_ztgsyl( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsyl", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztgsyl_work.c b/LAPACKE/src/lapacke_ztgsyl_work.c index 5cf44e41e2..b6142a7723 100644 --- a/LAPACKE/src/lapacke_ztgsyl_work.c +++ b/LAPACKE/src/lapacke_ztgsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztgsyl_work( int matrix_layout, char trans, lapack_int ijob, +lapack_int API_SUFFIX(LAPACKE_ztgsyl_work)( int matrix_layout, char trans, lapack_int ijob, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -69,32 +69,32 @@ lapack_int LAPACKE_ztgsyl_work( int matrix_layout, char trans, lapack_int ijob, /* Check leading dimension(s) */ if( lda < m ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } if( ldd < m ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } if( lde < n ) { info = -15; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } if( ldf < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -142,12 +142,12 @@ lapack_int LAPACKE_ztgsyl_work( int matrix_layout, char trans, lapack_int ijob, goto exit_level_5; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_zge_trans( matrix_layout, m, m, d, ldd, d_t, ldd_t ); - LAPACKE_zge_trans( matrix_layout, n, n, e, lde, e_t, lde_t ); - LAPACKE_zge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, m, d, ldd, d_t, ldd_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, e, lde, e_t, lde_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, f, ldf, f_t, ldf_t ); /* Call LAPACK function and adjust info */ LAPACK_ztgsyl( &trans, &ijob, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, d_t, &ldd_t, e_t, &lde_t, f_t, &ldf_t, scale, @@ -156,8 +156,8 @@ lapack_int LAPACKE_ztgsyl_work( int matrix_layout, char trans, lapack_int ijob, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); /* Release memory and exit */ LAPACKE_free( f_t ); exit_level_5: @@ -172,11 +172,11 @@ lapack_int LAPACKE_ztgsyl_work( int matrix_layout, char trans, lapack_int ijob, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztgsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztgsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpcon.c b/LAPACKE/src/lapacke_ztpcon.c index 54b4cdecc4..c2dafeb95a 100644 --- a/LAPACKE/src/lapacke_ztpcon.c +++ b/LAPACKE/src/lapacke_ztpcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztpcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_double* ap, double* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_ztpcon( int matrix_layout, char norm, char uplo, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ztp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -6; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_ztpcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztpcon_work( matrix_layout, norm, uplo, diag, n, ap, rcond, + info = API_SUFFIX(LAPACKE_ztpcon_work)( matrix_layout, norm, uplo, diag, n, ap, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_ztpcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpcon_work.c b/LAPACKE/src/lapacke_ztpcon_work.c index 6c1baefbef..036f1c2307 100644 --- a/LAPACKE/src/lapacke_ztpcon_work.c +++ b/LAPACKE/src/lapacke_ztpcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztpcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_double* ap, double* rcond, lapack_complex_double* work, double* rwork ) @@ -55,7 +55,7 @@ lapack_int LAPACKE_ztpcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpcon( &norm, &uplo, &diag, &n, ap_t, rcond, work, rwork, &info ); @@ -66,11 +66,11 @@ lapack_int LAPACKE_ztpcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpmqrt.c b/LAPACKE/src/lapacke_ztpmqrt.c index e39995e751..cc32a12f52 100644 --- a/LAPACKE/src/lapacke_ztpmqrt.c +++ b/LAPACKE/src/lapacke_ztpmqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpmqrt( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_ztpmqrt)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const lapack_complex_double* v, lapack_int ldv, @@ -46,35 +46,35 @@ lapack_int LAPACKE_ztpmqrt( int matrix_layout, char side, char trans, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpmqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - 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 ) ) { + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0 ); + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0 ); + nrows_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0 ); + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_a, ncols_a, a, lda ) ) { return -13; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -15; } - if( LAPACKE_zge_nancheck( matrix_layout, nb, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nb, k, t, ldt ) ) { return -11; } - if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, k, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_v, k, v, ldv ) ) { return -9; } } #endif /* Allocate memory for working array(s) */ - lwork = LAPACKE_lsame( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : - ( LAPACKE_lsame( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); + lwork = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? MAX(1,nb) * MAX(1,n) : + ( API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? MAX(1,m) * MAX(1,nb) : 0 ); work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( work == NULL ) { @@ -82,13 +82,13 @@ lapack_int LAPACKE_ztpmqrt( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztpmqrt_work( matrix_layout, side, trans, m, n, k, l, nb, v, + info = API_SUFFIX(LAPACKE_ztpmqrt_work)( matrix_layout, side, trans, m, n, k, l, nb, v, ldv, t, ldt, a, lda, b, ldb, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpmqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpmqrt_work.c b/LAPACKE/src/lapacke_ztpmqrt_work.c index 104efa8f3c..eb0ee3f55c 100644 --- a/LAPACKE/src/lapacke_ztpmqrt_work.c +++ b/LAPACKE/src/lapacke_ztpmqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_ztpmqrt_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, lapack_int nb, const lapack_complex_double* v, lapack_int ldv, @@ -51,11 +51,11 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); return info; } lapack_int lda_t = MAX(1,nrowsA); @@ -69,22 +69,22 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < ncolsA ) { info = -14; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); return info; } if( ldb < n ) { info = -16; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); return info; } if( ldt < k ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); return info; } if( ldv < k ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -113,10 +113,10 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info ); @@ -124,8 +124,8 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -136,11 +136,11 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpqrt.c b/LAPACKE/src/lapacke_ztpqrt.c index f13112b2c7..9aa6860bd9 100644 --- a/LAPACKE/src/lapacke_ztpqrt.c +++ b/LAPACKE/src/lapacke_ztpqrt.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztpqrt)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -41,16 +41,16 @@ lapack_int LAPACKE_ztpqrt( int matrix_layout, lapack_int m, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpqrt", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -8; } } @@ -63,13 +63,13 @@ lapack_int LAPACKE_ztpqrt( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztpqrt_work( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, + info = API_SUFFIX(LAPACKE_ztpqrt_work)( matrix_layout, m, n, l, nb, a, lda, b, ldb, t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpqrt", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpqrt2.c b/LAPACKE/src/lapacke_ztpqrt2.c index 82208f0fbc..1b68b7ec85 100644 --- a/LAPACKE/src/lapacke_ztpqrt2.c +++ b/LAPACKE/src/lapacke_ztpqrt2.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt2( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_ztpqrt2)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpqrt2", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -4; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -6; } } #endif - return LAPACKE_ztpqrt2_work( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); + return API_SUFFIX(LAPACKE_ztpqrt2_work)( matrix_layout, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/LAPACKE/src/lapacke_ztpqrt2_work.c b/LAPACKE/src/lapacke_ztpqrt2_work.c index 7a7db867f9..37c0d7d033 100644 --- a/LAPACKE/src/lapacke_ztpqrt2_work.c +++ b/LAPACKE/src/lapacke_ztpqrt2_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt2_work( int matrix_layout, +lapack_int API_SUFFIX(LAPACKE_ztpqrt2_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -55,17 +55,17 @@ lapack_int LAPACKE_ztpqrt2_work( int matrix_layout, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2_work", info ); return info; } if( ldb < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2_work", info ); return info; } if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,17 +88,17 @@ lapack_int LAPACKE_ztpqrt2_work( int matrix_layout, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -107,11 +107,11 @@ lapack_int LAPACKE_ztpqrt2_work( int matrix_layout, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt2_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpqrt_work.c b/LAPACKE/src/lapacke_ztpqrt_work.c index 0ae35cd584..dbee38dfcf 100644 --- a/LAPACKE/src/lapacke_ztpqrt_work.c +++ b/LAPACKE/src/lapacke_ztpqrt_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztpqrt_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_ztpqrt_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt_work", info ); return info; } if( ldb < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt_work", info ); return info; } if( ldt < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,8 +90,8 @@ lapack_int LAPACKE_ztpqrt_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, work, &info ); @@ -99,9 +99,9 @@ lapack_int LAPACKE_ztpqrt_work( int matrix_layout, lapack_int m, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nb, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_2: @@ -110,11 +110,11 @@ lapack_int LAPACKE_ztpqrt_work( int matrix_layout, lapack_int m, lapack_int n, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpqrt_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpqrt_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztprfb.c b/LAPACKE/src/lapacke_ztprfb.c index a1ddaa4012..6fbecec3d0 100644 --- a/LAPACKE/src/lapacke_ztprfb.c +++ b/LAPACKE/src/lapacke_ztprfb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct, +lapack_int API_SUFFIX(LAPACKE_ztprfb)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_double* v, lapack_int ldv, @@ -46,7 +46,7 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct lapack_int work_size; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztprfb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -61,32 +61,32 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct * or m-by-k (right) * B is m-by-n */ - if( LAPACKE_lsame( storev, 'C' ) ) { + if( API_SUFFIX(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 = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; + } else if( API_SUFFIX(LAPACKE_lsame)( storev, 'R' ) ) { + ncols_v = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? m : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - nrows_a = LAPACKE_lsame( side, 'L' ) ? k : - LAPACKE_lsame( side, 'R' ) ? m : 0; - ncols_a = LAPACKE_lsame( side, 'L' ) ? n : - LAPACKE_lsame( side, 'R' ) ? k : 0; - if( LAPACKE_zge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { + nrows_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? k : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? m : 0; + ncols_a = API_SUFFIX(LAPACKE_lsame)( side, 'L' ) ? n : + API_SUFFIX(LAPACKE_lsame)( side, 'R' ) ? k : 0; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, b, ldb ) ) { return -16; } - if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, k, t, ldt ) ) { return -12; } - if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_v, ncols_v, v, ldv ) ) { return -10; } } @@ -107,14 +107,14 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztprfb_work( matrix_layout, side, trans, direct, storev, m, n, + info = API_SUFFIX(LAPACKE_ztprfb_work)( matrix_layout, side, trans, direct, storev, m, n, k, l, v, ldv, t, ldt, a, lda, b, ldb, work, ldwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztprfb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztprfb_work.c b/LAPACKE/src/lapacke_ztprfb_work.c index 36944bbed2..03fe04f9da 100644 --- a/LAPACKE/src/lapacke_ztprfb_work.c +++ b/LAPACKE/src/lapacke_ztprfb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_ztprfb_work)( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_double* v, lapack_int ldv, @@ -61,22 +61,22 @@ lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -15; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); return info; } if( ldb < n ) { info = -17; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); return info; } if( ldt < k ) { info = -13; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); return info; } if( ldv < k ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -105,18 +105,18 @@ lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, goto exit_level_3; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); - LAPACKE_zge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); - LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, ldv, k, v, ldv, v_t, ldv_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, ldt, k, t, ldt, t_t, ldt_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: @@ -127,11 +127,11 @@ lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztprfs.c b/LAPACKE/src/lapacke_ztprfs.c index bf299ee943..97a8d76676 100644 --- a/LAPACKE/src/lapacke_ztprfs.c +++ b/LAPACKE/src/lapacke_ztprfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztprfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztprfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ztprfs( int matrix_layout, char uplo, char trans, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztprfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ztp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -10; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ztprfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztprfs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + info = API_SUFFIX(LAPACKE_ztprfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_ztprfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztprfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztprfs_work.c b/LAPACKE/src/lapacke_ztprfs_work.c index c650c3c47d..e6ff80fce2 100644 --- a/LAPACKE/src/lapacke_ztprfs_work.c +++ b/LAPACKE/src/lapacke_ztprfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztprfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztprfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, const lapack_complex_double* b, lapack_int ldb, @@ -57,12 +57,12 @@ lapack_int LAPACKE_ztprfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -88,9 +88,9 @@ lapack_int LAPACKE_ztprfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); - LAPACKE_ztp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztprfs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -105,11 +105,11 @@ lapack_int LAPACKE_ztprfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztprfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztprfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztptri.c b/LAPACKE/src/lapacke_ztptri.c index fefcb2cafb..518247579e 100644 --- a/LAPACKE/src/lapacke_ztptri.c +++ b/LAPACKE/src/lapacke_ztptri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztptri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztptri)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztptri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ztp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -5; } } #endif - return LAPACKE_ztptri_work( matrix_layout, uplo, diag, n, ap ); + return API_SUFFIX(LAPACKE_ztptri_work)( matrix_layout, uplo, diag, n, ap ); } diff --git a/LAPACKE/src/lapacke_ztptri_work.c b/LAPACKE/src/lapacke_ztptri_work.c index e72d847d24..adc9065be9 100644 --- a/LAPACKE/src/lapacke_ztptri_work.c +++ b/LAPACKE/src/lapacke_ztptri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztptri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztptri_work)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_double* ap ) { lapack_int info = 0; @@ -53,23 +53,23 @@ lapack_int LAPACKE_ztptri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztptri( &uplo, &diag, &n, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ztp_trans( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); + API_SUFFIX(LAPACKE_ztp_trans)( LAPACK_COL_MAJOR, uplo, diag, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztptri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztptrs.c b/LAPACKE/src/lapacke_ztptrs.c index bd69e98aaf..ce09d5e1d4 100644 --- a/LAPACKE/src/lapacke_ztptrs.c +++ b/LAPACKE/src/lapacke_ztptrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztptrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztptrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztptrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztp_nancheck( matrix_layout, uplo, diag, n, ap ) ) { + if( API_SUFFIX(LAPACKE_ztp_nancheck)( matrix_layout, uplo, diag, n, ap ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -8; } } #endif - return LAPACKE_ztptrs_work( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, + return API_SUFFIX(LAPACKE_ztptrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, ap, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ztptrs_work.c b/LAPACKE/src/lapacke_ztptrs_work.c index 8dc2258320..5d6a4e17a3 100644 --- a/LAPACKE/src/lapacke_ztptrs_work.c +++ b/LAPACKE/src/lapacke_ztptrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztptrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztptrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* ap, lapack_complex_double* b, lapack_int ldb ) @@ -51,7 +51,7 @@ lapack_int LAPACKE_ztptrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,8 +70,8 @@ lapack_int LAPACKE_ztptrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_ztp_trans( matrix_layout, uplo, diag, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); @@ -79,18 +79,18 @@ lapack_int LAPACKE_ztptrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztptrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztptrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpttf.c b/LAPACKE/src/lapacke_ztpttf.c index 248985d0d8..6b1490e471 100644 --- a/LAPACKE/src/lapacke_ztpttf.c +++ b/LAPACKE/src/lapacke_ztpttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztpttf)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* ap, lapack_complex_double* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -5; } } #endif - return LAPACKE_ztpttf_work( matrix_layout, transr, uplo, n, ap, arf ); + return API_SUFFIX(LAPACKE_ztpttf_work)( matrix_layout, transr, uplo, n, ap, arf ); } diff --git a/LAPACKE/src/lapacke_ztpttf_work.c b/LAPACKE/src/lapacke_ztpttf_work.c index 4df8d567a2..011c38954b 100644 --- a/LAPACKE/src/lapacke_ztpttf_work.c +++ b/LAPACKE/src/lapacke_ztpttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztpttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* ap, lapack_complex_double* arf ) { @@ -62,25 +62,25 @@ lapack_int LAPACKE_ztpttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpttf( &transr, &uplo, &n, ap_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_zpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( ap_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztpttr.c b/LAPACKE/src/lapacke_ztpttr.c index bd3a3235ae..c38d1204e3 100644 --- a/LAPACKE/src/lapacke_ztpttr.c +++ b/LAPACKE/src/lapacke_ztpttr.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpttr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztpttr)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztpttr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } } #endif - return LAPACKE_ztpttr_work( matrix_layout, uplo, n, ap, a, lda ); + return API_SUFFIX(LAPACKE_ztpttr_work)( matrix_layout, uplo, n, ap, a, lda ); } diff --git a/LAPACKE/src/lapacke_ztpttr_work.c b/LAPACKE/src/lapacke_ztpttr_work.c index 66ecd0b52c..472f3f2958 100644 --- a/LAPACKE/src/lapacke_ztpttr_work.c +++ b/LAPACKE/src/lapacke_ztpttr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpttr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztpttr_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, lapack_complex_double* a, lapack_int lda ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ztpttr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ztpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ztpttr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpttr( &uplo, &n, ap_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztpttr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpttr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrcon.c b/LAPACKE/src/lapacke_ztrcon.c index 39f8d2312d..eac3bda4f6 100644 --- a/LAPACKE/src/lapacke_ztrcon.c +++ b/LAPACKE/src/lapacke_ztrcon.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrcon( int matrix_layout, char norm, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztrcon)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* rcond ) { @@ -40,13 +40,13 @@ lapack_int LAPACKE_ztrcon( int matrix_layout, char norm, char uplo, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrcon", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrcon", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -6; } } @@ -64,7 +64,7 @@ lapack_int LAPACKE_ztrcon( int matrix_layout, char norm, char uplo, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztrcon_work( matrix_layout, norm, uplo, diag, n, a, lda, + info = API_SUFFIX(LAPACKE_ztrcon_work)( matrix_layout, norm, uplo, diag, n, a, lda, rcond, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -72,7 +72,7 @@ lapack_int LAPACKE_ztrcon( int matrix_layout, char norm, char uplo, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrcon", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrcon", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrcon_work.c b/LAPACKE/src/lapacke_ztrcon_work.c index 08188d8790..969f8a8536 100644 --- a/LAPACKE/src/lapacke_ztrcon_work.c +++ b/LAPACKE/src/lapacke_ztrcon_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrcon_work( int matrix_layout, char norm, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztrcon_work)( int matrix_layout, char norm, char uplo, char diag, lapack_int n, const lapack_complex_double* a, lapack_int lda, double* rcond, lapack_complex_double* work, @@ -52,7 +52,7 @@ lapack_int LAPACKE_ztrcon_work( int matrix_layout, char norm, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrcon_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -63,7 +63,7 @@ lapack_int LAPACKE_ztrcon_work( int matrix_layout, char norm, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrcon( &norm, &uplo, &diag, &n, a_t, &lda_t, rcond, work, rwork, &info ); @@ -74,11 +74,11 @@ lapack_int LAPACKE_ztrcon_work( int matrix_layout, char norm, char uplo, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrcon_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrcon_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrcon_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrevc.c b/LAPACKE/src/lapacke_ztrevc.c index 185ed8854b..da9d0bd0d6 100644 --- a/LAPACKE/src/lapacke_ztrevc.c +++ b/LAPACKE/src/lapacke_ztrevc.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrevc( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztrevc)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* vl, lapack_int ldvl, @@ -43,22 +43,22 @@ lapack_int LAPACKE_ztrevc( int matrix_layout, char side, char howmny, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrevc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } @@ -77,7 +77,7 @@ lapack_int LAPACKE_ztrevc( int matrix_layout, char side, char howmny, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztrevc_work( matrix_layout, side, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_ztrevc_work)( matrix_layout, side, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, mm, m, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -85,7 +85,7 @@ lapack_int LAPACKE_ztrevc( int matrix_layout, char side, char howmny, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrevc", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrevc_work.c b/LAPACKE/src/lapacke_ztrevc_work.c index 818658fe02..3c88602000 100644 --- a/LAPACKE/src/lapacke_ztrevc_work.c +++ b/LAPACKE/src/lapacke_ztrevc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztrevc_work)( int matrix_layout, char side, char howmny, const lapack_logical* select, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* vl, lapack_int ldvl, @@ -58,17 +58,17 @@ lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -78,7 +78,7 @@ lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,mm) ); @@ -87,7 +87,7 @@ lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,mm) ); @@ -97,14 +97,14 @@ lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) && - LAPACKE_lsame( howmny, 'b' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( ( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) || API_SUFFIX(LAPACKE_lsame)( side, 'b' ) ) && + API_SUFFIX(LAPACKE_lsame)( howmny, 'b' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztrevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -113,32 +113,32 @@ lapack_int LAPACKE_ztrevc_work( int matrix_layout, char side, char howmny, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl, ldvl ); } - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'b' ) || API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrevc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrevc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrexc.c b/LAPACKE/src/lapacke_ztrexc.c index 29b786a6b9..5c7358843e 100644 --- a/LAPACKE/src/lapacke_ztrexc.c +++ b/LAPACKE/src/lapacke_ztrexc.c @@ -32,28 +32,28 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrexc( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztrexc)( int matrix_layout, char compq, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* q, lapack_int ldq, lapack_int ifst, lapack_int ilst ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrexc", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrexc", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -6; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -4; } } #endif - return LAPACKE_ztrexc_work( matrix_layout, compq, n, t, ldt, q, ldq, ifst, + return API_SUFFIX(LAPACKE_ztrexc_work)( matrix_layout, compq, n, t, ldt, q, ldq, ifst, ilst ); } diff --git a/LAPACKE/src/lapacke_ztrexc_work.c b/LAPACKE/src/lapacke_ztrexc_work.c index 86647ede2d..c443fece72 100644 --- a/LAPACKE/src/lapacke_ztrexc_work.c +++ b/LAPACKE/src/lapacke_ztrexc_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrexc_work( int matrix_layout, char compq, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztrexc_work)( int matrix_layout, char compq, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* q, lapack_int ldq, lapack_int ifst, lapack_int ilst ) @@ -50,14 +50,14 @@ lapack_int LAPACKE_ztrexc_work( int matrix_layout, char compq, lapack_int n, lapack_complex_double* t_t = NULL; lapack_complex_double* q_t = NULL; /* Check leading dimension(s) */ - if( ldq < n && LAPACKE_lsame( compq, 'v' ) ) { + if( ldq < n && API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrexc_work", info ); return info; } if( ldt < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ztrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrexc_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -67,7 +67,7 @@ lapack_int LAPACKE_ztrexc_work( int matrix_layout, char compq, lapack_int n, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -77,9 +77,9 @@ lapack_int LAPACKE_ztrexc_work( int matrix_layout, char compq, lapack_int n, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, &ifst, &ilst, @@ -88,23 +88,23 @@ lapack_int LAPACKE_ztrexc_work( int matrix_layout, char compq, lapack_int n, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrexc_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrexc_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrexc_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrrfs.c b/LAPACKE/src/lapacke_ztrrfs.c index e1da3828a0..fce1cb0cbf 100644 --- a/LAPACKE/src/lapacke_ztrrfs.c +++ b/LAPACKE/src/lapacke_ztrrfs.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrrfs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztrrfs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -43,19 +43,19 @@ lapack_int LAPACKE_ztrrfs( int matrix_layout, char uplo, char trans, char diag, double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrrfs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, x, ldx ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, x, ldx ) ) { return -11; } } @@ -73,7 +73,7 @@ lapack_int LAPACKE_ztrrfs( int matrix_layout, char uplo, char trans, char diag, goto exit_level_1; } /* Call middle-level interface */ - info = LAPACKE_ztrrfs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + info = API_SUFFIX(LAPACKE_ztrrfs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb, x, ldx, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); @@ -81,7 +81,7 @@ lapack_int LAPACKE_ztrrfs( int matrix_layout, char uplo, char trans, char diag, LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrrfs", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrrfs_work.c b/LAPACKE/src/lapacke_ztrrfs_work.c index f84a27be6c..8e1c4bb076 100644 --- a/LAPACKE/src/lapacke_ztrrfs_work.c +++ b/LAPACKE/src/lapacke_ztrrfs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrrfs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztrrfs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -58,17 +58,17 @@ lapack_int LAPACKE_ztrrfs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -93,9 +93,9 @@ lapack_int LAPACKE_ztrrfs_work( int matrix_layout, char uplo, char trans, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_ztr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); @@ -110,11 +110,11 @@ lapack_int LAPACKE_ztrrfs_work( int matrix_layout, char uplo, char trans, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrrfs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrrfs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsen.c b/LAPACKE/src/lapacke_ztrsen.c index 0846ef6946..957b936465 100644 --- a/LAPACKE/src/lapacke_ztrsen.c +++ b/LAPACKE/src/lapacke_ztrsen.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsen( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_ztrsen)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* q, lapack_int ldq, @@ -44,24 +44,24 @@ lapack_int LAPACKE_ztrsen( int matrix_layout, char job, char compq, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrsen", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_lsame( compq, 'v' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, q, ldq ) ) { return -8; } } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ztrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_ztrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_ztrsen( int matrix_layout, char job, char compq, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztrsen_work( matrix_layout, job, compq, select, n, t, ldt, q, + info = API_SUFFIX(LAPACKE_ztrsen_work)( matrix_layout, job, compq, select, n, t, ldt, q, ldq, w, m, s, sep, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsen", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsen_work.c b/LAPACKE/src/lapacke_ztrsen_work.c index 55dcee4877..8aaddab46c 100644 --- a/LAPACKE/src/lapacke_ztrsen_work.c +++ b/LAPACKE/src/lapacke_ztrsen_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsen_work( int matrix_layout, char job, char compq, +lapack_int API_SUFFIX(LAPACKE_ztrsen_work)( int matrix_layout, char job, char compq, const lapack_logical* select, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* q, lapack_int ldq, @@ -56,12 +56,12 @@ lapack_int LAPACKE_ztrsen_work( int matrix_layout, char job, char compq, /* Check leading dimension(s) */ if( ldq < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen_work", info ); return info; } if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -77,7 +77,7 @@ lapack_int LAPACKE_ztrsen_work( int matrix_layout, char job, char compq, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { q_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) ); @@ -87,9 +87,9 @@ lapack_int LAPACKE_ztrsen_work( int matrix_layout, char job, char compq, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztrsen( &job, &compq, select, &n, t_t, &ldt_t, q_t, &ldq_t, w, m, @@ -98,23 +98,23 @@ lapack_int LAPACKE_ztrsen_work( int matrix_layout, char job, char compq, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); - if( LAPACKE_lsame( compq, 'v' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ - if( LAPACKE_lsame( compq, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( compq, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrsen_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsen_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsna.c b/LAPACKE/src/lapacke_ztrsna.c index cf08c44d06..388e7e2a6a 100644 --- a/LAPACKE/src/lapacke_ztrsna.c +++ b/LAPACKE/src/lapacke_ztrsna.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsna( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztrsna)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* t, lapack_int ldt, const lapack_complex_double* vl, lapack_int ldvl, @@ -41,40 +41,40 @@ lapack_int LAPACKE_ztrsna( int matrix_layout, char job, char howmny, lapack_int* m ) { lapack_int info = 0; - lapack_int ldwork = LAPACKE_lsame( job, 'e' ) ? 1 : MAX(1,n) ; + lapack_int ldwork = API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ? 1 : MAX(1,n) ; double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrsna", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, t, ldt ) ) { return -6; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vl, ldvl ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vl, ldvl ) ) { return -8; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - if( LAPACKE_zge_nancheck( matrix_layout, n, mm, vr, ldvr ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, mm, vr, ldvr ) ) { return -10; } } } #endif /* Allocate memory for working array(s) */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldwork * MAX(1,n+6) ); @@ -84,20 +84,20 @@ lapack_int LAPACKE_ztrsna( int matrix_layout, char job, char howmny, } } /* Call middle-level interface */ - info = LAPACKE_ztrsna_work( matrix_layout, job, howmny, select, n, t, ldt, + info = API_SUFFIX(LAPACKE_ztrsna_work)( matrix_layout, job, howmny, select, n, t, ldt, vl, ldvl, vr, ldvr, s, sep, mm, m, work, ldwork, rwork ); /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( work ); } exit_level_1: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'v' ) ) { LAPACKE_free( rwork ); } exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsna", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsna_work.c b/LAPACKE/src/lapacke_ztrsna_work.c index 1f0717df86..26b9ca8c10 100644 --- a/LAPACKE/src/lapacke_ztrsna_work.c +++ b/LAPACKE/src/lapacke_ztrsna_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, +lapack_int API_SUFFIX(LAPACKE_ztrsna_work)( int matrix_layout, char job, char howmny, const lapack_logical* select, lapack_int n, const lapack_complex_double* t, lapack_int ldt, const lapack_complex_double* vl, @@ -61,17 +61,17 @@ lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, /* Check leading dimension(s) */ if( ldt < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_ztrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna_work", info ); return info; } if( ldvl < mm ) { info = -9; - LAPACKE_xerbla( "LAPACKE_ztrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna_work", info ); return info; } if( ldvr < mm ) { info = -11; - LAPACKE_xerbla( "LAPACKE_ztrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -81,7 +81,7 @@ lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vl_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvl_t * MAX(1,mm) ); @@ -90,7 +90,7 @@ lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, goto exit_level_1; } } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { vr_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvr_t * MAX(1,mm) ); @@ -100,12 +100,12 @@ lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t ); - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, t, ldt, t_t, ldt_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vl, ldvl, vl_t, ldvl_t ); } - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { - LAPACKE_zge_trans( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, mm, vr, ldvr, vr_t, ldvr_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztrsna( &job, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t, @@ -115,22 +115,22 @@ lapack_int LAPACKE_ztrsna_work( int matrix_layout, char job, char howmny, info = info - 1; } /* Release memory and exit */ - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vr_t ); } exit_level_2: - if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( job, 'b' ) || API_SUFFIX(LAPACKE_lsame)( job, 'e' ) ) { LAPACKE_free( vl_t ); } exit_level_1: LAPACKE_free( t_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrsna_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsna_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsyl.c b/LAPACKE/src/lapacke_ztrsyl.c index fe882e756b..b987a82e5f 100644 --- a/LAPACKE/src/lapacke_ztrsyl.c +++ b/LAPACKE/src/lapacke_ztrsyl.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsyl( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ztrsyl)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -40,23 +40,23 @@ lapack_int LAPACKE_ztrsyl( int matrix_layout, char trana, char tranb, double* scale ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrsyl", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif - return LAPACKE_ztrsyl_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + return API_SUFFIX(LAPACKE_ztrsyl_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale ); } diff --git a/LAPACKE/src/lapacke_ztrsyl3.c b/LAPACKE/src/lapacke_ztrsyl3.c index dbc9bcf9f7..3447f321f2 100644 --- a/LAPACKE/src/lapacke_ztrsyl3.c +++ b/LAPACKE/src/lapacke_ztrsyl3.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ztrsyl3)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -13,25 +13,25 @@ lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb, lapack_int ldswork = -1; lapack_int swork_size = -1; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrsyl3", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, m, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, b, ldb ) ) { return -9; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } } #endif /* Query optimal working array sizes */ - info = LAPACKE_ztrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda, + info = API_SUFFIX(LAPACKE_ztrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork_query, ldswork ); if( info != 0 ) { goto exit_level_0; @@ -44,13 +44,13 @@ lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, + info = API_SUFFIX(LAPACKE_ztrsyl3_work)( matrix_layout, trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, swork, ldswork ); /* Release memory and exit */ LAPACKE_free( swork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsyl3", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsyl3_work.c b/LAPACKE/src/lapacke_ztrsyl3_work.c index a7ebd5da60..c4bb2379d8 100644 --- a/LAPACKE/src/lapacke_ztrsyl3_work.c +++ b/LAPACKE/src/lapacke_ztrsyl3_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ztrsyl3_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -26,17 +26,17 @@ lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -59,9 +59,9 @@ lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrsyl3( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, swork, &ldswork, &info ); @@ -69,7 +69,7 @@ lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -78,11 +78,11 @@ lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrsyl3_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl3_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrsyl_work.c b/LAPACKE/src/lapacke_ztrsyl_work.c index 4b0813aaeb..3613cf8b5c 100644 --- a/LAPACKE/src/lapacke_ztrsyl_work.c +++ b/LAPACKE/src/lapacke_ztrsyl_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb, +lapack_int API_SUFFIX(LAPACKE_ztrsyl_work)( int matrix_layout, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* b, lapack_int ldb, @@ -57,17 +57,17 @@ lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl_work", info ); return info; } if( ldb < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_ztrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -90,9 +90,9 @@ lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb, goto exit_level_2; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, &info ); @@ -100,7 +100,7 @@ lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_2: @@ -109,11 +109,11 @@ lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb, LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrsyl_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrsyl_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrtri.c b/LAPACKE/src/lapacke_ztrtri.c index 94f8ef7289..65fdd3e121 100644 --- a/LAPACKE/src/lapacke_ztrtri.c +++ b/LAPACKE/src/lapacke_ztrtri.c @@ -32,20 +32,20 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrtri( int matrix_layout, char uplo, char diag, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztrtri)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_double* a, lapack_int lda ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrtri", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtri", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -5; } } #endif - return LAPACKE_ztrtri_work( matrix_layout, uplo, diag, n, a, lda ); + return API_SUFFIX(LAPACKE_ztrtri_work)( matrix_layout, uplo, diag, n, a, lda ); } diff --git a/LAPACKE/src/lapacke_ztrtri_work.c b/LAPACKE/src/lapacke_ztrtri_work.c index d3963e6c11..8bca966a28 100644 --- a/LAPACKE/src/lapacke_ztrtri_work.c +++ b/LAPACKE/src/lapacke_ztrtri_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrtri_work( int matrix_layout, char uplo, char diag, +lapack_int API_SUFFIX(LAPACKE_ztrtri_work)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_complex_double* a, lapack_int lda ) { @@ -49,7 +49,7 @@ lapack_int LAPACKE_ztrtri_work( int matrix_layout, char uplo, char diag, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ztrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtri_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -60,24 +60,24 @@ lapack_int LAPACKE_ztrtri_work( int matrix_layout, char uplo, char diag, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_ztr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrtri( &uplo, &diag, &n, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_ztr_trans( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, + API_SUFFIX(LAPACKE_ztr_trans)( LAPACK_COL_MAJOR, uplo, diag, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtri_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrtri_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtri_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrtrs.c b/LAPACKE/src/lapacke_ztrtrs.c index 0a8477f273..69049e9990 100644 --- a/LAPACKE/src/lapacke_ztrtrs.c +++ b/LAPACKE/src/lapacke_ztrtrs.c @@ -32,26 +32,26 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrtrs( int matrix_layout, char uplo, char trans, char diag, +lapack_int API_SUFFIX(LAPACKE_ztrtrs)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrtrs", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtrs", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, diag, n, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, nrhs, b, ldb ) ) { return -9; } } #endif - return LAPACKE_ztrtrs_work( matrix_layout, uplo, trans, diag, n, nrhs, a, + return API_SUFFIX(LAPACKE_ztrtrs_work)( matrix_layout, uplo, trans, diag, n, nrhs, a, lda, b, ldb ); } diff --git a/LAPACKE/src/lapacke_ztrtrs_work.c b/LAPACKE/src/lapacke_ztrtrs_work.c index 7a5ec17f3a..f962dec8ac 100644 --- a/LAPACKE/src/lapacke_ztrtrs_work.c +++ b/LAPACKE/src/lapacke_ztrtrs_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrtrs_work( int matrix_layout, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_ztrtrs_work)( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb ) @@ -53,12 +53,12 @@ lapack_int LAPACKE_ztrtrs_work( int matrix_layout, char uplo, char trans, /* Check leading dimension(s) */ if( lda < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_ztrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtrs_work", info ); return info; } if( ldb < nrhs ) { info = -10; - LAPACKE_xerbla( "LAPACKE_ztrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -76,8 +76,8 @@ lapack_int LAPACKE_ztrtrs_work( int matrix_layout, char uplo, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_ztr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrtrs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, &info ); @@ -85,18 +85,18 @@ lapack_int LAPACKE_ztrtrs_work( int matrix_layout, char uplo, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtrs_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrtrs_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrtrs_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrttf.c b/LAPACKE/src/lapacke_ztrttf.c index 22bb9b0f6a..ae0436a3fc 100644 --- a/LAPACKE/src/lapacke_ztrttf.c +++ b/LAPACKE/src/lapacke_ztrttf.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrttf( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztrttf)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* arf ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrttf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -5; } } #endif - return LAPACKE_ztrttf_work( matrix_layout, transr, uplo, n, a, lda, arf ); + return API_SUFFIX(LAPACKE_ztrttf_work)( matrix_layout, transr, uplo, n, a, lda, arf ); } diff --git a/LAPACKE/src/lapacke_ztrttf_work.c b/LAPACKE/src/lapacke_ztrttf_work.c index 5512a3d9c4..bac5999d09 100644 --- a/LAPACKE/src/lapacke_ztrttf_work.c +++ b/LAPACKE/src/lapacke_ztrttf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrttf_work( int matrix_layout, char transr, char uplo, +lapack_int API_SUFFIX(LAPACKE_ztrttf_work)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* arf ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ztrttf_work( int matrix_layout, char transr, char uplo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_ztrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttf_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ztrttf_work( int matrix_layout, char transr, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); + API_SUFFIX(LAPACKE_zpf_trans)( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrttf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztrttp.c b/LAPACKE/src/lapacke_ztrttp.c index 6c1239e94b..d0bccd0069 100644 --- a/LAPACKE/src/lapacke_ztrttp.c +++ b/LAPACKE/src/lapacke_ztrttp.c @@ -32,21 +32,21 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrttp( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztrttp)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* ap ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztrttp", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttp", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_ztr_nancheck( matrix_layout, uplo, 'n', n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ) ) { return -4; } } #endif - return LAPACKE_ztrttp_work( matrix_layout, uplo, n, a, lda, ap ); + return API_SUFFIX(LAPACKE_ztrttp_work)( matrix_layout, uplo, n, a, lda, ap ); } diff --git a/LAPACKE/src/lapacke_ztrttp_work.c b/LAPACKE/src/lapacke_ztrttp_work.c index b8488217de..25e71776b9 100644 --- a/LAPACKE/src/lapacke_ztrttp_work.c +++ b/LAPACKE/src/lapacke_ztrttp_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztrttp_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztrttp_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* ap ) { @@ -50,7 +50,7 @@ lapack_int LAPACKE_ztrttp_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ztrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttp_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -68,25 +68,25 @@ lapack_int LAPACKE_ztrttp_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ztrttp( &uplo, &n, a_t, &lda_t, ap_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); + API_SUFFIX(LAPACKE_zpp_trans)( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttp_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztrttp_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztrttp_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztzrzf.c b/LAPACKE/src/lapacke_ztzrzf.c index a5ea5a27c1..5738b0b479 100644 --- a/LAPACKE/src/lapacke_ztzrzf.c +++ b/LAPACKE/src/lapacke_ztzrzf.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztzrzf( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztzrzf)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau ) { @@ -41,19 +41,19 @@ lapack_int LAPACKE_ztzrzf( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_ztzrzf", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztzrzf", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -4; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_ztzrzf_work( matrix_layout, m, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_ztzrzf_work)( matrix_layout, m, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -67,12 +67,12 @@ lapack_int LAPACKE_ztzrzf( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ztzrzf_work( matrix_layout, m, n, a, lda, tau, work, lwork ); + info = API_SUFFIX(LAPACKE_ztzrzf_work)( matrix_layout, m, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztzrzf", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztzrzf", info ); } return info; } diff --git a/LAPACKE/src/lapacke_ztzrzf_work.c b/LAPACKE/src/lapacke_ztzrzf_work.c index 5a76dfc1fa..23f6b9173f 100644 --- a/LAPACKE/src/lapacke_ztzrzf_work.c +++ b/LAPACKE/src/lapacke_ztzrzf_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztzrzf_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_ztzrzf_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_ztzrzf_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_ztzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztzrzf_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_ztzrzf_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ztzrzf( &m, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_ztzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztzrzf_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_ztzrzf_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztzrzf_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunbdb.c b/LAPACKE/src/lapacke_zunbdb.c index 4d6cb8faf6..d840c1ed7d 100644 --- a/LAPACKE/src/lapacke_zunbdb.c +++ b/LAPACKE/src/lapacke_zunbdb.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunbdb( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_zunbdb)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x12, lapack_int ldx12, @@ -50,10 +50,10 @@ lapack_int LAPACKE_zunbdb( int matrix_layout, char trans, char signs, lapack_complex_double work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunbdb", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunbdb", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -61,22 +61,22 @@ lapack_int LAPACKE_zunbdb( int matrix_layout, char trans, char signs, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -7; } - if( LAPACKE_zge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -9; } - if( LAPACKE_zge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -11; } - if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -13; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_zunbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, &work_query, lwork ); @@ -92,14 +92,14 @@ lapack_int LAPACKE_zunbdb( int matrix_layout, char trans, char signs, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunbdb_work( matrix_layout, trans, signs, m, p, q, x11, ldx11, + info = API_SUFFIX(LAPACKE_zunbdb_work)( matrix_layout, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunbdb", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunbdb", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunbdb_work.c b/LAPACKE/src/lapacke_zunbdb_work.c index 94fc92d38e..57964443ac 100644 --- a/LAPACKE/src/lapacke_zunbdb_work.c +++ b/LAPACKE/src/lapacke_zunbdb_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunbdb_work( int matrix_layout, char trans, char signs, +lapack_int API_SUFFIX(LAPACKE_zunbdb_work)( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x12, lapack_int ldx12, @@ -63,7 +63,7 @@ lapack_int LAPACKE_zunbdb_work( int matrix_layout, char trans, char signs, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -77,7 +77,7 @@ lapack_int LAPACKE_zunbdb_work( int matrix_layout, char trans, char signs, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunbdb_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zuncsd.c b/LAPACKE/src/lapacke_zuncsd.c index a423e91357..1c77e7f0a8 100644 --- a/LAPACKE/src/lapacke_zuncsd.c +++ b/LAPACKE/src/lapacke_zuncsd.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_zuncsd)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, @@ -55,10 +55,10 @@ lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, lapack_complex_double work_query; int lapack_layout; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zuncsd", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd", -1 ); return -1; } - if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( API_SUFFIX(LAPACKE_lsame)( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) { lapack_layout = LAPACK_COL_MAJOR; } else { lapack_layout = LAPACK_ROW_MAJOR; @@ -66,16 +66,16 @@ lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, p, q, x11, ldx11 ) ) { return -11; } - if( LAPACKE_zge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, p, m-q, x12, ldx12 ) ) { return -13; } - if( LAPACKE_zge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-p, q, x21, ldx21 ) ) { return -15; } - if( LAPACKE_zge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( lapack_layout, m-p, m-q, x22, ldx22 ) ) { return -17; } } @@ -87,7 +87,7 @@ lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zuncsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_zuncsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, &work_query, @@ -110,7 +110,7 @@ lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zuncsd_work( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, + info = API_SUFFIX(LAPACKE_zuncsd_work)( matrix_layout, jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, work, lwork, @@ -123,7 +123,7 @@ lapack_int LAPACKE_zuncsd( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zuncsd", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zuncsd2by1.c b/LAPACKE/src/lapacke_zuncsd2by1.c index 321b5af49b..39a77a26e2 100644 --- a/LAPACKE/src/lapacke_zuncsd2by1.c +++ b/LAPACKE/src/lapacke_zuncsd2by1.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(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, @@ -50,7 +50,7 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, lapack_complex_double work_query; lapack_int nrows_x11, nrows_x21; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zuncsd2by1", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK @@ -58,11 +58,11 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, /* Optionally check input matrices for NaNs */ nrows_x11 = p; nrows_x21 = m-p; - if( LAPACKE_zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { return -9; } } @@ -74,7 +74,7 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_0; } /* Query optimal working array(s) size */ - info = LAPACKE_zuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_zuncsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, &work_query, lwork, &rwork_query, lrwork, iwork ); @@ -95,7 +95,7 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } /* Call middle-level interface */ - info = LAPACKE_zuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + info = API_SUFFIX(LAPACKE_zuncsd2by1_work)( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork ); /* Release memory and exit */ @@ -106,7 +106,7 @@ lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( iwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zuncsd2by1", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zuncsd2by1_work.c b/LAPACKE/src/lapacke_zuncsd2by1_work.c index 72f1454ff7..48917aad07 100644 --- a/LAPACKE/src/lapacke_zuncsd2by1_work.c +++ b/LAPACKE/src/lapacke_zuncsd2by1_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(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, @@ -56,9 +56,9 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_x11 = p; lapack_int nrows_x21 = m-p; - lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); - lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); - lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int nrows_u1 = ( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ? q : 1); lapack_int ldu1_t = MAX(1,nrows_u1); lapack_int ldu2_t = MAX(1,nrows_u2); lapack_int ldv1t_t = MAX(1,nrows_v1t); @@ -72,27 +72,27 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, /* Check leading dimension(s) */ if( ldu1 < p ) { info = -21; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); return info; } if( ldu2 < m-p ) { info = -23; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); return info; } if( ldv1t < q ) { info = -25; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); return info; } if( ldx11 < q ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); return info; } if( ldx21 < q ) { info = -16; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -114,7 +114,7 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { u1_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu1_t * MAX(1,p) ); if( u1_t == NULL ) { @@ -122,7 +122,7 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_2; } } - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { u2_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu2_t * MAX(1,m-p) ); if( u2_t == NULL ) { @@ -130,7 +130,7 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, goto exit_level_3; } } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { v1t_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldv1t_t * MAX(1,q) ); if( v1t_t == NULL ) { @@ -139,9 +139,9 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, } } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, ldx11_t ); - LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, ldx21_t ); /* Call LAPACK function and adjust info */ LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, @@ -152,32 +152,32 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, ldx11 ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, ldx21 ); - if( LAPACKE_lsame( jobu1, 'y' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, ldu1 ); } - if( LAPACKE_lsame( jobu2, 'y' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, u2, ldu2 ); } - if( LAPACKE_lsame( jobv1t, 'y' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, v1t, ldv1t ); } /* Release memory and exit */ - if( LAPACKE_lsame( jobv1t, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobv1t, 'y' ) ) { LAPACKE_free( v1t_t ); } exit_level_4: - if( LAPACKE_lsame( jobu2, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu2, 'y' ) ) { LAPACKE_free( u2_t ); } exit_level_3: - if( LAPACKE_lsame( jobu1, 'y' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( jobu1, 'y' ) ) { LAPACKE_free( u1_t ); } exit_level_2: @@ -186,11 +186,11 @@ lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, LAPACKE_free( x11_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd2by1_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zuncsd_work.c b/LAPACKE/src/lapacke_zuncsd_work.c index aa74cd5d8b..407fbe2854 100644 --- a/LAPACKE/src/lapacke_zuncsd_work.c +++ b/LAPACKE/src/lapacke_zuncsd_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zuncsd_work( int matrix_layout, char jobu1, char jobu2, +lapack_int API_SUFFIX(LAPACKE_zuncsd_work)( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, @@ -66,7 +66,7 @@ lapack_int LAPACKE_zuncsd_work( int matrix_layout, char jobu1, char jobu2, if( matrix_layout == LAPACK_COL_MAJOR || matrix_layout == LAPACK_ROW_MAJOR ) { char ltrans; - if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { + if( !API_SUFFIX(LAPACKE_lsame)( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) { ltrans = 'n'; } else { ltrans = 't'; @@ -81,7 +81,7 @@ lapack_int LAPACKE_zuncsd_work( int matrix_layout, char jobu1, char jobu2, } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zuncsd_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zuncsd_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungbr.c b/LAPACKE/src/lapacke_zungbr.c index a06b892679..4af00073df 100644 --- a/LAPACKE/src/lapacke_zungbr.c +++ b/LAPACKE/src/lapacke_zungbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungbr( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zungbr)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zungbr( int matrix_layout, char vect, lapack_int m, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_z_nancheck( MIN(m,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( MIN(m,k), tau, 1 ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungbr_work( matrix_layout, vect, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zungbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zungbr( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungbr_work( matrix_layout, vect, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zungbr_work)( matrix_layout, vect, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungbr_work.c b/LAPACKE/src/lapacke_zungbr_work.c index e7b1a18fe4..6b82d1dc9c 100644 --- a/LAPACKE/src/lapacke_zungbr_work.c +++ b/LAPACKE/src/lapacke_zungbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungbr_work( int matrix_layout, char vect, lapack_int m, +lapack_int API_SUFFIX(LAPACKE_zungbr_work)( int matrix_layout, char vect, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zungbr_work( int matrix_layout, char vect, lapack_int m, /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,7 +68,7 @@ lapack_int LAPACKE_zungbr_work( int matrix_layout, char vect, lapack_int m, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zungbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); @@ -76,16 +76,16 @@ lapack_int LAPACKE_zungbr_work( int matrix_layout, char vect, lapack_int m, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunghr.c b/LAPACKE/src/lapacke_zunghr.c index 276b263aa9..7e0f9859f4 100644 --- a/LAPACKE/src/lapacke_zunghr.c +++ b/LAPACKE/src/lapacke_zunghr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunghr( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_zunghr)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zunghr( int matrix_layout, lapack_int n, lapack_int ilo, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunghr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunghr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, n, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zunghr( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunghr_work( matrix_layout, n, ilo, ihi, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zunghr_work)( matrix_layout, n, ilo, ihi, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunghr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunghr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunghr_work.c b/LAPACKE/src/lapacke_zunghr_work.c index 6f91e4ee67..ca11abb982 100644 --- a/LAPACKE/src/lapacke_zunghr_work.c +++ b/LAPACKE/src/lapacke_zunghr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, +lapack_int API_SUFFIX(LAPACKE_zunghr_work)( int matrix_layout, lapack_int n, lapack_int ilo, lapack_int ihi, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunghr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -68,23 +68,23 @@ lapack_int LAPACKE_zunghr_work( int matrix_layout, lapack_int n, lapack_int ilo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zunghr( &n, &ilo, &ihi, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunghr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunghr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunghr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunglq.c b/LAPACKE/src/lapacke_zunglq.c index d42d1a2786..8ececc168a 100644 --- a/LAPACKE/src/lapacke_zunglq.c +++ b/LAPACKE/src/lapacke_zunglq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunglq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zunglq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zunglq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunglq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunglq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunglq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zunglq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zunglq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunglq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zunglq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunglq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunglq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunglq_work.c b/LAPACKE/src/lapacke_zunglq_work.c index 5e57d6accd..d7e8d0d862 100644 --- a/LAPACKE/src/lapacke_zunglq_work.c +++ b/LAPACKE/src/lapacke_zunglq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunglq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zunglq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zunglq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunglq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zunglq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zunglq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunglq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunglq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunglq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungql.c b/LAPACKE/src/lapacke_zungql.c index 516d2b2219..c013d7f0a8 100644 --- a/LAPACKE/src/lapacke_zungql.c +++ b/LAPACKE/src/lapacke_zungql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungql( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungql)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zungql( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungql_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zungql_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zungql( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungql_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zungql_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungql_work.c b/LAPACKE/src/lapacke_zungql_work.c index 61ab14ce5c..318c91ecd0 100644 --- a/LAPACKE/src/lapacke_zungql_work.c +++ b/LAPACKE/src/lapacke_zungql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungql_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungql_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zungql_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zungql_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zungql( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungqr.c b/LAPACKE/src/lapacke_zungqr.c index 8aeedc4026..0ecc5f9d6a 100644 --- a/LAPACKE/src/lapacke_zungqr.c +++ b/LAPACKE/src/lapacke_zungqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungqr( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungqr)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zungqr( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungqr_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zungqr_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zungqr( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungqr_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zungqr_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungqr_work.c b/LAPACKE/src/lapacke_zungqr_work.c index f50c0b15b0..202397b66f 100644 --- a/LAPACKE/src/lapacke_zungqr_work.c +++ b/LAPACKE/src/lapacke_zungqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungqr_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungqr_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zungqr_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zungqr_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zungqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungrq.c b/LAPACKE/src/lapacke_zungrq.c index 7b8a3eca5a..235f5a9b8b 100644 --- a/LAPACKE/src/lapacke_zungrq.c +++ b/LAPACKE/src/lapacke_zungrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungrq( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungrq)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zungrq( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -7; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungrq_work( matrix_layout, m, n, k, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zungrq_work)( matrix_layout, m, n, k, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zungrq( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungrq_work( matrix_layout, m, n, k, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zungrq_work)( matrix_layout, m, n, k, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungrq_work.c b/LAPACKE/src/lapacke_zungrq_work.c index 6c5856d738..352835ed18 100644 --- a/LAPACKE/src/lapacke_zungrq_work.c +++ b/LAPACKE/src/lapacke_zungrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungrq_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungrq_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int k, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -51,7 +51,7 @@ lapack_int LAPACKE_zungrq_work( int matrix_layout, lapack_int m, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -67,23 +67,23 @@ lapack_int LAPACKE_zungrq_work( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zungrq( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungtr.c b/LAPACKE/src/lapacke_zungtr.c index 9b57692257..69da63e734 100644 --- a/LAPACKE/src/lapacke_zungtr.c +++ b/LAPACKE/src/lapacke_zungtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungtr)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau ) { @@ -41,22 +41,22 @@ lapack_int LAPACKE_zungtr( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zhe_nancheck)( matrix_layout, uplo, n, a, lda ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, tau, 1 ) ) { return -6; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungtr_work( matrix_layout, uplo, n, a, lda, tau, &work_query, + info = API_SUFFIX(LAPACKE_zungtr_work)( matrix_layout, uplo, n, a, lda, tau, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -70,13 +70,13 @@ lapack_int LAPACKE_zungtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungtr_work( matrix_layout, uplo, n, a, lda, tau, work, + info = API_SUFFIX(LAPACKE_zungtr_work)( matrix_layout, uplo, n, a, lda, tau, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungtr_work.c b/LAPACKE/src/lapacke_zungtr_work.c index 0ddb09fba9..f4a876f686 100644 --- a/LAPACKE/src/lapacke_zungtr_work.c +++ b/LAPACKE/src/lapacke_zungtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungtr_work)( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, lapack_complex_double* work, lapack_int lwork ) @@ -50,7 +50,7 @@ lapack_int LAPACKE_zungtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( lda < n ) { info = -5; - LAPACKE_xerbla( "LAPACKE_zungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -66,23 +66,23 @@ lapack_int LAPACKE_zungtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zungtr( &uplo, &n, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zungtsqr_row.c b/LAPACKE/src/lapacke_zungtsqr_row.c index 71418fb849..55a85364b9 100644 --- a/LAPACKE/src/lapacke_zungtsqr_row.c +++ b/LAPACKE/src/lapacke_zungtsqr_row.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungtsqr_row)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int ldt ) @@ -42,22 +42,22 @@ lapack_int LAPACKE_zungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zungtsqr_row", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -6; } - if( LAPACKE_zge_nancheck( matrix_layout, nb, n, t, ldt ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, nb, n, t, ldt ) ) { return -8; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zungtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_zungtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -71,13 +71,13 @@ lapack_int LAPACKE_zungtsqr_row( int matrix_layout, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zungtsqr_row_work( matrix_layout, m, n, mb, nb, + info = API_SUFFIX(LAPACKE_zungtsqr_row_work)( matrix_layout, m, n, mb, nb, a, lda, t, ldt, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungtsqr_row", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_zungtsqr_row_work.c b/LAPACKE/src/lapacke_zungtsqr_row_work.c index 9098558640..33850cd5c1 100644 --- a/LAPACKE/src/lapacke_zungtsqr_row_work.c +++ b/LAPACKE/src/lapacke_zungtsqr_row_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zungtsqr_row_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zungtsqr_row_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int mb, lapack_int nb, lapack_complex_double* a, lapack_int lda, const lapack_complex_double* t, lapack_int ldt, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( lda < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row_work", info ); return info; } lapack_int ldt_t = MAX(1,nb); @@ -60,7 +60,7 @@ lapack_int LAPACKE_zungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in /* Check leading dimension(s) */ if( ldt < n ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, nb, n, a, lda, t_t, ldt_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, nb, n, a, lda, t_t, ldt_t ); /* Call LAPACK function and adjust info */ LAPACK_zungtsqr_row( &m, &n, &mb, &nb, a_t, &lda_t, t_t, &ldt_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_zungtsqr_row_work( int matrix_layout, lapack_int m, lapack_in info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zungtsqr_row_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zungtsqr_row_work", info ); } return info; } \ No newline at end of file diff --git a/LAPACKE/src/lapacke_zunhr_col.c b/LAPACKE/src/lapacke_zunhr_col.c index 7e2507daf6..1f2a0f25eb 100644 --- a/LAPACKE/src/lapacke_zunhr_col.c +++ b/LAPACKE/src/lapacke_zunhr_col.c @@ -1,24 +1,24 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunhr_col( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zunhr_col)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* d) { lapack_int info = 0; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunhr_col", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunhr_col", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ) ) { return -5; } } #endif /* Call middle-level interface */ - info = LAPACKE_zunhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d ); + info = API_SUFFIX(LAPACKE_zunhr_col_work)( matrix_layout, m, n, nb, a, lda, t, ldt, d ); return info; } diff --git a/LAPACKE/src/lapacke_zunhr_col_work.c b/LAPACKE/src/lapacke_zunhr_col_work.c index b5e6401776..f374f2431a 100644 --- a/LAPACKE/src/lapacke_zunhr_col_work.c +++ b/LAPACKE/src/lapacke_zunhr_col_work.c @@ -1,6 +1,6 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zunhr_col_work)( int matrix_layout, lapack_int m, lapack_int n, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* d ) @@ -20,12 +20,12 @@ lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n /* Check leading dimension(s) */ if( lda < n ) { info = -6; - LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunhr_col_work", info ); return info; } if( ldt < n ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunhr_col_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -43,15 +43,15 @@ lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zunhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - LAPACKE_zge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_t ); @@ -59,11 +59,11 @@ lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunhr_col_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunhr_col_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmbr.c b/LAPACKE/src/lapacke_zunmbr.c index 64c68b29c2..edcdc3b29d 100644 --- a/LAPACKE/src/lapacke_zunmbr.c +++ b/LAPACKE/src/lapacke_zunmbr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmbr( int matrix_layout, char vect, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmbr)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -44,27 +44,27 @@ lapack_int LAPACKE_zunmbr( int matrix_layout, char vect, char side, char trans, lapack_complex_double work_query; lapack_int nq, r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmbr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nq = LAPACKE_lsame( side, 'l' ) ? m : n; - r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); - if( LAPACKE_zge_nancheck( matrix_layout, r, MIN(nq,k), a, lda ) ) { + nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + r = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, MIN(nq,k), a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_z_nancheck( MIN(nq,k), tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( MIN(nq,k), tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_zunmbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -78,13 +78,13 @@ lapack_int LAPACKE_zunmbr( int matrix_layout, char vect, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmbr_work( matrix_layout, vect, side, trans, m, n, k, a, + info = API_SUFFIX(LAPACKE_zunmbr_work)( matrix_layout, vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmbr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmbr_work.c b/LAPACKE/src/lapacke_zunmbr_work.c index b11d67ffbc..c62dbfe61e 100644 --- a/LAPACKE/src/lapacke_zunmbr_work.c +++ b/LAPACKE/src/lapacke_zunmbr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, +lapack_int API_SUFFIX(LAPACKE_zunmbr_work)( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, @@ -49,8 +49,8 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n; - lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); + lapack_int nq = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( vect, 'q' ) ? nq : MIN(nq,k); lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_double* a_t = NULL; @@ -58,12 +58,12 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, /* Check leading dimension(s) */ if( lda < MIN(nq,k) ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -73,7 +73,7 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( vect, 'q' ) ) { + if( API_SUFFIX(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) ); @@ -89,8 +89,8 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -98,18 +98,18 @@ lapack_int LAPACKE_zunmbr_work( int matrix_layout, char vect, char side, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmbr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmbr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmhr.c b/LAPACKE/src/lapacke_zunmhr.c index f928b6c2ec..4c03b446ef 100644 --- a/LAPACKE/src/lapacke_zunmhr.c +++ b/LAPACKE/src/lapacke_zunmhr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmhr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmhr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zunmhr( int matrix_layout, char side, char trans, lapack_complex_double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmhr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, r, a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_z_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( r-1, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_zunmhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_zunmhr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmhr_work( matrix_layout, side, trans, m, n, ilo, ihi, a, + info = API_SUFFIX(LAPACKE_zunmhr_work)( matrix_layout, side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmhr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmhr_work.c b/LAPACKE/src/lapacke_zunmhr_work.c index 098473d125..81e546d012 100644 --- a/LAPACKE/src/lapacke_zunmhr_work.c +++ b/LAPACKE/src/lapacke_zunmhr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmhr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmhr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int ilo, lapack_int ihi, const lapack_complex_double* a, lapack_int lda, @@ -49,7 +49,7 @@ lapack_int LAPACKE_zunmhr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_double* a_t = NULL; @@ -57,12 +57,12 @@ lapack_int LAPACKE_zunmhr_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -85,8 +85,8 @@ lapack_int LAPACKE_zunmhr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmhr( &side, &trans, &m, &n, &ilo, &ihi, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -94,18 +94,18 @@ lapack_int LAPACKE_zunmhr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmhr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmhr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmlq.c b/LAPACKE/src/lapacke_zunmlq.c index 06b10389c1..da336dca12 100644 --- a/LAPACKE/src/lapacke_zunmlq.c +++ b/LAPACKE/src/lapacke_zunmlq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmlq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmlq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zunmlq( int matrix_layout, char side, char trans, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmlq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_zunmlq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmlq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmlq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmlq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmlq_work.c b/LAPACKE/src/lapacke_zunmlq_work.c index e82e7e3c68..82f6f96524 100644 --- a/LAPACKE/src/lapacke_zunmlq_work.c +++ b/LAPACKE/src/lapacke_zunmlq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmlq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -49,7 +49,7 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - r = LAPACKE_lsame( side, 'l' ) ? m : n; + r = API_SUFFIX(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; @@ -57,12 +57,12 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -72,7 +72,7 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) ); } else { @@ -90,8 +90,8 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -99,18 +99,18 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmlq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmlq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmql.c b/LAPACKE/src/lapacke_zunmql.c index 3cf4ace236..dce3459532 100644 --- a/LAPACKE/src/lapacke_zunmql.c +++ b/LAPACKE/src/lapacke_zunmql.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmql( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmql)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zunmql( int matrix_layout, char side, char trans, lapack_int r; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmql", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_zunmql( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmql_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmql_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmql", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmql_work.c b/LAPACKE/src/lapacke_zunmql_work.c index d0f155d947..937b9a84dc 100644 --- a/LAPACKE/src/lapacke_zunmql_work.c +++ b/LAPACKE/src/lapacke_zunmql_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmql_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmql_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_zunmql_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_double* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_zunmql_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zunmql_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_zunmql_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmql_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmql_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmqr.c b/LAPACKE/src/lapacke_zunmqr.c index 7ba58eb143..95d70c49f8 100644 --- a/LAPACKE/src/lapacke_zunmqr.c +++ b/LAPACKE/src/lapacke_zunmqr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmqr( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmqr)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zunmqr( int matrix_layout, char side, char trans, lapack_complex_double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmqr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, k, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_zunmqr( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmqr_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmqr_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmqr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmqr_work.c b/LAPACKE/src/lapacke_zunmqr_work.c index 4a8fbbae3a..44a397c2a1 100644 --- a/LAPACKE/src/lapacke_zunmqr_work.c +++ b/LAPACKE/src/lapacke_zunmqr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmqr_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmqr_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_zunmqr_work( int matrix_layout, char side, char trans, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_double* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_zunmqr_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < k ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zunmqr_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, k, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmqr( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_zunmqr_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmqr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmqr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmrq.c b/LAPACKE/src/lapacke_zunmrq.c index 8426d3b4eb..8d7a0648e6 100644 --- a/LAPACKE/src/lapacke_zunmrq.c +++ b/LAPACKE/src/lapacke_zunmrq.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmrq( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmrq)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zunmrq( int matrix_layout, char side, char trans, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmrq", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_zunmrq( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmrq_work( matrix_layout, side, trans, m, n, k, a, lda, tau, + info = API_SUFFIX(LAPACKE_zunmrq_work)( matrix_layout, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmrq", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmrq_work.c b/LAPACKE/src/lapacke_zunmrq_work.c index f3ae975603..fc43fa1d9b 100644 --- a/LAPACKE/src/lapacke_zunmrq_work.c +++ b/LAPACKE/src/lapacke_zunmrq_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmrq_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmrq_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -55,12 +55,12 @@ lapack_int LAPACKE_zunmrq_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -83,8 +83,8 @@ lapack_int LAPACKE_zunmrq_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmrq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -92,18 +92,18 @@ lapack_int LAPACKE_zunmrq_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmrq_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrq_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmrz.c b/LAPACKE/src/lapacke_zunmrz.c index f95f27e2cb..f9c9c2c827 100644 --- a/LAPACKE/src/lapacke_zunmrz.c +++ b/LAPACKE/src/lapacke_zunmrz.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmrz( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmrz)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -43,25 +43,25 @@ lapack_int LAPACKE_zunmrz( int matrix_layout, char side, char trans, lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmrz", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, m, a, lda ) ) { return -8; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_z_nancheck( k, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( k, tau, 1 ) ) { return -10; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_zunmrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -75,13 +75,13 @@ lapack_int LAPACKE_zunmrz( int matrix_layout, char side, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmrz_work( matrix_layout, side, trans, m, n, k, l, a, lda, + info = API_SUFFIX(LAPACKE_zunmrz_work)( matrix_layout, side, trans, m, n, k, l, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmrz", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmrz_work.c b/LAPACKE/src/lapacke_zunmrz_work.c index be1cc73e13..eefa205a2c 100644 --- a/LAPACKE/src/lapacke_zunmrz_work.c +++ b/LAPACKE/src/lapacke_zunmrz_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmrz_work( int matrix_layout, char side, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmrz_work)( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_double* a, lapack_int lda, @@ -56,12 +56,12 @@ lapack_int LAPACKE_zunmrz_work( int matrix_layout, char side, char trans, /* Check leading dimension(s) */ if( lda < m ) { info = -9; - LAPACKE_xerbla( "LAPACKE_zunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz_work", info ); return info; } if( ldc < n ) { info = -12; - LAPACKE_xerbla( "LAPACKE_zunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zunmrz_work( int matrix_layout, char side, char trans, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmrz( &side, &trans, &m, &n, &k, &l, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_zunmrz_work( int matrix_layout, char side, char trans, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmrz_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmrz_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmtr.c b/LAPACKE/src/lapacke_zunmtr.c index 90afb42dd1..3fc4132a36 100644 --- a/LAPACKE/src/lapacke_zunmtr.c +++ b/LAPACKE/src/lapacke_zunmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_zunmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -44,26 +44,26 @@ lapack_int LAPACKE_zunmtr( int matrix_layout, char side, char uplo, char trans, lapack_complex_double work_query; lapack_int r; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zunmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zge_nancheck( matrix_layout, r, r, a, lda ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, r, r, a, lda ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -10; } - if( LAPACKE_z_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( r-1, tau, 1 ) ) { return -9; } } #endif /* Query optimal working array(s) size */ - info = LAPACKE_zunmtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_zunmtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; @@ -77,13 +77,13 @@ lapack_int LAPACKE_zunmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zunmtr_work( matrix_layout, side, uplo, trans, m, n, a, lda, + info = API_SUFFIX(LAPACKE_zunmtr_work)( matrix_layout, side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zunmtr_work.c b/LAPACKE/src/lapacke_zunmtr_work.c index 41e1f26ce6..dd32ec7660 100644 --- a/LAPACKE/src/lapacke_zunmtr_work.c +++ b/LAPACKE/src/lapacke_zunmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zunmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_zunmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* tau, @@ -48,7 +48,7 @@ lapack_int LAPACKE_zunmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int lda_t = MAX(1,r); lapack_int ldc_t = MAX(1,m); lapack_complex_double* a_t = NULL; @@ -56,12 +56,12 @@ lapack_int LAPACKE_zunmtr_work( int matrix_layout, char side, char uplo, /* Check leading dimension(s) */ if( lda < r ) { info = -8; - LAPACKE_xerbla( "LAPACKE_zunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr_work", info ); return info; } if( ldc < n ) { info = -11; - LAPACKE_xerbla( "LAPACKE_zunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr_work", info ); return info; } /* Query optimal working array(s) size if requested */ @@ -84,8 +84,8 @@ lapack_int LAPACKE_zunmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, r, r, a, lda, a_t, lda_t ); - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, r, r, a, lda, a_t, lda_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_zunmtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t, &ldc_t, work, &lwork, &info ); @@ -93,18 +93,18 @@ lapack_int LAPACKE_zunmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zunmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zunmtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zupgtr.c b/LAPACKE/src/lapacke_zupgtr.c index 5c698bfd97..b8edcdcdbc 100644 --- a/LAPACKE/src/lapacke_zupgtr.c +++ b/LAPACKE/src/lapacke_zupgtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zupgtr( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zupgtr)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_complex_double* tau, lapack_complex_double* q, lapack_int ldq ) @@ -40,16 +40,16 @@ lapack_int LAPACKE_zupgtr( int matrix_layout, char uplo, lapack_int n, lapack_int info = 0; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zupgtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupgtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zpp_nancheck( n, ap ) ) { + if( API_SUFFIX(LAPACKE_zpp_nancheck)( n, ap ) ) { return -4; } - if( LAPACKE_z_nancheck( n-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( n-1, tau, 1 ) ) { return -5; } } @@ -62,12 +62,12 @@ lapack_int LAPACKE_zupgtr( int matrix_layout, char uplo, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zupgtr_work( matrix_layout, uplo, n, ap, tau, q, ldq, work ); + info = API_SUFFIX(LAPACKE_zupgtr_work)( matrix_layout, uplo, n, ap, tau, q, ldq, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zupgtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupgtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zupgtr_work.c b/LAPACKE/src/lapacke_zupgtr_work.c index 52f169df3a..4b80bd3d3a 100644 --- a/LAPACKE/src/lapacke_zupgtr_work.c +++ b/LAPACKE/src/lapacke_zupgtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zupgtr_work( int matrix_layout, char uplo, lapack_int n, +lapack_int API_SUFFIX(LAPACKE_zupgtr_work)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double* ap, const lapack_complex_double* tau, lapack_complex_double* q, lapack_int ldq, @@ -52,7 +52,7 @@ lapack_int LAPACKE_zupgtr_work( int matrix_layout, char uplo, lapack_int n, /* Check leading dimension(s) */ if( ldq < n ) { info = -7; - LAPACKE_xerbla( "LAPACKE_zupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupgtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -70,25 +70,25 @@ lapack_int LAPACKE_zupgtr_work( int matrix_layout, char uplo, lapack_int n, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zupgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( q_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupgtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zupgtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupgtr_work", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zupmtr.c b/LAPACKE/src/lapacke_zupmtr.c index 2f4cceeaa2..4302b899ec 100644 --- a/LAPACKE/src/lapacke_zupmtr.c +++ b/LAPACKE/src/lapacke_zupmtr.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zupmtr( int matrix_layout, char side, char uplo, char trans, +lapack_int API_SUFFIX(LAPACKE_zupmtr)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_double* ap, const lapack_complex_double* tau, @@ -44,28 +44,28 @@ lapack_int LAPACKE_zupmtr( int matrix_layout, char side, char uplo, char trans, lapack_complex_double* work = NULL; lapack_int r ; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { - LAPACKE_xerbla( "LAPACKE_zupmtr", -1 ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupmtr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - r = LAPACKE_lsame( side, 'l' ) ? m : n; - if( LAPACKE_zpp_nancheck( r, ap ) ) { + r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; + if( API_SUFFIX(LAPACKE_zpp_nancheck)( r, ap ) ) { return -7; } - if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) { return -9; } - if( LAPACKE_z_nancheck( r-1, tau, 1 ) ) { + if( API_SUFFIX(LAPACKE_z_nancheck)( r-1, tau, 1 ) ) { return -8; } } #endif /* Additional scalars initializations for work arrays */ - if( LAPACKE_lsame( side, 'l' ) ) { + if( API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ) { lwork = MAX(1,n); - } else if( LAPACKE_lsame( side, 'r' ) ) { + } else if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) { lwork = MAX(1,m); } else { lwork = 1; /* Any value */ @@ -78,13 +78,13 @@ lapack_int LAPACKE_zupmtr( int matrix_layout, char side, char uplo, char trans, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_zupmtr_work( matrix_layout, side, uplo, trans, m, n, ap, tau, + info = API_SUFFIX(LAPACKE_zupmtr_work)( matrix_layout, side, uplo, trans, m, n, ap, tau, c, ldc, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zupmtr", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupmtr", info ); } return info; } diff --git a/LAPACKE/src/lapacke_zupmtr_work.c b/LAPACKE/src/lapacke_zupmtr_work.c index 6b623889bc..f0e7724883 100644 --- a/LAPACKE/src/lapacke_zupmtr_work.c +++ b/LAPACKE/src/lapacke_zupmtr_work.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_zupmtr_work( int matrix_layout, char side, char uplo, +lapack_int API_SUFFIX(LAPACKE_zupmtr_work)( int matrix_layout, char side, char uplo, char trans, lapack_int m, lapack_int n, const lapack_complex_double* ap, const lapack_complex_double* tau, @@ -48,14 +48,14 @@ lapack_int LAPACKE_zupmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n; + lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n; lapack_int ldc_t = MAX(1,m); lapack_complex_double* c_t = NULL; lapack_complex_double* ap_t = NULL; /* Check leading dimension(s) */ if( ldc < n ) { info = -10; - LAPACKE_xerbla( "LAPACKE_zupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupmtr_work", info ); return info; } /* Allocate memory for temporary array(s) */ @@ -73,8 +73,8 @@ lapack_int LAPACKE_zupmtr_work( int matrix_layout, char side, char uplo, goto exit_level_1; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); - LAPACKE_zpp_trans( matrix_layout, uplo, r, ap, ap_t ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + API_SUFFIX(LAPACKE_zpp_trans)( matrix_layout, uplo, r, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_zupmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t, work, &info ); @@ -82,18 +82,18 @@ lapack_int LAPACKE_zupmtr_work( int matrix_layout, char side, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( ap_t ); exit_level_1: LAPACKE_free( c_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupmtr_work", info ); } } else { info = -1; - LAPACKE_xerbla( "LAPACKE_zupmtr_work", info ); + API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zupmtr_work", info ); } return info; } diff --git a/LAPACKE/utils/lapacke_c_nancheck.c b/LAPACKE/utils/lapacke_c_nancheck.c index 82a4242395..d635fd5bfe 100644 --- a/LAPACKE/utils/lapacke_c_nancheck.c +++ b/LAPACKE/utils/lapacke_c_nancheck.c @@ -33,7 +33,7 @@ /* Check a vector for NaN entries. */ -lapack_logical LAPACKE_c_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_c_nancheck)( lapack_int n, const lapack_complex_float *x, lapack_int incx ) { diff --git a/LAPACKE/utils/lapacke_cgb_nancheck.c b/LAPACKE/utils/lapacke_cgb_nancheck.c index 0c35bd67bb..0b6bc0d2c3 100644 --- a/LAPACKE/utils/lapacke_cgb_nancheck.c +++ b/LAPACKE/utils/lapacke_cgb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float *ab, diff --git a/LAPACKE/utils/lapacke_cgb_trans.c b/LAPACKE/utils/lapacke_cgb_trans.c index b32fc2f9e0..bd450d8d0e 100644 --- a/LAPACKE/utils/lapacke_cgb_trans.c +++ b/LAPACKE/utils/lapacke_cgb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_cgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) diff --git a/LAPACKE/utils/lapacke_cge_nancheck.c b/LAPACKE/utils/lapacke_cge_nancheck.c index 18e194d3a1..94cb051e0d 100644 --- a/LAPACKE/utils/lapacke_cge_nancheck.c +++ b/LAPACKE/utils/lapacke_cge_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ) diff --git a/LAPACKE/utils/lapacke_cge_trans.c b/LAPACKE/utils/lapacke_cge_trans.c index 0d44ad59d1..3b2f53356c 100644 --- a/LAPACKE/utils/lapacke_cge_trans.c +++ b/LAPACKE/utils/lapacke_cge_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_cge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cge_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* in, lapack_int ldin, lapack_complex_float* out, lapack_int ldout ) { diff --git a/LAPACKE/utils/lapacke_cgg_nancheck.c b/LAPACKE/utils/lapacke_cgg_nancheck.c index 371135ac7c..5750614875 100644 --- a/LAPACKE/utils/lapacke_cgg_nancheck.c +++ b/LAPACKE/utils/lapacke_cgg_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_cgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ) { - return LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ); + return API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_cgg_trans.c b/LAPACKE/utils/lapacke_cgg_trans.c index 678a482dfc..e1214b5f78 100644 --- a/LAPACKE/utils/lapacke_cgg_trans.c +++ b/LAPACKE/utils/lapacke_cgg_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_cgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_cgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float* in, lapack_int ldin, lapack_complex_float* out, lapack_int ldout ) { - LAPACKE_cge_trans( matrix_layout, m, n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_cgt_nancheck.c b/LAPACKE/utils/lapacke_cgt_nancheck.c index ea73848f3e..c07b815b3d 100644 --- a/LAPACKE/utils/lapacke_cgt_nancheck.c +++ b/LAPACKE/utils/lapacke_cgt_nancheck.c @@ -33,12 +33,12 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cgt_nancheck)( lapack_int n, const lapack_complex_float *dl, const lapack_complex_float *d, const lapack_complex_float *du ) { - return LAPACKE_c_nancheck( n-1, dl, 1 ) - || LAPACKE_c_nancheck( n , d, 1 ) - || LAPACKE_c_nancheck( n-1, du, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( n-1, dl, 1 ) + || API_SUFFIX(LAPACKE_c_nancheck)( n , d, 1 ) + || API_SUFFIX(LAPACKE_c_nancheck)( n-1, du, 1 ); } diff --git a/LAPACKE/utils/lapacke_chb_nancheck.c b/LAPACKE/utils/lapacke_chb_nancheck.c index 2c6211147f..6757d8ab95 100644 --- a/LAPACKE/utils/lapacke_chb_nancheck.c +++ b/LAPACKE/utils/lapacke_chb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_chb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_chb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_chb_trans.c b/LAPACKE/utils/lapacke_chb_trans.c index 00175027d5..855cb03de8 100644 --- a/LAPACKE/utils/lapacke_chb_trans.c +++ b/LAPACKE/utils/lapacke_chb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_chb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_chb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_che_nancheck.c b/LAPACKE/utils/lapacke_che_nancheck.c index 6e652b71d1..ebd62584e4 100644 --- a/LAPACKE/utils/lapacke_che_nancheck.c +++ b/LAPACKE/utils/lapacke_che_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_che_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_che_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ) { - return LAPACKE_ctr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_che_trans.c b/LAPACKE/utils/lapacke_che_trans.c index a6a96f7efb..4ee91bd40f 100644 --- a/LAPACKE/utils/lapacke_che_trans.c +++ b/LAPACKE/utils/lapacke_che_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_che_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_che_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { - LAPACKE_ctr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_chp_nancheck.c b/LAPACKE/utils/lapacke_chp_nancheck.c index 0d74cbf08f..ba24f2a1b4 100644 --- a/LAPACKE/utils/lapacke_chp_nancheck.c +++ b/LAPACKE/utils/lapacke_chp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_chp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_chp_nancheck)( lapack_int n, const lapack_complex_float *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_c_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_chp_trans.c b/LAPACKE/utils/lapacke_chp_trans.c index 2ab59b1126..0c6e883993 100644 --- a/LAPACKE/utils/lapacke_chp_trans.c +++ b/LAPACKE/utils/lapacke_chp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_chp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_chp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { - LAPACKE_ctp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_chs_nancheck.c b/LAPACKE/utils/lapacke_chs_nancheck.c index f0756bfb95..00fd19ceb2 100644 --- a/LAPACKE/utils/lapacke_chs_nancheck.c +++ b/LAPACKE/utils/lapacke_chs_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_chs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_chs_nancheck)( int matrix_layout, lapack_int n, const lapack_complex_float *a, lapack_int lda ) { @@ -43,14 +43,14 @@ lapack_logical LAPACKE_chs_nancheck( int matrix_layout, lapack_int n, /* Check subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - subdiag_nans = LAPACKE_c_nancheck( n-1, &a[1], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_c_nancheck)( n-1, &a[1], lda+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - subdiag_nans = LAPACKE_c_nancheck( n-1, &a[lda], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_c_nancheck)( n-1, &a[lda], lda+1 ); } else { return (lapack_logical) 0; } /* Check upper triangular if subdiagonal has no NaNs. */ - return subdiag_nans || LAPACKE_ctr_nancheck( matrix_layout, 'u', 'n', + return subdiag_nans || API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, 'u', 'n', n, a, lda); } diff --git a/LAPACKE/utils/lapacke_chs_trans.c b/LAPACKE/utils/lapacke_chs_trans.c index eff8c8c4ea..4d81dd9346 100644 --- a/LAPACKE/utils/lapacke_chs_trans.c +++ b/LAPACKE/utils/lapacke_chs_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_chs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_chs_trans)( int matrix_layout, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { @@ -44,15 +44,15 @@ void LAPACKE_chs_trans( int matrix_layout, lapack_int n, /* Convert subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, &out[ldout], ldout+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, &out[1], ldout+1 ); } else { return; } /* Convert upper triangular. */ - LAPACKE_ctr_trans( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); } diff --git a/LAPACKE/utils/lapacke_cpb_nancheck.c b/LAPACKE/utils/lapacke_cpb_nancheck.c index 5fea7377ac..b99f87eef3 100644 --- a/LAPACKE/utils/lapacke_cpb_nancheck.c +++ b/LAPACKE/utils/lapacke_cpb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_cpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_cpb_trans.c b/LAPACKE/utils/lapacke_cpb_trans.c index 99e3960fa5..e117c8e2a0 100644 --- a/LAPACKE/utils/lapacke_cpb_trans.c +++ b/LAPACKE/utils/lapacke_cpb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_cpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_cgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_cpf_nancheck.c b/LAPACKE/utils/lapacke_cpf_nancheck.c index 551b96966e..ae9eb67e75 100644 --- a/LAPACKE/utils/lapacke_cpf_nancheck.c +++ b/LAPACKE/utils/lapacke_cpf_nancheck.c @@ -37,9 +37,9 @@ * matrix_layout. */ -lapack_logical LAPACKE_cpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpf_nancheck)( lapack_int n, const lapack_complex_float *a ) { lapack_int len = n*(n+1)/2; - return LAPACKE_c_nancheck( len, a, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( len, a, 1 ); } diff --git a/LAPACKE/utils/lapacke_cpf_trans.c b/LAPACKE/utils/lapacke_cpf_trans.c index df397c0f6a..d6eb8b75eb 100644 --- a/LAPACKE/utils/lapacke_cpf_trans.c +++ b/LAPACKE/utils/lapacke_cpf_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_cpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_cpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { - LAPACKE_ctf_trans( matrix_layout, transr, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_cpo_nancheck.c b/LAPACKE/utils/lapacke_cpo_nancheck.c index 62091f36b6..c8ff502db1 100644 --- a/LAPACKE/utils/lapacke_cpo_nancheck.c +++ b/LAPACKE/utils/lapacke_cpo_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_cpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ) { - return LAPACKE_ctr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_cpo_trans.c b/LAPACKE/utils/lapacke_cpo_trans.c index 7b4f2a23f8..5c9714e160 100644 --- a/LAPACKE/utils/lapacke_cpo_trans.c +++ b/LAPACKE/utils/lapacke_cpo_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_cpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpo_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { - LAPACKE_ctr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_cpp_nancheck.c b/LAPACKE/utils/lapacke_cpp_nancheck.c index bc6d10442a..287b8f67f3 100644 --- a/LAPACKE/utils/lapacke_cpp_nancheck.c +++ b/LAPACKE/utils/lapacke_cpp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_cpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpp_nancheck)( lapack_int n, const lapack_complex_float *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_c_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_cpp_trans.c b/LAPACKE/utils/lapacke_cpp_trans.c index 6408b93a86..e36baa3a38 100644 --- a/LAPACKE/utils/lapacke_cpp_trans.c +++ b/LAPACKE/utils/lapacke_cpp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_cpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_cpp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { - LAPACKE_ctp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_cpt_nancheck.c b/LAPACKE/utils/lapacke_cpt_nancheck.c index f0c445c9e3..3596b49a83 100644 --- a/LAPACKE/utils/lapacke_cpt_nancheck.c +++ b/LAPACKE/utils/lapacke_cpt_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cpt_nancheck)( lapack_int n, const float *d, const lapack_complex_float *e ) { - return LAPACKE_s_nancheck( n, d, 1 ) - || LAPACKE_c_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_csp_nancheck.c b/LAPACKE/utils/lapacke_csp_nancheck.c index 8664be84b9..d6f840729c 100644 --- a/LAPACKE/utils/lapacke_csp_nancheck.c +++ b/LAPACKE/utils/lapacke_csp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_csp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_csp_nancheck)( lapack_int n, const lapack_complex_float *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_c_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_csp_trans.c b/LAPACKE/utils/lapacke_csp_trans.c index db1ff915d0..2530173b94 100644 --- a/LAPACKE/utils/lapacke_csp_trans.c +++ b/LAPACKE/utils/lapacke_csp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_csp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_csp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { - LAPACKE_ctp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ctp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_cst_nancheck.c b/LAPACKE/utils/lapacke_cst_nancheck.c index 831421dbc2..20baae7b11 100644 --- a/LAPACKE/utils/lapacke_cst_nancheck.c +++ b/LAPACKE/utils/lapacke_cst_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_cst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_cst_nancheck)( lapack_int n, const lapack_complex_float *d, const lapack_complex_float *e ) { - return LAPACKE_c_nancheck( n, d, 1 ) - || LAPACKE_c_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_c_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_csy_nancheck.c b/LAPACKE/utils/lapacke_csy_nancheck.c index aedb04734e..b7fbcc667f 100644 --- a/LAPACKE/utils/lapacke_csy_nancheck.c +++ b/LAPACKE/utils/lapacke_csy_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_csy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_csy_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *a, lapack_int lda ) { - return LAPACKE_ctr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_csy_trans.c b/LAPACKE/utils/lapacke_csy_trans.c index 48ee3187ce..871533d478 100644 --- a/LAPACKE/utils/lapacke_csy_trans.c +++ b/LAPACKE/utils/lapacke_csy_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_csy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_csy_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { - LAPACKE_ctr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_ctb_nancheck.c b/LAPACKE/utils/lapacke_ctb_nancheck.c index 9647d3b655..28a5da436a 100644 --- a/LAPACKE/utils/lapacke_ctb_nancheck.c +++ b/LAPACKE/utils/lapacke_ctb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ctb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float* ab, lapack_int ldab ) @@ -43,12 +43,12 @@ lapack_logical LAPACKE_ctb_nancheck( int matrix_layout, char uplo, char diag, if( ab == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -57,27 +57,27 @@ lapack_logical LAPACKE_ctb_nancheck( int matrix_layout, char uplo, char diag, /* Unit case, diagonal should be excluded from the check for NaN. */ if( colmaj ) { if( upper ) { - return LAPACKE_cgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[ldab], ldab ); } else { - return LAPACKE_cgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[1], ldab ); } } else { if( upper ) { - return LAPACKE_cgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[1], ldab ); } else { - return LAPACKE_cgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[ldab], ldab ); } } } else { /* Non-unit case */ if( upper ) { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); } else { - return LAPACKE_cgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + return API_SUFFIX(LAPACKE_cgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } } } diff --git a/LAPACKE/utils/lapacke_ctb_trans.c b/LAPACKE/utils/lapacke_ctb_trans.c index c266e3ea62..d3a2660314 100644 --- a/LAPACKE/utils/lapacke_ctb_trans.c +++ b/LAPACKE/utils/lapacke_ctb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ctb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) @@ -46,12 +46,12 @@ void LAPACKE_ctb_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -60,28 +60,28 @@ void LAPACKE_ctb_trans( int matrix_layout, char uplo, char diag, /* Unit case, diagonal excluded from transposition */ if( colmaj ) { if( upper ) { - LAPACKE_cgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[ldin], ldin, &out[1], ldout ); } else { - LAPACKE_cgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[1], ldin, &out[ldout], ldout ); } } else { if( upper ) { - LAPACKE_cgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[1], ldin, &out[ldout], ldout ); } else { - LAPACKE_cgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[ldin], ldin, &out[1], ldout ); } } } else { /* Non-unit case */ if( upper ) { - LAPACKE_cgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); } else { - LAPACKE_cgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, + API_SUFFIX(LAPACKE_cgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_ctf_nancheck.c b/LAPACKE/utils/lapacke_ctf_nancheck.c index e08f51175a..193e96f546 100644 --- a/LAPACKE/utils/lapacke_ctf_nancheck.c +++ b/LAPACKE/utils/lapacke_ctf_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_ctf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_float *a ) @@ -45,15 +45,15 @@ lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, if( a == NULL ) return (lapack_logical) 0; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) - && !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) + && !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -75,36 +75,36 @@ lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[0], n ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[n1], n ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n], n ); } else { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[n2], n ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[0], n ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n1], n ); } } else { /* N is odd and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[0], n1 ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[1], n1 ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[1], n1 ); } else { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[(size_t)n2*n2], n2 ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[0], n2 ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[(size_t)n1*n2], n2 ); } } @@ -114,36 +114,36 @@ lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[1], n+1 ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[k+1], n+1 ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[0], n+1 ); } else { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[k+1], n+1 ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], n+1 ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], n+1 ); } } else { /* N is even and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], k ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[0], k ); } else { - return LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_cge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], k ) - || LAPACKE_ctr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ctr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[(size_t)k*k], k ); } } @@ -151,6 +151,6 @@ lapack_logical LAPACKE_ctf_nancheck( int matrix_layout, char transr, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_cge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len ); + return API_SUFFIX(LAPACKE_cge_nancheck)( LAPACK_COL_MAJOR, len, 1, a, len ); } } diff --git a/LAPACKE/utils/lapacke_ctf_trans.c b/LAPACKE/utils/lapacke_ctf_trans.c index e0c88dde0f..c4b431f0b5 100644 --- a/LAPACKE/utils/lapacke_ctf_trans.c +++ b/LAPACKE/utils/lapacke_ctf_trans.c @@ -37,7 +37,7 @@ * This functions does copy diagonal for both unit and non-unit cases. */ -void LAPACKE_ctf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { @@ -47,15 +47,15 @@ void LAPACKE_ctf_trans( int matrix_layout, char transr, char uplo, char diag, if( in == NULL || out == NULL ) return ; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) && - !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) && + !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if input parameters are wrong */ return; } @@ -81,8 +81,8 @@ void LAPACKE_ctf_trans( int matrix_layout, char transr, char uplo, char diag, /* Perform conversion: */ if( rowmaj ) { - LAPACKE_cge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); } else { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col ); + API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, row, col, in, row, out, col ); } } diff --git a/LAPACKE/utils/lapacke_ctp_nancheck.c b/LAPACKE/utils/lapacke_ctp_nancheck.c index 30c8a93984..eb245ff511 100644 --- a/LAPACKE/utils/lapacke_ctp_nancheck.c +++ b/LAPACKE/utils/lapacke_ctp_nancheck.c @@ -36,7 +36,7 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_ctp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *ap ) { @@ -46,12 +46,12 @@ lapack_logical LAPACKE_ctp_nancheck( int matrix_layout, char uplo, char diag, if( ap == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -65,11 +65,11 @@ lapack_logical LAPACKE_ctp_nancheck( int matrix_layout, char uplo, char diag, */ if( ( colmaj || upper ) && !( colmaj && upper ) ) { for( i = 1; i < n; i++ ) - if( LAPACKE_c_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) + if( API_SUFFIX(LAPACKE_c_nancheck)( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) return (lapack_logical) 1; } else { for( i = 0; i < n-1; i++ ) - if( LAPACKE_c_nancheck( n-i-1, + if( API_SUFFIX(LAPACKE_c_nancheck)( n-i-1, &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) ) return (lapack_logical) 1; } @@ -77,6 +77,6 @@ lapack_logical LAPACKE_ctp_nancheck( int matrix_layout, char uplo, char diag, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_c_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_c_nancheck)( len, ap, 1 ); } } diff --git a/LAPACKE/utils/lapacke_ctp_trans.c b/LAPACKE/utils/lapacke_ctp_trans.c index 2141a6c61d..8cb373847d 100644 --- a/LAPACKE/utils/lapacke_ctp_trans.c +++ b/LAPACKE/utils/lapacke_ctp_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ctp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ctp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_complex_float *out ) { @@ -46,12 +46,12 @@ void LAPACKE_ctp_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_ctr_nancheck.c b/LAPACKE/utils/lapacke_ctr_nancheck.c index 4bc96ed4cb..c21adfdce7 100644 --- a/LAPACKE/utils/lapacke_ctr_nancheck.c +++ b/LAPACKE/utils/lapacke_ctr_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ctr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ctr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *a, lapack_int lda ) @@ -44,12 +44,12 @@ lapack_logical LAPACKE_ctr_nancheck( int matrix_layout, char uplo, char diag, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_ctr_trans.c b/LAPACKE/utils/lapacke_ctr_trans.c index a57c0562f4..7022f74dea 100644 --- a/LAPACKE/utils/lapacke_ctr_trans.c +++ b/LAPACKE/utils/lapacke_ctr_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_ctr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_ctr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) { @@ -46,12 +46,12 @@ void LAPACKE_ctr_trans( int matrix_layout, char uplo, char diag, lapack_int n, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_ctz_nancheck.c b/LAPACKE/utils/lapacke_ctz_nancheck.c index bea9567811..91f759b46c 100644 --- a/LAPACKE/utils/lapacke_ctz_nancheck.c +++ b/LAPACKE/utils/lapacke_ctz_nancheck.c @@ -80,7 +80,7 @@ *****************************************************************************/ -lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ctz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float *a, lapack_int lda ) @@ -90,14 +90,14 @@ lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -132,13 +132,13 @@ lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo, /* Check rectangular part */ if( rect_offset >= 0 ) { - if( LAPACKE_cge_nancheck( matrix_layout, rect_m, rect_n, + if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, rect_m, rect_n, &a[rect_offset], lda) ) { return (lapack_logical) 1; } } /* Check triangular part */ - return LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, tri_n, + return API_SUFFIX(LAPACKE_ctr_nancheck)( matrix_layout, uplo, diag, tri_n, &a[tri_offset], lda ); } diff --git a/LAPACKE/utils/lapacke_ctz_trans.c b/LAPACKE/utils/lapacke_ctz_trans.c index 0abe03d283..83f7b61cb8 100644 --- a/LAPACKE/utils/lapacke_ctz_trans.c +++ b/LAPACKE/utils/lapacke_ctz_trans.c @@ -81,7 +81,7 @@ *****************************************************************************/ -void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_ctz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout ) @@ -91,14 +91,14 @@ void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -141,13 +141,13 @@ void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo, /* Copy & transpose rectangular part */ if( rect_in_offset >= 0 && rect_out_offset >= 0 ) { - LAPACKE_cge_trans( matrix_layout, rect_m, rect_n, + API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, rect_m, rect_n, &in[rect_in_offset], ldin, &out[rect_out_offset], ldout ); } /* Copy & transpose triangular part */ - LAPACKE_ctr_trans( matrix_layout, uplo, diag, tri_n, + API_SUFFIX(LAPACKE_ctr_trans)( matrix_layout, uplo, diag, tri_n, &in[tri_in_offset], ldin, &out[tri_out_offset], ldout ); } diff --git a/LAPACKE/utils/lapacke_d_nancheck.c b/LAPACKE/utils/lapacke_d_nancheck.c index 328939b448..0ae9ea220e 100644 --- a/LAPACKE/utils/lapacke_d_nancheck.c +++ b/LAPACKE/utils/lapacke_d_nancheck.c @@ -33,7 +33,7 @@ /* Check a vector for NaN entries. */ -lapack_logical LAPACKE_d_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_d_nancheck)( lapack_int n, const double *x, lapack_int incx ) { diff --git a/LAPACKE/utils/lapacke_dgb_nancheck.c b/LAPACKE/utils/lapacke_dgb_nancheck.c index 4f3e039c1e..5ec877e51f 100644 --- a/LAPACKE/utils/lapacke_dgb_nancheck.c +++ b/LAPACKE/utils/lapacke_dgb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double *ab, diff --git a/LAPACKE/utils/lapacke_dgb_trans.c b/LAPACKE/utils/lapacke_dgb_trans.c index 89e421eae1..2bd6da1b88 100644 --- a/LAPACKE/utils/lapacke_dgb_trans.c +++ b/LAPACKE/utils/lapacke_dgb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const double *in, lapack_int ldin, double *out, lapack_int ldout ) diff --git a/LAPACKE/utils/lapacke_dge_nancheck.c b/LAPACKE/utils/lapacke_dge_nancheck.c index 47d7d5db8c..c47fc5b9de 100644 --- a/LAPACKE/utils/lapacke_dge_nancheck.c +++ b/LAPACKE/utils/lapacke_dge_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const double *a, lapack_int lda ) diff --git a/LAPACKE/utils/lapacke_dge_trans.c b/LAPACKE/utils/lapacke_dge_trans.c index ac9d5e47eb..c9c8ced9c2 100644 --- a/LAPACKE/utils/lapacke_dge_trans.c +++ b/LAPACKE/utils/lapacke_dge_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_dge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dge_trans)( int matrix_layout, lapack_int m, lapack_int n, const double* in, lapack_int ldin, double* out, lapack_int ldout ) { diff --git a/LAPACKE/utils/lapacke_dgg_nancheck.c b/LAPACKE/utils/lapacke_dgg_nancheck.c index f70fae5853..524c59cb10 100644 --- a/LAPACKE/utils/lapacke_dgg_nancheck.c +++ b/LAPACKE/utils/lapacke_dgg_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_dgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const double *a, lapack_int lda ) { - return LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ); + return API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, m, n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_dgg_trans.c b/LAPACKE/utils/lapacke_dgg_trans.c index 117ffa416b..2c7dbec86e 100644 --- a/LAPACKE/utils/lapacke_dgg_trans.c +++ b/LAPACKE/utils/lapacke_dgg_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_dgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_dgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const double* in, lapack_int ldin, double* out, lapack_int ldout ) { - LAPACKE_dge_trans( matrix_layout, m, n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_dgt_nancheck.c b/LAPACKE/utils/lapacke_dgt_nancheck.c index 8d42c5738d..d6e9b1add5 100644 --- a/LAPACKE/utils/lapacke_dgt_nancheck.c +++ b/LAPACKE/utils/lapacke_dgt_nancheck.c @@ -33,12 +33,12 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dgt_nancheck)( lapack_int n, const double *dl, const double *d, const double *du ) { - return LAPACKE_d_nancheck( n-1, dl, 1 ) - || LAPACKE_d_nancheck( n , d, 1 ) - || LAPACKE_d_nancheck( n-1, du, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( n-1, dl, 1 ) + || API_SUFFIX(LAPACKE_d_nancheck)( n , d, 1 ) + || API_SUFFIX(LAPACKE_d_nancheck)( n-1, du, 1 ); } diff --git a/LAPACKE/utils/lapacke_dhs_nancheck.c b/LAPACKE/utils/lapacke_dhs_nancheck.c index 6dc087cbe6..1b14cb03d5 100644 --- a/LAPACKE/utils/lapacke_dhs_nancheck.c +++ b/LAPACKE/utils/lapacke_dhs_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dhs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dhs_nancheck)( int matrix_layout, lapack_int n, const double *a, lapack_int lda ) { @@ -43,14 +43,14 @@ lapack_logical LAPACKE_dhs_nancheck( int matrix_layout, lapack_int n, /* Check subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - subdiag_nans = LAPACKE_d_nancheck( n-1, &a[1], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_d_nancheck)( n-1, &a[1], lda+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - subdiag_nans = LAPACKE_d_nancheck( n-1, &a[lda], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_d_nancheck)( n-1, &a[lda], lda+1 ); } else { return (lapack_logical) 0; } /* Check upper triangular if subdiagonal has no NaNs. */ - return subdiag_nans || LAPACKE_dtr_nancheck( matrix_layout, 'u', 'n', + return subdiag_nans || API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, 'u', 'n', n, a, lda); } diff --git a/LAPACKE/utils/lapacke_dhs_trans.c b/LAPACKE/utils/lapacke_dhs_trans.c index 6d6fbeb9db..1c758bf298 100644 --- a/LAPACKE/utils/lapacke_dhs_trans.c +++ b/LAPACKE/utils/lapacke_dhs_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_dhs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_dhs_trans)( int matrix_layout, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { @@ -44,15 +44,15 @@ void LAPACKE_dhs_trans( int matrix_layout, lapack_int n, /* Convert subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, &out[ldout], ldout+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, &out[1], ldout+1 ); } else { return; } /* Convert upper triangular. */ - LAPACKE_dtr_trans( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); } diff --git a/LAPACKE/utils/lapacke_dpb_nancheck.c b/LAPACKE/utils/lapacke_dpb_nancheck.c index 0ea19feeb1..ef7f480049 100644 --- a/LAPACKE/utils/lapacke_dpb_nancheck.c +++ b/LAPACKE/utils/lapacke_dpb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_dpb_trans.c b/LAPACKE/utils/lapacke_dpb_trans.c index 88b9bebfa0..cfe63b6b92 100644 --- a/LAPACKE/utils/lapacke_dpb_trans.c +++ b/LAPACKE/utils/lapacke_dpb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_dpf_nancheck.c b/LAPACKE/utils/lapacke_dpf_nancheck.c index cb36afc17c..62561b85b5 100644 --- a/LAPACKE/utils/lapacke_dpf_nancheck.c +++ b/LAPACKE/utils/lapacke_dpf_nancheck.c @@ -37,9 +37,9 @@ * matrix_layout. */ -lapack_logical LAPACKE_dpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpf_nancheck)( lapack_int n, const double *a ) { lapack_int len = n*(n+1)/2; - return LAPACKE_d_nancheck( len, a, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( len, a, 1 ); } diff --git a/LAPACKE/utils/lapacke_dpf_trans.c b/LAPACKE/utils/lapacke_dpf_trans.c index 4ba320ecd1..5f059fa435 100644 --- a/LAPACKE/utils/lapacke_dpf_trans.c +++ b/LAPACKE/utils/lapacke_dpf_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_dpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_dpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const double *in, double *out ) { - LAPACKE_dtf_trans( matrix_layout, transr, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_dpo_nancheck.c b/LAPACKE/utils/lapacke_dpo_nancheck.c index 2faacbb708..6e59f17507 100644 --- a/LAPACKE/utils/lapacke_dpo_nancheck.c +++ b/LAPACKE/utils/lapacke_dpo_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const double *a, lapack_int lda ) { - return LAPACKE_dtr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_dpo_trans.c b/LAPACKE/utils/lapacke_dpo_trans.c index f2de7eaa15..1cfb253957 100644 --- a/LAPACKE/utils/lapacke_dpo_trans.c +++ b/LAPACKE/utils/lapacke_dpo_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_dpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpo_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { - LAPACKE_dtr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_dpp_nancheck.c b/LAPACKE/utils/lapacke_dpp_nancheck.c index 6e2182e1f0..a94473a40e 100644 --- a/LAPACKE/utils/lapacke_dpp_nancheck.c +++ b/LAPACKE/utils/lapacke_dpp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_dpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpp_nancheck)( lapack_int n, const double *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_d_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_dpp_trans.c b/LAPACKE/utils/lapacke_dpp_trans.c index 43de0bd466..6d97487d44 100644 --- a/LAPACKE/utils/lapacke_dpp_trans.c +++ b/LAPACKE/utils/lapacke_dpp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dpp_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, double *out ) { - LAPACKE_dtp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_dpt_nancheck.c b/LAPACKE/utils/lapacke_dpt_nancheck.c index 887db5cf85..cd88b04150 100644 --- a/LAPACKE/utils/lapacke_dpt_nancheck.c +++ b/LAPACKE/utils/lapacke_dpt_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dpt_nancheck)( lapack_int n, const double *d, const double *e ) { - return LAPACKE_d_nancheck( n, d, 1 ) - || LAPACKE_d_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_dsb_nancheck.c b/LAPACKE/utils/lapacke_dsb_nancheck.c index 8de1aa088a..76b329aa29 100644 --- a/LAPACKE/utils/lapacke_dsb_nancheck.c +++ b/LAPACKE/utils/lapacke_dsb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dsb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dsb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_dsb_trans.c b/LAPACKE/utils/lapacke_dsb_trans.c index db2994e0c3..183a953223 100644 --- a/LAPACKE/utils/lapacke_dsb_trans.c +++ b/LAPACKE/utils/lapacke_dsb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dsb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_dgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_dsp_nancheck.c b/LAPACKE/utils/lapacke_dsp_nancheck.c index ba9e6a0ace..19b37b7aa6 100644 --- a/LAPACKE/utils/lapacke_dsp_nancheck.c +++ b/LAPACKE/utils/lapacke_dsp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_dsp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dsp_nancheck)( lapack_int n, const double *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_d_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_dsp_trans.c b/LAPACKE/utils/lapacke_dsp_trans.c index 3a73a691cb..b37e7d98b8 100644 --- a/LAPACKE/utils/lapacke_dsp_trans.c +++ b/LAPACKE/utils/lapacke_dsp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dsp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsp_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, double *out ) { - LAPACKE_dtp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_dtp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_dst_nancheck.c b/LAPACKE/utils/lapacke_dst_nancheck.c index f306606fad..9b5707bc88 100644 --- a/LAPACKE/utils/lapacke_dst_nancheck.c +++ b/LAPACKE/utils/lapacke_dst_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_dst_nancheck)( lapack_int n, const double *d, const double *e ) { - return LAPACKE_d_nancheck( n, d, 1 ) - || LAPACKE_d_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_d_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_dsy_nancheck.c b/LAPACKE/utils/lapacke_dsy_nancheck.c index c9d78b9217..90f3d5c6e3 100644 --- a/LAPACKE/utils/lapacke_dsy_nancheck.c +++ b/LAPACKE/utils/lapacke_dsy_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dsy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dsy_nancheck)( int matrix_layout, char uplo, lapack_int n, const double *a, lapack_int lda ) { - return LAPACKE_dtr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_dsy_trans.c b/LAPACKE/utils/lapacke_dsy_trans.c index 697e2048f7..4f9a364be1 100644 --- a/LAPACKE/utils/lapacke_dsy_trans.c +++ b/LAPACKE/utils/lapacke_dsy_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_dsy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_dsy_trans)( int matrix_layout, char uplo, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { - LAPACKE_dtr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_dtb_nancheck.c b/LAPACKE/utils/lapacke_dtb_nancheck.c index 57912510cd..088b581ab4 100644 --- a/LAPACKE/utils/lapacke_dtb_nancheck.c +++ b/LAPACKE/utils/lapacke_dtb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dtb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const double* ab, lapack_int ldab ) @@ -43,12 +43,12 @@ lapack_logical LAPACKE_dtb_nancheck( int matrix_layout, char uplo, char diag, if( ab == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -57,27 +57,27 @@ lapack_logical LAPACKE_dtb_nancheck( int matrix_layout, char uplo, char diag, /* Unit case, diagonal should be excluded from the check for NaN. */ if( colmaj ) { if( upper ) { - return LAPACKE_dgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[ldab], ldab ); } else { - return LAPACKE_dgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[1], ldab ); } } else { if( upper ) { - return LAPACKE_dgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[1], ldab ); } else { - return LAPACKE_dgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[ldab], ldab ); } } } else { /* Non-unit case */ if( upper ) { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); } else { - return LAPACKE_dgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + return API_SUFFIX(LAPACKE_dgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } } } diff --git a/LAPACKE/utils/lapacke_dtb_trans.c b/LAPACKE/utils/lapacke_dtb_trans.c index 54199debca..0071cc7f79 100644 --- a/LAPACKE/utils/lapacke_dtb_trans.c +++ b/LAPACKE/utils/lapacke_dtb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dtb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const double *in, lapack_int ldin, double *out, lapack_int ldout ) @@ -46,12 +46,12 @@ void LAPACKE_dtb_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -60,28 +60,28 @@ void LAPACKE_dtb_trans( int matrix_layout, char uplo, char diag, /* Unit case, diagonal excluded from transposition */ if( colmaj ) { if( upper ) { - LAPACKE_dgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[ldin], ldin, &out[1], ldout ); } else { - LAPACKE_dgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[1], ldin, &out[ldout], ldout ); } } else { if( upper ) { - LAPACKE_dgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[1], ldin, &out[ldout], ldout ); } else { - LAPACKE_dgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[ldin], ldin, &out[1], ldout ); } } } else { /* Non-unit case */ if( upper ) { - LAPACKE_dgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); } else { - LAPACKE_dgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, + API_SUFFIX(LAPACKE_dgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_dtf_nancheck.c b/LAPACKE/utils/lapacke_dtf_nancheck.c index 0aae448374..23ebc7b357 100644 --- a/LAPACKE/utils/lapacke_dtf_nancheck.c +++ b/LAPACKE/utils/lapacke_dtf_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_dtf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const double *a ) @@ -45,15 +45,15 @@ lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, if( a == NULL ) return (lapack_logical) 0; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) - && !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) + && !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -75,36 +75,36 @@ lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[0], n ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[n1], n ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n], n ); } else { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[n2], n ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[0], n ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n1], n ); } } else { /* N is odd and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[0], n1 ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[1], n1 ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[1], n1 ); } else { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[(size_t)n2*n2], n2 ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[0], n2 ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[(size_t)n1*n2], n2 ); } } @@ -114,36 +114,36 @@ lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[1], n+1 ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[k+1], n+1 ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[0], n+1 ); } else { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[k+1], n+1 ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], n+1 ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], n+1 ); } } else { /* N is even and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], k ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[0], k ); } else { - return LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_dge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], k ) - || LAPACKE_dtr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_dtr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[(size_t)k*k], k ); } } @@ -151,6 +151,6 @@ lapack_logical LAPACKE_dtf_nancheck( int matrix_layout, char transr, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_dge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len ); + return API_SUFFIX(LAPACKE_dge_nancheck)( LAPACK_COL_MAJOR, len, 1, a, len ); } } diff --git a/LAPACKE/utils/lapacke_dtf_trans.c b/LAPACKE/utils/lapacke_dtf_trans.c index 24ef7f5ab8..7a183cdd21 100644 --- a/LAPACKE/utils/lapacke_dtf_trans.c +++ b/LAPACKE/utils/lapacke_dtf_trans.c @@ -37,7 +37,7 @@ * This functions does copy diagonal for both unit and non-unit cases. */ -void LAPACKE_dtf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const double *in, double *out ) { @@ -47,15 +47,15 @@ void LAPACKE_dtf_trans( int matrix_layout, char transr, char uplo, char diag, if( in == NULL || out == NULL ) return ; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) && - !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) && + !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if input parameters are wrong */ return; } @@ -81,8 +81,8 @@ void LAPACKE_dtf_trans( int matrix_layout, char transr, char uplo, char diag, /* Perform conversion: */ if( rowmaj ) { - LAPACKE_dge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); } else { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col ); + API_SUFFIX(LAPACKE_dge_trans)( LAPACK_COL_MAJOR, row, col, in, row, out, col ); } } diff --git a/LAPACKE/utils/lapacke_dtp_nancheck.c b/LAPACKE/utils/lapacke_dtp_nancheck.c index d8b5eabbba..804e6057fc 100644 --- a/LAPACKE/utils/lapacke_dtp_nancheck.c +++ b/LAPACKE/utils/lapacke_dtp_nancheck.c @@ -36,7 +36,7 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_dtp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const double *ap ) { @@ -46,12 +46,12 @@ lapack_logical LAPACKE_dtp_nancheck( int matrix_layout, char uplo, char diag, if( ap == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -65,11 +65,11 @@ lapack_logical LAPACKE_dtp_nancheck( int matrix_layout, char uplo, char diag, */ if( ( colmaj || upper ) && !( colmaj && upper ) ) { for( i = 1; i < n; i++ ) - if( LAPACKE_d_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) + if( API_SUFFIX(LAPACKE_d_nancheck)( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) return (lapack_logical) 1; } else { for( i = 0; i < n-1; i++ ) - if( LAPACKE_d_nancheck( n-i-1, + if( API_SUFFIX(LAPACKE_d_nancheck)( n-i-1, &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) ) return (lapack_logical) 1; } @@ -77,6 +77,6 @@ lapack_logical LAPACKE_dtp_nancheck( int matrix_layout, char uplo, char diag, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_d_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( len, ap, 1 ); } } diff --git a/LAPACKE/utils/lapacke_dtp_trans.c b/LAPACKE/utils/lapacke_dtp_trans.c index dc8e03242e..c0d3102286 100644 --- a/LAPACKE/utils/lapacke_dtp_trans.c +++ b/LAPACKE/utils/lapacke_dtp_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_dtp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_dtp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const double *in, double *out ) { @@ -46,12 +46,12 @@ void LAPACKE_dtp_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_dtr_nancheck.c b/LAPACKE/utils/lapacke_dtr_nancheck.c index 93fe775d38..8696804bfe 100644 --- a/LAPACKE/utils/lapacke_dtr_nancheck.c +++ b/LAPACKE/utils/lapacke_dtr_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_dtr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_dtr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const double *a, lapack_int lda ) @@ -44,12 +44,12 @@ lapack_logical LAPACKE_dtr_nancheck( int matrix_layout, char uplo, char diag, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_dtr_trans.c b/LAPACKE/utils/lapacke_dtr_trans.c index f378b8503d..bef80ba556 100644 --- a/LAPACKE/utils/lapacke_dtr_trans.c +++ b/LAPACKE/utils/lapacke_dtr_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_dtr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_dtr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ) { @@ -46,12 +46,12 @@ void LAPACKE_dtr_trans( int matrix_layout, char uplo, char diag, lapack_int n, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_dtz_nancheck.c b/LAPACKE/utils/lapacke_dtz_nancheck.c index cd2ae6731a..b3e6c0f646 100644 --- a/LAPACKE/utils/lapacke_dtz_nancheck.c +++ b/LAPACKE/utils/lapacke_dtz_nancheck.c @@ -80,7 +80,7 @@ *****************************************************************************/ -lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_dtz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const double *a, lapack_int lda ) { @@ -89,14 +89,14 @@ lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -131,13 +131,13 @@ lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo, /* Check rectangular part */ if( rect_offset >= 0 ) { - if( LAPACKE_dge_nancheck( matrix_layout, rect_m, rect_n, + if( API_SUFFIX(LAPACKE_dge_nancheck)( matrix_layout, rect_m, rect_n, &a[rect_offset], lda ) ) { return (lapack_logical) 1; } } /* Check triangular part */ - return LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, tri_n, + return API_SUFFIX(LAPACKE_dtr_nancheck)( matrix_layout, uplo, diag, tri_n, &a[tri_offset], lda ); } diff --git a/LAPACKE/utils/lapacke_dtz_trans.c b/LAPACKE/utils/lapacke_dtz_trans.c index f53e03adcf..d0f583fc8c 100644 --- a/LAPACKE/utils/lapacke_dtz_trans.c +++ b/LAPACKE/utils/lapacke_dtz_trans.c @@ -81,7 +81,7 @@ *****************************************************************************/ -void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_dtz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const double *in, lapack_int ldin, double *out, lapack_int ldout ) @@ -91,14 +91,14 @@ void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -141,13 +141,13 @@ void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo, /* Copy & transpose rectangular part */ if( rect_in_offset >= 0 && rect_out_offset >= 0 ) { - LAPACKE_dge_trans( matrix_layout, rect_m, rect_n, + API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, rect_m, rect_n, &in[rect_in_offset], ldin, &out[rect_out_offset], ldout ); } /* Copy & transpose triangular part */ - LAPACKE_dtr_trans( matrix_layout, uplo, diag, tri_n, + API_SUFFIX(LAPACKE_dtr_trans)( matrix_layout, uplo, diag, tri_n, &in[tri_in_offset], ldin, &out[tri_out_offset], ldout ); } diff --git a/LAPACKE/utils/lapacke_lsame.c b/LAPACKE/utils/lapacke_lsame.c index e4592ce114..6b805e3231 100644 --- a/LAPACKE/utils/lapacke_lsame.c +++ b/LAPACKE/utils/lapacke_lsame.c @@ -32,7 +32,7 @@ #include "lapacke_utils.h" -lapack_logical LAPACKE_lsame( char ca, char cb ) +lapack_logical API_SUFFIX(LAPACKE_lsame)( char ca, char cb ) { return (lapack_logical) LAPACK_lsame( &ca, &cb, 1, 1 ); } diff --git a/LAPACKE/utils/lapacke_s_nancheck.c b/LAPACKE/utils/lapacke_s_nancheck.c index 6abc907e2e..8913630049 100644 --- a/LAPACKE/utils/lapacke_s_nancheck.c +++ b/LAPACKE/utils/lapacke_s_nancheck.c @@ -33,7 +33,7 @@ /* Check a vector for NaN entries. */ -lapack_logical LAPACKE_s_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_s_nancheck)( lapack_int n, const float *x, lapack_int incx ) { diff --git a/LAPACKE/utils/lapacke_sgb_nancheck.c b/LAPACKE/utils/lapacke_sgb_nancheck.c index a1f3aa97b9..e6839a98c5 100644 --- a/LAPACKE/utils/lapacke_sgb_nancheck.c +++ b/LAPACKE/utils/lapacke_sgb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_sgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float *ab, diff --git a/LAPACKE/utils/lapacke_sgb_trans.c b/LAPACKE/utils/lapacke_sgb_trans.c index a90c9617ac..7c8e006a68 100644 --- a/LAPACKE/utils/lapacke_sgb_trans.c +++ b/LAPACKE/utils/lapacke_sgb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_sgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const float *in, lapack_int ldin, float *out, lapack_int ldout ) diff --git a/LAPACKE/utils/lapacke_sge_nancheck.c b/LAPACKE/utils/lapacke_sge_nancheck.c index e15d087dba..184a608920 100644 --- a/LAPACKE/utils/lapacke_sge_nancheck.c +++ b/LAPACKE/utils/lapacke_sge_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_sge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const float *a, lapack_int lda ) diff --git a/LAPACKE/utils/lapacke_sge_trans.c b/LAPACKE/utils/lapacke_sge_trans.c index 21199e4d50..68f03cd9b4 100644 --- a/LAPACKE/utils/lapacke_sge_trans.c +++ b/LAPACKE/utils/lapacke_sge_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_sge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sge_trans)( int matrix_layout, lapack_int m, lapack_int n, const float* in, lapack_int ldin, float* out, lapack_int ldout ) { diff --git a/LAPACKE/utils/lapacke_sgg_nancheck.c b/LAPACKE/utils/lapacke_sgg_nancheck.c index 382c448c96..ce0ce19100 100644 --- a/LAPACKE/utils/lapacke_sgg_nancheck.c +++ b/LAPACKE/utils/lapacke_sgg_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_sgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_sgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const float *a, lapack_int lda ) { - return LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ); + return API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, m, n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_sgg_trans.c b/LAPACKE/utils/lapacke_sgg_trans.c index 3d9d0d22fc..f758d20047 100644 --- a/LAPACKE/utils/lapacke_sgg_trans.c +++ b/LAPACKE/utils/lapacke_sgg_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_sgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_sgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const float* in, lapack_int ldin, float* out, lapack_int ldout ) { - LAPACKE_sge_trans( matrix_layout, m, n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_sgt_nancheck.c b/LAPACKE/utils/lapacke_sgt_nancheck.c index 71ebfd7aa9..ce35eae207 100644 --- a/LAPACKE/utils/lapacke_sgt_nancheck.c +++ b/LAPACKE/utils/lapacke_sgt_nancheck.c @@ -33,12 +33,12 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_sgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_sgt_nancheck)( lapack_int n, const float *dl, const float *d, const float *du ) { - return LAPACKE_s_nancheck( n-1, dl, 1 ) - || LAPACKE_s_nancheck( n , d, 1 ) - || LAPACKE_s_nancheck( n-1, du, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( n-1, dl, 1 ) + || API_SUFFIX(LAPACKE_s_nancheck)( n , d, 1 ) + || API_SUFFIX(LAPACKE_s_nancheck)( n-1, du, 1 ); } diff --git a/LAPACKE/utils/lapacke_shs_nancheck.c b/LAPACKE/utils/lapacke_shs_nancheck.c index 400c3f2ef0..af31f2093b 100644 --- a/LAPACKE/utils/lapacke_shs_nancheck.c +++ b/LAPACKE/utils/lapacke_shs_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_shs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_shs_nancheck)( int matrix_layout, lapack_int n, const float *a, lapack_int lda ) { @@ -43,14 +43,14 @@ lapack_logical LAPACKE_shs_nancheck( int matrix_layout, lapack_int n, /* Check subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - subdiag_nans = LAPACKE_s_nancheck( n-1, &a[1], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_s_nancheck)( n-1, &a[1], lda+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - subdiag_nans = LAPACKE_s_nancheck( n-1, &a[lda], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_s_nancheck)( n-1, &a[lda], lda+1 ); } else { return (lapack_logical) 0; } /* Check upper triangular if subdiagonal has no NaNs. */ - return subdiag_nans || LAPACKE_str_nancheck( matrix_layout, 'u', 'n', + return subdiag_nans || API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, 'u', 'n', n, a, lda); } diff --git a/LAPACKE/utils/lapacke_shs_trans.c b/LAPACKE/utils/lapacke_shs_trans.c index 00e7fa80da..6c23733c39 100644 --- a/LAPACKE/utils/lapacke_shs_trans.c +++ b/LAPACKE/utils/lapacke_shs_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_shs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_shs_trans)( int matrix_layout, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { @@ -44,15 +44,15 @@ void LAPACKE_shs_trans( int matrix_layout, lapack_int n, /* Convert subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, &out[ldout], ldout+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, &out[1], ldout+1 ); } else { return; } /* Convert upper triangular. */ - LAPACKE_str_trans( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); } diff --git a/LAPACKE/utils/lapacke_spb_nancheck.c b/LAPACKE/utils/lapacke_spb_nancheck.c index 0ea931cf8b..896508a667 100644 --- a/LAPACKE/utils/lapacke_spb_nancheck.c +++ b/LAPACKE/utils/lapacke_spb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_spb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_spb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_spb_trans.c b/LAPACKE/utils/lapacke_spb_trans.c index 7b329cd0fd..91efdc9ed7 100644 --- a/LAPACKE/utils/lapacke_spb_trans.c +++ b/LAPACKE/utils/lapacke_spb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_spb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_spf_nancheck.c b/LAPACKE/utils/lapacke_spf_nancheck.c index 5499e150cc..2787aa7f33 100644 --- a/LAPACKE/utils/lapacke_spf_nancheck.c +++ b/LAPACKE/utils/lapacke_spf_nancheck.c @@ -37,9 +37,9 @@ * matrix_layout. */ -lapack_logical LAPACKE_spf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spf_nancheck)( lapack_int n, const float *a ) { lapack_int len = n*(n+1)/2; - return LAPACKE_s_nancheck( len, a, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( len, a, 1 ); } diff --git a/LAPACKE/utils/lapacke_spf_trans.c b/LAPACKE/utils/lapacke_spf_trans.c index 13458cb428..285d4360a3 100644 --- a/LAPACKE/utils/lapacke_spf_trans.c +++ b/LAPACKE/utils/lapacke_spf_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_spf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_spf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const float *in, float *out ) { - LAPACKE_stf_trans( matrix_layout, transr, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_spo_nancheck.c b/LAPACKE/utils/lapacke_spo_nancheck.c index 5b0734e730..e5c1d93ec0 100644 --- a/LAPACKE/utils/lapacke_spo_nancheck.c +++ b/LAPACKE/utils/lapacke_spo_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_spo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_spo_nancheck)( int matrix_layout, char uplo, lapack_int n, const float *a, lapack_int lda ) { - return LAPACKE_str_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_spo_trans.c b/LAPACKE/utils/lapacke_spo_trans.c index f99e661afe..fe9ca777ef 100644 --- a/LAPACKE/utils/lapacke_spo_trans.c +++ b/LAPACKE/utils/lapacke_spo_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_spo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spo_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { - LAPACKE_str_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_spp_nancheck.c b/LAPACKE/utils/lapacke_spp_nancheck.c index ff83c22755..f9fd816aed 100644 --- a/LAPACKE/utils/lapacke_spp_nancheck.c +++ b/LAPACKE/utils/lapacke_spp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_spp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spp_nancheck)( lapack_int n, const float *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_s_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_spp_trans.c b/LAPACKE/utils/lapacke_spp_trans.c index a382fe6e8a..d8c73608cb 100644 --- a/LAPACKE/utils/lapacke_spp_trans.c +++ b/LAPACKE/utils/lapacke_spp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_spp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_spp_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, float *out ) { - LAPACKE_stp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_spt_nancheck.c b/LAPACKE/utils/lapacke_spt_nancheck.c index aa4d0b8c5e..54b627e2f4 100644 --- a/LAPACKE/utils/lapacke_spt_nancheck.c +++ b/LAPACKE/utils/lapacke_spt_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_spt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_spt_nancheck)( lapack_int n, const float *d, const float *e ) { - return LAPACKE_s_nancheck( n, d, 1 ) - || LAPACKE_s_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_ssb_nancheck.c b/LAPACKE/utils/lapacke_ssb_nancheck.c index 4a8edf156c..f2f3da52cd 100644 --- a/LAPACKE/utils/lapacke_ssb_nancheck.c +++ b/LAPACKE/utils/lapacke_ssb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ssb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ssb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_ssb_trans.c b/LAPACKE/utils/lapacke_ssb_trans.c index b11b513ce8..b6565dc27b 100644 --- a/LAPACKE/utils/lapacke_ssb_trans.c +++ b/LAPACKE/utils/lapacke_ssb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ssb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_sgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_ssp_nancheck.c b/LAPACKE/utils/lapacke_ssp_nancheck.c index 94e5338771..37bbc475e1 100644 --- a/LAPACKE/utils/lapacke_ssp_nancheck.c +++ b/LAPACKE/utils/lapacke_ssp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_ssp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_ssp_nancheck)( lapack_int n, const float *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_s_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_ssp_trans.c b/LAPACKE/utils/lapacke_ssp_trans.c index 1737f33381..f677ec214f 100644 --- a/LAPACKE/utils/lapacke_ssp_trans.c +++ b/LAPACKE/utils/lapacke_ssp_trans.c @@ -36,10 +36,10 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ssp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssp_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, float *out ) { - LAPACKE_stp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_stp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_sst_nancheck.c b/LAPACKE/utils/lapacke_sst_nancheck.c index 3372a36095..31c6079de3 100644 --- a/LAPACKE/utils/lapacke_sst_nancheck.c +++ b/LAPACKE/utils/lapacke_sst_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_sst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_sst_nancheck)( lapack_int n, const float *d, const float *e ) { - return LAPACKE_s_nancheck( n, d, 1 ) - || LAPACKE_s_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_s_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_ssy_nancheck.c b/LAPACKE/utils/lapacke_ssy_nancheck.c index ed6ac60ea5..ab0426b0e7 100644 --- a/LAPACKE/utils/lapacke_ssy_nancheck.c +++ b/LAPACKE/utils/lapacke_ssy_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ssy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ssy_nancheck)( int matrix_layout, char uplo, lapack_int n, const float *a, lapack_int lda ) { - return LAPACKE_str_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_ssy_trans.c b/LAPACKE/utils/lapacke_ssy_trans.c index a9122b685d..59e3847170 100644 --- a/LAPACKE/utils/lapacke_ssy_trans.c +++ b/LAPACKE/utils/lapacke_ssy_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_ssy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_ssy_trans)( int matrix_layout, char uplo, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { - LAPACKE_str_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_stb_nancheck.c b/LAPACKE/utils/lapacke_stb_nancheck.c index e1910162a5..cd7925eb7e 100644 --- a/LAPACKE/utils/lapacke_stb_nancheck.c +++ b/LAPACKE/utils/lapacke_stb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_stb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_stb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const float* ab, lapack_int ldab ) @@ -43,12 +43,12 @@ lapack_logical LAPACKE_stb_nancheck( int matrix_layout, char uplo, char diag, if( ab == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -57,27 +57,27 @@ lapack_logical LAPACKE_stb_nancheck( int matrix_layout, char uplo, char diag, /* Unit case, diagonal should be excluded from the check for NaN. */ if( colmaj ) { if( upper ) { - return LAPACKE_sgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[ldab], ldab ); } else { - return LAPACKE_sgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[1], ldab ); } } else { if( upper ) { - return LAPACKE_sgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[1], ldab ); } else { - return LAPACKE_sgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[ldab], ldab ); } } } else { /* Non-unit case */ if( upper ) { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); } else { - return LAPACKE_sgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + return API_SUFFIX(LAPACKE_sgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } } } diff --git a/LAPACKE/utils/lapacke_stb_trans.c b/LAPACKE/utils/lapacke_stb_trans.c index f915cc752f..fa8d2cf73b 100644 --- a/LAPACKE/utils/lapacke_stb_trans.c +++ b/LAPACKE/utils/lapacke_stb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_stb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_stb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const float *in, lapack_int ldin, float *out, lapack_int ldout ) @@ -46,12 +46,12 @@ void LAPACKE_stb_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -60,28 +60,28 @@ void LAPACKE_stb_trans( int matrix_layout, char uplo, char diag, /* Unit case, diagonal excluded from transposition */ if( colmaj ) { if( upper ) { - LAPACKE_sgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[ldin], ldin, &out[1], ldout ); } else { - LAPACKE_sgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[1], ldin, &out[ldout], ldout ); } } else { if( upper ) { - LAPACKE_sgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[1], ldin, &out[ldout], ldout ); } else { - LAPACKE_sgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[ldin], ldin, &out[1], ldout ); } } } else { /* Non-unit case */ if( upper ) { - LAPACKE_sgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); } else { - LAPACKE_sgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, + API_SUFFIX(LAPACKE_sgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_stf_nancheck.c b/LAPACKE/utils/lapacke_stf_nancheck.c index 95128c0e7a..a9d4d7e4d1 100644 --- a/LAPACKE/utils/lapacke_stf_nancheck.c +++ b/LAPACKE/utils/lapacke_stf_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_stf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const float *a ) @@ -45,15 +45,15 @@ lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, if( a == NULL ) return (lapack_logical) 0; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) - && !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) + && !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -75,36 +75,36 @@ lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[0], n ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[n1], n ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n], n ); } else { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[n2], n ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[0], n ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n1], n ); } } else { /* N is odd and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[0], n1 ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[1], n1 ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[1], n1 ); } else { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[(size_t)n2*n2], n2 ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[0], n2 ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[(size_t)n1*n2], n2 ); } } @@ -114,18 +114,18 @@ lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[1], n+1 ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[k+1], n+1 ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[0], n+1 ); } else { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[k+1], n+1 ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], n+1 ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], n+1 ); } } else { @@ -133,18 +133,18 @@ lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, * ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], k ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[0], k ); } else { - return LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_sge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], k ) - || LAPACKE_str_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_str_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[(size_t)k*k], k ); } } @@ -152,6 +152,6 @@ lapack_logical LAPACKE_stf_nancheck( int matrix_layout, char transr, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_sge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len ); + return API_SUFFIX(LAPACKE_sge_nancheck)( LAPACK_COL_MAJOR, len, 1, a, len ); } } diff --git a/LAPACKE/utils/lapacke_stf_trans.c b/LAPACKE/utils/lapacke_stf_trans.c index 6d737e2c9b..aa3795ca6e 100644 --- a/LAPACKE/utils/lapacke_stf_trans.c +++ b/LAPACKE/utils/lapacke_stf_trans.c @@ -37,7 +37,7 @@ * This functions does copy diagonal for both unit and non-unit cases. */ -void LAPACKE_stf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_stf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const float *in, float *out ) { @@ -47,15 +47,15 @@ void LAPACKE_stf_trans( int matrix_layout, char transr, char uplo, char diag, if( in == NULL || out == NULL ) return ; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) && - !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) && + !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if input parameters are wrong */ return; } @@ -81,8 +81,8 @@ void LAPACKE_stf_trans( int matrix_layout, char transr, char uplo, char diag, /* Perform conversion: */ if( rowmaj ) { - LAPACKE_sge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); } else { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col ); + API_SUFFIX(LAPACKE_sge_trans)( LAPACK_COL_MAJOR, row, col, in, row, out, col ); } } diff --git a/LAPACKE/utils/lapacke_stp_nancheck.c b/LAPACKE/utils/lapacke_stp_nancheck.c index 6c16368d56..105be69e18 100644 --- a/LAPACKE/utils/lapacke_stp_nancheck.c +++ b/LAPACKE/utils/lapacke_stp_nancheck.c @@ -36,7 +36,7 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_stp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_stp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const float *ap ) { @@ -46,12 +46,12 @@ lapack_logical LAPACKE_stp_nancheck( int matrix_layout, char uplo, char diag, if( ap == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -65,11 +65,11 @@ lapack_logical LAPACKE_stp_nancheck( int matrix_layout, char uplo, char diag, */ if( ( colmaj || upper ) && !( colmaj && upper ) ) { for( i = 1; i < n; i++ ) - if( LAPACKE_s_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) + if( API_SUFFIX(LAPACKE_s_nancheck)( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) return (lapack_logical) 1; } else { for( i = 0; i < n-1; i++ ) - if( LAPACKE_s_nancheck( n-i-1, + if( API_SUFFIX(LAPACKE_s_nancheck)( n-i-1, &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) ) return (lapack_logical) 1; } @@ -77,6 +77,6 @@ lapack_logical LAPACKE_stp_nancheck( int matrix_layout, char uplo, char diag, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_s_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_s_nancheck)( len, ap, 1 ); } } diff --git a/LAPACKE/utils/lapacke_stp_trans.c b/LAPACKE/utils/lapacke_stp_trans.c index 5c74724e8c..f9e6b29301 100644 --- a/LAPACKE/utils/lapacke_stp_trans.c +++ b/LAPACKE/utils/lapacke_stp_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_stp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_stp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const float *in, float *out ) { @@ -46,12 +46,12 @@ void LAPACKE_stp_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_str_nancheck.c b/LAPACKE/utils/lapacke_str_nancheck.c index df5c7dd5a6..fbcaa2f627 100644 --- a/LAPACKE/utils/lapacke_str_nancheck.c +++ b/LAPACKE/utils/lapacke_str_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_str_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_str_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const float *a, lapack_int lda ) @@ -44,12 +44,12 @@ lapack_logical LAPACKE_str_nancheck( int matrix_layout, char uplo, char diag, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_str_trans.c b/LAPACKE/utils/lapacke_str_trans.c index 4416572e6d..d33e175015 100644 --- a/LAPACKE/utils/lapacke_str_trans.c +++ b/LAPACKE/utils/lapacke_str_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_str_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_str_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { @@ -46,12 +46,12 @@ void LAPACKE_str_trans( int matrix_layout, char uplo, char diag, lapack_int n, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_stz_nancheck.c b/LAPACKE/utils/lapacke_stz_nancheck.c index 7d7c30f96c..903eef9b5d 100644 --- a/LAPACKE/utils/lapacke_stz_nancheck.c +++ b/LAPACKE/utils/lapacke_stz_nancheck.c @@ -80,7 +80,7 @@ *****************************************************************************/ -lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_stz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const float *a, lapack_int lda ) { @@ -89,14 +89,14 @@ lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -131,13 +131,13 @@ lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo, /* Check rectangular part */ if( rect_offset >= 0 ) { - if( LAPACKE_sge_nancheck( matrix_layout, rect_m, rect_n, + if( API_SUFFIX(LAPACKE_sge_nancheck)( matrix_layout, rect_m, rect_n, &a[rect_offset], lda) ) { return (lapack_logical) 1; } } /* Check triangular part */ - return LAPACKE_str_nancheck( matrix_layout, uplo, diag, tri_n, + return API_SUFFIX(LAPACKE_str_nancheck)( matrix_layout, uplo, diag, tri_n, &a[tri_offset], lda ); } diff --git a/LAPACKE/utils/lapacke_stz_trans.c b/LAPACKE/utils/lapacke_stz_trans.c index bdb4279572..5e55c39eef 100644 --- a/LAPACKE/utils/lapacke_stz_trans.c +++ b/LAPACKE/utils/lapacke_stz_trans.c @@ -81,7 +81,7 @@ *****************************************************************************/ -void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_stz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) @@ -91,14 +91,14 @@ void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -141,13 +141,13 @@ void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo, /* Copy & transpose rectangular part */ if( rect_in_offset >= 0 && rect_out_offset >= 0 ) { - LAPACKE_sge_trans( matrix_layout, rect_m, rect_n, + API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, rect_m, rect_n, &in[rect_in_offset], ldin, &out[rect_out_offset], ldout ); } /* Copy & transpose triangular part */ - LAPACKE_str_trans( matrix_layout, uplo, diag, tri_n, + API_SUFFIX(LAPACKE_str_trans)( matrix_layout, uplo, diag, tri_n, &in[tri_in_offset], ldin, &out[tri_out_offset], ldout ); } diff --git a/LAPACKE/utils/lapacke_xerbla.c b/LAPACKE/utils/lapacke_xerbla.c index 8ce4b8e081..a70dd0a1d1 100644 --- a/LAPACKE/utils/lapacke_xerbla.c +++ b/LAPACKE/utils/lapacke_xerbla.c @@ -33,7 +33,7 @@ #include #include "lapacke_utils.h" -void LAPACKE_xerbla( const char *name, lapack_int info ) +void API_SUFFIX(LAPACKE_xerbla)( const char *name, lapack_int info ) { if( info == LAPACK_WORK_MEMORY_ERROR ) { printf( "Not enough memory to allocate work array in %s\n", name ); diff --git a/LAPACKE/utils/lapacke_z_nancheck.c b/LAPACKE/utils/lapacke_z_nancheck.c index ce6b18e630..c983876cfb 100644 --- a/LAPACKE/utils/lapacke_z_nancheck.c +++ b/LAPACKE/utils/lapacke_z_nancheck.c @@ -33,7 +33,7 @@ /* Check a vector for NaN entries. */ -lapack_logical LAPACKE_z_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_z_nancheck)( lapack_int n, const lapack_complex_double *x, lapack_int incx ) { diff --git a/LAPACKE/utils/lapacke_zgb_nancheck.c b/LAPACKE/utils/lapacke_zgb_nancheck.c index 5d98cd5881..5c3673b357 100644 --- a/LAPACKE/utils/lapacke_zgb_nancheck.c +++ b/LAPACKE/utils/lapacke_zgb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zgb_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zgb_nancheck)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double *ab, diff --git a/LAPACKE/utils/lapacke_zgb_trans.c b/LAPACKE/utils/lapacke_zgb_trans.c index 63323b1c3a..6bfc7a5cb9 100644 --- a/LAPACKE/utils/lapacke_zgb_trans.c +++ b/LAPACKE/utils/lapacke_zgb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zgb_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zgb_trans)( int matrix_layout, lapack_int m, lapack_int n, lapack_int kl, lapack_int ku, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) diff --git a/LAPACKE/utils/lapacke_zge_nancheck.c b/LAPACKE/utils/lapacke_zge_nancheck.c index 9fa7fc61ca..efbbca29a6 100644 --- a/LAPACKE/utils/lapacke_zge_nancheck.c +++ b/LAPACKE/utils/lapacke_zge_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zge_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zge_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ) diff --git a/LAPACKE/utils/lapacke_zge_trans.c b/LAPACKE/utils/lapacke_zge_trans.c index bc4d96255f..b5248780ff 100644 --- a/LAPACKE/utils/lapacke_zge_trans.c +++ b/LAPACKE/utils/lapacke_zge_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_zge_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zge_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* in, lapack_int ldin, lapack_complex_double* out, lapack_int ldout ) { diff --git a/LAPACKE/utils/lapacke_zgg_nancheck.c b/LAPACKE/utils/lapacke_zgg_nancheck.c index 2ecf90613d..6aa7f270e7 100644 --- a/LAPACKE/utils/lapacke_zgg_nancheck.c +++ b/LAPACKE/utils/lapacke_zgg_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zgg_nancheck( int matrix_layout, lapack_int m, +lapack_logical API_SUFFIX(LAPACKE_zgg_nancheck)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ) { - return LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ); + return API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_zgg_trans.c b/LAPACKE/utils/lapacke_zgg_trans.c index 3596f3b164..d7dcdccd5d 100644 --- a/LAPACKE/utils/lapacke_zgg_trans.c +++ b/LAPACKE/utils/lapacke_zgg_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_zgg_trans( int matrix_layout, lapack_int m, lapack_int n, +void API_SUFFIX(LAPACKE_zgg_trans)( int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_double* in, lapack_int ldin, lapack_complex_double* out, lapack_int ldout ) { - LAPACKE_zge_trans( matrix_layout, m, n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_zgt_nancheck.c b/LAPACKE/utils/lapacke_zgt_nancheck.c index 6a434bd59d..c6285f64ea 100644 --- a/LAPACKE/utils/lapacke_zgt_nancheck.c +++ b/LAPACKE/utils/lapacke_zgt_nancheck.c @@ -33,12 +33,12 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zgt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zgt_nancheck)( lapack_int n, const lapack_complex_double *dl, const lapack_complex_double *d, const lapack_complex_double *du ) { - return LAPACKE_z_nancheck( n-1, dl, 1 ) - || LAPACKE_z_nancheck( n , d, 1 ) - || LAPACKE_z_nancheck( n-1, du, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( n-1, dl, 1 ) + || API_SUFFIX(LAPACKE_z_nancheck)( n , d, 1 ) + || API_SUFFIX(LAPACKE_z_nancheck)( n-1, du, 1 ); } diff --git a/LAPACKE/utils/lapacke_zhb_nancheck.c b/LAPACKE/utils/lapacke_zhb_nancheck.c index 23e0971793..d6ac42d8d2 100644 --- a/LAPACKE/utils/lapacke_zhb_nancheck.c +++ b/LAPACKE/utils/lapacke_zhb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zhb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zhb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_zhb_trans.c b/LAPACKE/utils/lapacke_zhb_trans.c index 6bab305b9a..e77b95a155 100644 --- a/LAPACKE/utils/lapacke_zhb_trans.c +++ b/LAPACKE/utils/lapacke_zhb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zhb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_zhe_nancheck.c b/LAPACKE/utils/lapacke_zhe_nancheck.c index d0fe8e1682..a8da25f09f 100644 --- a/LAPACKE/utils/lapacke_zhe_nancheck.c +++ b/LAPACKE/utils/lapacke_zhe_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zhe_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zhe_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ) { - return LAPACKE_ztr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_zhe_trans.c b/LAPACKE/utils/lapacke_zhe_trans.c index d7fd00f6ff..dcb8c77ca6 100644 --- a/LAPACKE/utils/lapacke_zhe_trans.c +++ b/LAPACKE/utils/lapacke_zhe_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_zhe_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhe_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { - LAPACKE_ztr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_zhp_nancheck.c b/LAPACKE/utils/lapacke_zhp_nancheck.c index 1cfbd7e546..152a1bf568 100644 --- a/LAPACKE/utils/lapacke_zhp_nancheck.c +++ b/LAPACKE/utils/lapacke_zhp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_zhp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zhp_nancheck)( lapack_int n, const lapack_complex_double *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_z_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_zhp_trans.c b/LAPACKE/utils/lapacke_zhp_trans.c index b61b1b3ba0..118ad1059f 100644 --- a/LAPACKE/utils/lapacke_zhp_trans.c +++ b/LAPACKE/utils/lapacke_zhp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zhp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zhp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { - LAPACKE_ztp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_zhs_nancheck.c b/LAPACKE/utils/lapacke_zhs_nancheck.c index 7283af0314..2b007a01c4 100644 --- a/LAPACKE/utils/lapacke_zhs_nancheck.c +++ b/LAPACKE/utils/lapacke_zhs_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zhs_nancheck( int matrix_layout, lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zhs_nancheck)( int matrix_layout, lapack_int n, const lapack_complex_double *a, lapack_int lda ) { @@ -43,14 +43,14 @@ lapack_logical LAPACKE_zhs_nancheck( int matrix_layout, lapack_int n, /* Check subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - subdiag_nans = LAPACKE_z_nancheck( n-1, &a[1], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_z_nancheck)( n-1, &a[1], lda+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - subdiag_nans = LAPACKE_z_nancheck( n-1, &a[lda], lda+1 ); + subdiag_nans = API_SUFFIX(LAPACKE_z_nancheck)( n-1, &a[lda], lda+1 ); } else { return (lapack_logical) 0; } /* Check upper triangular if subdiagonal has no NaNs. */ - return subdiag_nans || LAPACKE_ztr_nancheck( matrix_layout, 'u', 'n', + return subdiag_nans || API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, 'u', 'n', n, a, lda); } diff --git a/LAPACKE/utils/lapacke_zhs_trans.c b/LAPACKE/utils/lapacke_zhs_trans.c index 44a2d976a4..6e0a454a65 100644 --- a/LAPACKE/utils/lapacke_zhs_trans.c +++ b/LAPACKE/utils/lapacke_zhs_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_zhs_trans( int matrix_layout, lapack_int n, +void API_SUFFIX(LAPACKE_zhs_trans)( int matrix_layout, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { @@ -44,15 +44,15 @@ void LAPACKE_zhs_trans( int matrix_layout, lapack_int n, /* Convert subdiagonal first */ if( matrix_layout == LAPACK_COL_MAJOR ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, &out[ldout], ldout+1 ); } else if ( matrix_layout == LAPACK_ROW_MAJOR ) { - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, &out[1], ldout+1 ); } else { return; } /* Convert upper triangular. */ - LAPACKE_ztr_trans( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, 'u', 'n', n, in, ldin, out, ldout); } diff --git a/LAPACKE/utils/lapacke_zpb_nancheck.c b/LAPACKE/utils/lapacke_zpb_nancheck.c index 521eed9593..2fc53123c7 100644 --- a/LAPACKE/utils/lapacke_zpb_nancheck.c +++ b/LAPACKE/utils/lapacke_zpb_nancheck.c @@ -33,15 +33,15 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zpb_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zpb_nancheck)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_zpb_trans.c b/LAPACKE/utils/lapacke_zpb_trans.c index 5afb4071ee..708173737b 100644 --- a/LAPACKE/utils/lapacke_zpb_trans.c +++ b/LAPACKE/utils/lapacke_zpb_trans.c @@ -36,14 +36,14 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zpb_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpb_trans)( int matrix_layout, char uplo, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { - if( LAPACKE_lsame( uplo, 'u' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); - } else if( LAPACKE_lsame( uplo, 'l' ) ) { - LAPACKE_zgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); + if( API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); + } else if( API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) { + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_zpf_nancheck.c b/LAPACKE/utils/lapacke_zpf_nancheck.c index 6ec322af0b..04c46f8ead 100644 --- a/LAPACKE/utils/lapacke_zpf_nancheck.c +++ b/LAPACKE/utils/lapacke_zpf_nancheck.c @@ -37,9 +37,9 @@ * matrix_layout. */ -lapack_logical LAPACKE_zpf_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpf_nancheck)( lapack_int n, const lapack_complex_double *a ) { lapack_int len = n*(n+1)/2; - return LAPACKE_z_nancheck( len, a, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( len, a, 1 ); } diff --git a/LAPACKE/utils/lapacke_zpf_trans.c b/LAPACKE/utils/lapacke_zpf_trans.c index 2cc41bff2c..c1830f6128 100644 --- a/LAPACKE/utils/lapacke_zpf_trans.c +++ b/LAPACKE/utils/lapacke_zpf_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_zpf_trans( int matrix_layout, char transr, char uplo, +void API_SUFFIX(LAPACKE_zpf_trans)( int matrix_layout, char transr, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { - LAPACKE_ztf_trans( matrix_layout, transr, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_zpo_nancheck.c b/LAPACKE/utils/lapacke_zpo_nancheck.c index 61eb46da57..66740ae874 100644 --- a/LAPACKE/utils/lapacke_zpo_nancheck.c +++ b/LAPACKE/utils/lapacke_zpo_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zpo_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zpo_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ) { - return LAPACKE_ztr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_zpo_trans.c b/LAPACKE/utils/lapacke_zpo_trans.c index 70d7a845a5..88d05081bc 100644 --- a/LAPACKE/utils/lapacke_zpo_trans.c +++ b/LAPACKE/utils/lapacke_zpo_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_zpo_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpo_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { - LAPACKE_ztr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_zpp_nancheck.c b/LAPACKE/utils/lapacke_zpp_nancheck.c index f2982a855d..ce4446a645 100644 --- a/LAPACKE/utils/lapacke_zpp_nancheck.c +++ b/LAPACKE/utils/lapacke_zpp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_zpp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpp_nancheck)( lapack_int n, const lapack_complex_double *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_z_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_zpp_trans.c b/LAPACKE/utils/lapacke_zpp_trans.c index 1cae636374..e1853dd917 100644 --- a/LAPACKE/utils/lapacke_zpp_trans.c +++ b/LAPACKE/utils/lapacke_zpp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zpp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zpp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { - LAPACKE_ztp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_zpt_nancheck.c b/LAPACKE/utils/lapacke_zpt_nancheck.c index 3e09ee0bd2..c9b27924d0 100644 --- a/LAPACKE/utils/lapacke_zpt_nancheck.c +++ b/LAPACKE/utils/lapacke_zpt_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zpt_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zpt_nancheck)( lapack_int n, const double *d, const lapack_complex_double *e ) { - return LAPACKE_d_nancheck( n, d, 1 ) - || LAPACKE_z_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_d_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_zsp_nancheck.c b/LAPACKE/utils/lapacke_zsp_nancheck.c index edc59029fa..648269757e 100644 --- a/LAPACKE/utils/lapacke_zsp_nancheck.c +++ b/LAPACKE/utils/lapacke_zsp_nancheck.c @@ -36,9 +36,9 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_zsp_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zsp_nancheck)( lapack_int n, const lapack_complex_double *ap ) { lapack_int len = n*(n+1)/2; - return LAPACKE_z_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( len, ap, 1 ); } diff --git a/LAPACKE/utils/lapacke_zsp_trans.c b/LAPACKE/utils/lapacke_zsp_trans.c index a445a6016b..74ba2a7595 100644 --- a/LAPACKE/utils/lapacke_zsp_trans.c +++ b/LAPACKE/utils/lapacke_zsp_trans.c @@ -36,9 +36,9 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_zsp_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zsp_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { - LAPACKE_ztp_trans( matrix_layout, uplo, 'n', n, in, out ); + API_SUFFIX(LAPACKE_ztp_trans)( matrix_layout, uplo, 'n', n, in, out ); } diff --git a/LAPACKE/utils/lapacke_zst_nancheck.c b/LAPACKE/utils/lapacke_zst_nancheck.c index 7775a1a2dc..2b8f40bf9b 100644 --- a/LAPACKE/utils/lapacke_zst_nancheck.c +++ b/LAPACKE/utils/lapacke_zst_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zst_nancheck( lapack_int n, +lapack_logical API_SUFFIX(LAPACKE_zst_nancheck)( lapack_int n, const lapack_complex_double *d, const lapack_complex_double *e ) { - return LAPACKE_z_nancheck( n, d, 1 ) - || LAPACKE_z_nancheck( n-1, e, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( n, d, 1 ) + || API_SUFFIX(LAPACKE_z_nancheck)( n-1, e, 1 ); } diff --git a/LAPACKE/utils/lapacke_zsy_nancheck.c b/LAPACKE/utils/lapacke_zsy_nancheck.c index 57deee0d03..812b043707 100644 --- a/LAPACKE/utils/lapacke_zsy_nancheck.c +++ b/LAPACKE/utils/lapacke_zsy_nancheck.c @@ -33,10 +33,10 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_zsy_nancheck( int matrix_layout, char uplo, +lapack_logical API_SUFFIX(LAPACKE_zsy_nancheck)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *a, lapack_int lda ) { - return LAPACKE_ztr_nancheck( matrix_layout, uplo, 'n', n, a, lda ); + return API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, 'n', n, a, lda ); } diff --git a/LAPACKE/utils/lapacke_zsy_trans.c b/LAPACKE/utils/lapacke_zsy_trans.c index 341fda7316..4eaefd33ca 100644 --- a/LAPACKE/utils/lapacke_zsy_trans.c +++ b/LAPACKE/utils/lapacke_zsy_trans.c @@ -36,9 +36,9 @@ * layout or vice versa. */ -void LAPACKE_zsy_trans( int matrix_layout, char uplo, lapack_int n, +void API_SUFFIX(LAPACKE_zsy_trans)( int matrix_layout, char uplo, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { - LAPACKE_ztr_trans( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, 'n', n, in, ldin, out, ldout ); } diff --git a/LAPACKE/utils/lapacke_ztb_nancheck.c b/LAPACKE/utils/lapacke_ztb_nancheck.c index 0c2c809b87..23dbb14d09 100644 --- a/LAPACKE/utils/lapacke_ztb_nancheck.c +++ b/LAPACKE/utils/lapacke_ztb_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ztb_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztb_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double* ab, lapack_int ldab ) @@ -43,12 +43,12 @@ lapack_logical LAPACKE_ztb_nancheck( int matrix_layout, char uplo, char diag, if( ab == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -57,27 +57,27 @@ lapack_logical LAPACKE_ztb_nancheck( int matrix_layout, char uplo, char diag, /* Unit case, diagonal should be excluded from the check for NaN. */ if( colmaj ) { if( upper ) { - return LAPACKE_zgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[ldab], ldab ); } else { - return LAPACKE_zgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[1], ldab ); } } else { if( upper ) { - return LAPACKE_zgb_nancheck( matrix_layout, n-1, n-1, 0, kd-1, + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n-1, n-1, 0, kd-1, &ab[1], ldab ); } else { - return LAPACKE_zgb_nancheck( matrix_layout, n-1, n-1, kd-1, 0, + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n-1, n-1, kd-1, 0, &ab[ldab], ldab ); } } } else { /* Non-unit case */ if( upper ) { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, 0, kd, ab, ldab ); + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, 0, kd, ab, ldab ); } else { - return LAPACKE_zgb_nancheck( matrix_layout, n, n, kd, 0, ab, ldab ); + return API_SUFFIX(LAPACKE_zgb_nancheck)( matrix_layout, n, n, kd, 0, ab, ldab ); } } } diff --git a/LAPACKE/utils/lapacke_ztb_trans.c b/LAPACKE/utils/lapacke_ztb_trans.c index 063f145404..5a300153ae 100644 --- a/LAPACKE/utils/lapacke_ztb_trans.c +++ b/LAPACKE/utils/lapacke_ztb_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ztb_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztb_trans)( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int kd, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) @@ -46,12 +46,12 @@ void LAPACKE_ztb_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -60,28 +60,28 @@ void LAPACKE_ztb_trans( int matrix_layout, char uplo, char diag, /* Unit case, diagonal excluded from transposition */ if( colmaj ) { if( upper ) { - LAPACKE_zgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[ldin], ldin, &out[1], ldout ); } else { - LAPACKE_zgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[1], ldin, &out[ldout], ldout ); } } else { if( upper ) { - LAPACKE_zgb_trans( matrix_layout, n-1, n-1, 0, kd-1, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n-1, n-1, 0, kd-1, &in[1], ldin, &out[ldout], ldout ); } else { - LAPACKE_zgb_trans( matrix_layout, n-1, n-1, kd-1, 0, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n-1, n-1, kd-1, 0, &in[ldin], ldin, &out[1], ldout ); } } } else { /* Non-unit case */ if( upper ) { - LAPACKE_zgb_trans( matrix_layout, n, n, 0, kd, in, ldin, out, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, 0, kd, in, ldin, out, ldout ); } else { - LAPACKE_zgb_trans( matrix_layout, n, n, kd, 0, in, ldin, out, + API_SUFFIX(LAPACKE_zgb_trans)( matrix_layout, n, n, kd, 0, in, ldin, out, ldout ); } } diff --git a/LAPACKE/utils/lapacke_ztf_nancheck.c b/LAPACKE/utils/lapacke_ztf_nancheck.c index 2cfa86bf1c..d43e986350 100644 --- a/LAPACKE/utils/lapacke_ztf_nancheck.c +++ b/LAPACKE/utils/lapacke_ztf_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, +lapack_logical API_SUFFIX(LAPACKE_ztf_nancheck)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_double *a ) @@ -45,15 +45,15 @@ lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, if( a == NULL ) return (lapack_logical) 0; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) - && !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) + && !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -75,18 +75,18 @@ lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is odd and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[0], n ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[n1], n ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n], n ); } else { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n1, &a[n2], n ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[0], n ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n2, &a[n1], n ); } } else { @@ -94,18 +94,18 @@ lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, * ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[0], n1 ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, n1, n2, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, n1, n2, &a[1], n1 ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[1], n1 ); } else { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', n1, &a[(size_t)n2*n2], n2 ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, n2, n1, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, n2, n1, &a[0], n2 ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', n2, &a[(size_t)n1*n2], n2 ); } } @@ -115,36 +115,36 @@ lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, if( ( rowmaj || ntr ) && !( rowmaj && ntr ) ) { /* N is even and ( TRANSR = 'N' .XOR. ROWMAJOR) */ if( lower ) { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[1], n+1 ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[k+1], n+1 ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[0], n+1 ); } else { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[k+1], n+1 ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], n+1 ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], n+1 ); } } else { /* N is even and ( ( TRANSR = 'C' || TRANSR = 'T' ) .XOR. COLMAJOR ) */ if( lower ) { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[k], k ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[0], k ); } else { - return LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'u', 'u', + return API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'u', 'u', k, &a[(size_t)k*(k+1)], k ) - || LAPACKE_zge_nancheck( LAPACK_ROW_MAJOR, k, k, + || API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_ROW_MAJOR, k, k, &a[0], k ) - || LAPACKE_ztr_nancheck( LAPACK_ROW_MAJOR, 'l', 'u', + || API_SUFFIX(LAPACKE_ztr_nancheck)( LAPACK_ROW_MAJOR, 'l', 'u', k, &a[(size_t)k*k], k ); } } @@ -152,6 +152,6 @@ lapack_logical LAPACKE_ztf_nancheck( int matrix_layout, char transr, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_zge_nancheck( LAPACK_COL_MAJOR, len, 1, a, len ); + return API_SUFFIX(LAPACKE_zge_nancheck)( LAPACK_COL_MAJOR, len, 1, a, len ); } } diff --git a/LAPACKE/utils/lapacke_ztf_trans.c b/LAPACKE/utils/lapacke_ztf_trans.c index 6bc6fcc48d..8a8bf64884 100644 --- a/LAPACKE/utils/lapacke_ztf_trans.c +++ b/LAPACKE/utils/lapacke_ztf_trans.c @@ -37,7 +37,7 @@ * This functions does copy diagonal for both unit and non-unit cases. */ -void LAPACKE_ztf_trans( int matrix_layout, char transr, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztf_trans)( int matrix_layout, char transr, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { @@ -47,15 +47,15 @@ void LAPACKE_ztf_trans( int matrix_layout, char transr, char uplo, char diag, if( in == NULL || out == NULL ) return ; rowmaj = (matrix_layout == LAPACK_ROW_MAJOR); - ntr = LAPACKE_lsame( transr, 'n' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + ntr = API_SUFFIX(LAPACKE_lsame)( transr, 'n' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) || - ( !ntr && !LAPACKE_lsame( transr, 't' ) && - !LAPACKE_lsame( transr, 'c' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !ntr && !API_SUFFIX(LAPACKE_lsame)( transr, 't' ) && + !API_SUFFIX(LAPACKE_lsame)( transr, 'c' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if input parameters are wrong */ return; } @@ -81,8 +81,8 @@ void LAPACKE_ztf_trans( int matrix_layout, char transr, char uplo, char diag, /* Perform conversion: */ if( rowmaj ) { - LAPACKE_zge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_ROW_MAJOR, row, col, in, col, out, row ); } else { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, row, col, in, row, out, col ); } } diff --git a/LAPACKE/utils/lapacke_ztp_nancheck.c b/LAPACKE/utils/lapacke_ztp_nancheck.c index dc347eaa5a..cd56224d88 100644 --- a/LAPACKE/utils/lapacke_ztp_nancheck.c +++ b/LAPACKE/utils/lapacke_ztp_nancheck.c @@ -36,7 +36,7 @@ * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ -lapack_logical LAPACKE_ztp_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztp_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *ap ) { @@ -46,12 +46,12 @@ lapack_logical LAPACKE_ztp_nancheck( int matrix_layout, char uplo, char diag, if( ap == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -65,11 +65,11 @@ lapack_logical LAPACKE_ztp_nancheck( int matrix_layout, char uplo, char diag, */ if( ( colmaj || upper ) && !( colmaj && upper ) ) { for( i = 1; i < n; i++ ) - if( LAPACKE_z_nancheck( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) + if( API_SUFFIX(LAPACKE_z_nancheck)( i, &ap[ ((size_t)i+1)*i/2 ], 1 ) ) return (lapack_logical) 1; } else { for( i = 0; i < n-1; i++ ) - if( LAPACKE_z_nancheck( n-i-1, + if( API_SUFFIX(LAPACKE_z_nancheck)( n-i-1, &ap[ (size_t)i+1 + i*((size_t)2*n-i+1)/2 ], 1 ) ) return (lapack_logical) 1; } @@ -77,6 +77,6 @@ lapack_logical LAPACKE_ztp_nancheck( int matrix_layout, char uplo, char diag, } else { /* Non-unit case - just check whole array for NaNs. */ len = n*(n+1)/2; - return LAPACKE_z_nancheck( len, ap, 1 ); + return API_SUFFIX(LAPACKE_z_nancheck)( len, ap, 1 ); } } diff --git a/LAPACKE/utils/lapacke_ztp_trans.c b/LAPACKE/utils/lapacke_ztp_trans.c index 47b4851b65..ea19b6585c 100644 --- a/LAPACKE/utils/lapacke_ztp_trans.c +++ b/LAPACKE/utils/lapacke_ztp_trans.c @@ -36,7 +36,7 @@ * column-major(Fortran) layout or vice versa. */ -void LAPACKE_ztp_trans( int matrix_layout, char uplo, char diag, +void API_SUFFIX(LAPACKE_ztp_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_complex_double *out ) { @@ -46,12 +46,12 @@ void LAPACKE_ztp_trans( int matrix_layout, char uplo, char diag, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - upper = LAPACKE_lsame( uplo, 'u' ); - unit = LAPACKE_lsame( diag, 'u' ); + upper = API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !upper && !LAPACKE_lsame( uplo, 'l' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !upper && !API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_ztr_nancheck.c b/LAPACKE/utils/lapacke_ztr_nancheck.c index 7058a33ed6..5c870a6461 100644 --- a/LAPACKE/utils/lapacke_ztr_nancheck.c +++ b/LAPACKE/utils/lapacke_ztr_nancheck.c @@ -33,7 +33,7 @@ /* Check a matrix for NaN entries. */ -lapack_logical LAPACKE_ztr_nancheck( int matrix_layout, char uplo, char diag, +lapack_logical API_SUFFIX(LAPACKE_ztr_nancheck)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *a, lapack_int lda ) @@ -44,12 +44,12 @@ lapack_logical LAPACKE_ztr_nancheck( int matrix_layout, char uplo, char diag, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } diff --git a/LAPACKE/utils/lapacke_ztr_trans.c b/LAPACKE/utils/lapacke_ztr_trans.c index e3042bfa52..f126000b03 100644 --- a/LAPACKE/utils/lapacke_ztr_trans.c +++ b/LAPACKE/utils/lapacke_ztr_trans.c @@ -36,7 +36,7 @@ * layout or vice versa. */ -void LAPACKE_ztr_trans( int matrix_layout, char uplo, char diag, lapack_int n, +void API_SUFFIX(LAPACKE_ztr_trans)( int matrix_layout, char uplo, char diag, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) { @@ -46,12 +46,12 @@ void LAPACKE_ztr_trans( int matrix_layout, char uplo, char diag, lapack_int n, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } diff --git a/LAPACKE/utils/lapacke_ztz_nancheck.c b/LAPACKE/utils/lapacke_ztz_nancheck.c index 481fa4c033..f316cf13d4 100644 --- a/LAPACKE/utils/lapacke_ztz_nancheck.c +++ b/LAPACKE/utils/lapacke_ztz_nancheck.c @@ -80,7 +80,7 @@ *****************************************************************************/ -lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo, +lapack_logical API_SUFFIX(LAPACKE_ztz_nancheck)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double *a, lapack_int lda ) @@ -90,14 +90,14 @@ lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo, if( a == NULL ) return (lapack_logical) 0; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return (lapack_logical) 0; } @@ -132,13 +132,13 @@ lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo, /* Check rectangular part */ if( rect_offset >= 0 ) { - if( LAPACKE_zge_nancheck( matrix_layout, rect_m, rect_n, + if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, rect_m, rect_n, &a[rect_offset], lda) ) { return (lapack_logical) 1; } } /* Check triangular part */ - return LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, tri_n, + return API_SUFFIX(LAPACKE_ztr_nancheck)( matrix_layout, uplo, diag, tri_n, &a[tri_offset], lda ); } diff --git a/LAPACKE/utils/lapacke_ztz_trans.c b/LAPACKE/utils/lapacke_ztz_trans.c index fa4bb94c5f..1bb141b477 100644 --- a/LAPACKE/utils/lapacke_ztz_trans.c +++ b/LAPACKE/utils/lapacke_ztz_trans.c @@ -81,7 +81,7 @@ *****************************************************************************/ -void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo, +void API_SUFFIX(LAPACKE_ztz_trans)( int matrix_layout, char direct, char uplo, char diag, lapack_int m, lapack_int n, const lapack_complex_double *in, lapack_int ldin, lapack_complex_double *out, lapack_int ldout ) @@ -91,14 +91,14 @@ void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo, if( in == NULL || out == NULL ) return ; colmaj = ( matrix_layout == LAPACK_COL_MAJOR ); - front = LAPACKE_lsame( direct, 'f' ); - lower = LAPACKE_lsame( uplo, 'l' ); - unit = LAPACKE_lsame( diag, 'u' ); + front = API_SUFFIX(LAPACKE_lsame)( direct, 'f' ); + lower = API_SUFFIX(LAPACKE_lsame)( uplo, 'l' ); + unit = API_SUFFIX(LAPACKE_lsame)( diag, 'u' ); if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) || - ( !front && !LAPACKE_lsame( direct, 'b' ) ) || - ( !lower && !LAPACKE_lsame( uplo, 'u' ) ) || - ( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) { + ( !front && !API_SUFFIX(LAPACKE_lsame)( direct, 'b' ) ) || + ( !lower && !API_SUFFIX(LAPACKE_lsame)( uplo, 'u' ) ) || + ( !unit && !API_SUFFIX(LAPACKE_lsame)( diag, 'n' ) ) ) { /* Just exit if any of input parameters are wrong */ return; } @@ -141,13 +141,13 @@ void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo, /* Copy & transpose rectangular part */ if( rect_in_offset >= 0 && rect_out_offset >= 0 ) { - LAPACKE_zge_trans( matrix_layout, rect_m, rect_n, + API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, rect_m, rect_n, &in[rect_in_offset], ldin, &out[rect_out_offset], ldout ); } /* Copy & transpose triangular part */ - LAPACKE_ztr_trans( matrix_layout, uplo, diag, tri_n, + API_SUFFIX(LAPACKE_ztr_trans)( matrix_layout, uplo, diag, tri_n, &in[tri_in_offset], ldin, &out[tri_out_offset], ldout ); } From b8911458992b2ff00d6873ae5dc41cdc293365f0 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Thu, 6 Jul 2023 08:44:06 -0700 Subject: [PATCH 038/206] Add extended API with _64 suffix to LAPACK with lapack_64.h --- INSTALL/dlamch.f | 1 + INSTALL/droundup_lwork.f | 1 + INSTALL/ilaver.f | 1 + INSTALL/lsame.f | 1 + INSTALL/slamch.f | 1 + INSTALL/sroundup_lwork.f | 1 + SRC/CMakeLists.txt | 28 +- SRC/cbbcsd.f | 1 + SRC/cbdsqr.f | 1 + SRC/cgbbrd.f | 1 + SRC/cgbcon.f | 1 + SRC/cgbequ.f | 1 + SRC/cgbequb.f | 1 + SRC/cgbrfs.f | 1 + SRC/cgbrfsx.f | 1 + SRC/cgbsv.f | 1 + SRC/cgbsvx.f | 1 + SRC/cgbsvxx.f | 1 + SRC/cgbtf2.f | 1 + SRC/cgbtrf.f | 1 + SRC/cgbtrs.f | 1 + SRC/cgebak.f | 1 + SRC/cgebal.f | 1 + SRC/cgebd2.f | 1 + SRC/cgebrd.f | 1 + SRC/cgecon.f | 1 + SRC/cgedmd.f90 | 1 + SRC/cgedmdq.f90 | 1 + SRC/cgeequ.f | 1 + SRC/cgeequb.f | 1 + SRC/cgees.f | 1 + SRC/cgeesx.f | 1 + SRC/cgeev.f | 1 + SRC/cgeevx.f | 1 + SRC/cgehd2.f | 1 + SRC/cgehrd.f | 1 + SRC/cgejsv.f | 1 + SRC/cgelq.f | 1 + SRC/cgelq2.f | 1 + SRC/cgelqf.f | 1 + SRC/cgelqt.f | 1 + SRC/cgelqt3.f | 1 + SRC/cgels.f | 1 + SRC/cgelsd.f | 1 + SRC/cgelss.f | 1 + SRC/cgelst.f | 1 + SRC/cgelsy.f | 1 + SRC/cgemlq.f | 1 + SRC/cgemlqt.f | 1 + SRC/cgemqr.f | 1 + SRC/cgemqrt.f | 1 + SRC/cgeql2.f | 1 + SRC/cgeqlf.f | 1 + SRC/cgeqp3.f | 1 + SRC/cgeqr.f | 1 + SRC/cgeqr2.f | 1 + SRC/cgeqr2p.f | 1 + SRC/cgeqrf.f | 1 + SRC/cgeqrfp.f | 1 + SRC/cgeqrt.f | 1 + SRC/cgeqrt2.f | 1 + SRC/cgeqrt3.f | 1 + SRC/cgerfs.f | 1 + SRC/cgerfsx.f | 1 + SRC/cgerq2.f | 1 + SRC/cgerqf.f | 1 + SRC/cgesc2.f | 1 + SRC/cgesdd.f | 1 + SRC/cgesv.f | 1 + SRC/cgesvd.f | 1 + SRC/cgesvdq.f | 1 + SRC/cgesvdx.f | 1 + SRC/cgesvj.f | 1 + SRC/cgesvx.f | 1 + SRC/cgesvxx.f | 1 + SRC/cgetc2.f | 1 + SRC/cgetf2.f | 1 + SRC/cgetrf.f | 1 + SRC/cgetrf2.f | 1 + SRC/cgetri.f | 1 + SRC/cgetrs.f | 1 + SRC/cgetsls.f | 1 + SRC/cgetsqrhrt.f | 1 + SRC/cggbak.f | 1 + SRC/cggbal.f | 1 + SRC/cgges.f | 1 + SRC/cgges3.f | 1 + SRC/cggesx.f | 1 + SRC/cggev.f | 1 + SRC/cggev3.f | 1 + SRC/cggevx.f | 1 + SRC/cggglm.f | 1 + SRC/cgghd3.f | 1 + SRC/cgghrd.f | 1 + SRC/cgglse.f | 1 + SRC/cggqrf.f | 1 + SRC/cggrqf.f | 1 + SRC/cggsvd3.f | 1 + SRC/cggsvp3.f | 1 + SRC/cgsvj0.f | 1 + SRC/cgsvj1.f | 1 + SRC/cgtcon.f | 1 + SRC/cgtrfs.f | 1 + SRC/cgtsv.f | 1 + SRC/cgtsvx.f | 1 + SRC/cgttrf.f | 1 + SRC/cgttrs.f | 1 + SRC/cgtts2.f | 1 + SRC/chb2st_kernels.f | 1 + SRC/chbev.f | 1 + SRC/chbev_2stage.f | 1 + SRC/chbevd.f | 1 + SRC/chbevd_2stage.f | 1 + SRC/chbevx.f | 1 + SRC/chbevx_2stage.f | 1 + SRC/chbgst.f | 1 + SRC/chbgv.f | 1 + SRC/chbgvd.f | 1 + SRC/chbgvx.f | 1 + SRC/chbtrd.f | 1 + SRC/checon.f | 1 + SRC/checon_3.f | 1 + SRC/checon_rook.f | 1 + SRC/cheequb.f | 1 + SRC/cheev.f | 1 + SRC/cheev_2stage.f | 1 + SRC/cheevd.f | 1 + SRC/cheevd_2stage.f | 1 + SRC/cheevr.f | 1 + SRC/cheevr_2stage.f | 1 + SRC/cheevx.f | 1 + SRC/cheevx_2stage.f | 1 + SRC/chegs2.f | 1 + SRC/chegst.f | 1 + SRC/chegv.f | 1 + SRC/chegv_2stage.f | 1 + SRC/chegvd.f | 1 + SRC/chegvx.f | 1 + SRC/cherfs.f | 1 + SRC/cherfsx.f | 1 + SRC/chesv.f | 1 + SRC/chesv_aa.f | 1 + SRC/chesv_aa_2stage.f | 1 + SRC/chesv_rk.f | 1 + SRC/chesv_rook.f | 1 + SRC/chesvx.f | 1 + SRC/chesvxx.f | 1 + SRC/cheswapr.f | 1 + SRC/chetd2.f | 1 + SRC/chetf2.f | 1 + SRC/chetf2_rk.f | 1 + SRC/chetf2_rook.f | 1 + SRC/chetrd.f | 1 + SRC/chetrd_2stage.f | 1 + SRC/chetrd_hb2st.F | 1 + SRC/chetrd_he2hb.f | 1 + SRC/chetrf.f | 1 + SRC/chetrf_aa.f | 1 + SRC/chetrf_aa_2stage.f | 1 + SRC/chetrf_rk.f | 1 + SRC/chetrf_rook.f | 1 + SRC/chetri.f | 1 + SRC/chetri2.f | 1 + SRC/chetri2x.f | 1 + SRC/chetri_3.f | 1 + SRC/chetri_3x.f | 1 + SRC/chetri_rook.f | 1 + SRC/chetrs.f | 1 + SRC/chetrs2.f | 1 + SRC/chetrs_3.f | 1 + SRC/chetrs_aa.f | 1 + SRC/chetrs_aa_2stage.f | 1 + SRC/chetrs_rook.f | 1 + SRC/chfrk.f | 1 + SRC/chgeqz.f | 1 + SRC/chla_transtype.f | 1 + SRC/chpcon.f | 1 + SRC/chpev.f | 1 + SRC/chpevd.f | 1 + SRC/chpevx.f | 1 + SRC/chpgst.f | 1 + SRC/chpgv.f | 1 + SRC/chpgvd.f | 1 + SRC/chpgvx.f | 1 + SRC/chprfs.f | 1 + SRC/chpsv.f | 1 + SRC/chpsvx.f | 1 + SRC/chptrd.f | 1 + SRC/chptrf.f | 1 + SRC/chptri.f | 1 + SRC/chptrs.f | 1 + SRC/chsein.f | 1 + SRC/chseqr.f | 1 + SRC/cla_gbamv.f | 1 + SRC/cla_gbrcond_c.f | 1 + SRC/cla_gbrcond_x.f | 1 + SRC/cla_gbrfsx_extended.f | 1 + SRC/cla_gbrpvgrw.f | 1 + SRC/cla_geamv.f | 1 + SRC/cla_gercond_c.f | 1 + SRC/cla_gercond_x.f | 1 + SRC/cla_gerfsx_extended.f | 1 + SRC/cla_gerpvgrw.f | 1 + SRC/cla_heamv.f | 1 + SRC/cla_hercond_c.f | 1 + SRC/cla_hercond_x.f | 1 + SRC/cla_herfsx_extended.f | 1 + SRC/cla_herpvgrw.f | 1 + SRC/cla_lin_berr.f | 1 + SRC/cla_porcond_c.f | 1 + SRC/cla_porcond_x.f | 1 + SRC/cla_porfsx_extended.f | 1 + SRC/cla_porpvgrw.f | 1 + SRC/cla_syamv.f | 1 + SRC/cla_syrcond_c.f | 1 + SRC/cla_syrcond_x.f | 1 + SRC/cla_syrfsx_extended.f | 1 + SRC/cla_syrpvgrw.f | 1 + SRC/cla_wwaddw.f | 1 + SRC/clabrd.f | 1 + SRC/clacgv.f | 1 + SRC/clacn2.f | 1 + SRC/clacon.f | 1 + SRC/clacp2.f | 1 + SRC/clacpy.f | 1 + SRC/clacrm.f | 1 + SRC/clacrt.f | 1 + SRC/cladiv.f | 1 + SRC/claed0.f | 1 + SRC/claed7.f | 1 + SRC/claed8.f | 1 + SRC/claein.f | 1 + SRC/claesy.f | 1 + SRC/claev2.f | 1 + SRC/clag2z.f | 1 + SRC/clags2.f | 1 + SRC/clagtm.f | 1 + SRC/clahef.f | 1 + SRC/clahef_aa.f | 1 + SRC/clahef_rk.f | 1 + SRC/clahef_rook.f | 1 + SRC/clahqr.f | 1 + SRC/clahr2.f | 1 + SRC/claic1.f | 1 + SRC/clals0.f | 1 + SRC/clalsa.f | 1 + SRC/clalsd.f | 1 + SRC/clamswlq.f | 1 + SRC/clamtsqr.f | 1 + SRC/clangb.f | 1 + SRC/clange.f | 1 + SRC/clangt.f | 1 + SRC/clanhb.f | 1 + SRC/clanhe.f | 1 + SRC/clanhf.f | 1 + SRC/clanhp.f | 1 + SRC/clanhs.f | 1 + SRC/clanht.f | 1 + SRC/clansb.f | 1 + SRC/clansp.f | 1 + SRC/clansy.f | 1 + SRC/clantb.f | 1 + SRC/clantp.f | 1 + SRC/clantr.f | 1 + SRC/clapll.f | 1 + SRC/clapmr.f | 1 + SRC/clapmt.f | 1 + SRC/claqgb.f | 1 + SRC/claqge.f | 1 + SRC/claqhb.f | 1 + SRC/claqhe.f | 1 + SRC/claqhp.f | 1 + SRC/claqp2.f | 1 + SRC/claqps.f | 1 + SRC/claqr0.f | 1 + SRC/claqr1.f | 1 + SRC/claqr2.f | 1 + SRC/claqr3.f | 1 + SRC/claqr4.f | 1 + SRC/claqr5.f | 1 + SRC/claqsb.f | 1 + SRC/claqsp.f | 1 + SRC/claqsy.f | 1 + SRC/claqz0.f | 1 + SRC/claqz1.f | 1 + SRC/claqz2.f | 1 + SRC/claqz3.f | 1 + SRC/clar1v.f | 1 + SRC/clar2v.f | 1 + SRC/clarcm.f | 1 + SRC/clarf.f | 1 + SRC/clarfb.f | 1 + SRC/clarfb_gett.f | 1 + SRC/clarfg.f | 1 + SRC/clarfgp.f | 1 + SRC/clarft.f | 1 + SRC/clarfx.f | 1 + SRC/clarfy.f | 1 + SRC/clargv.f | 1 + SRC/clarnv.f | 1 + SRC/clarrv.f | 1 + SRC/clarscl2.f | 1 + SRC/clartg.f90 | 1 + SRC/clartv.f | 1 + SRC/clarz.f | 1 + SRC/clarzb.f | 1 + SRC/clarzt.f | 1 + SRC/clascl.f | 1 + SRC/clascl2.f | 1 + SRC/claset.f | 1 + SRC/clasr.f | 1 + SRC/classq.f90 | 1 + SRC/claswlq.f | 1 + SRC/claswp.f | 1 + SRC/clasyf.f | 1 + SRC/clasyf_aa.f | 1 + SRC/clasyf_rk.f | 1 + SRC/clasyf_rook.f | 1 + SRC/clatbs.f | 1 + SRC/clatdf.f | 1 + SRC/clatps.f | 1 + SRC/clatrd.f | 1 + SRC/clatrs.f | 1 + SRC/clatrs3.f | 1 + SRC/clatrz.f | 1 + SRC/clatsqr.f | 1 + SRC/claunhr_col_getrfnp.f | 1 + SRC/claunhr_col_getrfnp2.f | 1 + SRC/clauu2.f | 1 + SRC/clauum.f | 1 + SRC/cpbcon.f | 1 + SRC/cpbequ.f | 1 + SRC/cpbrfs.f | 1 + SRC/cpbstf.f | 1 + SRC/cpbsv.f | 1 + SRC/cpbsvx.f | 1 + SRC/cpbtf2.f | 1 + SRC/cpbtrf.f | 1 + SRC/cpbtrs.f | 1 + SRC/cpftrf.f | 1 + SRC/cpftri.f | 1 + SRC/cpftrs.f | 1 + SRC/cpocon.f | 1 + SRC/cpoequ.f | 1 + SRC/cpoequb.f | 1 + SRC/cporfs.f | 1 + SRC/cporfsx.f | 1 + SRC/cposv.f | 1 + SRC/cposvx.f | 1 + SRC/cposvxx.f | 1 + SRC/cpotf2.f | 1 + SRC/cpotrf.f | 1 + SRC/cpotrf2.f | 1 + SRC/cpotri.f | 1 + SRC/cpotrs.f | 1 + SRC/cppcon.f | 1 + SRC/cppequ.f | 1 + SRC/cpprfs.f | 1 + SRC/cppsv.f | 1 + SRC/cppsvx.f | 1 + SRC/cpptrf.f | 1 + SRC/cpptri.f | 1 + SRC/cpptrs.f | 1 + SRC/cpstf2.f | 1 + SRC/cpstrf.f | 1 + SRC/cptcon.f | 1 + SRC/cpteqr.f | 1 + SRC/cptrfs.f | 1 + SRC/cptsv.f | 1 + SRC/cptsvx.f | 1 + SRC/cpttrf.f | 1 + SRC/cpttrs.f | 1 + SRC/cptts2.f | 1 + SRC/crot.f | 1 + SRC/crscl.f | 1 + SRC/cspcon.f | 1 + SRC/cspmv.f | 1 + SRC/cspr.f | 1 + SRC/csprfs.f | 1 + SRC/cspsv.f | 1 + SRC/cspsvx.f | 1 + SRC/csptrf.f | 1 + SRC/csptri.f | 1 + SRC/csptrs.f | 1 + SRC/csrscl.f | 1 + SRC/cstedc.f | 1 + SRC/cstegr.f | 1 + SRC/cstein.f | 1 + SRC/cstemr.f | 1 + SRC/csteqr.f | 1 + SRC/csycon.f | 1 + SRC/csycon_3.f | 1 + SRC/csycon_rook.f | 1 + SRC/csyconv.f | 1 + SRC/csyconvf.f | 1 + SRC/csyconvf_rook.f | 1 + SRC/csyequb.f | 1 + SRC/csymv.f | 1 + SRC/csyr.f | 1 + SRC/csyrfs.f | 1 + SRC/csyrfsx.f | 1 + SRC/csysv.f | 1 + SRC/csysv_aa.f | 1 + SRC/csysv_aa_2stage.f | 1 + SRC/csysv_rk.f | 1 + SRC/csysv_rook.f | 1 + SRC/csysvx.f | 1 + SRC/csysvxx.f | 1 + SRC/csyswapr.f | 1 + SRC/csytf2.f | 1 + SRC/csytf2_rk.f | 1 + SRC/csytf2_rook.f | 1 + SRC/csytrf.f | 1 + SRC/csytrf_aa.f | 1 + SRC/csytrf_aa_2stage.f | 1 + SRC/csytrf_rk.f | 1 + SRC/csytrf_rook.f | 1 + SRC/csytri.f | 1 + SRC/csytri2.f | 1 + SRC/csytri2x.f | 1 + SRC/csytri_3.f | 1 + SRC/csytri_3x.f | 1 + SRC/csytri_rook.f | 1 + SRC/csytrs.f | 1 + SRC/csytrs2.f | 1 + SRC/csytrs_3.f | 1 + SRC/csytrs_aa.f | 1 + SRC/csytrs_aa_2stage.f | 1 + SRC/csytrs_rook.f | 1 + SRC/ctbcon.f | 1 + SRC/ctbrfs.f | 1 + SRC/ctbtrs.f | 1 + SRC/ctfsm.f | 1 + SRC/ctftri.f | 1 + SRC/ctfttp.f | 1 + SRC/ctfttr.f | 1 + SRC/ctgevc.f | 1 + SRC/ctgex2.f | 1 + SRC/ctgexc.f | 1 + SRC/ctgsen.f | 1 + SRC/ctgsja.f | 1 + SRC/ctgsna.f | 1 + SRC/ctgsy2.f | 1 + SRC/ctgsyl.f | 1 + SRC/ctpcon.f | 1 + SRC/ctplqt.f | 1 + SRC/ctplqt2.f | 1 + SRC/ctpmlqt.f | 1 + SRC/ctpmqrt.f | 1 + SRC/ctpqrt.f | 1 + SRC/ctpqrt2.f | 1 + SRC/ctprfb.f | 1 + SRC/ctprfs.f | 1 + SRC/ctptri.f | 1 + SRC/ctptrs.f | 1 + SRC/ctpttf.f | 1 + SRC/ctpttr.f | 1 + SRC/ctrcon.f | 1 + SRC/ctrevc.f | 1 + SRC/ctrevc3.f | 1 + SRC/ctrexc.f | 1 + SRC/ctrrfs.f | 1 + SRC/ctrsen.f | 1 + SRC/ctrsna.f | 1 + SRC/ctrsyl.f | 1 + SRC/ctrsyl3.f | 1 + SRC/ctrti2.f | 1 + SRC/ctrtri.f | 1 + SRC/ctrtrs.f | 1 + SRC/ctrttf.f | 1 + SRC/ctrttp.f | 1 + SRC/ctzrzf.f | 1 + SRC/cunbdb.f | 1 + SRC/cunbdb1.f | 1 + SRC/cunbdb2.f | 1 + SRC/cunbdb3.f | 1 + SRC/cunbdb4.f | 1 + SRC/cunbdb5.f | 1 + SRC/cunbdb6.f | 1 + SRC/cuncsd.f | 1 + SRC/cuncsd2by1.f | 1 + SRC/cung2l.f | 1 + SRC/cung2r.f | 1 + SRC/cungbr.f | 1 + SRC/cunghr.f | 1 + SRC/cungl2.f | 1 + SRC/cunglq.f | 1 + SRC/cungql.f | 1 + SRC/cungqr.f | 1 + SRC/cungr2.f | 1 + SRC/cungrq.f | 1 + SRC/cungtr.f | 1 + SRC/cungtsqr.f | 1 + SRC/cungtsqr_row.f | 1 + SRC/cunhr_col.f | 1 + SRC/cunm22.f | 1 + SRC/cunm2l.f | 1 + SRC/cunm2r.f | 1 + SRC/cunmbr.f | 1 + SRC/cunmhr.f | 1 + SRC/cunml2.f | 1 + SRC/cunmlq.f | 1 + SRC/cunmql.f | 1 + SRC/cunmqr.f | 1 + SRC/cunmr2.f | 1 + SRC/cunmr3.f | 1 + SRC/cunmrq.f | 1 + SRC/cunmrz.f | 1 + SRC/cunmtr.f | 1 + SRC/cupgtr.f | 1 + SRC/cupmtr.f | 1 + SRC/dbbcsd.f | 1 + SRC/dbdsdc.f | 1 + SRC/dbdsqr.f | 1 + SRC/dbdsvdx.f | 1 + SRC/ddisna.f | 1 + SRC/dgbbrd.f | 1 + SRC/dgbcon.f | 1 + SRC/dgbequ.f | 1 + SRC/dgbequb.f | 1 + SRC/dgbrfs.f | 1 + SRC/dgbrfsx.f | 1 + SRC/dgbsv.f | 1 + SRC/dgbsvx.f | 1 + SRC/dgbsvxx.f | 1 + SRC/dgbtf2.f | 1 + SRC/dgbtrf.f | 1 + SRC/dgbtrs.f | 1 + SRC/dgebak.f | 1 + SRC/dgebal.f | 1 + SRC/dgebd2.f | 1 + SRC/dgebrd.f | 1 + SRC/dgecon.f | 1 + SRC/dgedmd.f90 | 1 + SRC/dgedmdq.f90 | 1 + SRC/dgeequ.f | 1 + SRC/dgeequb.f | 1 + SRC/dgees.f | 1 + SRC/dgeesx.f | 1 + SRC/dgeev.f | 1 + SRC/dgeevx.f | 1 + SRC/dgehd2.f | 1 + SRC/dgehrd.f | 1 + SRC/dgejsv.f | 1 + SRC/dgelq.f | 1 + SRC/dgelq2.f | 1 + SRC/dgelqf.f | 1 + SRC/dgelqt.f | 1 + SRC/dgelqt3.f | 1 + SRC/dgels.f | 1 + SRC/dgelsd.f | 1 + SRC/dgelss.f | 1 + SRC/dgelst.f | 1 + SRC/dgelsy.f | 1 + SRC/dgemlq.f | 1 + SRC/dgemlqt.f | 1 + SRC/dgemqr.f | 1 + SRC/dgemqrt.f | 1 + SRC/dgeql2.f | 1 + SRC/dgeqlf.f | 1 + SRC/dgeqp3.f | 1 + SRC/dgeqr.f | 1 + SRC/dgeqr2.f | 1 + SRC/dgeqr2p.f | 1 + SRC/dgeqrf.f | 1 + SRC/dgeqrfp.f | 1 + SRC/dgeqrt.f | 1 + SRC/dgeqrt2.f | 1 + SRC/dgeqrt3.f | 1 + SRC/dgerfs.f | 1 + SRC/dgerfsx.f | 1 + SRC/dgerq2.f | 1 + SRC/dgerqf.f | 1 + SRC/dgesc2.f | 1 + SRC/dgesdd.f | 1 + SRC/dgesv.f | 1 + SRC/dgesvd.f | 1 + SRC/dgesvdq.f | 1 + SRC/dgesvdx.f | 1 + SRC/dgesvj.f | 1 + SRC/dgesvx.f | 1 + SRC/dgesvxx.f | 1 + SRC/dgetc2.f | 1 + SRC/dgetf2.f | 1 + SRC/dgetrf.f | 1 + SRC/dgetrf2.f | 1 + SRC/dgetri.f | 1 + SRC/dgetrs.f | 1 + SRC/dgetsls.f | 1 + SRC/dgetsqrhrt.f | 1 + SRC/dggbak.f | 1 + SRC/dggbal.f | 1 + SRC/dgges.f | 1 + SRC/dgges3.f | 1 + SRC/dggesx.f | 1 + SRC/dggev.f | 1 + SRC/dggev3.f | 1 + SRC/dggevx.f | 1 + SRC/dggglm.f | 1 + SRC/dgghd3.f | 1 + SRC/dgghrd.f | 1 + SRC/dgglse.f | 1 + SRC/dggqrf.f | 1 + SRC/dggrqf.f | 1 + SRC/dggsvd3.f | 1 + SRC/dggsvp3.f | 1 + SRC/dgsvj0.f | 1 + SRC/dgsvj1.f | 1 + SRC/dgtcon.f | 1 + SRC/dgtrfs.f | 1 + SRC/dgtsv.f | 1 + SRC/dgtsvx.f | 1 + SRC/dgttrf.f | 1 + SRC/dgttrs.f | 1 + SRC/dgtts2.f | 1 + SRC/dhgeqz.f | 1 + SRC/dhsein.f | 1 + SRC/dhseqr.f | 1 + SRC/disnan.f | 1 + SRC/dla_gbamv.f | 1 + SRC/dla_gbrcond.f | 1 + SRC/dla_gbrfsx_extended.f | 1 + SRC/dla_gbrpvgrw.f | 1 + SRC/dla_geamv.f | 1 + SRC/dla_gercond.f | 1 + SRC/dla_gerfsx_extended.f | 1 + SRC/dla_gerpvgrw.f | 1 + SRC/dla_lin_berr.f | 1 + SRC/dla_porcond.f | 1 + SRC/dla_porfsx_extended.f | 1 + SRC/dla_porpvgrw.f | 1 + SRC/dla_syamv.f | 1 + SRC/dla_syrcond.f | 1 + SRC/dla_syrfsx_extended.f | 1 + SRC/dla_syrpvgrw.f | 1 + SRC/dla_wwaddw.f | 1 + SRC/dlabad.f | 1 + SRC/dlabrd.f | 1 + SRC/dlacn2.f | 1 + SRC/dlacon.f | 1 + SRC/dlacpy.f | 1 + SRC/dladiv.f | 1 + SRC/dlae2.f | 1 + SRC/dlaebz.f | 1 + SRC/dlaed0.f | 1 + SRC/dlaed1.f | 1 + SRC/dlaed2.f | 1 + SRC/dlaed3.f | 1 + SRC/dlaed4.f | 1 + SRC/dlaed5.f | 1 + SRC/dlaed6.f | 1 + SRC/dlaed7.f | 1 + SRC/dlaed8.f | 1 + SRC/dlaed9.f | 1 + SRC/dlaeda.f | 1 + SRC/dlaein.f | 1 + SRC/dlaev2.f | 1 + SRC/dlaexc.f | 1 + SRC/dlag2.f | 1 + SRC/dlag2s.f | 1 + SRC/dlags2.f | 1 + SRC/dlagtf.f | 1 + SRC/dlagtm.f | 1 + SRC/dlagts.f | 1 + SRC/dlagv2.f | 1 + SRC/dlahqr.f | 1 + SRC/dlahr2.f | 1 + SRC/dlaic1.f | 1 + SRC/dlaisnan.f | 1 + SRC/dlaln2.f | 1 + SRC/dlals0.f | 1 + SRC/dlalsa.f | 1 + SRC/dlalsd.f | 1 + SRC/dlamrg.f | 1 + SRC/dlamswlq.f | 1 + SRC/dlamtsqr.f | 1 + SRC/dlaneg.f | 1 + SRC/dlangb.f | 1 + SRC/dlange.f | 1 + SRC/dlangt.f | 1 + SRC/dlanhs.f | 1 + SRC/dlansb.f | 1 + SRC/dlansf.f | 1 + SRC/dlansp.f | 1 + SRC/dlanst.f | 1 + SRC/dlansy.f | 1 + SRC/dlantb.f | 1 + SRC/dlantp.f | 1 + SRC/dlantr.f | 1 + SRC/dlanv2.f | 1 + SRC/dlaorhr_col_getrfnp.f | 1 + SRC/dlaorhr_col_getrfnp2.f | 1 + SRC/dlapll.f | 1 + SRC/dlapmr.f | 1 + SRC/dlapmt.f | 1 + SRC/dlapy2.f | 1 + SRC/dlapy3.f | 1 + SRC/dlaqgb.f | 1 + SRC/dlaqge.f | 1 + SRC/dlaqp2.f | 1 + SRC/dlaqps.f | 1 + SRC/dlaqr0.f | 1 + SRC/dlaqr1.f | 1 + SRC/dlaqr2.f | 1 + SRC/dlaqr3.f | 1 + SRC/dlaqr4.f | 1 + SRC/dlaqr5.f | 1 + SRC/dlaqsb.f | 1 + SRC/dlaqsp.f | 1 + SRC/dlaqsy.f | 1 + SRC/dlaqtr.f | 1 + SRC/dlaqz0.f | 1 + SRC/dlaqz1.f | 1 + SRC/dlaqz2.f | 1 + SRC/dlaqz3.f | 1 + SRC/dlaqz4.f | 1 + SRC/dlar1v.f | 1 + SRC/dlar2v.f | 1 + SRC/dlarf.f | 1 + SRC/dlarfb.f | 1 + SRC/dlarfb_gett.f | 1 + SRC/dlarfg.f | 1 + SRC/dlarfgp.f | 1 + SRC/dlarft.f | 1 + SRC/dlarfx.f | 1 + SRC/dlarfy.f | 1 + SRC/dlargv.f | 1 + SRC/dlarmm.f | 1 + SRC/dlarnv.f | 1 + SRC/dlarra.f | 1 + SRC/dlarrb.f | 1 + SRC/dlarrc.f | 1 + SRC/dlarrd.f | 1 + SRC/dlarre.f | 1 + SRC/dlarrf.f | 1 + SRC/dlarrj.f | 1 + SRC/dlarrk.f | 1 + SRC/dlarrr.f | 1 + SRC/dlarrv.f | 1 + SRC/dlarscl2.f | 1 + SRC/dlartg.f90 | 1 + SRC/dlartgp.f | 1 + SRC/dlartgs.f | 1 + SRC/dlartv.f | 1 + SRC/dlaruv.f | 1 + SRC/dlarz.f | 1 + SRC/dlarzb.f | 1 + SRC/dlarzt.f | 1 + SRC/dlas2.f | 1 + SRC/dlascl.f | 1 + SRC/dlascl2.f | 1 + SRC/dlasd0.f | 1 + SRC/dlasd1.f | 1 + SRC/dlasd2.f | 1 + SRC/dlasd3.f | 1 + SRC/dlasd4.f | 1 + SRC/dlasd5.f | 1 + SRC/dlasd6.f | 1 + SRC/dlasd7.f | 1 + SRC/dlasd8.f | 1 + SRC/dlasda.f | 1 + SRC/dlasdq.f | 1 + SRC/dlasdt.f | 1 + SRC/dlaset.f | 1 + SRC/dlasq1.f | 1 + SRC/dlasq2.f | 1 + SRC/dlasq3.f | 1 + SRC/dlasq4.f | 1 + SRC/dlasq5.f | 1 + SRC/dlasq6.f | 1 + SRC/dlasr.f | 1 + SRC/dlasrt.f | 1 + SRC/dlassq.f90 | 1 + SRC/dlasv2.f | 1 + SRC/dlaswlq.f | 1 + SRC/dlaswp.f | 1 + SRC/dlasy2.f | 1 + SRC/dlasyf.f | 1 + SRC/dlasyf_aa.f | 1 + SRC/dlasyf_rk.f | 1 + SRC/dlasyf_rook.f | 1 + SRC/dlat2s.f | 1 + SRC/dlatbs.f | 1 + SRC/dlatdf.f | 1 + SRC/dlatps.f | 1 + SRC/dlatrd.f | 1 + SRC/dlatrs.f | 1 + SRC/dlatrs3.f | 1 + SRC/dlatrz.f | 1 + SRC/dlatsqr.f | 1 + SRC/dlauu2.f | 1 + SRC/dlauum.f | 1 + SRC/dopgtr.f | 1 + SRC/dopmtr.f | 1 + SRC/dorbdb.f | 1 + SRC/dorbdb1.f | 1 + SRC/dorbdb2.f | 1 + SRC/dorbdb3.f | 1 + SRC/dorbdb4.f | 1 + SRC/dorbdb5.f | 1 + SRC/dorbdb6.f | 1 + SRC/dorcsd.f | 1 + SRC/dorcsd2by1.f | 1 + SRC/dorg2l.f | 1 + SRC/dorg2r.f | 1 + SRC/dorgbr.f | 1 + SRC/dorghr.f | 1 + SRC/dorgl2.f | 1 + SRC/dorglq.f | 1 + SRC/dorgql.f | 1 + SRC/dorgqr.f | 1 + SRC/dorgr2.f | 1 + SRC/dorgrq.f | 1 + SRC/dorgtr.f | 1 + SRC/dorgtsqr.f | 1 + SRC/dorgtsqr_row.f | 1 + SRC/dorhr_col.f | 1 + SRC/dorm22.f | 1 + SRC/dorm2l.f | 1 + SRC/dorm2r.f | 1 + SRC/dormbr.f | 1 + SRC/dormhr.f | 1 + SRC/dorml2.f | 1 + SRC/dormlq.f | 1 + SRC/dormql.f | 1 + SRC/dormqr.f | 1 + SRC/dormr2.f | 1 + SRC/dormr3.f | 1 + SRC/dormrq.f | 1 + SRC/dormrz.f | 1 + SRC/dormtr.f | 1 + SRC/dpbcon.f | 1 + SRC/dpbequ.f | 1 + SRC/dpbrfs.f | 1 + SRC/dpbstf.f | 1 + SRC/dpbsv.f | 1 + SRC/dpbsvx.f | 1 + SRC/dpbtf2.f | 1 + SRC/dpbtrf.f | 1 + SRC/dpbtrs.f | 1 + SRC/dpftrf.f | 1 + SRC/dpftri.f | 1 + SRC/dpftrs.f | 1 + SRC/dpocon.f | 1 + SRC/dpoequ.f | 1 + SRC/dpoequb.f | 1 + SRC/dporfs.f | 1 + SRC/dporfsx.f | 1 + SRC/dposv.f | 1 + SRC/dposvx.f | 1 + SRC/dposvxx.f | 1 + SRC/dpotf2.f | 1 + SRC/dpotrf.f | 1 + SRC/dpotrf2.f | 1 + SRC/dpotri.f | 1 + SRC/dpotrs.f | 1 + SRC/dppcon.f | 1 + SRC/dppequ.f | 1 + SRC/dpprfs.f | 1 + SRC/dppsv.f | 1 + SRC/dppsvx.f | 1 + SRC/dpptrf.f | 1 + SRC/dpptri.f | 1 + SRC/dpptrs.f | 1 + SRC/dpstf2.f | 1 + SRC/dpstrf.f | 1 + SRC/dptcon.f | 1 + SRC/dpteqr.f | 1 + SRC/dptrfs.f | 1 + SRC/dptsv.f | 1 + SRC/dptsvx.f | 1 + SRC/dpttrf.f | 1 + SRC/dpttrs.f | 1 + SRC/dptts2.f | 1 + SRC/drscl.f | 1 + SRC/dsb2st_kernels.f | 1 + SRC/dsbev.f | 1 + SRC/dsbev_2stage.f | 1 + SRC/dsbevd.f | 1 + SRC/dsbevd_2stage.f | 1 + SRC/dsbevx.f | 1 + SRC/dsbevx_2stage.f | 1 + SRC/dsbgst.f | 1 + SRC/dsbgv.f | 1 + SRC/dsbgvd.f | 1 + SRC/dsbgvx.f | 1 + SRC/dsbtrd.f | 1 + SRC/dsfrk.f | 1 + SRC/dsgesv.f | 1 + SRC/dspcon.f | 1 + SRC/dspev.f | 1 + SRC/dspevd.f | 1 + SRC/dspevx.f | 1 + SRC/dspgst.f | 1 + SRC/dspgv.f | 1 + SRC/dspgvd.f | 1 + SRC/dspgvx.f | 1 + SRC/dsposv.f | 1 + SRC/dsprfs.f | 1 + SRC/dspsv.f | 1 + SRC/dspsvx.f | 1 + SRC/dsptrd.f | 1 + SRC/dsptrf.f | 1 + SRC/dsptri.f | 1 + SRC/dsptrs.f | 1 + SRC/dstebz.f | 1 + SRC/dstedc.f | 1 + SRC/dstegr.f | 1 + SRC/dstein.f | 1 + SRC/dstemr.f | 1 + SRC/dsteqr.f | 1 + SRC/dsterf.f | 1 + SRC/dstev.f | 1 + SRC/dstevd.f | 1 + SRC/dstevr.f | 1 + SRC/dstevx.f | 1 + SRC/dsycon.f | 1 + SRC/dsycon_3.f | 1 + SRC/dsycon_rook.f | 1 + SRC/dsyconv.f | 1 + SRC/dsyconvf.f | 1 + SRC/dsyconvf_rook.f | 1 + SRC/dsyequb.f | 1 + SRC/dsyev.f | 1 + SRC/dsyev_2stage.f | 1 + SRC/dsyevd.f | 1 + SRC/dsyevd_2stage.f | 1 + SRC/dsyevr.f | 1 + SRC/dsyevr_2stage.f | 1 + SRC/dsyevx.f | 1 + SRC/dsyevx_2stage.f | 1 + SRC/dsygs2.f | 1 + SRC/dsygst.f | 1 + SRC/dsygv.f | 1 + SRC/dsygv_2stage.f | 1 + SRC/dsygvd.f | 1 + SRC/dsygvx.f | 1 + SRC/dsyrfs.f | 1 + SRC/dsyrfsx.f | 1 + SRC/dsysv.f | 1 + SRC/dsysv_aa.f | 1 + SRC/dsysv_aa_2stage.f | 1 + SRC/dsysv_rk.f | 1 + SRC/dsysv_rook.f | 1 + SRC/dsysvx.f | 1 + SRC/dsysvxx.f | 1 + SRC/dsyswapr.f | 1 + SRC/dsytd2.f | 1 + SRC/dsytf2.f | 1 + SRC/dsytf2_rk.f | 1 + SRC/dsytf2_rook.f | 1 + SRC/dsytrd.f | 1 + SRC/dsytrd_2stage.f | 1 + SRC/dsytrd_sb2st.F | 1 + SRC/dsytrd_sy2sb.f | 1 + SRC/dsytrf.f | 1 + SRC/dsytrf_aa.f | 1 + SRC/dsytrf_aa_2stage.f | 1 + SRC/dsytrf_rk.f | 1 + SRC/dsytrf_rook.f | 1 + SRC/dsytri.f | 1 + SRC/dsytri2.f | 1 + SRC/dsytri2x.f | 1 + SRC/dsytri_3.f | 1 + SRC/dsytri_3x.f | 1 + SRC/dsytri_rook.f | 1 + SRC/dsytrs.f | 1 + SRC/dsytrs2.f | 1 + SRC/dsytrs_3.f | 1 + SRC/dsytrs_aa.f | 1 + SRC/dsytrs_aa_2stage.f | 1 + SRC/dsytrs_rook.f | 1 + SRC/dtbcon.f | 1 + SRC/dtbrfs.f | 1 + SRC/dtbtrs.f | 1 + SRC/dtfsm.f | 1 + SRC/dtftri.f | 1 + SRC/dtfttp.f | 1 + SRC/dtfttr.f | 1 + SRC/dtgevc.f | 1 + SRC/dtgex2.f | 1 + SRC/dtgexc.f | 1 + SRC/dtgsen.f | 1 + SRC/dtgsja.f | 1 + SRC/dtgsna.f | 1 + SRC/dtgsy2.f | 1 + SRC/dtgsyl.f | 1 + SRC/dtpcon.f | 1 + SRC/dtplqt.f | 1 + SRC/dtplqt2.f | 1 + SRC/dtpmlqt.f | 1 + SRC/dtpmqrt.f | 1 + SRC/dtpqrt.f | 1 + SRC/dtpqrt2.f | 1 + SRC/dtprfb.f | 1 + SRC/dtprfs.f | 1 + SRC/dtptri.f | 1 + SRC/dtptrs.f | 1 + SRC/dtpttf.f | 1 + SRC/dtpttr.f | 1 + SRC/dtrcon.f | 1 + SRC/dtrevc.f | 1 + SRC/dtrevc3.f | 1 + SRC/dtrexc.f | 1 + SRC/dtrrfs.f | 1 + SRC/dtrsen.f | 1 + SRC/dtrsna.f | 1 + SRC/dtrsyl.f | 1 + SRC/dtrsyl3.f | 1 + SRC/dtrti2.f | 1 + SRC/dtrtri.f | 1 + SRC/dtrtrs.f | 1 + SRC/dtrttf.f | 1 + SRC/dtrttp.f | 1 + SRC/dtzrzf.f | 1 + SRC/dzsum1.f | 1 + SRC/icmax1.f | 1 + SRC/ieeeck.f | 1 + SRC/ilaclc.f | 1 + SRC/ilaclr.f | 1 + SRC/iladiag.f | 1 + SRC/iladlc.f | 1 + SRC/iladlr.f | 1 + SRC/ilaenv.f | 1 + SRC/ilaenv2stage.f | 1 + SRC/ilaprec.f | 1 + SRC/ilaslc.f | 1 + SRC/ilaslr.f | 1 + SRC/ilatrans.f | 1 + SRC/ilauplo.f | 1 + SRC/ilazlc.f | 1 + SRC/ilazlr.f | 1 + SRC/iparam2stage.F | 1 + SRC/iparmq.f | 1 + SRC/izmax1.f | 1 + SRC/la_constants.f90 | 1 + SRC/la_xisnan.F90 | 1 + SRC/lapack_64.h | 2255 ++++++++++++++++++++++++++++++++++++ SRC/lsamen.f | 1 + SRC/sbbcsd.f | 1 + SRC/sbdsdc.f | 1 + SRC/sbdsqr.f | 1 + SRC/sbdsvdx.f | 1 + SRC/scsum1.f | 1 + SRC/sdisna.f | 1 + SRC/sgbbrd.f | 4 +- SRC/sgbcon.f | 8 +- SRC/sgbequ.f | 1 + SRC/sgbequb.f | 1 + SRC/sgbrfs.f | 1 + SRC/sgbrfsx.f | 1 + SRC/sgbsv.f | 1 + SRC/sgbsvx.f | 1 + SRC/sgbsvxx.f | 1 + SRC/sgbtf2.f | 1 + SRC/sgbtrf.f | 1 + SRC/sgbtrs.f | 1 + SRC/sgebak.f | 1 + SRC/sgebal.f | 1 + SRC/sgebd2.f | 1 + SRC/sgebrd.f | 1 + SRC/sgecon.f | 1 + SRC/sgedmd.f90 | 1 + SRC/sgedmdq.f90 | 1 + SRC/sgeequ.f | 1 + SRC/sgeequb.f | 1 + SRC/sgees.f | 1 + SRC/sgeesx.f | 1 + SRC/sgeev.f | 1 + SRC/sgeevx.f | 1 + SRC/sgehd2.f | 1 + SRC/sgehrd.f | 1 + SRC/sgejsv.f | 1 + SRC/sgelq.f | 1 + SRC/sgelq2.f | 1 + SRC/sgelqf.f | 1 + SRC/sgelqt.f | 1 + SRC/sgelqt3.f | 1 + SRC/sgels.f | 1 + SRC/sgelsd.f | 1 + SRC/sgelss.f | 1 + SRC/sgelst.f | 1 + SRC/sgelsy.f | 1 + SRC/sgemlq.f | 1 + SRC/sgemlqt.f | 1 + SRC/sgemqr.f | 1 + SRC/sgemqrt.f | 1 + SRC/sgeql2.f | 1 + SRC/sgeqlf.f | 1 + SRC/sgeqp3.f | 1 + SRC/sgeqr.f | 1 + SRC/sgeqr2.f | 1 + SRC/sgeqr2p.f | 1 + SRC/sgeqrf.f | 1 + SRC/sgeqrfp.f | 1 + SRC/sgeqrt.f | 1 + SRC/sgeqrt2.f | 1 + SRC/sgeqrt3.f | 1 + SRC/sgerfs.f | 1 + SRC/sgerfsx.f | 1 + SRC/sgerq2.f | 1 + SRC/sgerqf.f | 1 + SRC/sgesc2.f | 1 + SRC/sgesdd.f | 1 + SRC/sgesv.f | 1 + SRC/sgesvd.f | 1 + SRC/sgesvdq.f | 1 + SRC/sgesvdx.f | 1 + SRC/sgesvj.f | 1 + SRC/sgesvx.f | 1 + SRC/sgesvxx.f | 1 + SRC/sgetc2.f | 1 + SRC/sgetf2.f | 1 + SRC/sgetrf.f | 1 + SRC/sgetrf2.f | 1 + SRC/sgetri.f | 1 + SRC/sgetrs.f | 1 + SRC/sgetsls.f | 1 + SRC/sgetsqrhrt.f | 1 + SRC/sggbak.f | 1 + SRC/sggbal.f | 1 + SRC/sgges.f | 1 + SRC/sgges3.f | 1 + SRC/sggesx.f | 1 + SRC/sggev.f | 1 + SRC/sggev3.f | 1 + SRC/sggevx.f | 1 + SRC/sggglm.f | 1 + SRC/sgghd3.f | 1 + SRC/sgghrd.f | 1 + SRC/sgglse.f | 1 + SRC/sggqrf.f | 1 + SRC/sggrqf.f | 1 + SRC/sggsvd3.f | 1 + SRC/sggsvp3.f | 1 + SRC/sgsvj0.f | 1 + SRC/sgsvj1.f | 1 + SRC/sgtcon.f | 1 + SRC/sgtrfs.f | 1 + SRC/sgtsv.f | 1 + SRC/sgtsvx.f | 1 + SRC/sgttrf.f | 1 + SRC/sgttrs.f | 1 + SRC/sgtts2.f | 1 + SRC/shgeqz.f | 1 + SRC/shsein.f | 1 + SRC/shseqr.f | 1 + SRC/sisnan.f | 1 + SRC/sla_gbamv.f | 1 + SRC/sla_gbrcond.f | 1 + SRC/sla_gbrfsx_extended.f | 1 + SRC/sla_gbrpvgrw.f | 1 + SRC/sla_geamv.f | 1 + SRC/sla_gercond.f | 1 + SRC/sla_gerfsx_extended.f | 1 + SRC/sla_gerpvgrw.f | 1 + SRC/sla_lin_berr.f | 1 + SRC/sla_porcond.f | 1 + SRC/sla_porfsx_extended.f | 1 + SRC/sla_porpvgrw.f | 1 + SRC/sla_syamv.f | 1 + SRC/sla_syrcond.f | 1 + SRC/sla_syrfsx_extended.f | 1 + SRC/sla_syrpvgrw.f | 1 + SRC/sla_wwaddw.f | 1 + SRC/slabad.f | 1 + SRC/slabrd.f | 1 + SRC/slacn2.f | 1 + SRC/slacon.f | 1 + SRC/slacpy.f | 1 + SRC/sladiv.f | 1 + SRC/slae2.f | 1 + SRC/slaebz.f | 1 + SRC/slaed0.f | 1 + SRC/slaed1.f | 1 + SRC/slaed2.f | 1 + SRC/slaed3.f | 1 + SRC/slaed4.f | 1 + SRC/slaed5.f | 1 + SRC/slaed6.f | 1 + SRC/slaed7.f | 1 + SRC/slaed8.f | 1 + SRC/slaed9.f | 1 + SRC/slaeda.f | 1 + SRC/slaein.f | 1 + SRC/slaev2.f | 1 + SRC/slaexc.f | 1 + SRC/slag2.f | 1 + SRC/slag2d.f | 1 + SRC/slags2.f | 1 + SRC/slagtf.f | 1 + SRC/slagtm.f | 1 + SRC/slagts.f | 1 + SRC/slagv2.f | 1 + SRC/slahqr.f | 1 + SRC/slahr2.f | 1 + SRC/slaic1.f | 1 + SRC/slaisnan.f | 1 + SRC/slaln2.f | 1 + SRC/slals0.f | 1 + SRC/slalsa.f | 1 + SRC/slalsd.f | 1 + SRC/slamrg.f | 1 + SRC/slamswlq.f | 1 + SRC/slamtsqr.f | 1 + SRC/slaneg.f | 1 + SRC/slangb.f | 1 + SRC/slange.f | 1 + SRC/slangt.f | 1 + SRC/slanhs.f | 1 + SRC/slansb.f | 1 + SRC/slansf.f | 1 + SRC/slansp.f | 1 + SRC/slanst.f | 1 + SRC/slansy.f | 1 + SRC/slantb.f | 1 + SRC/slantp.f | 1 + SRC/slantr.f | 1 + SRC/slanv2.f | 1 + SRC/slaorhr_col_getrfnp.f | 1 + SRC/slaorhr_col_getrfnp2.f | 1 + SRC/slapll.f | 1 + SRC/slapmr.f | 1 + SRC/slapmt.f | 1 + SRC/slapy2.f | 1 + SRC/slapy3.f | 1 + SRC/slaqgb.f | 1 + SRC/slaqge.f | 1 + SRC/slaqp2.f | 1 + SRC/slaqps.f | 1 + SRC/slaqr0.f | 1 + SRC/slaqr1.f | 1 + SRC/slaqr2.f | 1 + SRC/slaqr3.f | 1 + SRC/slaqr4.f | 1 + SRC/slaqr5.f | 1 + SRC/slaqsb.f | 1 + SRC/slaqsp.f | 1 + SRC/slaqsy.f | 1 + SRC/slaqtr.f | 1 + SRC/slaqz0.f | 1 + SRC/slaqz1.f | 1 + SRC/slaqz2.f | 1 + SRC/slaqz3.f | 1 + SRC/slaqz4.f | 1 + SRC/slar1v.f | 1 + SRC/slar2v.f | 1 + SRC/slarf.f | 1 + SRC/slarfb.f | 1 + SRC/slarfb_gett.f | 1 + SRC/slarfg.f | 1 + SRC/slarfgp.f | 1 + SRC/slarft.f | 1 + SRC/slarfx.f | 1 + SRC/slarfy.f | 1 + SRC/slargv.f | 1 + SRC/slarmm.f | 1 + SRC/slarnv.f | 1 + SRC/slarra.f | 1 + SRC/slarrb.f | 1 + SRC/slarrc.f | 1 + SRC/slarrd.f | 1 + SRC/slarre.f | 1 + SRC/slarrf.f | 1 + SRC/slarrj.f | 1 + SRC/slarrk.f | 1 + SRC/slarrr.f | 1 + SRC/slarrv.f | 1 + SRC/slarscl2.f | 1 + SRC/slartg.f90 | 1 + SRC/slartgp.f | 1 + SRC/slartgs.f | 1 + SRC/slartv.f | 1 + SRC/slaruv.f | 1 + SRC/slarz.f | 1 + SRC/slarzb.f | 1 + SRC/slarzt.f | 1 + SRC/slas2.f | 1 + SRC/slascl.f | 1 + SRC/slascl2.f | 1 + SRC/slasd0.f | 1 + SRC/slasd1.f | 1 + SRC/slasd2.f | 1 + SRC/slasd3.f | 1 + SRC/slasd4.f | 1 + SRC/slasd5.f | 1 + SRC/slasd6.f | 1 + SRC/slasd7.f | 1 + SRC/slasd8.f | 1 + SRC/slasda.f | 1 + SRC/slasdq.f | 1 + SRC/slasdt.f | 1 + SRC/slaset.f | 1 + SRC/slasq1.f | 1 + SRC/slasq2.f | 1 + SRC/slasq3.f | 1 + SRC/slasq4.f | 1 + SRC/slasq5.f | 1 + SRC/slasq6.f | 1 + SRC/slasr.f | 1 + SRC/slasrt.f | 1 + SRC/slassq.f90 | 1 + SRC/slasv2.f | 1 + SRC/slaswlq.f | 1 + SRC/slaswp.f | 1 + SRC/slasy2.f | 1 + SRC/slasyf.f | 1 + SRC/slasyf_aa.f | 1 + SRC/slasyf_rk.f | 1 + SRC/slasyf_rook.f | 1 + SRC/slatbs.f | 1 + SRC/slatdf.f | 1 + SRC/slatps.f | 1 + SRC/slatrd.f | 1 + SRC/slatrs.f | 1 + SRC/slatrs3.f | 1 + SRC/slatrz.f | 1 + SRC/slatsqr.f | 1 + SRC/slauu2.f | 1 + SRC/slauum.f | 1 + SRC/sopgtr.f | 1 + SRC/sopmtr.f | 1 + SRC/sorbdb.f | 1 + SRC/sorbdb1.f | 1 + SRC/sorbdb2.f | 1 + SRC/sorbdb3.f | 1 + SRC/sorbdb4.f | 1 + SRC/sorbdb5.f | 1 + SRC/sorbdb6.f | 1 + SRC/sorcsd.f | 1 + SRC/sorcsd2by1.f | 1 + SRC/sorg2l.f | 1 + SRC/sorg2r.f | 1 + SRC/sorgbr.f | 1 + SRC/sorghr.f | 1 + SRC/sorgl2.f | 1 + SRC/sorglq.f | 1 + SRC/sorgql.f | 1 + SRC/sorgqr.f | 1 + SRC/sorgr2.f | 1 + SRC/sorgrq.f | 1 + SRC/sorgtr.f | 1 + SRC/sorgtsqr.f | 1 + SRC/sorgtsqr_row.f | 1 + SRC/sorhr_col.f | 1 + SRC/sorm22.f | 1 + SRC/sorm2l.f | 1 + SRC/sorm2r.f | 1 + SRC/sormbr.f | 1 + SRC/sormhr.f | 1 + SRC/sorml2.f | 1 + SRC/sormlq.f | 1 + SRC/sormql.f | 1 + SRC/sormqr.f | 1 + SRC/sormr2.f | 1 + SRC/sormr3.f | 1 + SRC/sormrq.f | 1 + SRC/sormrz.f | 1 + SRC/sormtr.f | 1 + SRC/spbcon.f | 1 + SRC/spbequ.f | 1 + SRC/spbrfs.f | 1 + SRC/spbstf.f | 1 + SRC/spbsv.f | 1 + SRC/spbsvx.f | 1 + SRC/spbtf2.f | 1 + SRC/spbtrf.f | 1 + SRC/spbtrs.f | 1 + SRC/spftrf.f | 1 + SRC/spftri.f | 1 + SRC/spftrs.f | 1 + SRC/spocon.f | 1 + SRC/spoequ.f | 1 + SRC/spoequb.f | 1 + SRC/sporfs.f | 1 + SRC/sporfsx.f | 1 + SRC/sposv.f | 1 + SRC/sposvx.f | 1 + SRC/sposvxx.f | 1 + SRC/spotf2.f | 1 + SRC/spotrf.f | 1 + SRC/spotrf2.f | 1 + SRC/spotri.f | 1 + SRC/spotrs.f | 1 + SRC/sppcon.f | 1 + SRC/sppequ.f | 1 + SRC/spprfs.f | 1 + SRC/sppsv.f | 1 + SRC/sppsvx.f | 1 + SRC/spptrf.f | 1 + SRC/spptri.f | 1 + SRC/spptrs.f | 1 + SRC/spstf2.f | 1 + SRC/spstrf.f | 1 + SRC/sptcon.f | 1 + SRC/spteqr.f | 1 + SRC/sptrfs.f | 1 + SRC/sptsv.f | 1 + SRC/sptsvx.f | 1 + SRC/spttrf.f | 1 + SRC/spttrs.f | 1 + SRC/sptts2.f | 1 + SRC/srscl.f | 1 + SRC/ssb2st_kernels.f | 1 + SRC/ssbev.f | 1 + SRC/ssbev_2stage.f | 1 + SRC/ssbevd.f | 1 + SRC/ssbevd_2stage.f | 1 + SRC/ssbevx.f | 1 + SRC/ssbevx_2stage.f | 1 + SRC/ssbgst.f | 1 + SRC/ssbgv.f | 1 + SRC/ssbgvd.f | 1 + SRC/ssbgvx.f | 1 + SRC/ssbtrd.f | 1 + SRC/ssfrk.f | 1 + SRC/sspcon.f | 1 + SRC/sspev.f | 1 + SRC/sspevd.f | 1 + SRC/sspevx.f | 1 + SRC/sspgst.f | 1 + SRC/sspgv.f | 1 + SRC/sspgvd.f | 1 + SRC/sspgvx.f | 1 + SRC/ssprfs.f | 1 + SRC/sspsv.f | 1 + SRC/sspsvx.f | 1 + SRC/ssptrd.f | 1 + SRC/ssptrf.f | 1 + SRC/ssptri.f | 1 + SRC/ssptrs.f | 1 + SRC/sstebz.f | 1 + SRC/sstedc.f | 1 + SRC/sstegr.f | 1 + SRC/sstein.f | 1 + SRC/sstemr.f | 1 + SRC/ssteqr.f | 1 + SRC/ssterf.f | 1 + SRC/sstev.f | 1 + SRC/sstevd.f | 1 + SRC/sstevr.f | 1 + SRC/sstevx.f | 1 + SRC/ssycon.f | 1 + SRC/ssycon_3.f | 1 + SRC/ssycon_rook.f | 1 + SRC/ssyconv.f | 1 + SRC/ssyconvf.f | 1 + SRC/ssyconvf_rook.f | 1 + SRC/ssyequb.f | 1 + SRC/ssyev.f | 1 + SRC/ssyev_2stage.f | 1 + SRC/ssyevd.f | 1 + SRC/ssyevd_2stage.f | 1 + SRC/ssyevr.f | 1 + SRC/ssyevr_2stage.f | 1 + SRC/ssyevx.f | 1 + SRC/ssyevx_2stage.f | 1 + SRC/ssygs2.f | 1 + SRC/ssygst.f | 1 + SRC/ssygv.f | 1 + SRC/ssygv_2stage.f | 1 + SRC/ssygvd.f | 1 + SRC/ssygvx.f | 1 + SRC/ssyrfs.f | 1 + SRC/ssyrfsx.f | 1 + SRC/ssysv.f | 1 + SRC/ssysv_aa.f | 1 + SRC/ssysv_aa_2stage.f | 1 + SRC/ssysv_rk.f | 1 + SRC/ssysv_rook.f | 1 + SRC/ssysvx.f | 1 + SRC/ssysvxx.f | 1 + SRC/ssyswapr.f | 1 + SRC/ssytd2.f | 1 + SRC/ssytf2.f | 1 + SRC/ssytf2_rk.f | 1 + SRC/ssytf2_rook.f | 1 + SRC/ssytrd.f | 1 + SRC/ssytrd_2stage.f | 1 + SRC/ssytrd_sb2st.F | 1 + SRC/ssytrd_sy2sb.f | 1 + SRC/ssytrf.f | 1 + SRC/ssytrf_aa.f | 1 + SRC/ssytrf_aa_2stage.f | 1 + SRC/ssytrf_rk.f | 1 + SRC/ssytrf_rook.f | 1 + SRC/ssytri.f | 1 + SRC/ssytri2.f | 1 + SRC/ssytri2x.f | 1 + SRC/ssytri_3.f | 1 + SRC/ssytri_3x.f | 1 + SRC/ssytri_rook.f | 1 + SRC/ssytrs.f | 1 + SRC/ssytrs2.f | 1 + SRC/ssytrs_3.f | 1 + SRC/ssytrs_aa.f | 1 + SRC/ssytrs_aa_2stage.f | 1 + SRC/ssytrs_rook.f | 1 + SRC/stbcon.f | 1 + SRC/stbrfs.f | 1 + SRC/stbtrs.f | 1 + SRC/stfsm.f | 1 + SRC/stftri.f | 1 + SRC/stfttp.f | 1 + SRC/stfttr.f | 1 + SRC/stgevc.f | 1 + SRC/stgex2.f | 1 + SRC/stgexc.f | 1 + SRC/stgsen.f | 1 + SRC/stgsja.f | 1 + SRC/stgsna.f | 1 + SRC/stgsy2.f | 1 + SRC/stgsyl.f | 1 + SRC/stpcon.f | 1 + SRC/stplqt.f | 1 + SRC/stplqt2.f | 1 + SRC/stpmlqt.f | 1 + SRC/stpmqrt.f | 1 + SRC/stpqrt.f | 1 + SRC/stpqrt2.f | 1 + SRC/stprfb.f | 1 + SRC/stprfs.f | 1 + SRC/stptri.f | 1 + SRC/stptrs.f | 1 + SRC/stpttf.f | 1 + SRC/stpttr.f | 1 + SRC/strcon.f | 1 + SRC/strevc.f | 1 + SRC/strevc3.f | 1 + SRC/strexc.f | 1 + SRC/strrfs.f | 1 + SRC/strsen.f | 1 + SRC/strsna.f | 1 + SRC/strsyl.f | 1 + SRC/strsyl3.f | 1 + SRC/strti2.f | 1 + SRC/strtri.f | 1 + SRC/strtrs.f | 1 + SRC/strttf.f | 1 + SRC/strttp.f | 1 + SRC/stzrzf.f | 1 + SRC/xerbla.f | 1 + SRC/xerbla_array.f | 1 + SRC/zbbcsd.f | 1 + SRC/zbdsqr.f | 1 + SRC/zcgesv.f | 1 + SRC/zcposv.f | 1 + SRC/zdrscl.f | 1 + SRC/zgbbrd.f | 1 + SRC/zgbcon.f | 1 + SRC/zgbequ.f | 1 + SRC/zgbequb.f | 1 + SRC/zgbrfs.f | 1 + SRC/zgbrfsx.f | 1 + SRC/zgbsv.f | 1 + SRC/zgbsvx.f | 1 + SRC/zgbsvxx.f | 1 + SRC/zgbtf2.f | 1 + SRC/zgbtrf.f | 1 + SRC/zgbtrs.f | 1 + SRC/zgebak.f | 1 + SRC/zgebal.f | 1 + SRC/zgebd2.f | 1 + SRC/zgebrd.f | 1 + SRC/zgecon.f | 1 + SRC/zgedmd.f90 | 1 + SRC/zgedmdq.f90 | 1 + SRC/zgeequ.f | 1 + SRC/zgeequb.f | 1 + SRC/zgees.f | 1 + SRC/zgeesx.f | 1 + SRC/zgeev.f | 1 + SRC/zgeevx.f | 1 + SRC/zgehd2.f | 1 + SRC/zgehrd.f | 1 + SRC/zgejsv.f | 1 + SRC/zgelq.f | 1 + SRC/zgelq2.f | 1 + SRC/zgelqf.f | 1 + SRC/zgelqt.f | 1 + SRC/zgelqt3.f | 1 + SRC/zgels.f | 1 + SRC/zgelsd.f | 1 + SRC/zgelss.f | 1 + SRC/zgelst.f | 1 + SRC/zgelsy.f | 1 + SRC/zgemlq.f | 1 + SRC/zgemlqt.f | 1 + SRC/zgemqr.f | 1 + SRC/zgemqrt.f | 1 + SRC/zgeql2.f | 1 + SRC/zgeqlf.f | 1 + SRC/zgeqp3.f | 1 + SRC/zgeqr.f | 1 + SRC/zgeqr2.f | 1 + SRC/zgeqr2p.f | 1 + SRC/zgeqrf.f | 1 + SRC/zgeqrfp.f | 1 + SRC/zgeqrt.f | 1 + SRC/zgeqrt2.f | 1 + SRC/zgeqrt3.f | 1 + SRC/zgerfs.f | 1 + SRC/zgerfsx.f | 1 + SRC/zgerq2.f | 1 + SRC/zgerqf.f | 1 + SRC/zgesc2.f | 1 + SRC/zgesdd.f | 1 + SRC/zgesv.f | 1 + SRC/zgesvd.f | 1 + SRC/zgesvdq.f | 1 + SRC/zgesvdx.f | 1 + SRC/zgesvj.f | 1 + SRC/zgesvx.f | 1 + SRC/zgesvxx.f | 1 + SRC/zgetc2.f | 1 + SRC/zgetf2.f | 1 + SRC/zgetrf.f | 1 + SRC/zgetrf2.f | 1 + SRC/zgetri.f | 1 + SRC/zgetrs.f | 1 + SRC/zgetsls.f | 1 + SRC/zgetsqrhrt.f | 1 + SRC/zggbak.f | 1 + SRC/zggbal.f | 1 + SRC/zgges.f | 1 + SRC/zgges3.f | 1 + SRC/zggesx.f | 1 + SRC/zggev.f | 1 + SRC/zggev3.f | 1 + SRC/zggevx.f | 1 + SRC/zggglm.f | 1 + SRC/zgghd3.f | 1 + SRC/zgghrd.f | 1 + SRC/zgglse.f | 1 + SRC/zggqrf.f | 1 + SRC/zggrqf.f | 1 + SRC/zggsvd3.f | 1 + SRC/zggsvp3.f | 1 + SRC/zgsvj0.f | 1 + SRC/zgsvj1.f | 1 + SRC/zgtcon.f | 1 + SRC/zgtrfs.f | 1 + SRC/zgtsv.f | 1 + SRC/zgtsvx.f | 1 + SRC/zgttrf.f | 1 + SRC/zgttrs.f | 1 + SRC/zgtts2.f | 1 + SRC/zhb2st_kernels.f | 1 + SRC/zhbev.f | 1 + SRC/zhbev_2stage.f | 1 + SRC/zhbevd.f | 1 + SRC/zhbevd_2stage.f | 1 + SRC/zhbevx.f | 1 + SRC/zhbevx_2stage.f | 1 + SRC/zhbgst.f | 1 + SRC/zhbgv.f | 1 + SRC/zhbgvd.f | 1 + SRC/zhbgvx.f | 1 + SRC/zhbtrd.f | 1 + SRC/zhecon.f | 1 + SRC/zhecon_3.f | 1 + SRC/zhecon_rook.f | 1 + SRC/zheequb.f | 1 + SRC/zheev.f | 1 + SRC/zheev_2stage.f | 1 + SRC/zheevd.f | 1 + SRC/zheevd_2stage.f | 1 + SRC/zheevr.f | 1 + SRC/zheevr_2stage.f | 1 + SRC/zheevx.f | 1 + SRC/zheevx_2stage.f | 1 + SRC/zhegs2.f | 1 + SRC/zhegst.f | 1 + SRC/zhegv.f | 1 + SRC/zhegv_2stage.f | 1 + SRC/zhegvd.f | 1 + SRC/zhegvx.f | 1 + SRC/zherfs.f | 1 + SRC/zherfsx.f | 1 + SRC/zhesv.f | 1 + SRC/zhesv_aa.f | 1 + SRC/zhesv_aa_2stage.f | 1 + SRC/zhesv_rk.f | 1 + SRC/zhesv_rook.f | 1 + SRC/zhesvx.f | 1 + SRC/zhesvxx.f | 1 + SRC/zheswapr.f | 1 + SRC/zhetd2.f | 1 + SRC/zhetf2.f | 1 + SRC/zhetf2_rk.f | 1 + SRC/zhetf2_rook.f | 1 + SRC/zhetrd.f | 1 + SRC/zhetrd_2stage.f | 1 + SRC/zhetrd_hb2st.F | 1 + SRC/zhetrd_he2hb.f | 1 + SRC/zhetrf.f | 1 + SRC/zhetrf_aa.f | 1 + SRC/zhetrf_aa_2stage.f | 1 + SRC/zhetrf_rk.f | 1 + SRC/zhetrf_rook.f | 1 + SRC/zhetri.f | 1 + SRC/zhetri2.f | 1 + SRC/zhetri2x.f | 1 + SRC/zhetri_3.f | 1 + SRC/zhetri_3x.f | 1 + SRC/zhetri_rook.f | 1 + SRC/zhetrs.f | 1 + SRC/zhetrs2.f | 1 + SRC/zhetrs_3.f | 1 + SRC/zhetrs_aa.f | 1 + SRC/zhetrs_aa_2stage.f | 1 + SRC/zhetrs_rook.f | 1 + SRC/zhfrk.f | 1 + SRC/zhgeqz.f | 1 + SRC/zhpcon.f | 1 + SRC/zhpev.f | 1 + SRC/zhpevd.f | 1 + SRC/zhpevx.f | 1 + SRC/zhpgst.f | 1 + SRC/zhpgv.f | 1 + SRC/zhpgvd.f | 1 + SRC/zhpgvx.f | 1 + SRC/zhprfs.f | 1 + SRC/zhpsv.f | 1 + SRC/zhpsvx.f | 1 + SRC/zhptrd.f | 1 + SRC/zhptrf.f | 1 + SRC/zhptri.f | 1 + SRC/zhptrs.f | 1 + SRC/zhsein.f | 1 + SRC/zhseqr.f | 1 + SRC/zla_gbamv.f | 1 + SRC/zla_gbrcond_c.f | 1 + SRC/zla_gbrcond_x.f | 1 + SRC/zla_gbrfsx_extended.f | 1 + SRC/zla_gbrpvgrw.f | 1 + SRC/zla_geamv.f | 1 + SRC/zla_gercond_c.f | 1 + SRC/zla_gercond_x.f | 1 + SRC/zla_gerfsx_extended.f | 1 + SRC/zla_gerpvgrw.f | 1 + SRC/zla_heamv.f | 1 + SRC/zla_hercond_c.f | 1 + SRC/zla_hercond_x.f | 1 + SRC/zla_herfsx_extended.f | 1 + SRC/zla_herpvgrw.f | 1 + SRC/zla_lin_berr.f | 1 + SRC/zla_porcond_c.f | 1 + SRC/zla_porcond_x.f | 1 + SRC/zla_porfsx_extended.f | 1 + SRC/zla_porpvgrw.f | 1 + SRC/zla_syamv.f | 1 + SRC/zla_syrcond_c.f | 1 + SRC/zla_syrcond_x.f | 1 + SRC/zla_syrfsx_extended.f | 1 + SRC/zla_syrpvgrw.f | 1 + SRC/zla_wwaddw.f | 1 + SRC/zlabrd.f | 1 + SRC/zlacgv.f | 1 + SRC/zlacn2.f | 1 + SRC/zlacon.f | 1 + SRC/zlacp2.f | 1 + SRC/zlacpy.f | 1 + SRC/zlacrm.f | 1 + SRC/zlacrt.f | 1 + SRC/zladiv.f | 1 + SRC/zlaed0.f | 1 + SRC/zlaed7.f | 1 + SRC/zlaed8.f | 1 + SRC/zlaein.f | 1 + SRC/zlaesy.f | 1 + SRC/zlaev2.f | 1 + SRC/zlag2c.f | 1 + SRC/zlags2.f | 1 + SRC/zlagtm.f | 1 + SRC/zlahef.f | 1 + SRC/zlahef_aa.f | 1 + SRC/zlahef_rk.f | 1 + SRC/zlahef_rook.f | 1 + SRC/zlahqr.f | 1 + SRC/zlahr2.f | 1 + SRC/zlaic1.f | 1 + SRC/zlals0.f | 1 + SRC/zlalsa.f | 1 + SRC/zlalsd.f | 1 + SRC/zlamswlq.f | 1 + SRC/zlamtsqr.f | 1 + SRC/zlangb.f | 1 + SRC/zlange.f | 1 + SRC/zlangt.f | 1 + SRC/zlanhb.f | 1 + SRC/zlanhe.f | 1 + SRC/zlanhf.f | 1 + SRC/zlanhp.f | 1 + SRC/zlanhs.f | 1 + SRC/zlanht.f | 1 + SRC/zlansb.f | 1 + SRC/zlansp.f | 1 + SRC/zlansy.f | 1 + SRC/zlantb.f | 1 + SRC/zlantp.f | 1 + SRC/zlantr.f | 1 + SRC/zlapll.f | 1 + SRC/zlapmr.f | 1 + SRC/zlapmt.f | 1 + SRC/zlaqgb.f | 1 + SRC/zlaqge.f | 1 + SRC/zlaqhb.f | 1 + SRC/zlaqhe.f | 1 + SRC/zlaqhp.f | 1 + SRC/zlaqp2.f | 1 + SRC/zlaqps.f | 1 + SRC/zlaqr0.f | 1 + SRC/zlaqr1.f | 1 + SRC/zlaqr2.f | 1 + SRC/zlaqr3.f | 1 + SRC/zlaqr4.f | 1 + SRC/zlaqr5.f | 1 + SRC/zlaqsb.f | 1 + SRC/zlaqsp.f | 1 + SRC/zlaqsy.f | 1 + SRC/zlaqz0.f | 1 + SRC/zlaqz1.f | 1 + SRC/zlaqz2.f | 1 + SRC/zlaqz3.f | 1 + SRC/zlar1v.f | 1 + SRC/zlar2v.f | 1 + SRC/zlarcm.f | 1 + SRC/zlarf.f | 1 + SRC/zlarfb.f | 1 + SRC/zlarfb_gett.f | 1 + SRC/zlarfg.f | 1 + SRC/zlarfgp.f | 1 + SRC/zlarft.f | 1 + SRC/zlarfx.f | 1 + SRC/zlarfy.f | 1 + SRC/zlargv.f | 1 + SRC/zlarnv.f | 1 + SRC/zlarrv.f | 1 + SRC/zlarscl2.f | 1 + SRC/zlartg.f90 | 1 + SRC/zlartv.f | 1 + SRC/zlarz.f | 1 + SRC/zlarzb.f | 1 + SRC/zlarzt.f | 1 + SRC/zlascl.f | 1 + SRC/zlascl2.f | 1 + SRC/zlaset.f | 1 + SRC/zlasr.f | 1 + SRC/zlassq.f90 | 1 + SRC/zlaswlq.f | 1 + SRC/zlaswp.f | 1 + SRC/zlasyf.f | 1 + SRC/zlasyf_aa.f | 1 + SRC/zlasyf_rk.f | 1 + SRC/zlasyf_rook.f | 1 + SRC/zlat2c.f | 1 + SRC/zlatbs.f | 1 + SRC/zlatdf.f | 1 + SRC/zlatps.f | 1 + SRC/zlatrd.f | 1 + SRC/zlatrs.f | 1 + SRC/zlatrs3.f | 1 + SRC/zlatrz.f | 1 + SRC/zlatsqr.f | 1 + SRC/zlaunhr_col_getrfnp.f | 1 + SRC/zlaunhr_col_getrfnp2.f | 1 + SRC/zlauu2.f | 1 + SRC/zlauum.f | 1 + SRC/zpbcon.f | 1 + SRC/zpbequ.f | 1 + SRC/zpbrfs.f | 1 + SRC/zpbstf.f | 1 + SRC/zpbsv.f | 1 + SRC/zpbsvx.f | 1 + SRC/zpbtf2.f | 1 + SRC/zpbtrf.f | 1 + SRC/zpbtrs.f | 1 + SRC/zpftrf.f | 1 + SRC/zpftri.f | 1 + SRC/zpftrs.f | 1 + SRC/zpocon.f | 1 + SRC/zpoequ.f | 1 + SRC/zpoequb.f | 1 + SRC/zporfs.f | 1 + SRC/zporfsx.f | 1 + SRC/zposv.f | 1 + SRC/zposvx.f | 1 + SRC/zposvxx.f | 1 + SRC/zpotf2.f | 1 + SRC/zpotrf.f | 1 + SRC/zpotrf2.f | 1 + SRC/zpotri.f | 1 + SRC/zpotrs.f | 1 + SRC/zppcon.f | 1 + SRC/zppequ.f | 1 + SRC/zpprfs.f | 1 + SRC/zppsv.f | 1 + SRC/zppsvx.f | 1 + SRC/zpptrf.f | 1 + SRC/zpptri.f | 1 + SRC/zpptrs.f | 1 + SRC/zpstf2.f | 1 + SRC/zpstrf.f | 1 + SRC/zptcon.f | 1 + SRC/zpteqr.f | 1 + SRC/zptrfs.f | 1 + SRC/zptsv.f | 1 + SRC/zptsvx.f | 1 + SRC/zpttrf.f | 1 + SRC/zpttrs.f | 1 + SRC/zptts2.f | 1 + SRC/zrot.f | 1 + SRC/zrscl.f | 1 + SRC/zspcon.f | 1 + SRC/zspmv.f | 1 + SRC/zspr.f | 1 + SRC/zsprfs.f | 1 + SRC/zspsv.f | 1 + SRC/zspsvx.f | 1 + SRC/zsptrf.f | 1 + SRC/zsptri.f | 1 + SRC/zsptrs.f | 1 + SRC/zstedc.f | 1 + SRC/zstegr.f | 1 + SRC/zstein.f | 1 + SRC/zstemr.f | 1 + SRC/zsteqr.f | 1 + SRC/zsycon.f | 1 + SRC/zsycon_3.f | 1 + SRC/zsycon_rook.f | 1 + SRC/zsyconv.f | 1 + SRC/zsyconvf.f | 1 + SRC/zsyconvf_rook.f | 1 + SRC/zsyequb.f | 1 + SRC/zsymv.f | 1 + SRC/zsyr.f | 1 + SRC/zsyrfs.f | 1 + SRC/zsyrfsx.f | 1 + SRC/zsysv.f | 1 + SRC/zsysv_aa.f | 1 + SRC/zsysv_aa_2stage.f | 1 + SRC/zsysv_rk.f | 1 + SRC/zsysv_rook.f | 1 + SRC/zsysvx.f | 1 + SRC/zsysvxx.f | 1 + SRC/zsyswapr.f | 1 + SRC/zsytf2.f | 1 + SRC/zsytf2_rk.f | 1 + SRC/zsytf2_rook.f | 1 + SRC/zsytrf.f | 1 + SRC/zsytrf_aa.f | 1 + SRC/zsytrf_aa_2stage.f | 1 + SRC/zsytrf_rk.f | 1 + SRC/zsytrf_rook.f | 1 + SRC/zsytri.f | 1 + SRC/zsytri2.f | 1 + SRC/zsytri2x.f | 1 + SRC/zsytri_3.f | 1 + SRC/zsytri_3x.f | 1 + SRC/zsytri_rook.f | 1 + SRC/zsytrs.f | 1 + SRC/zsytrs2.f | 1 + SRC/zsytrs_3.f | 1 + SRC/zsytrs_aa.f | 1 + SRC/zsytrs_aa_2stage.f | 1 + SRC/zsytrs_rook.f | 1 + SRC/ztbcon.f | 1 + SRC/ztbrfs.f | 1 + SRC/ztbtrs.f | 1 + SRC/ztfsm.f | 1 + SRC/ztftri.f | 1 + SRC/ztfttp.f | 1 + SRC/ztfttr.f | 1 + SRC/ztgevc.f | 1 + SRC/ztgex2.f | 1 + SRC/ztgexc.f | 1 + SRC/ztgsen.f | 1 + SRC/ztgsja.f | 1 + SRC/ztgsna.f | 1 + SRC/ztgsy2.f | 1 + SRC/ztgsyl.f | 1 + SRC/ztpcon.f | 1 + SRC/ztplqt.f | 1 + SRC/ztplqt2.f | 1 + SRC/ztpmlqt.f | 1 + SRC/ztpmqrt.f | 1 + SRC/ztpqrt.f | 1 + SRC/ztpqrt2.f | 1 + SRC/ztprfb.f | 1 + SRC/ztprfs.f | 1 + SRC/ztptri.f | 1 + SRC/ztptrs.f | 1 + SRC/ztpttf.f | 1 + SRC/ztpttr.f | 1 + SRC/ztrcon.f | 1 + SRC/ztrevc.f | 1 + SRC/ztrevc3.f | 1 + SRC/ztrexc.f | 1 + SRC/ztrrfs.f | 1 + SRC/ztrsen.f | 1 + SRC/ztrsna.f | 1 + SRC/ztrsyl.f | 1 + SRC/ztrsyl3.f | 1 + SRC/ztrti2.f | 1 + SRC/ztrtri.f | 1 + SRC/ztrtrs.f | 1 + SRC/ztrttf.f | 1 + SRC/ztrttp.f | 1 + SRC/ztzrzf.f | 1 + SRC/zunbdb.f | 1 + SRC/zunbdb1.f | 1 + SRC/zunbdb2.f | 1 + SRC/zunbdb3.f | 1 + SRC/zunbdb4.f | 1 + SRC/zunbdb5.f | 1 + SRC/zunbdb6.f | 1 + SRC/zuncsd.f | 1 + SRC/zuncsd2by1.f | 1 + SRC/zung2l.f | 1 + SRC/zung2r.f | 1 + SRC/zungbr.f | 1 + SRC/zunghr.f | 1 + SRC/zungl2.f | 1 + SRC/zunglq.f | 1 + SRC/zungql.f | 1 + SRC/zungqr.f | 1 + SRC/zungr2.f | 1 + SRC/zungrq.f | 1 + SRC/zungtr.f | 1 + SRC/zungtsqr.f | 1 + SRC/zungtsqr_row.f | 1 + SRC/zunhr_col.f | 1 + SRC/zunm22.f | 1 + SRC/zunm2l.f | 1 + SRC/zunm2r.f | 1 + SRC/zunmbr.f | 1 + SRC/zunmhr.f | 1 + SRC/zunml2.f | 1 + SRC/zunmlq.f | 1 + SRC/zunmql.f | 1 + SRC/zunmqr.f | 1 + SRC/zunmr2.f | 1 + SRC/zunmr3.f | 1 + SRC/zunmrq.f | 1 + SRC/zunmrz.f | 1 + SRC/zunmtr.f | 1 + SRC/zupgtr.f | 1 + SRC/zupmtr.f | 1 + 2049 files changed, 4334 insertions(+), 6 deletions(-) create mode 100644 SRC/lapack_64.h diff --git a/INSTALL/dlamch.f b/INSTALL/dlamch.f index c3a7b61581..ae327134b2 100644 --- a/INSTALL/dlamch.f +++ b/INSTALL/dlamch.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b DLAMCH * * =========== DOCUMENTATION =========== diff --git a/INSTALL/droundup_lwork.f b/INSTALL/droundup_lwork.f index 69e3c7f358..77c8790827 100644 --- a/INSTALL/droundup_lwork.f +++ b/INSTALL/droundup_lwork.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b DROUNDUP_LWORK * * =========== DOCUMENTATION =========== diff --git a/INSTALL/ilaver.f b/INSTALL/ilaver.f index ced58e6b0f..db6f81c40c 100644 --- a/INSTALL/ilaver.f +++ b/INSTALL/ilaver.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b ILAVER returns the LAPACK version. ** * =========== DOCUMENTATION =========== diff --git a/INSTALL/lsame.f b/INSTALL/lsame.f index 7bb7315dcb..e47cfac9bc 100644 --- a/INSTALL/lsame.f +++ b/INSTALL/lsame.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b LSAME * * =========== DOCUMENTATION =========== diff --git a/INSTALL/slamch.f b/INSTALL/slamch.f index cfe0770a85..37ae246aeb 100644 --- a/INSTALL/slamch.f +++ b/INSTALL/slamch.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b SLAMCH * * =========== DOCUMENTATION =========== diff --git a/INSTALL/sroundup_lwork.f b/INSTALL/sroundup_lwork.f index 64e7f313c4..c45bff3e14 100644 --- a/INSTALL/sroundup_lwork.f +++ b/INSTALL/sroundup_lwork.f @@ -1,3 +1,4 @@ +#include "../SRC/lapack_64.h" *> \brief \b SROUNDUP_LWORK * * =========== DOCUMENTATION =========== diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 767165a5f4..22930b5ebf 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -516,7 +516,31 @@ if(BUILD_COMPLEX16) endif() list(REMOVE_DUPLICATES SOURCES) -add_library(${LAPACKLIB} ${SOURCES}) +add_library(${LAPACKLIB}_obj OBJECT ${SOURCES}) +set_target_properties( + ${LAPACKLIB}_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) + +if(BUILD_INDEX64_EXT_API) + set(SOURCES_64) + list(APPEND SOURCES_64 ${SOURCES}) + list(REMOVE_ITEM SOURCES_64 la_xisnan.F90) + list(REMOVE_ITEM SOURCES_64 ${SECOND_SRC}) + list(REMOVE_ITEM SOURCES_64 ${DSECOND_SRC}) + add_library(${LAPACKLIB}_64_obj OBJECT ${SOURCES_64}) + target_compile_options(${LAPACKLIB}_64_obj PRIVATE ${FOPT_ILP64} -DLAPACK_64) + set_target_properties( + ${LAPACKLIB}_64_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) +endif() + +add_library(${LAPACKLIB} + $ + $<$: $>) set_target_properties( ${LAPACKLIB} PROPERTIES VERSION ${LAPACK_VERSION} @@ -534,7 +558,7 @@ target_link_libraries(${LAPACKLIB} PRIVATE ${BLAS_LIBRARIES}) if(_is_coverage_build) target_link_libraries(${LAPACKLIB} PRIVATE gcov) - add_coverage(${LAPACKLIB}) + add_coverage(${LAPACKLIB}_obj) endif() lapack_install_library(${LAPACKLIB}) diff --git a/SRC/cbbcsd.f b/SRC/cbbcsd.f index e67be4ae36..21188d9304 100644 --- a/SRC/cbbcsd.f +++ b/SRC/cbbcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index cf1459ad22..8a9a9086c8 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbbrd.f b/SRC/cgbbrd.f index 7889c090a2..8c12e1e7ce 100644 --- a/SRC/cgbbrd.f +++ b/SRC/cgbbrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbcon.f b/SRC/cgbcon.f index 8b50fffb10..023ffd11f0 100644 --- a/SRC/cgbcon.f +++ b/SRC/cgbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbequ.f b/SRC/cgbequ.f index ab31116f0a..ffcf335e8a 100644 --- a/SRC/cgbequ.f +++ b/SRC/cgbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbequb.f b/SRC/cgbequb.f index 6d8426b28a..69bcc0069b 100644 --- a/SRC/cgbequb.f +++ b/SRC/cgbequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbrfs.f b/SRC/cgbrfs.f index 1a142ed898..a5f576b8e3 100644 --- a/SRC/cgbrfs.f +++ b/SRC/cgbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbrfsx.f b/SRC/cgbrfsx.f index ba3f731eda..b7db93b27b 100644 --- a/SRC/cgbrfsx.f +++ b/SRC/cgbrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsv.f b/SRC/cgbsv.f index 606b6fbe69..8cfc35a2dd 100644 --- a/SRC/cgbsv.f +++ b/SRC/cgbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsvx.f b/SRC/cgbsvx.f index 1f480f3162..95fa154b5d 100644 --- a/SRC/cgbsvx.f +++ b/SRC/cgbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsvxx.f b/SRC/cgbsvxx.f index 732dcda8b1..4cfca65d26 100644 --- a/SRC/cgbsvxx.f +++ b/SRC/cgbsvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtf2.f b/SRC/cgbtf2.f index 1f22c5c411..c8cc452767 100644 --- a/SRC/cgbtf2.f +++ b/SRC/cgbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtrf.f b/SRC/cgbtrf.f index 061c90d4a0..e34cb59811 100644 --- a/SRC/cgbtrf.f +++ b/SRC/cgbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtrs.f b/SRC/cgbtrs.f index 9cd2457c84..23591896f1 100644 --- a/SRC/cgbtrs.f +++ b/SRC/cgbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebak.f b/SRC/cgebak.f index c8ab1739ec..e16506b20c 100644 --- a/SRC/cgebak.f +++ b/SRC/cgebak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebal.f b/SRC/cgebal.f index bc35090947..24c812306d 100644 --- a/SRC/cgebal.f +++ b/SRC/cgebal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebd2.f b/SRC/cgebd2.f index 5175d9e845..fdc1885cca 100644 --- a/SRC/cgebd2.f +++ b/SRC/cgebd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebrd.f b/SRC/cgebrd.f index 5920b1cf58..5e4528f53e 100644 --- a/SRC/cgebrd.f +++ b/SRC/cgebrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgecon.f b/SRC/cgecon.f index e018b18bb8..43e8859e21 100644 --- a/SRC/cgecon.f +++ b/SRC/cgecon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index 87e92eeb4c..d3badc9a19 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b CGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index dd70a34a9e..d294760c0d 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/cgeequ.f b/SRC/cgeequ.f index 9b4e19d2bd..7ae1cf12f5 100644 --- a/SRC/cgeequ.f +++ b/SRC/cgeequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeequb.f b/SRC/cgeequb.f index 60ce07d9c7..939c816548 100644 --- a/SRC/cgeequb.f +++ b/SRC/cgeequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cgees.f b/SRC/cgees.f index 2085dc49b5..8f26a1229e 100644 --- a/SRC/cgees.f +++ b/SRC/cgees.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index 036ae90c26..32e9ec48c4 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeev.f b/SRC/cgeev.f index bb41599d1d..c4ff74868b 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index 5dbc394e9f..fad00bbf33 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgehd2.f b/SRC/cgehd2.f index 1570bde231..4540e5f2b5 100644 --- a/SRC/cgehd2.f +++ b/SRC/cgehd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index 7ba87cc01b..5cba55ed43 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f index fd246a88c9..8d306d97e4 100644 --- a/SRC/cgejsv.f +++ b/SRC/cgejsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelq.f b/SRC/cgelq.f index 24aaa982e3..b27f57fffb 100644 --- a/SRC/cgelq.f +++ b/SRC/cgelq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGELQ * * Definition: diff --git a/SRC/cgelq2.f b/SRC/cgelq2.f index bf8086cffe..1d6e316858 100644 --- a/SRC/cgelq2.f +++ b/SRC/cgelq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelqf.f b/SRC/cgelqf.f index 3847a958a7..e46aa644f1 100644 --- a/SRC/cgelqf.f +++ b/SRC/cgelqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelqt.f b/SRC/cgelqt.f index 5f4bb59063..557373a2b9 100644 --- a/SRC/cgelqt.f +++ b/SRC/cgelqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGELQT * * Definition: diff --git a/SRC/cgelqt3.f b/SRC/cgelqt3.f index fe56b576c4..600db841d9 100644 --- a/SRC/cgelqt3.f +++ b/SRC/cgelqt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGELQT3 * * Definition: diff --git a/SRC/cgels.f b/SRC/cgels.f index ffbc310756..59a60b04a6 100644 --- a/SRC/cgels.f +++ b/SRC/cgels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index 5d7eec68d4..982530bc0e 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelss.f b/SRC/cgelss.f index 00d7f596af..87f03f1f98 100644 --- a/SRC/cgelss.f +++ b/SRC/cgelss.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelst.f b/SRC/cgelst.f index b696269343..cad2fe6eaa 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelsy.f b/SRC/cgelsy.f index 94bc7dd8a2..8c92c702a7 100644 --- a/SRC/cgelsy.f +++ b/SRC/cgelsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f index e5b02b6693..b180671a5c 100644 --- a/SRC/cgemlq.f +++ b/SRC/cgemlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEMLQ * * Definition: diff --git a/SRC/cgemlqt.f b/SRC/cgemlqt.f index 5e43f0b600..3b8fdf9f9b 100644 --- a/SRC/cgemlqt.f +++ b/SRC/cgemlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEMLQT * * Definition: diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f index 0b7dd9dd71..2d848a808e 100644 --- a/SRC/cgemqr.f +++ b/SRC/cgemqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEMQR * * Definition: diff --git a/SRC/cgemqrt.f b/SRC/cgemqrt.f index bf7d99632a..73e46559c5 100644 --- a/SRC/cgemqrt.f +++ b/SRC/cgemqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeql2.f b/SRC/cgeql2.f index c55c6d76ad..de570d0941 100644 --- a/SRC/cgeql2.f +++ b/SRC/cgeql2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqlf.f b/SRC/cgeqlf.f index 6c67344c5c..12d89a593c 100644 --- a/SRC/cgeqlf.f +++ b/SRC/cgeqlf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqp3.f b/SRC/cgeqp3.f index 00e03270e2..c7886798dd 100644 --- a/SRC/cgeqp3.f +++ b/SRC/cgeqp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index 3617594d02..767574b1da 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQR * * Definition: diff --git a/SRC/cgeqr2.f b/SRC/cgeqr2.f index 29dddb2085..a0572bcf13 100644 --- a/SRC/cgeqr2.f +++ b/SRC/cgeqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqr2p.f b/SRC/cgeqr2p.f index fb5012b49a..812860f92a 100644 --- a/SRC/cgeqr2p.f +++ b/SRC/cgeqr2p.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrf.f b/SRC/cgeqrf.f index bf22a2cd3b..db7fbcc502 100644 --- a/SRC/cgeqrf.f +++ b/SRC/cgeqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrfp.f b/SRC/cgeqrfp.f index 5b6226c67b..58d8fd1899 100644 --- a/SRC/cgeqrfp.f +++ b/SRC/cgeqrfp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt.f b/SRC/cgeqrt.f index 4fc22bf810..f1953a39a5 100644 --- a/SRC/cgeqrt.f +++ b/SRC/cgeqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt2.f b/SRC/cgeqrt2.f index dc7c2045b0..1b801b5444 100644 --- a/SRC/cgeqrt2.f +++ b/SRC/cgeqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt3.f b/SRC/cgeqrt3.f index f3bb4ab67e..de24ef607f 100644 --- a/SRC/cgeqrt3.f +++ b/SRC/cgeqrt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerfs.f b/SRC/cgerfs.f index 53b9031944..b2aa4ec277 100644 --- a/SRC/cgerfs.f +++ b/SRC/cgerfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerfsx.f b/SRC/cgerfsx.f index dfbfc96753..a147d7ca67 100644 --- a/SRC/cgerfsx.f +++ b/SRC/cgerfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerq2.f b/SRC/cgerq2.f index ac1217118d..5ef9ec1253 100644 --- a/SRC/cgerq2.f +++ b/SRC/cgerq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerqf.f b/SRC/cgerqf.f index 6f914c8920..020f14044a 100644 --- a/SRC/cgerqf.f +++ b/SRC/cgerqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesc2.f b/SRC/cgesc2.f index 677a0ac408..5fe420a2a2 100644 --- a/SRC/cgesc2.f +++ b/SRC/cgesc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesdd.f b/SRC/cgesdd.f index 42a90f0705..a9619fd041 100644 --- a/SRC/cgesdd.f +++ b/SRC/cgesdd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesv.f b/SRC/cgesv.f index ef4ef6631f..eb63b38354 100644 --- a/SRC/cgesv.f +++ b/SRC/cgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \addtogroup gesv *> *> \brief CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/cgesvd.f b/SRC/cgesvd.f index 6165a6acf0..4aed3e2a04 100644 --- a/SRC/cgesvd.f +++ b/SRC/cgesvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvdq.f b/SRC/cgesvdq.f index e035826a62..9c10245f53 100644 --- a/SRC/cgesvdq.f +++ b/SRC/cgesvdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index e1856a65fd..caabe90657 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvj.f b/SRC/cgesvj.f index b9c8f1709e..1bd37ccca6 100644 --- a/SRC/cgesvj.f +++ b/SRC/cgesvj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvx.f b/SRC/cgesvx.f index bfdb4d8e80..c8ac7e9547 100644 --- a/SRC/cgesvx.f +++ b/SRC/cgesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvxx.f b/SRC/cgesvxx.f index 767646fcc7..26155d268c 100644 --- a/SRC/cgesvxx.f +++ b/SRC/cgesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetc2.f b/SRC/cgetc2.f index c452aa0670..e7446ee172 100644 --- a/SRC/cgetc2.f +++ b/SRC/cgetc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetf2.f b/SRC/cgetf2.f index 995ee40ece..e36afaa915 100644 --- a/SRC/cgetf2.f +++ b/SRC/cgetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrf.f b/SRC/cgetrf.f index 706106b095..f783cc30b7 100644 --- a/SRC/cgetrf.f +++ b/SRC/cgetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrf2.f b/SRC/cgetrf2.f index 8622918d3a..771e68cae8 100644 --- a/SRC/cgetrf2.f +++ b/SRC/cgetrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetri.f b/SRC/cgetri.f index 2eb3da7abe..c968759a09 100644 --- a/SRC/cgetri.f +++ b/SRC/cgetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrs.f b/SRC/cgetrs.f index 07b086be50..81bfb1cd93 100644 --- a/SRC/cgetrs.f +++ b/SRC/cgetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index 3f43dc8de0..c8012e42e7 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETSLS * * Definition: diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 087e9bc7fa..573bea95da 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cggbak.f b/SRC/cggbak.f index 670d6146f1..473495b502 100644 --- a/SRC/cggbak.f +++ b/SRC/cggbak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/cggbal.f b/SRC/cggbal.f index ec1ee44bba..1f366ac25d 100644 --- a/SRC/cggbal.f +++ b/SRC/cggbal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/cgges.f b/SRC/cgges.f index 0ff8487352..94ff8cb524 100644 --- a/SRC/cgges.f +++ b/SRC/cgges.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgges3.f b/SRC/cgges3.f index c1ca796887..a73f0dd345 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/cggesx.f b/SRC/cggesx.f index 3bf460fac3..bb544aa6d7 100644 --- a/SRC/cggesx.f +++ b/SRC/cggesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggev.f b/SRC/cggev.f index cf16e3079c..a976d88251 100644 --- a/SRC/cggev.f +++ b/SRC/cggev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggev3.f b/SRC/cggev3.f index d2b75aebc7..85ff635cf1 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/cggevx.f b/SRC/cggevx.f index fa4e926821..3d5933046d 100644 --- a/SRC/cggevx.f +++ b/SRC/cggevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggglm.f b/SRC/cggglm.f index 0d36deca62..a9f2910dac 100644 --- a/SRC/cggglm.f +++ b/SRC/cggglm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index f7175a72c7..df983b4546 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgghrd.f b/SRC/cgghrd.f index 10564f6eef..9d328fbf96 100644 --- a/SRC/cgghrd.f +++ b/SRC/cgghrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgglse.f b/SRC/cgglse.f index b1c5623858..466d92dcef 100644 --- a/SRC/cgglse.f +++ b/SRC/cgglse.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f index 309f170e8f..ef5463cb7d 100644 --- a/SRC/cggqrf.f +++ b/SRC/cggqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cggrqf.f b/SRC/cggrqf.f index 8470a1ce22..ed09da5e2b 100644 --- a/SRC/cggrqf.f +++ b/SRC/cggrqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cggsvd3.f b/SRC/cggsvd3.f index 4c4b85baee..7443fbea9d 100644 --- a/SRC/cggsvd3.f +++ b/SRC/cggsvd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggsvp3.f b/SRC/cggsvp3.f index e19f7efd51..249048ad84 100644 --- a/SRC/cggsvp3.f +++ b/SRC/cggsvp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgsvj0.f b/SRC/cgsvj0.f index 823c4428fd..76acddbe5a 100644 --- a/SRC/cgsvj0.f +++ b/SRC/cgsvj0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGSVJ0 pre-processor for the routine cgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgsvj1.f b/SRC/cgsvj1.f index 4a734a745a..b917ee37a1 100644 --- a/SRC/cgsvj1.f +++ b/SRC/cgsvj1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGSVJ1 pre-processor for the routine cgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtcon.f b/SRC/cgtcon.f index 517ed48f36..70267d0ff2 100644 --- a/SRC/cgtcon.f +++ b/SRC/cgtcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtrfs.f b/SRC/cgtrfs.f index 3904472a2f..630b8d3836 100644 --- a/SRC/cgtrfs.f +++ b/SRC/cgtrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtsv.f b/SRC/cgtsv.f index 5b4d651a83..30c774fece 100644 --- a/SRC/cgtsv.f +++ b/SRC/cgtsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtsvx.f b/SRC/cgtsvx.f index 382948a31c..b25dee0480 100644 --- a/SRC/cgtsvx.f +++ b/SRC/cgtsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgttrf.f b/SRC/cgttrf.f index c825fa3f6a..7c79106a4b 100644 --- a/SRC/cgttrf.f +++ b/SRC/cgttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgttrs.f b/SRC/cgttrs.f index 1ea51846f9..2edabac33c 100644 --- a/SRC/cgttrs.f +++ b/SRC/cgttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtts2.f b/SRC/cgtts2.f index 3c754891e2..7e846825ef 100644 --- a/SRC/cgtts2.f +++ b/SRC/cgtts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f index f23ad2d9de..9cdae58e93 100644 --- a/SRC/chb2st_kernels.f +++ b/SRC/chb2st_kernels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> c, Wed Dec 7 08:22:40 2016 diff --git a/SRC/chbev.f b/SRC/chbev.f index 21fc8dc5dc..17ab41130b 100644 --- a/SRC/chbev.f +++ b/SRC/chbev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbev_2stage.f b/SRC/chbev_2stage.f index f84d8d3d42..c4521f5aeb 100644 --- a/SRC/chbev_2stage.f +++ b/SRC/chbev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbev_2stage.f, fortran z -> c, Sat Nov 5 23:18:20 2016 diff --git a/SRC/chbevd.f b/SRC/chbevd.f index a5afe6b762..7c9968669f 100644 --- a/SRC/chbevd.f +++ b/SRC/chbevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbevd_2stage.f b/SRC/chbevd_2stage.f index 5d725dfdbe..2dbe33d7ef 100644 --- a/SRC/chbevd_2stage.f +++ b/SRC/chbevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbevd_2stage.f, fortran z -> c, Sat Nov 5 23:18:17 2016 diff --git a/SRC/chbevx.f b/SRC/chbevx.f index c9063023ff..db8d57c26e 100644 --- a/SRC/chbevx.f +++ b/SRC/chbevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbevx_2stage.f b/SRC/chbevx_2stage.f index 1d609dfbd3..07431b0560 100644 --- a/SRC/chbevx_2stage.f +++ b/SRC/chbevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbevx_2stage.f, fortran z -> c, Sat Nov 5 23:18:22 2016 diff --git a/SRC/chbgst.f b/SRC/chbgst.f index f7b14cc861..8aec38f36c 100644 --- a/SRC/chbgst.f +++ b/SRC/chbgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgv.f b/SRC/chbgv.f index 23426df09b..dd7e62cbe2 100644 --- a/SRC/chbgv.f +++ b/SRC/chbgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgvd.f b/SRC/chbgvd.f index 00fb2b5f58..0ccb7ffaa7 100644 --- a/SRC/chbgvd.f +++ b/SRC/chbgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgvx.f b/SRC/chbgvx.f index 3e11ae3fe0..36d77437ae 100644 --- a/SRC/chbgvx.f +++ b/SRC/chbgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/chbtrd.f b/SRC/chbtrd.f index 9c03c779b5..d77a4e31f6 100644 --- a/SRC/chbtrd.f +++ b/SRC/chbtrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/checon.f b/SRC/checon.f index 7cc6ab0187..0156823cee 100644 --- a/SRC/checon.f +++ b/SRC/checon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHECON * * =========== DOCUMENTATION =========== diff --git a/SRC/checon_3.f b/SRC/checon_3.f index 2bf524c077..ee10bf375e 100644 --- a/SRC/checon_3.f +++ b/SRC/checon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHECON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/checon_rook.f b/SRC/checon_rook.f index 3fdf789f9b..f7164ea746 100644 --- a/SRC/checon_rook.f +++ b/SRC/checon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/cheequb.f b/SRC/cheequb.f index 1adfd7fac4..608eb938a5 100644 --- a/SRC/cheequb.f +++ b/SRC/cheequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cheev.f b/SRC/cheev.f index 60df7d8b84..fda28e6dd3 100644 --- a/SRC/cheev.f +++ b/SRC/cheev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheev_2stage.f b/SRC/cheev_2stage.f index 4e1cecc64f..6df9e5053d 100644 --- a/SRC/cheev_2stage.f +++ b/SRC/cheev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheev_2stage.f, fortran z -> c, Sat Nov 5 23:18:06 2016 diff --git a/SRC/cheevd.f b/SRC/cheevd.f index 9b62a2df60..cdd5ca1c77 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevd_2stage.f b/SRC/cheevd_2stage.f index 7fd6950e93..198164ebb6 100644 --- a/SRC/cheevd_2stage.f +++ b/SRC/cheevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevd_2stage.f, fortran z -> c, Sat Nov 5 23:18:14 2016 diff --git a/SRC/cheevr.f b/SRC/cheevr.f index ad5c8cd4aa..5e75891f40 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index e06925fcd0..2894392ce8 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevr_2stage.f, fortran z -> c, Sat Nov 5 23:18:11 2016 diff --git a/SRC/cheevx.f b/SRC/cheevx.f index a8a2bde630..8ace8a1f95 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevx_2stage.f b/SRC/cheevx_2stage.f index 70a681ec4e..b387bcd76e 100644 --- a/SRC/cheevx_2stage.f +++ b/SRC/cheevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevx_2stage.f, fortran z -> c, Sat Nov 5 23:18:09 2016 diff --git a/SRC/chegs2.f b/SRC/chegs2.f index 18d2db6351..abfa9bd716 100644 --- a/SRC/chegs2.f +++ b/SRC/chegs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorization results obtained from cpotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chegst.f b/SRC/chegst.f index 7d13e43d9d..4083dc2f19 100644 --- a/SRC/chegst.f +++ b/SRC/chegst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chegv.f b/SRC/chegv.f index 53f9d5196e..9c318e214d 100644 --- a/SRC/chegv.f +++ b/SRC/chegv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chegv_2stage.f b/SRC/chegv_2stage.f index 8de1f7f060..8ad59a0b25 100644 --- a/SRC/chegv_2stage.f +++ b/SRC/chegv_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGV_2STAGE * * @generated from zhegv_2stage.f, fortran z -> c, Sun Nov 6 13:09:52 2016 diff --git a/SRC/chegvd.f b/SRC/chegvd.f index d2dc941e6d..d9d16b8c7f 100644 --- a/SRC/chegvd.f +++ b/SRC/chegvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chegvx.f b/SRC/chegvx.f index 172d0571e5..ecee050c91 100644 --- a/SRC/chegvx.f +++ b/SRC/chegvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHEGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/cherfs.f b/SRC/cherfs.f index 9ca42393f1..52c8a37b58 100644 --- a/SRC/cherfs.f +++ b/SRC/cherfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cherfsx.f b/SRC/cherfsx.f index 81a88ddea7..ed7343f5d7 100644 --- a/SRC/cherfsx.f +++ b/SRC/cherfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv.f b/SRC/chesv.f index cea1235b7b..3b9ad1d9ae 100644 --- a/SRC/chesv.f +++ b/SRC/chesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESV computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f index 0f41c93321..82c429b1c5 100644 --- a/SRC/chesv_aa.f +++ b/SRC/chesv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESV_AA computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_aa_2stage.f b/SRC/chesv_aa_2stage.f index 05ebd9253a..fe9110c292 100644 --- a/SRC/chesv_aa_2stage.f +++ b/SRC/chesv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_rk.f b/SRC/chesv_rk.f index 268a55e234..19e74f901e 100644 --- a/SRC/chesv_rk.f +++ b/SRC/chesv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_rook.f b/SRC/chesv_rook.f index 2a0d3fdaf7..da84af8b49 100644 --- a/SRC/chesv_rook.f +++ b/SRC/chesv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the bounded Bunch-Kaufman ("rook") diagonal pivoting method * * =========== DOCUMENTATION =========== diff --git a/SRC/chesvx.f b/SRC/chesvx.f index bdaad55ec1..8587531ef0 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESVX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesvxx.f b/SRC/chesvxx.f index 011987cf0f..7d78d5c0e8 100644 --- a/SRC/chesvxx.f +++ b/SRC/chesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHESVXX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheswapr.f b/SRC/cheswapr.f index a6161df5e6..5734df94f3 100644 --- a/SRC/cheswapr.f +++ b/SRC/cheswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/chetd2.f b/SRC/chetd2.f index aad0fb00c7..d70ca18cd4 100644 --- a/SRC/chetd2.f +++ b/SRC/chetd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2.f b/SRC/chetf2.f index 180d5f0451..6a8dfdb0e5 100644 --- a/SRC/chetf2.f +++ b/SRC/chetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (unblocked algorithm calling Level 2 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2_rk.f b/SRC/chetf2_rk.f index a3d5acb19d..657f1ce162 100644 --- a/SRC/chetf2_rk.f +++ b/SRC/chetf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2_rook.f b/SRC/chetf2_rook.f index 53ddb93f74..775899410e 100644 --- a/SRC/chetf2_rook.f +++ b/SRC/chetf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrd.f b/SRC/chetrd.f index e5b4401c64..40ada21230 100644 --- a/SRC/chetrd.f +++ b/SRC/chetrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRD * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f index ec70757980..97fbfea8ad 100644 --- a/SRC/chetrd_2stage.f +++ b/SRC/chetrd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> c, Sun Nov 6 19:34:06 2016 diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index b0d3e45fbf..9639f581c6 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 42e71e0b20..15d53b71ae 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRD_HE2HB * * @generated from zhetrd_he2hb.f, fortran z -> c, Wed Dec 7 08:22:40 2016 diff --git a/SRC/chetrf.f b/SRC/chetrf.f index 2836e30bcc..136408d9ec 100644 --- a/SRC/chetrf.f +++ b/SRC/chetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index 51410a6ed7..8a1faabf7a 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index a79343753b..130111f66e 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f index a13c740e3c..d1811e3fe1 100644 --- a/SRC/chetrf_rk.f +++ b/SRC/chetrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_rook.f b/SRC/chetrf_rook.f index df0323520b..0055d0a6a1 100644 --- a/SRC/chetrf_rook.f +++ b/SRC/chetrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri.f b/SRC/chetri.f index b67cb67353..8874941205 100644 --- a/SRC/chetri.f +++ b/SRC/chetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri2.f b/SRC/chetri2.f index f15065ae7d..2456f788fb 100644 --- a/SRC/chetri2.f +++ b/SRC/chetri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri2x.f b/SRC/chetri2x.f index a507d09ce7..eb5008c19c 100644 --- a/SRC/chetri2x.f +++ b/SRC/chetri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_3.f b/SRC/chetri_3.f index ccfce5070b..4847ab9513 100644 --- a/SRC/chetri_3.f +++ b/SRC/chetri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_3x.f b/SRC/chetri_3x.f index bb7c6002f1..70d77d3a67 100644 --- a/SRC/chetri_3x.f +++ b/SRC/chetri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_rook.f b/SRC/chetri_rook.f index 30621b48af..49ea89d332 100644 --- a/SRC/chetri_rook.f +++ b/SRC/chetri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs.f b/SRC/chetrs.f index abf7b42f0f..8ee65a42ec 100644 --- a/SRC/chetrs.f +++ b/SRC/chetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs2.f b/SRC/chetrs2.f index c036e5710a..9d421c5f4c 100644 --- a/SRC/chetrs2.f +++ b/SRC/chetrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_3.f b/SRC/chetrs_3.f index ae137df639..11c5e36ad3 100644 --- a/SRC/chetrs_3.f +++ b/SRC/chetrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f index 07179ab923..0662e53a39 100644 --- a/SRC/chetrs_aa.f +++ b/SRC/chetrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_aa_2stage.f b/SRC/chetrs_aa_2stage.f index caf72e27a8..7f1ba8edd5 100644 --- a/SRC/chetrs_aa_2stage.f +++ b/SRC/chetrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS_AA_2STAGE * * @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017 diff --git a/SRC/chetrs_rook.f b/SRC/chetrs_rook.f index 8e4d4b1d58..d69840a6bf 100644 --- a/SRC/chetrs_rook.f +++ b/SRC/chetrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/chfrk.f b/SRC/chfrk.f index 970b4bee96..34bdec5869 100644 --- a/SRC/chfrk.f +++ b/SRC/chfrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHFRK performs a Hermitian rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/chgeqz.f b/SRC/chgeqz.f index 62e6da39a6..7ff8c0a77a 100644 --- a/SRC/chgeqz.f +++ b/SRC/chgeqz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/chla_transtype.f b/SRC/chla_transtype.f index 170a4e2b10..01364a83e3 100644 --- a/SRC/chla_transtype.f +++ b/SRC/chla_transtype.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHLA_TRANSTYPE * * =========== DOCUMENTATION =========== diff --git a/SRC/chpcon.f b/SRC/chpcon.f index 621840c7c2..5de7499e19 100644 --- a/SRC/chpcon.f +++ b/SRC/chpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/chpev.f b/SRC/chpev.f index ab98def3f9..f060c3b5ea 100644 --- a/SRC/chpev.f +++ b/SRC/chpev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpevd.f b/SRC/chpevd.f index 2449783a29..27849ba860 100644 --- a/SRC/chpevd.f +++ b/SRC/chpevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpevx.f b/SRC/chpevx.f index 2cfec2cbc6..51ae863846 100644 --- a/SRC/chpevx.f +++ b/SRC/chpevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgst.f b/SRC/chpgst.f index b666965868..ba56396beb 100644 --- a/SRC/chpgst.f +++ b/SRC/chpgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgv.f b/SRC/chpgv.f index 68a2c0a081..2570c59dbb 100644 --- a/SRC/chpgv.f +++ b/SRC/chpgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgvd.f b/SRC/chpgvd.f index 57ac4fc728..81ac4f7ed8 100644 --- a/SRC/chpgvd.f +++ b/SRC/chpgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgvx.f b/SRC/chpgvx.f index 56f1eddbf0..8c7248c46e 100644 --- a/SRC/chpgvx.f +++ b/SRC/chpgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/chprfs.f b/SRC/chprfs.f index 47413c6d21..7d56f1d5a6 100644 --- a/SRC/chprfs.f +++ b/SRC/chprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/chpsv.f b/SRC/chpsv.f index 4fc4a3a0ac..eed77b9aab 100644 --- a/SRC/chpsv.f +++ b/SRC/chpsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpsvx.f b/SRC/chpsvx.f index b6b6d14f04..67db548f48 100644 --- a/SRC/chpsvx.f +++ b/SRC/chpsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrd.f b/SRC/chptrd.f index 07bc2cae57..b324a1e65b 100644 --- a/SRC/chptrd.f +++ b/SRC/chptrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrf.f b/SRC/chptrf.f index 150afed54d..470e8c85b7 100644 --- a/SRC/chptrf.f +++ b/SRC/chptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/chptri.f b/SRC/chptri.f index 0a29f45c7a..8aa40985a6 100644 --- a/SRC/chptri.f +++ b/SRC/chptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrs.f b/SRC/chptrs.f index ed49ec6703..3c421923fd 100644 --- a/SRC/chptrs.f +++ b/SRC/chptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/chsein.f b/SRC/chsein.f index 34c7f65654..0b7ddc6b33 100644 --- a/SRC/chsein.f +++ b/SRC/chsein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/chseqr.f b/SRC/chseqr.f index 56ff01fc6c..3e8a1ac0e8 100644 --- a/SRC/chseqr.f +++ b/SRC/chseqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbamv.f b/SRC/cla_gbamv.f index c652e65ecb..a8b0ca2980 100644 --- a/SRC/cla_gbamv.f +++ b/SRC/cla_gbamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrcond_c.f b/SRC/cla_gbrcond_c.f index 011ff50971..271aeeb004 100644 --- a/SRC/cla_gbrcond_c.f +++ b/SRC/cla_gbrcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GBRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrcond_x.f b/SRC/cla_gbrcond_x.f index f14c1cea85..96a06b5b25 100644 --- a/SRC/cla_gbrcond_x.f +++ b/SRC/cla_gbrcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrfsx_extended.f b/SRC/cla_gbrfsx_extended.f index 8f483ab281..2a50974e1f 100644 --- a/SRC/cla_gbrfsx_extended.f +++ b/SRC/cla_gbrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrpvgrw.f b/SRC/cla_gbrpvgrw.f index e779e7ef5b..0037590ff7 100644 --- a/SRC/cla_gbrpvgrw.f +++ b/SRC/cla_gbrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_geamv.f b/SRC/cla_geamv.f index d8fdb2c913..f99e297026 100644 --- a/SRC/cla_geamv.f +++ b/SRC/cla_geamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gercond_c.f b/SRC/cla_gercond_c.f index d5b05a2bbe..211e7a9944 100644 --- a/SRC/cla_gercond_c.f +++ b/SRC/cla_gercond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gercond_x.f b/SRC/cla_gercond_x.f index a9d4ad46ad..c2bc4b2192 100644 --- a/SRC/cla_gercond_x.f +++ b/SRC/cla_gercond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gerfsx_extended.f b/SRC/cla_gerfsx_extended.f index fd14afa3f1..28efc4d1cb 100644 --- a/SRC/cla_gerfsx_extended.f +++ b/SRC/cla_gerfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GERFSX_EXTENDED * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gerpvgrw.f b/SRC/cla_gerpvgrw.f index 26442ab4bf..4ed992b335 100644 --- a/SRC/cla_gerpvgrw.f +++ b/SRC/cla_gerpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_GERPVGRW multiplies a square real matrix by a complex matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_heamv.f b/SRC/cla_heamv.f index 5be2f9cb95..85cca0b553 100644 --- a/SRC/cla_heamv.f +++ b/SRC/cla_heamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_hercond_c.f b/SRC/cla_hercond_c.f index eb0d13822b..cf8fe8d601 100644 --- a/SRC/cla_hercond_c.f +++ b/SRC/cla_hercond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_hercond_x.f b/SRC/cla_hercond_x.f index fb04e116dd..b4ebdeb82a 100644 --- a/SRC/cla_hercond_x.f +++ b/SRC/cla_hercond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_herfsx_extended.f b/SRC/cla_herfsx_extended.f index 6a5d3a8eb0..ce174ea1fe 100644 --- a/SRC/cla_herfsx_extended.f +++ b/SRC/cla_herfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_HERFSX_EXTENDED improves the computed solution to a system of linear equations for Hermitian indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_herpvgrw.f b/SRC/cla_herpvgrw.f index de403fdca3..de27096286 100644 --- a/SRC/cla_herpvgrw.f +++ b/SRC/cla_herpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_HERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_lin_berr.f b/SRC/cla_lin_berr.f index 38cbff6144..e86906ed7f 100644 --- a/SRC/cla_lin_berr.f +++ b/SRC/cla_lin_berr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porcond_c.f b/SRC/cla_porcond_c.f index 119172f498..7cefbbeb13 100644 --- a/SRC/cla_porcond_c.f +++ b/SRC/cla_porcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porcond_x.f b/SRC/cla_porcond_x.f index b996d0fdf0..198beb576b 100644 --- a/SRC/cla_porcond_x.f +++ b/SRC/cla_porcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_PORCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porfsx_extended.f b/SRC/cla_porfsx_extended.f index 83708938ce..093636f612 100644 --- a/SRC/cla_porfsx_extended.f +++ b/SRC/cla_porfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porpvgrw.f b/SRC/cla_porpvgrw.f index 696c6ac31f..5476e3b846 100644 --- a/SRC/cla_porpvgrw.f +++ b/SRC/cla_porpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syamv.f b/SRC/cla_syamv.f index fbf8be9920..860c150564 100644 --- a/SRC/cla_syamv.f +++ b/SRC/cla_syamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrcond_c.f b/SRC/cla_syrcond_c.f index 8521a8e76d..9d6ee36800 100644 --- a/SRC/cla_syrcond_c.f +++ b/SRC/cla_syrcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrcond_x.f b/SRC/cla_syrcond_x.f index 002c0aed2b..be284a6184 100644 --- a/SRC/cla_syrcond_x.f +++ b/SRC/cla_syrcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrfsx_extended.f b/SRC/cla_syrfsx_extended.f index 33fa22f8a9..724d756672 100644 --- a/SRC/cla_syrfsx_extended.f +++ b/SRC/cla_syrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrpvgrw.f b/SRC/cla_syrpvgrw.f index 937ec75e23..238c27ad87 100644 --- a/SRC/cla_syrpvgrw.f +++ b/SRC/cla_syrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_wwaddw.f b/SRC/cla_wwaddw.f index b767942431..2777cd987c 100644 --- a/SRC/cla_wwaddw.f +++ b/SRC/cla_wwaddw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clabrd.f b/SRC/clabrd.f index 2bde3842a7..a04ee5f24d 100644 --- a/SRC/clabrd.f +++ b/SRC/clabrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacgv.f b/SRC/clacgv.f index 27d8b48475..8eed5e7313 100644 --- a/SRC/clacgv.f +++ b/SRC/clacgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACGV conjugates a complex vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacn2.f b/SRC/clacn2.f index f253f7c187..61a1f99403 100644 --- a/SRC/clacn2.f +++ b/SRC/clacn2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacon.f b/SRC/clacon.f index 13c2ed1f67..bc0d44ada9 100644 --- a/SRC/clacon.f +++ b/SRC/clacon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacp2.f b/SRC/clacp2.f index 92a9f26642..41c0da32e0 100644 --- a/SRC/clacp2.f +++ b/SRC/clacp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACP2 copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacpy.f b/SRC/clacpy.f index b365d92bfe..950d4b6b63 100644 --- a/SRC/clacpy.f +++ b/SRC/clacpy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacrm.f b/SRC/clacrm.f index cca6e40aac..8f35905ca8 100644 --- a/SRC/clacrm.f +++ b/SRC/clacrm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACRM multiplies a complex matrix by a square real matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacrt.f b/SRC/clacrt.f index 666009aad4..0df69036cd 100644 --- a/SRC/clacrt.f +++ b/SRC/clacrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLACRT performs a linear transformation of a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/cladiv.f b/SRC/cladiv.f index 9d80831074..23dd6ceb47 100644 --- a/SRC/cladiv.f +++ b/SRC/cladiv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed0.f b/SRC/claed0.f index 1661b02a3d..6ad7493833 100644 --- a/SRC/claed0.f +++ b/SRC/claed0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAED0 used by CSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed7.f b/SRC/claed7.f index 5391e09fcb..996c05700b 100644 --- a/SRC/claed7.f +++ b/SRC/claed7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAED7 used by CSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed8.f b/SRC/claed8.f index 4600729b18..2786104b74 100644 --- a/SRC/claed8.f +++ b/SRC/claed8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAED8 used by CSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/claein.f b/SRC/claein.f index d48263b4f9..4e242d4bd6 100644 --- a/SRC/claein.f +++ b/SRC/claein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/claesy.f b/SRC/claesy.f index c6d8a3a0cf..95d67a4e48 100644 --- a/SRC/claesy.f +++ b/SRC/claesy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAESY computes the eigenvalues and eigenvectors of a 2-by-2 complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claev2.f b/SRC/claev2.f index e6178e471c..d0d67cae68 100644 --- a/SRC/claev2.f +++ b/SRC/claev2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clag2z.f b/SRC/clag2z.f index 5cf9dcc420..eb22f8aea3 100644 --- a/SRC/clag2z.f +++ b/SRC/clag2z.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAG2Z converts a complex single precision matrix to a complex double precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clags2.f b/SRC/clags2.f index de912de18d..7d4af38ade 100644 --- a/SRC/clags2.f +++ b/SRC/clags2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAGS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/clagtm.f b/SRC/clagtm.f index 568e5b804e..0f7680a46f 100644 --- a/SRC/clagtm.f +++ b/SRC/clagtm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef.f b/SRC/clahef.f index 6d7ea23bf1..1f30100985 100644 --- a/SRC/clahef.f +++ b/SRC/clahef.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAHEF computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kaufman diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_aa.f b/SRC/clahef_aa.f index 0081b249e2..91f6ed4513 100644 --- a/SRC/clahef_aa.f +++ b/SRC/clahef_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAHEF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_rk.f b/SRC/clahef_rk.f index c6bd514855..e01e66d5f5 100644 --- a/SRC/clahef_rk.f +++ b/SRC/clahef_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_rook.f b/SRC/clahef_rook.f index 1c195b3fb4..c824d16dd6 100644 --- a/SRC/clahef_rook.f +++ b/SRC/clahef_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" * \brief \b CLAHEF_ROOK computes a partial factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/clahqr.f b/SRC/clahqr.f index caca0e8ddb..68e4538bc0 100644 --- a/SRC/clahqr.f +++ b/SRC/clahqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahr2.f b/SRC/clahr2.f index 4132bc0e10..f8a019ae46 100644 --- a/SRC/clahr2.f +++ b/SRC/clahr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/claic1.f b/SRC/claic1.f index 43f63b026f..01e14a8f77 100644 --- a/SRC/claic1.f +++ b/SRC/claic1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/clals0.f b/SRC/clals0.f index 131d97542e..57f72a88a6 100644 --- a/SRC/clals0.f +++ b/SRC/clals0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/clalsa.f b/SRC/clalsa.f index a331f8e7ab..5cf5066eb9 100644 --- a/SRC/clalsa.f +++ b/SRC/clalsa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/clalsd.f b/SRC/clalsd.f index 855f22b19b..de51725b86 100644 --- a/SRC/clalsd.f +++ b/SRC/clalsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index 8f474a3abb..a80ca8b52c 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAMSWLQ * * Definition: diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f index 13625087f0..387f982a59 100644 --- a/SRC/clamtsqr.f +++ b/SRC/clamtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAMTSQR * * Definition: diff --git a/SRC/clangb.f b/SRC/clangb.f index 380318631e..5b9c5dee90 100644 --- a/SRC/clangb.f +++ b/SRC/clangb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clange.f b/SRC/clange.f index e760394291..5aca9e872f 100644 --- a/SRC/clange.f +++ b/SRC/clange.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clangt.f b/SRC/clangt.f index c4a4de4ec2..765f938506 100644 --- a/SRC/clangt.f +++ b/SRC/clangt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhb.f b/SRC/clanhb.f index c0f5edfa46..43c98e201a 100644 --- a/SRC/clanhb.f +++ b/SRC/clanhb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhe.f b/SRC/clanhe.f index 6342cb9b23..0f8f80a7ae 100644 --- a/SRC/clanhe.f +++ b/SRC/clanhe.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhf.f b/SRC/clanhf.f index 08c987e7ad..f82f170ba2 100644 --- a/SRC/clanhf.f +++ b/SRC/clanhf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhp.f b/SRC/clanhp.f index 94b679dbda..1be8e0e9e7 100644 --- a/SRC/clanhp.f +++ b/SRC/clanhp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhs.f b/SRC/clanhs.f index 28392bf954..2a76ddcd03 100644 --- a/SRC/clanhs.f +++ b/SRC/clanhs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanht.f b/SRC/clanht.f index c7359b9ae9..a12d4a7fb2 100644 --- a/SRC/clanht.f +++ b/SRC/clanht.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansb.f b/SRC/clansb.f index e32ec96ece..52c37047c1 100644 --- a/SRC/clansb.f +++ b/SRC/clansb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansp.f b/SRC/clansp.f index 0a5527ba25..a491d0c5c8 100644 --- a/SRC/clansp.f +++ b/SRC/clansp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansy.f b/SRC/clansy.f index 4b65281117..930f065590 100644 --- a/SRC/clansy.f +++ b/SRC/clansy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantb.f b/SRC/clantb.f index 37252c48b7..7fa1a35643 100644 --- a/SRC/clantb.f +++ b/SRC/clantb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantp.f b/SRC/clantp.f index 7b68b8d83e..ae34d19e2e 100644 --- a/SRC/clantp.f +++ b/SRC/clantp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantr.f b/SRC/clantr.f index 51e63b0d8b..7906da231f 100644 --- a/SRC/clantr.f +++ b/SRC/clantr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapll.f b/SRC/clapll.f index 5bb450871b..112f54b2c4 100644 --- a/SRC/clapll.f +++ b/SRC/clapll.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapmr.f b/SRC/clapmr.f index 1c9535896a..d95c2c20d0 100644 --- a/SRC/clapmr.f +++ b/SRC/clapmr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapmt.f b/SRC/clapmt.f index a6edcb2539..ab430d402d 100644 --- a/SRC/clapmt.f +++ b/SRC/clapmt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqgb.f b/SRC/claqgb.f index 79c455fc00..ee6979fc53 100644 --- a/SRC/claqgb.f +++ b/SRC/claqgb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqge.f b/SRC/claqge.f index c0cb8a750f..3cc36e68cf 100644 --- a/SRC/claqge.f +++ b/SRC/claqge.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhb.f b/SRC/claqhb.f index 841617c4d4..6e0983368c 100644 --- a/SRC/claqhb.f +++ b/SRC/claqhb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhe.f b/SRC/claqhe.f index 7a243ab2b4..6f3ebbf829 100644 --- a/SRC/claqhe.f +++ b/SRC/claqhe.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQHE scales a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhp.f b/SRC/claqhp.f index 34cc74c6c7..d181963698 100644 --- a/SRC/claqhp.f +++ b/SRC/claqhp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQHP scales a Hermitian matrix stored in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqp2.f b/SRC/claqp2.f index b7e958ccd8..910ddd857b 100644 --- a/SRC/claqp2.f +++ b/SRC/claqp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqps.f b/SRC/claqps.f index 35dc450293..cdee732d1d 100644 --- a/SRC/claqps.f +++ b/SRC/claqps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr0.f b/SRC/claqr0.f index 8a9afe52ec..e520aad3fb 100644 --- a/SRC/claqr0.f +++ b/SRC/claqr0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr1.f b/SRC/claqr1.f index f25a8ab281..0a6624faef 100644 --- a/SRC/claqr1.f +++ b/SRC/claqr1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 01dc02150d..2bb79b0852 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR2 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr3.f b/SRC/claqr3.f index a12a87519e..b72293da03 100644 --- a/SRC/claqr3.f +++ b/SRC/claqr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR3 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr4.f b/SRC/claqr4.f index cb38af7016..f14c837afc 100644 --- a/SRC/claqr4.f +++ b/SRC/claqr4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr5.f b/SRC/claqr5.f index 2283c37b00..8ca152adb4 100644 --- a/SRC/claqr5.f +++ b/SRC/claqr5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsb.f b/SRC/claqsb.f index 9d9d9b4258..c782efc327 100644 --- a/SRC/claqsb.f +++ b/SRC/claqsb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsp.f b/SRC/claqsp.f index c59606b19c..dc2431d73c 100644 --- a/SRC/claqsp.f +++ b/SRC/claqsp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsy.f b/SRC/claqsy.f index 11d1444e77..5eb9b80eaf 100644 --- a/SRC/claqsy.f +++ b/SRC/claqsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz0.f b/SRC/claqz0.f index 73471d5121..4085834052 100644 --- a/SRC/claqz0.f +++ b/SRC/claqz0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz1.f b/SRC/claqz1.f index 1a8feb8d10..a91c7f96a9 100644 --- a/SRC/claqz1.f +++ b/SRC/claqz1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz2.f b/SRC/claqz2.f index e3bd6fb4f5..a5a3e0f9ae 100644 --- a/SRC/claqz2.f +++ b/SRC/claqz2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz3.f b/SRC/claqz3.f index cd3a238060..caaebcbc44 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/clar1v.f b/SRC/clar1v.f index 60183d2728..954da8b0bd 100644 --- a/SRC/clar1v.f +++ b/SRC/clar1v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/clar2v.f b/SRC/clar2v.f index 4f6a29cf80..63d7d8aa1a 100644 --- a/SRC/clar2v.f +++ b/SRC/clar2v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAR2V applies a vector of plane rotations with real cosines and complex sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarcm.f b/SRC/clarcm.f index 0ee10399a1..a6fca0adca 100644 --- a/SRC/clarcm.f +++ b/SRC/clarcm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARCM copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarf.f b/SRC/clarf.f index 04474a97a5..ef7458c348 100644 --- a/SRC/clarf.f +++ b/SRC/clarf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfb.f b/SRC/clarfb.f index ff9cce353b..17692a7952 100644 --- a/SRC/clarfb.f +++ b/SRC/clarfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfb_gett.f b/SRC/clarfb_gett.f index 5f078ab788..6fbbef8027 100644 --- a/SRC/clarfb_gett.f +++ b/SRC/clarfb_gett.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfg.f b/SRC/clarfg.f index e335e0fd63..8ee459ce05 100644 --- a/SRC/clarfg.f +++ b/SRC/clarfg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f index 980e936122..2fa96196ec 100644 --- a/SRC/clarfgp.f +++ b/SRC/clarfgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarft.f b/SRC/clarft.f index c28b2262c8..8e33d80388 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfx.f b/SRC/clarfx.f index fdfc5a3f1f..53c90d8fd1 100644 --- a/SRC/clarfx.f +++ b/SRC/clarfx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfy.f b/SRC/clarfy.f index f01ba7c0e0..bbda28283a 100644 --- a/SRC/clarfy.f +++ b/SRC/clarfy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/clargv.f b/SRC/clargv.f index 47a46f72ee..0732178d0f 100644 --- a/SRC/clargv.f +++ b/SRC/clargv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARGV generates a vector of plane rotations with real cosines and complex sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarnv.f b/SRC/clarnv.f index efef3a7b3a..5d0586abf4 100644 --- a/SRC/clarnv.f +++ b/SRC/clarnv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarrv.f b/SRC/clarrv.f index bb33150d3f..02985ebf5f 100644 --- a/SRC/clarrv.f +++ b/SRC/clarrv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarscl2.f b/SRC/clarscl2.f index 3253b435ac..d128e8e699 100644 --- a/SRC/clarscl2.f +++ b/SRC/clarscl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clartg.f90 b/SRC/clartg.f90 index ffcf2b3e25..b022ec6752 100644 --- a/SRC/clartg.f90 +++ b/SRC/clartg.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b CLARTG generates a plane rotation with real cosine and complex sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/clartv.f b/SRC/clartv.f index 987d809879..a4f5918523 100644 --- a/SRC/clartv.f +++ b/SRC/clartv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARTV applies a vector of plane rotations with real cosines and complex sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarz.f b/SRC/clarz.f index 65245cc8fb..56a6f38290 100644 --- a/SRC/clarz.f +++ b/SRC/clarz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarzb.f b/SRC/clarzb.f index 83707b7636..c0cc3fd577 100644 --- a/SRC/clarzb.f +++ b/SRC/clarzb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARZB applies a block reflector or its conjugate-transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarzt.f b/SRC/clarzt.f index 9ecf3d853a..8cdf0ecdf3 100644 --- a/SRC/clarzt.f +++ b/SRC/clarzt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/clascl.f b/SRC/clascl.f index e1c33d439e..2ebdfbe0f5 100644 --- a/SRC/clascl.f +++ b/SRC/clascl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/clascl2.f b/SRC/clascl2.f index afcbef6b3d..6d02512c4d 100644 --- a/SRC/clascl2.f +++ b/SRC/clascl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claset.f b/SRC/claset.f index 4d7ac6d19a..6fec8ed33e 100644 --- a/SRC/claset.f +++ b/SRC/claset.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasr.f b/SRC/clasr.f index fafb961901..1ee283a33b 100644 --- a/SRC/clasr.f +++ b/SRC/clasr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/classq.f90 b/SRC/classq.f90 index c5f793cc0b..680e3d04c9 100644 --- a/SRC/classq.f90 +++ b/SRC/classq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b CLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/claswlq.f b/SRC/claswlq.f index 2044e055cc..bd394a68ff 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASWLQ * * Definition: diff --git a/SRC/claswp.f b/SRC/claswp.f index 1fdc07186c..cf83f089b2 100644 --- a/SRC/claswp.f +++ b/SRC/claswp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf.f b/SRC/clasyf.f index b9dc4d5635..b2037c646a 100644 --- a/SRC/clasyf.f +++ b/SRC/clasyf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASYF computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_aa.f b/SRC/clasyf_aa.f index 47a0371819..53fe486523 100644 --- a/SRC/clasyf_aa.f +++ b/SRC/clasyf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_rk.f b/SRC/clasyf_rk.f index eb4bd1292b..7cadb06238 100644 --- a/SRC/clasyf_rk.f +++ b/SRC/clasyf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_rook.f b/SRC/clasyf_rook.f index a5d31dd78a..49f566211c 100644 --- a/SRC/clasyf_rook.f +++ b/SRC/clasyf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLASYF_ROOK computes a partial factorization of a complex symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatbs.f b/SRC/clatbs.f index 1f217bc178..94e8435303 100644 --- a/SRC/clatbs.f +++ b/SRC/clatbs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatdf.f b/SRC/clatdf.f index d3ac536d95..d05ce9be7a 100644 --- a/SRC/clatdf.f +++ b/SRC/clatdf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatps.f b/SRC/clatps.f index 9c49b5112f..1c9910b706 100644 --- a/SRC/clatps.f +++ b/SRC/clatps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrd.f b/SRC/clatrd.f index 9f89f140ee..dd210a893b 100644 --- a/SRC/clatrd.f +++ b/SRC/clatrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an unitary similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrs.f b/SRC/clatrs.f index cee1cb7586..6e02f6f35c 100644 --- a/SRC/clatrs.f +++ b/SRC/clatrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index 354141a8b1..89fab12551 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/clatrz.f b/SRC/clatrz.f index 5354007641..9afbc3f519 100644 --- a/SRC/clatrz.f +++ b/SRC/clatrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATRZ factors an upper trapezoidal matrix by means of unitary transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f index 67403693f8..fe964de5ec 100644 --- a/SRC/clatsqr.f +++ b/SRC/clatsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLATSQR * * Definition: diff --git a/SRC/claunhr_col_getrfnp.f b/SRC/claunhr_col_getrfnp.f index f571956dfc..4cb370b229 100644 --- a/SRC/claunhr_col_getrfnp.f +++ b/SRC/claunhr_col_getrfnp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAUNHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/claunhr_col_getrfnp2.f b/SRC/claunhr_col_getrfnp2.f index eb5ffb71ac..f438f54de9 100644 --- a/SRC/claunhr_col_getrfnp2.f +++ b/SRC/claunhr_col_getrfnp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAUNHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/clauu2.f b/SRC/clauu2.f index 738ecaf717..62ca5af595 100644 --- a/SRC/clauu2.f +++ b/SRC/clauu2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/clauum.f b/SRC/clauum.f index 472cc7a72f..aa1a4da232 100644 --- a/SRC/clauum.f +++ b/SRC/clauum.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbcon.f b/SRC/cpbcon.f index 66cbdd0694..e3bfff6985 100644 --- a/SRC/cpbcon.f +++ b/SRC/cpbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbequ.f b/SRC/cpbequ.f index 7e93209e64..30e38b7a64 100644 --- a/SRC/cpbequ.f +++ b/SRC/cpbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbrfs.f b/SRC/cpbrfs.f index 77786f204d..44c1693008 100644 --- a/SRC/cpbrfs.f +++ b/SRC/cpbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbstf.f b/SRC/cpbstf.f index 6b20f08fc8..55c848b230 100644 --- a/SRC/cpbstf.f +++ b/SRC/cpbstf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbsv.f b/SRC/cpbsv.f index b4a74d2dbb..2682459ae5 100644 --- a/SRC/cpbsv.f +++ b/SRC/cpbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbsvx.f b/SRC/cpbsvx.f index 55e894f6e3..09293f2b1a 100644 --- a/SRC/cpbsvx.f +++ b/SRC/cpbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtf2.f b/SRC/cpbtf2.f index 815d6fa952..525bde4473 100644 --- a/SRC/cpbtf2.f +++ b/SRC/cpbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtrf.f b/SRC/cpbtrf.f index b75c480341..f2db4dfac5 100644 --- a/SRC/cpbtrf.f +++ b/SRC/cpbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtrs.f b/SRC/cpbtrs.f index fc462d5f2d..5b632d189c 100644 --- a/SRC/cpbtrs.f +++ b/SRC/cpbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftrf.f b/SRC/cpftrf.f index 2de002d671..d69484ee71 100644 --- a/SRC/cpftrf.f +++ b/SRC/cpftrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftri.f b/SRC/cpftri.f index b581a31ab2..beba935045 100644 --- a/SRC/cpftri.f +++ b/SRC/cpftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftrs.f b/SRC/cpftrs.f index 91aaf26274..0c9540239d 100644 --- a/SRC/cpftrs.f +++ b/SRC/cpftrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpocon.f b/SRC/cpocon.f index f392fc5bfa..16a1a8f2e7 100644 --- a/SRC/cpocon.f +++ b/SRC/cpocon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpoequ.f b/SRC/cpoequ.f index 7ca95f2d2b..801b8054cf 100644 --- a/SRC/cpoequ.f +++ b/SRC/cpoequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpoequb.f b/SRC/cpoequb.f index 198671200b..4042fba8cb 100644 --- a/SRC/cpoequb.f +++ b/SRC/cpoequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cporfs.f b/SRC/cporfs.f index 2485250ee8..7021a20831 100644 --- a/SRC/cporfs.f +++ b/SRC/cporfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cporfsx.f b/SRC/cporfsx.f index f285cb0f80..012d9a78d7 100644 --- a/SRC/cporfsx.f +++ b/SRC/cporfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cposv.f b/SRC/cposv.f index bf43c7f2e9..cb871a4325 100644 --- a/SRC/cposv.f +++ b/SRC/cposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cposvx.f b/SRC/cposvx.f index 654dd730b9..ddb7a901e4 100644 --- a/SRC/cposvx.f +++ b/SRC/cposvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cposvxx.f b/SRC/cposvxx.f index d3d78f3697..e7b2e42de5 100644 --- a/SRC/cposvxx.f +++ b/SRC/cposvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotf2.f b/SRC/cpotf2.f index 96bb82249a..a1b1e4deb6 100644 --- a/SRC/cpotf2.f +++ b/SRC/cpotf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrf.f b/SRC/cpotrf.f index 83307b029d..06ef4b76ae 100644 --- a/SRC/cpotrf.f +++ b/SRC/cpotrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrf2.f b/SRC/cpotrf2.f index fa016f13c1..fe9f02c498 100644 --- a/SRC/cpotrf2.f +++ b/SRC/cpotrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotri.f b/SRC/cpotri.f index 70128bda0b..3f0fe8d50b 100644 --- a/SRC/cpotri.f +++ b/SRC/cpotri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrs.f b/SRC/cpotrs.f index 046e336f85..cdcd7c165c 100644 --- a/SRC/cpotrs.f +++ b/SRC/cpotrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cppcon.f b/SRC/cppcon.f index 0dedb7bd1e..894a173542 100644 --- a/SRC/cppcon.f +++ b/SRC/cppcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cppequ.f b/SRC/cppequ.f index 40673b9b01..1a7b86b130 100644 --- a/SRC/cppequ.f +++ b/SRC/cppequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpprfs.f b/SRC/cpprfs.f index a163d996e2..796ebada68 100644 --- a/SRC/cpprfs.f +++ b/SRC/cpprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cppsv.f b/SRC/cppsv.f index 2b6dfddc22..55dc6e05cc 100644 --- a/SRC/cppsv.f +++ b/SRC/cppsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cppsvx.f b/SRC/cppsvx.f index e3bc98b21c..be2522c090 100644 --- a/SRC/cppsvx.f +++ b/SRC/cppsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptrf.f b/SRC/cpptrf.f index 5e6f94fe76..b1e5cf9874 100644 --- a/SRC/cpptrf.f +++ b/SRC/cpptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptri.f b/SRC/cpptri.f index 174a0f8ed2..0000b5fdd1 100644 --- a/SRC/cpptri.f +++ b/SRC/cpptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptrs.f b/SRC/cpptrs.f index 8ad9f6af36..148035b097 100644 --- a/SRC/cpptrs.f +++ b/SRC/cpptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpstf2.f b/SRC/cpstf2.f index 48eeed5a0f..54c836fde9 100644 --- a/SRC/cpstf2.f +++ b/SRC/cpstf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPSTF2 computes the Cholesky factorization with complete pivoting of complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cpstrf.f b/SRC/cpstrf.f index 564a273d1d..7175c03668 100644 --- a/SRC/cpstrf.f +++ b/SRC/cpstrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPSTRF computes the Cholesky factorization with complete pivoting of complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cptcon.f b/SRC/cptcon.f index 671814fd4d..757da055ea 100644 --- a/SRC/cptcon.f +++ b/SRC/cptcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpteqr.f b/SRC/cpteqr.f index 2dc9547074..a2f253517f 100644 --- a/SRC/cpteqr.f +++ b/SRC/cpteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cptrfs.f b/SRC/cptrfs.f index dca1ae634e..86cd723216 100644 --- a/SRC/cptrfs.f +++ b/SRC/cptrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cptsv.f b/SRC/cptsv.f index 020db58cce..b87a2c7da8 100644 --- a/SRC/cptsv.f +++ b/SRC/cptsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cptsvx.f b/SRC/cptsvx.f index 3db09a3199..7d2916e8c6 100644 --- a/SRC/cptsvx.f +++ b/SRC/cptsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpttrf.f b/SRC/cpttrf.f index 20a321f0a0..f9143802ce 100644 --- a/SRC/cpttrf.f +++ b/SRC/cpttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpttrs.f b/SRC/cpttrs.f index d857a4b456..9a86cc1856 100644 --- a/SRC/cpttrs.f +++ b/SRC/cpttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cptts2.f b/SRC/cptts2.f index 107d1c82dc..a7a0528745 100644 --- a/SRC/cptts2.f +++ b/SRC/cptts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/crot.f b/SRC/crot.f index 9c74e76c84..eedc9d387f 100644 --- a/SRC/crot.f +++ b/SRC/crot.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/crscl.f b/SRC/crscl.f index 22919cd62c..7e1f1fcaaa 100644 --- a/SRC/crscl.f +++ b/SRC/crscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/cspcon.f b/SRC/cspcon.f index d002530010..88443f2b16 100644 --- a/SRC/cspcon.f +++ b/SRC/cspcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cspmv.f b/SRC/cspmv.f index 3d2661974a..4efc03dce4 100644 --- a/SRC/cspmv.f +++ b/SRC/cspmv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix * * =========== DOCUMENTATION =========== diff --git a/SRC/cspr.f b/SRC/cspr.f index d4fd3fc839..ce8fa5d44c 100644 --- a/SRC/cspr.f +++ b/SRC/cspr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csprfs.f b/SRC/csprfs.f index 862c8a347a..05914923ff 100644 --- a/SRC/csprfs.f +++ b/SRC/csprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cspsv.f b/SRC/cspsv.f index ac6f9fa895..79a77be8b7 100644 --- a/SRC/cspsv.f +++ b/SRC/cspsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cspsvx.f b/SRC/cspsvx.f index 86e3bc62b3..0d4e53a57e 100644 --- a/SRC/cspsvx.f +++ b/SRC/cspsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csptrf.f b/SRC/csptrf.f index f559b8a7df..8ea6ed10b8 100644 --- a/SRC/csptrf.f +++ b/SRC/csptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/csptri.f b/SRC/csptri.f index 487daca3d3..c299918548 100644 --- a/SRC/csptri.f +++ b/SRC/csptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/csptrs.f b/SRC/csptrs.f index 592cb3be92..3288174400 100644 --- a/SRC/csptrs.f +++ b/SRC/csptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/csrscl.f b/SRC/csrscl.f index c26278a84a..a5ebf0d908 100644 --- a/SRC/csrscl.f +++ b/SRC/csrscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/cstedc.f b/SRC/cstedc.f index d7db591b3e..3e6960d5fe 100644 --- a/SRC/cstedc.f +++ b/SRC/cstedc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/cstegr.f b/SRC/cstegr.f index 718161efe7..827ed3873f 100644 --- a/SRC/cstegr.f +++ b/SRC/cstegr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/cstein.f b/SRC/cstein.f index 8e272eaf17..f627a6f6e6 100644 --- a/SRC/cstein.f +++ b/SRC/cstein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/cstemr.f b/SRC/cstemr.f index 46b20d880d..d56f829991 100644 --- a/SRC/cstemr.f +++ b/SRC/cstemr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/csteqr.f b/SRC/csteqr.f index 7d5b4fbd42..e372678139 100644 --- a/SRC/csteqr.f +++ b/SRC/csteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon.f b/SRC/csycon.f index 69a0a2b7d5..e564866ab8 100644 --- a/SRC/csycon.f +++ b/SRC/csycon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon_3.f b/SRC/csycon_3.f index 75005d008d..f810c3b242 100644 --- a/SRC/csycon_3.f +++ b/SRC/csycon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon_rook.f b/SRC/csycon_rook.f index 7996a513d2..dd7802c24c 100644 --- a/SRC/csycon_rook.f +++ b/SRC/csycon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconv.f b/SRC/csyconv.f index 974d12d84a..a6037ca307 100644 --- a/SRC/csyconv.f +++ b/SRC/csyconv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconvf.f b/SRC/csyconvf.f index c977cfa8fb..8eedd24d6e 100644 --- a/SRC/csyconvf.f +++ b/SRC/csyconvf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconvf_rook.f b/SRC/csyconvf_rook.f index 6ee7981707..3f5a6a6d4c 100644 --- a/SRC/csyconvf_rook.f +++ b/SRC/csyconvf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csyequb.f b/SRC/csyequb.f index 8c8c76eb21..ebeec8e79d 100644 --- a/SRC/csyequb.f +++ b/SRC/csyequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/csymv.f b/SRC/csymv.f index a7ff3a1f0e..cabf700e2f 100644 --- a/SRC/csymv.f +++ b/SRC/csymv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYMV computes a matrix-vector product for a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csyr.f b/SRC/csyr.f index de72dd53c2..ec37148050 100644 --- a/SRC/csyr.f +++ b/SRC/csyr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYR performs the symmetric rank-1 update of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csyrfs.f b/SRC/csyrfs.f index b800fcfc45..09e6d337f0 100644 --- a/SRC/csyrfs.f +++ b/SRC/csyrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/csyrfsx.f b/SRC/csyrfsx.f index c0d3f4e1e0..4e65d76eb0 100644 --- a/SRC/csyrfsx.f +++ b/SRC/csyrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv.f b/SRC/csysv.f index a2d1e7cbed..ffad7c9a5d 100644 --- a/SRC/csysv.f +++ b/SRC/csysv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_aa.f b/SRC/csysv_aa.f index 571a91123f..d0fadec76e 100644 --- a/SRC/csysv_aa.f +++ b/SRC/csysv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_aa_2stage.f b/SRC/csysv_aa_2stage.f index 10119d8ba3..a0c6b5520d 100644 --- a/SRC/csysv_aa_2stage.f +++ b/SRC/csysv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_rk.f b/SRC/csysv_rk.f index cb98ab1dc8..965d91d153 100644 --- a/SRC/csysv_rk.f +++ b/SRC/csysv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_rook.f b/SRC/csysv_rook.f index 8798ddfb22..f0700a12bb 100644 --- a/SRC/csysv_rook.f +++ b/SRC/csysv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysvx.f b/SRC/csysvx.f index 3c7a378892..cd87fb58b2 100644 --- a/SRC/csysvx.f +++ b/SRC/csysvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysvxx.f b/SRC/csysvxx.f index 72e11479b9..401893b0c3 100644 --- a/SRC/csysvxx.f +++ b/SRC/csysvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief CSYSVXX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csyswapr.f b/SRC/csyswapr.f index d8c547bead..9c38b4c7dd 100644 --- a/SRC/csyswapr.f +++ b/SRC/csyswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYSWAPR * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2.f b/SRC/csytf2.f index b7f219b44d..4391f3a9c6 100644 --- a/SRC/csytf2.f +++ b/SRC/csytf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2_rk.f b/SRC/csytf2_rk.f index 36b3fb8439..18896c59c7 100644 --- a/SRC/csytf2_rk.f +++ b/SRC/csytf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2_rook.f b/SRC/csytf2_rook.f index b96523df31..64b691274b 100644 --- a/SRC/csytf2_rook.f +++ b/SRC/csytf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf.f b/SRC/csytrf.f index 519e784906..53bbccefd9 100644 --- a/SRC/csytrf.f +++ b/SRC/csytrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f index cf994913dd..f04da09bbc 100644 --- a/SRC/csytrf_aa.f +++ b/SRC/csytrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_aa_2stage.f b/SRC/csytrf_aa_2stage.f index e56aedaf63..5975ad5737 100644 --- a/SRC/csytrf_aa_2stage.f +++ b/SRC/csytrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_rk.f b/SRC/csytrf_rk.f index de39bda41a..8e58541cb5 100644 --- a/SRC/csytrf_rk.f +++ b/SRC/csytrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_rook.f b/SRC/csytrf_rook.f index 72fe0629f1..fc9382fe1e 100644 --- a/SRC/csytrf_rook.f +++ b/SRC/csytrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri.f b/SRC/csytri.f index 4739a3c119..ead4c9e0f3 100644 --- a/SRC/csytri.f +++ b/SRC/csytri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri2.f b/SRC/csytri2.f index 3f11fdb62e..17a51035e8 100644 --- a/SRC/csytri2.f +++ b/SRC/csytri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri2x.f b/SRC/csytri2x.f index 0692c75f06..481029abbb 100644 --- a/SRC/csytri2x.f +++ b/SRC/csytri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_3.f b/SRC/csytri_3.f index 604d84b213..be1f5a5232 100644 --- a/SRC/csytri_3.f +++ b/SRC/csytri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_3x.f b/SRC/csytri_3x.f index 1a57f3f0de..a3ae6a34df 100644 --- a/SRC/csytri_3x.f +++ b/SRC/csytri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_rook.f b/SRC/csytri_rook.f index 1301a269ec..9aea579d6d 100644 --- a/SRC/csytri_rook.f +++ b/SRC/csytri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs.f b/SRC/csytrs.f index 6552e7a501..e84a7e4680 100644 --- a/SRC/csytrs.f +++ b/SRC/csytrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs2.f b/SRC/csytrs2.f index 69b8f41d5f..d4f0f0fcfc 100644 --- a/SRC/csytrs2.f +++ b/SRC/csytrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_3.f b/SRC/csytrs_3.f index 1111863e6a..1857589283 100644 --- a/SRC/csytrs_3.f +++ b/SRC/csytrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_aa.f b/SRC/csytrs_aa.f index 7f63539a65..638df1c5d3 100644 --- a/SRC/csytrs_aa.f +++ b/SRC/csytrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_aa_2stage.f b/SRC/csytrs_aa_2stage.f index 0ffeffdc2c..ec98a7c774 100644 --- a/SRC/csytrs_aa_2stage.f +++ b/SRC/csytrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_rook.f b/SRC/csytrs_rook.f index 280ec031a2..55eccaa49d 100644 --- a/SRC/csytrs_rook.f +++ b/SRC/csytrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbcon.f b/SRC/ctbcon.f index 796bc0571f..d64625c833 100644 --- a/SRC/ctbcon.f +++ b/SRC/ctbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbrfs.f b/SRC/ctbrfs.f index d60c07d8bc..d4423bea6e 100644 --- a/SRC/ctbrfs.f +++ b/SRC/ctbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbtrs.f b/SRC/ctbtrs.f index 576353ce49..354e2aab2a 100644 --- a/SRC/ctbtrs.f +++ b/SRC/ctbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfsm.f b/SRC/ctfsm.f index a1e2431090..237400e2b7 100644 --- a/SRC/ctfsm.f +++ b/SRC/ctfsm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctftri.f b/SRC/ctftri.f index c27c4b3f42..b5c437654a 100644 --- a/SRC/ctftri.f +++ b/SRC/ctftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfttp.f b/SRC/ctfttp.f index 4254cc7cf0..2f4421ada5 100644 --- a/SRC/ctfttp.f +++ b/SRC/ctfttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfttr.f b/SRC/ctfttr.f index 13bfd770b8..bede02f249 100644 --- a/SRC/ctfttr.f +++ b/SRC/ctfttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgevc.f b/SRC/ctgevc.f index e885a29d85..9aac91aebf 100644 --- a/SRC/ctgevc.f +++ b/SRC/ctgevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgex2.f b/SRC/ctgex2.f index f7d4e28f15..1e8d2b1134 100644 --- a/SRC/ctgex2.f +++ b/SRC/ctgex2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an unitary equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgexc.f b/SRC/ctgexc.f index 109044d36f..4da8bb5869 100644 --- a/SRC/ctgexc.f +++ b/SRC/ctgexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsen.f b/SRC/ctgsen.f index 180e96b322..87dcf9f5c7 100644 --- a/SRC/ctgsen.f +++ b/SRC/ctgsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsja.f b/SRC/ctgsja.f index ded801a813..9bb58afab5 100644 --- a/SRC/ctgsja.f +++ b/SRC/ctgsja.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsna.f b/SRC/ctgsna.f index 50498c4139..f6b015748e 100644 --- a/SRC/ctgsna.f +++ b/SRC/ctgsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsy2.f b/SRC/ctgsy2.f index ed67bf2f9b..aeb24f125c 100644 --- a/SRC/ctgsy2.f +++ b/SRC/ctgsy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsyl.f b/SRC/ctgsyl.f index 620556399e..64b8da08c6 100644 --- a/SRC/ctgsyl.f +++ b/SRC/ctgsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpcon.f b/SRC/ctpcon.f index 6d2b541ee4..2c2e045a70 100644 --- a/SRC/ctpcon.f +++ b/SRC/ctpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctplqt.f b/SRC/ctplqt.f index a9f188526a..5e687ace51 100644 --- a/SRC/ctplqt.f +++ b/SRC/ctplqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPLQT * * Definition: diff --git a/SRC/ctplqt2.f b/SRC/ctplqt2.f index e299fa53ea..f17f9f9f6d 100644 --- a/SRC/ctplqt2.f +++ b/SRC/ctplqt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPLQT2 * * Definition: diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f index e1e9edea2f..717e3214de 100644 --- a/SRC/ctpmlqt.f +++ b/SRC/ctpmlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPMLQT * * Definition: diff --git a/SRC/ctpmqrt.f b/SRC/ctpmqrt.f index de73fd46e0..9c92acb769 100644 --- a/SRC/ctpmqrt.f +++ b/SRC/ctpmqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpqrt.f b/SRC/ctpqrt.f index f20168eebd..14d5343e8e 100644 --- a/SRC/ctpqrt.f +++ b/SRC/ctpqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpqrt2.f b/SRC/ctpqrt2.f index 581f2584f9..c3178c62c8 100644 --- a/SRC/ctpqrt2.f +++ b/SRC/ctpqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctprfb.f b/SRC/ctprfb.f index bb7798a30b..45bef1b02f 100644 --- a/SRC/ctprfb.f +++ b/SRC/ctprfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPRFB applies a complex "triangular-pentagonal" block reflector to a complex matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctprfs.f b/SRC/ctprfs.f index b7bb1ea9fb..845d489a01 100644 --- a/SRC/ctprfs.f +++ b/SRC/ctprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctptri.f b/SRC/ctptri.f index 928104684c..f1f54729b6 100644 --- a/SRC/ctptri.f +++ b/SRC/ctptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctptrs.f b/SRC/ctptrs.f index 515a205775..d9a1ede55f 100644 --- a/SRC/ctptrs.f +++ b/SRC/ctptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpttf.f b/SRC/ctpttf.f index a1431a6093..0c4abe4652 100644 --- a/SRC/ctpttf.f +++ b/SRC/ctpttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpttr.f b/SRC/ctpttr.f index 628f7f246f..209a746bc2 100644 --- a/SRC/ctpttr.f +++ b/SRC/ctpttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrcon.f b/SRC/ctrcon.f index 1aa19c2a2d..afea0f8d53 100644 --- a/SRC/ctrcon.f +++ b/SRC/ctrcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrevc.f b/SRC/ctrevc.f index 7ea2d00d4a..220dda97fb 100644 --- a/SRC/ctrevc.f +++ b/SRC/ctrevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index 13cbf553fc..7fe0f23ad2 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrexc.f b/SRC/ctrexc.f index f71cd5070b..d322e86746 100644 --- a/SRC/ctrexc.f +++ b/SRC/ctrexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrrfs.f b/SRC/ctrrfs.f index 2ff09a6f15..52dea48751 100644 --- a/SRC/ctrrfs.f +++ b/SRC/ctrrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsen.f b/SRC/ctrsen.f index 9d59f6bf2b..524ea25613 100644 --- a/SRC/ctrsen.f +++ b/SRC/ctrsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsna.f b/SRC/ctrsna.f index 270bec6d70..759a15138d 100644 --- a/SRC/ctrsna.f +++ b/SRC/ctrsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsyl.f b/SRC/ctrsyl.f index be52552b5f..f1a221bb8b 100644 --- a/SRC/ctrsyl.f +++ b/SRC/ctrsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index 5e42fc39ef..10576d8f90 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRSYL3 * * Definition: diff --git a/SRC/ctrti2.f b/SRC/ctrti2.f index 54681a3407..33aa8aa869 100644 --- a/SRC/ctrti2.f +++ b/SRC/ctrti2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrtri.f b/SRC/ctrtri.f index f72c4e5792..ebac52fe68 100644 --- a/SRC/ctrtri.f +++ b/SRC/ctrtri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrtrs.f b/SRC/ctrtrs.f index 75975d3a66..7db08f63ce 100644 --- a/SRC/ctrtrs.f +++ b/SRC/ctrtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrttf.f b/SRC/ctrttf.f index 655b689687..b6673b3c61 100644 --- a/SRC/ctrttf.f +++ b/SRC/ctrttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrttp.f b/SRC/ctrttp.f index e38f01e3d5..c7bb9f68dc 100644 --- a/SRC/ctrttp.f +++ b/SRC/ctrttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctzrzf.f b/SRC/ctzrzf.f index ac3f59400b..ac85cce30a 100644 --- a/SRC/ctzrzf.f +++ b/SRC/ctzrzf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index b45dcfde6f..980028bf2b 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb1.f b/SRC/cunbdb1.f index a4875ab5ba..937b3cb200 100644 --- a/SRC/cunbdb1.f +++ b/SRC/cunbdb1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f index 6399964f8d..7ee8bb867a 100644 --- a/SRC/cunbdb2.f +++ b/SRC/cunbdb2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb3.f b/SRC/cunbdb3.f index d024605979..e648899f09 100644 --- a/SRC/cunbdb3.f +++ b/SRC/cunbdb3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f index 33acc1ee51..0bdec660bd 100644 --- a/SRC/cunbdb4.f +++ b/SRC/cunbdb4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb5.f b/SRC/cunbdb5.f index 22513cf8b1..4d611928bc 100644 --- a/SRC/cunbdb5.f +++ b/SRC/cunbdb5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb6.f b/SRC/cunbdb6.f index 566fd76b7c..9575d5f441 100644 --- a/SRC/cunbdb6.f +++ b/SRC/cunbdb6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/cuncsd.f b/SRC/cuncsd.f index 003daaab43..5d6531050b 100644 --- a/SRC/cuncsd.f +++ b/SRC/cuncsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/cuncsd2by1.f b/SRC/cuncsd2by1.f index 128e82cecf..80b3635230 100644 --- a/SRC/cuncsd2by1.f +++ b/SRC/cuncsd2by1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/cung2l.f b/SRC/cung2l.f index 7b9fb5c228..fb263f20f5 100644 --- a/SRC/cung2l.f +++ b/SRC/cung2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cung2r.f b/SRC/cung2r.f index d854ed437f..6e86c4e507 100644 --- a/SRC/cung2r.f +++ b/SRC/cung2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNG2R * * =========== DOCUMENTATION =========== diff --git a/SRC/cungbr.f b/SRC/cungbr.f index 2f0208fdb7..f4b2b3be8c 100644 --- a/SRC/cungbr.f +++ b/SRC/cungbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunghr.f b/SRC/cunghr.f index 3aa3fb1ae7..b6df366dba 100644 --- a/SRC/cunghr.f +++ b/SRC/cunghr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungl2.f b/SRC/cungl2.f index 4e5042b636..3870b21cb7 100644 --- a/SRC/cungl2.f +++ b/SRC/cungl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunglq.f b/SRC/cunglq.f index 3537150543..df9a62a883 100644 --- a/SRC/cunglq.f +++ b/SRC/cunglq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cungql.f b/SRC/cungql.f index ed2f6803c7..9e87a28662 100644 --- a/SRC/cungql.f +++ b/SRC/cungql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/cungqr.f b/SRC/cungqr.f index b6e8cc59a6..55dc3d334f 100644 --- a/SRC/cungqr.f +++ b/SRC/cungqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungr2.f b/SRC/cungr2.f index 1e99911121..28d114d4c8 100644 --- a/SRC/cungr2.f +++ b/SRC/cungr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cungrq.f b/SRC/cungrq.f index aceaac0b8f..bbebe2dfbf 100644 --- a/SRC/cungrq.f +++ b/SRC/cungrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtr.f b/SRC/cungtr.f index 27f1973406..94ec42ce34 100644 --- a/SRC/cungtr.f +++ b/SRC/cungtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtsqr.f b/SRC/cungtsqr.f index 22f21d5e6d..6457c6b6ef 100644 --- a/SRC/cungtsqr.f +++ b/SRC/cungtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtsqr_row.f b/SRC/cungtsqr_row.f index 4515440a16..560325e453 100644 --- a/SRC/cungtsqr_row.f +++ b/SRC/cungtsqr_row.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/cunhr_col.f b/SRC/cunhr_col.f index 9d5f560439..42b86ca448 100644 --- a/SRC/cunhr_col.f +++ b/SRC/cunhr_col.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm22.f b/SRC/cunm22.f index ca82117098..bb29b199d1 100644 --- a/SRC/cunm22.f +++ b/SRC/cunm22.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNM22 multiplies a general matrix by a banded unitary matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm2l.f b/SRC/cunm2l.f index 238b73525e..8faadfde3e 100644 --- a/SRC/cunm2l.f +++ b/SRC/cunm2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index 684ae9c3c0..fecebcea0d 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmbr.f b/SRC/cunmbr.f index a21c486e9a..fed5d75db3 100644 --- a/SRC/cunmbr.f +++ b/SRC/cunmbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmhr.f b/SRC/cunmhr.f index 29bb631f1a..5948567fef 100644 --- a/SRC/cunmhr.f +++ b/SRC/cunmhr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunml2.f b/SRC/cunml2.f index a00ce5ff0c..8b54b6cb8a 100644 --- a/SRC/cunml2.f +++ b/SRC/cunml2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNML2 multiplies a general matrix by the unitary matrix from a LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmlq.f b/SRC/cunmlq.f index 4da1af1d5b..f61c8d5bb7 100644 --- a/SRC/cunmlq.f +++ b/SRC/cunmlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmql.f b/SRC/cunmql.f index 84fc29d327..60fc5b0de8 100644 --- a/SRC/cunmql.f +++ b/SRC/cunmql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmqr.f b/SRC/cunmqr.f index 7d85a861fa..a8c5e7708a 100644 --- a/SRC/cunmqr.f +++ b/SRC/cunmqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmr2.f b/SRC/cunmr2.f index de83b7c58b..64caed8778 100644 --- a/SRC/cunmr2.f +++ b/SRC/cunmr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMR2 multiplies a general matrix by the unitary matrix from a RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmr3.f b/SRC/cunmr3.f index 15fd6df89d..9cb111f8be 100644 --- a/SRC/cunmr3.f +++ b/SRC/cunmr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMR3 multiplies a general matrix by the unitary matrix from a RZ factorization determined by ctzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmrq.f b/SRC/cunmrq.f index f02cfd9a99..df600c90dd 100644 --- a/SRC/cunmrq.f +++ b/SRC/cunmrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmrz.f b/SRC/cunmrz.f index 9ccf1878b7..60f1d5e507 100644 --- a/SRC/cunmrz.f +++ b/SRC/cunmrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmtr.f b/SRC/cunmtr.f index 6eafc15c42..f508e1ab2a 100644 --- a/SRC/cunmtr.f +++ b/SRC/cunmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUNMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cupgtr.f b/SRC/cupgtr.f index 4370cdeacf..70fe6b5d5b 100644 --- a/SRC/cupgtr.f +++ b/SRC/cupgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cupmtr.f b/SRC/cupmtr.f index 8e0dff80cd..f383c0401c 100644 --- a/SRC/cupmtr.f +++ b/SRC/cupmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CUPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dbbcsd.f b/SRC/dbbcsd.f index 49a73a13e8..c0bbf21db5 100644 --- a/SRC/dbbcsd.f +++ b/SRC/dbbcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsdc.f b/SRC/dbdsdc.f index 0003f31fb4..613c610a2d 100644 --- a/SRC/dbdsdc.f +++ b/SRC/dbdsdc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DBDSDC * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsqr.f b/SRC/dbdsqr.f index 395f7bd88d..68f1235745 100644 --- a/SRC/dbdsqr.f +++ b/SRC/dbdsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsvdx.f b/SRC/dbdsvdx.f index a212efe66a..be20285fdf 100644 --- a/SRC/dbdsvdx.f +++ b/SRC/dbdsvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DBDSVDX * * =========== DOCUMENTATION =========== diff --git a/SRC/ddisna.f b/SRC/ddisna.f index 0e026f55d1..92e572cf98 100644 --- a/SRC/ddisna.f +++ b/SRC/ddisna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DDISNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbbrd.f b/SRC/dgbbrd.f index 7cfc750246..3f04cd9016 100644 --- a/SRC/dgbbrd.f +++ b/SRC/dgbbrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbcon.f b/SRC/dgbcon.f index 135eadd95e..4471ca7ce4 100644 --- a/SRC/dgbcon.f +++ b/SRC/dgbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbequ.f b/SRC/dgbequ.f index 3a0f275fa0..091942c7a0 100644 --- a/SRC/dgbequ.f +++ b/SRC/dgbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbequb.f b/SRC/dgbequb.f index da1c1d80fa..8c69bc57cd 100644 --- a/SRC/dgbequb.f +++ b/SRC/dgbequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbrfs.f b/SRC/dgbrfs.f index edc2df6318..6fca00075f 100644 --- a/SRC/dgbrfs.f +++ b/SRC/dgbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbrfsx.f b/SRC/dgbrfsx.f index 87ac7c30c0..9085b12c76 100644 --- a/SRC/dgbrfsx.f +++ b/SRC/dgbrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsv.f b/SRC/dgbsv.f index 4e833e928e..8639ada7d2 100644 --- a/SRC/dgbsv.f +++ b/SRC/dgbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsvx.f b/SRC/dgbsvx.f index 3383af61b5..5f2ea6bb13 100644 --- a/SRC/dgbsvx.f +++ b/SRC/dgbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsvxx.f b/SRC/dgbsvxx.f index 49bd6cae10..725fb8f7a5 100644 --- a/SRC/dgbsvxx.f +++ b/SRC/dgbsvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtf2.f b/SRC/dgbtf2.f index 4d149642a2..26597c540e 100644 --- a/SRC/dgbtf2.f +++ b/SRC/dgbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtrf.f b/SRC/dgbtrf.f index c8b3bdff16..523879717a 100644 --- a/SRC/dgbtrf.f +++ b/SRC/dgbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtrs.f b/SRC/dgbtrs.f index c1992dda45..beabcf4cdc 100644 --- a/SRC/dgbtrs.f +++ b/SRC/dgbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebak.f b/SRC/dgebak.f index ef03298c1f..4d85c529a0 100644 --- a/SRC/dgebak.f +++ b/SRC/dgebak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebal.f b/SRC/dgebal.f index d2c9922fab..f7d70468a5 100644 --- a/SRC/dgebal.f +++ b/SRC/dgebal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebd2.f b/SRC/dgebd2.f index f0014578fb..0f3ff21041 100644 --- a/SRC/dgebd2.f +++ b/SRC/dgebd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebrd.f b/SRC/dgebrd.f index ac11d48a0b..d82d34b810 100644 --- a/SRC/dgebrd.f +++ b/SRC/dgebrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgecon.f b/SRC/dgecon.f index a543eb03a3..96eecec248 100644 --- a/SRC/dgecon.f +++ b/SRC/dgecon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgedmd.f90 b/SRC/dgedmd.f90 index 9c4afd182d..9d43ded556 100644 --- a/SRC/dgedmd.f90 +++ b/SRC/dgedmd.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b DGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dgedmdq.f90 b/SRC/dgedmdq.f90 index b1fb62b44a..f3596cdab2 100644 --- a/SRC/dgedmdq.f90 +++ b/SRC/dgedmdq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dgeequ.f b/SRC/dgeequ.f index 8306ae9d1a..520973c139 100644 --- a/SRC/dgeequ.f +++ b/SRC/dgeequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeequb.f b/SRC/dgeequb.f index b0f40687a0..49b46f5fc8 100644 --- a/SRC/dgeequb.f +++ b/SRC/dgeequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dgees.f b/SRC/dgees.f index 34ffc8e2a5..a87151075b 100644 --- a/SRC/dgees.f +++ b/SRC/dgees.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeesx.f b/SRC/dgeesx.f index 83a6ea8c00..3ebd66e743 100644 --- a/SRC/dgeesx.f +++ b/SRC/dgeesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 64cd31c792..c6fad12bd4 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index 8d5c691992..240144c096 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgehd2.f b/SRC/dgehd2.f index 62417aa8c1..d777cc7b03 100644 --- a/SRC/dgehd2.f +++ b/SRC/dgehd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index d95bbd1827..23c2ebbdf1 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f index 42afb084fd..d6162aaab6 100644 --- a/SRC/dgejsv.f +++ b/SRC/dgejsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelq.f b/SRC/dgelq.f index 255e8732f2..c475b8c083 100644 --- a/SRC/dgelq.f +++ b/SRC/dgelq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGELQ * * Definition: diff --git a/SRC/dgelq2.f b/SRC/dgelq2.f index a07ae4df7f..ef8d5d59d4 100644 --- a/SRC/dgelq2.f +++ b/SRC/dgelq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index f0eb00a55d..54b9b84c78 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqt.f b/SRC/dgelqt.f index fa33f0d885..2bab6db467 100644 --- a/SRC/dgelqt.f +++ b/SRC/dgelqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGELQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqt3.f b/SRC/dgelqt3.f index 857b1b71de..df41bb3b54 100644 --- a/SRC/dgelqt3.f +++ b/SRC/dgelqt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgels.f b/SRC/dgels.f index 17878825af..164e2a7185 100644 --- a/SRC/dgels.f +++ b/SRC/dgels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelsd.f b/SRC/dgelsd.f index 7dc564f481..6f256ca956 100644 --- a/SRC/dgelsd.f +++ b/SRC/dgelsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelss.f b/SRC/dgelss.f index 38449be7f6..af5976793d 100644 --- a/SRC/dgelss.f +++ b/SRC/dgelss.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelst.f b/SRC/dgelst.f index eefac16cdd..ed561e5454 100644 --- a/SRC/dgelst.f +++ b/SRC/dgelst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelsy.f b/SRC/dgelsy.f index f2a10c0926..9bf35ad1fa 100644 --- a/SRC/dgelsy.f +++ b/SRC/dgelsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f index 757683f467..2f4afd40ba 100644 --- a/SRC/dgemlq.f +++ b/SRC/dgemlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEMLQ * * Definition: diff --git a/SRC/dgemlqt.f b/SRC/dgemlqt.f index e341343959..b71da1315c 100644 --- a/SRC/dgemlqt.f +++ b/SRC/dgemlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f index 6088154837..ff662b3c7d 100644 --- a/SRC/dgemqr.f +++ b/SRC/dgemqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEMQR * * Definition: diff --git a/SRC/dgemqrt.f b/SRC/dgemqrt.f index bf7a0e001b..705b97f718 100644 --- a/SRC/dgemqrt.f +++ b/SRC/dgemqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeql2.f b/SRC/dgeql2.f index d087ac29f4..ef196de9ad 100644 --- a/SRC/dgeql2.f +++ b/SRC/dgeql2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index a72d9dc766..0373d9cbfe 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqp3.f b/SRC/dgeqp3.f index 9da7b2c428..9e2a089426 100644 --- a/SRC/dgeqp3.f +++ b/SRC/dgeqp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f index 6ed8f211f1..4f7b79d1ca 100644 --- a/SRC/dgeqr.f +++ b/SRC/dgeqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQR * * Definition: diff --git a/SRC/dgeqr2.f b/SRC/dgeqr2.f index bd4facfce7..645dc61227 100644 --- a/SRC/dgeqr2.f +++ b/SRC/dgeqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqr2p.f b/SRC/dgeqr2p.f index b2f3188f3f..a3966474f1 100644 --- a/SRC/dgeqr2p.f +++ b/SRC/dgeqr2p.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrf.f b/SRC/dgeqrf.f index c005d47af5..ab1e68bab7 100644 --- a/SRC/dgeqrf.f +++ b/SRC/dgeqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f index aa757e96cf..a78338e269 100644 --- a/SRC/dgeqrfp.f +++ b/SRC/dgeqrfp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt.f b/SRC/dgeqrt.f index 1128760aff..690a443562 100644 --- a/SRC/dgeqrt.f +++ b/SRC/dgeqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt2.f b/SRC/dgeqrt2.f index b200b5d1c9..1b78efe069 100644 --- a/SRC/dgeqrt2.f +++ b/SRC/dgeqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt3.f b/SRC/dgeqrt3.f index d289aeff8f..816084da86 100644 --- a/SRC/dgeqrt3.f +++ b/SRC/dgeqrt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerfs.f b/SRC/dgerfs.f index 9e27498881..57f82f5b5f 100644 --- a/SRC/dgerfs.f +++ b/SRC/dgerfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerfsx.f b/SRC/dgerfsx.f index 727c81a915..47d3dfb153 100644 --- a/SRC/dgerfsx.f +++ b/SRC/dgerfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerq2.f b/SRC/dgerq2.f index a4ef46d854..426bc567d4 100644 --- a/SRC/dgerq2.f +++ b/SRC/dgerq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 435239cc79..ca65a32655 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesc2.f b/SRC/dgesc2.f index 11f83ae9e6..59ea9f9497 100644 --- a/SRC/dgesc2.f +++ b/SRC/dgesc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesdd.f b/SRC/dgesdd.f index 940f2a2913..b39e6e6f53 100644 --- a/SRC/dgesdd.f +++ b/SRC/dgesdd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesv.f b/SRC/dgesv.f index 9bd574e5cc..ece84e2c8f 100644 --- a/SRC/dgesv.f +++ b/SRC/dgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \addtogroup gesv *> *> \brief DGESV computes the solution to system of linear equations A * X = B for GE matrices diff --git a/SRC/dgesvd.f b/SRC/dgesvd.f index e91ebce9a4..4d0049e47f 100644 --- a/SRC/dgesvd.f +++ b/SRC/dgesvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvdq.f b/SRC/dgesvdq.f index 9b08d64990..586c3e4a21 100644 --- a/SRC/dgesvdq.f +++ b/SRC/dgesvdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvdx.f b/SRC/dgesvdx.f index 76d02c8b50..d5caea0a4d 100644 --- a/SRC/dgesvdx.f +++ b/SRC/dgesvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvj.f b/SRC/dgesvj.f index 198bfb0a50..319bb29cf5 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvx.f b/SRC/dgesvx.f index 6f1cbc309b..54f4f4e11a 100644 --- a/SRC/dgesvx.f +++ b/SRC/dgesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvxx.f b/SRC/dgesvxx.f index f810e22b87..3c3cb0c45f 100644 --- a/SRC/dgesvxx.f +++ b/SRC/dgesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetc2.f b/SRC/dgetc2.f index 8ee83328c4..79535ea54f 100644 --- a/SRC/dgetc2.f +++ b/SRC/dgetc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetf2.f b/SRC/dgetf2.f index 60dc33d16f..121a73430b 100644 --- a/SRC/dgetf2.f +++ b/SRC/dgetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrf.f b/SRC/dgetrf.f index 42b3a4f6fe..68222fb8b9 100644 --- a/SRC/dgetrf.f +++ b/SRC/dgetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrf2.f b/SRC/dgetrf2.f index 64b92030d2..ad7df02073 100644 --- a/SRC/dgetrf2.f +++ b/SRC/dgetrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetri.f b/SRC/dgetri.f index 7b5a3a1b6c..92a4247795 100644 --- a/SRC/dgetri.f +++ b/SRC/dgetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrs.f b/SRC/dgetrs.f index 36c0f27063..c03e3bcd33 100644 --- a/SRC/dgetrs.f +++ b/SRC/dgetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index 73b505ff7e..7b35b0f20f 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETSLS * * Definition: diff --git a/SRC/dgetsqrhrt.f b/SRC/dgetsqrhrt.f index 682c7c30fa..53734796f5 100644 --- a/SRC/dgetsqrhrt.f +++ b/SRC/dgetsqrhrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dggbak.f b/SRC/dggbak.f index e881159612..1779a3537f 100644 --- a/SRC/dggbak.f +++ b/SRC/dggbak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/dggbal.f b/SRC/dggbal.f index 308fc5bbd8..8dff4d2dfa 100644 --- a/SRC/dggbal.f +++ b/SRC/dggbal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/dgges.f b/SRC/dgges.f index b9ffc79827..fa97ec1f03 100644 --- a/SRC/dgges.f +++ b/SRC/dgges.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgges3.f b/SRC/dgges3.f index 2ef55951a3..b6b2c29c68 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/dggesx.f b/SRC/dggesx.f index 7eb59d5ab9..d66aa0b827 100644 --- a/SRC/dggesx.f +++ b/SRC/dggesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggev.f b/SRC/dggev.f index 3e42099101..961b503a2d 100644 --- a/SRC/dggev.f +++ b/SRC/dggev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggev3.f b/SRC/dggev3.f index b970c04c4e..44e616a031 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/dggevx.f b/SRC/dggevx.f index 74e01d59de..e41e4df599 100644 --- a/SRC/dggevx.f +++ b/SRC/dggevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggglm.f b/SRC/dggglm.f index c39dfe24dc..6b13fdb6bb 100644 --- a/SRC/dggglm.f +++ b/SRC/dggglm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f index 21a6685734..345e24d263 100644 --- a/SRC/dgghd3.f +++ b/SRC/dgghd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgghrd.f b/SRC/dgghrd.f index 8cf4c10ed5..d4936fbefc 100644 --- a/SRC/dgghrd.f +++ b/SRC/dgghrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgglse.f b/SRC/dgglse.f index 3bcb5f96e0..b46eab5201 100644 --- a/SRC/dgglse.f +++ b/SRC/dgglse.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggqrf.f b/SRC/dggqrf.f index edac7f22f2..43bf3be1d6 100644 --- a/SRC/dggqrf.f +++ b/SRC/dggqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dggrqf.f b/SRC/dggrqf.f index 3b1024c1cd..df4b440636 100644 --- a/SRC/dggrqf.f +++ b/SRC/dggrqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dggsvd3.f b/SRC/dggsvd3.f index ee4d11e86f..038caa51d1 100644 --- a/SRC/dggsvd3.f +++ b/SRC/dggsvd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggsvp3.f b/SRC/dggsvp3.f index 485d95b369..8672d694a0 100644 --- a/SRC/dggsvp3.f +++ b/SRC/dggsvp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgsvj0.f b/SRC/dgsvj0.f index 91c4cbcc18..5ea44afaf6 100644 --- a/SRC/dgsvj0.f +++ b/SRC/dgsvj0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGSVJ0 pre-processor for the routine dgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgsvj1.f b/SRC/dgsvj1.f index 9fedc4eff1..8e22c53cc6 100644 --- a/SRC/dgsvj1.f +++ b/SRC/dgsvj1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGSVJ1 pre-processor for the routine dgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtcon.f b/SRC/dgtcon.f index af9b90068e..ef5ad2089e 100644 --- a/SRC/dgtcon.f +++ b/SRC/dgtcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtrfs.f b/SRC/dgtrfs.f index ae272ec407..05765004e2 100644 --- a/SRC/dgtrfs.f +++ b/SRC/dgtrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtsv.f b/SRC/dgtsv.f index 16168b8625..ec4311d94b 100644 --- a/SRC/dgtsv.f +++ b/SRC/dgtsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtsvx.f b/SRC/dgtsvx.f index be3a33fdfe..510dc7b9ef 100644 --- a/SRC/dgtsvx.f +++ b/SRC/dgtsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgttrf.f b/SRC/dgttrf.f index 996a691d80..3bbd9a0cff 100644 --- a/SRC/dgttrf.f +++ b/SRC/dgttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgttrs.f b/SRC/dgttrs.f index f99eede8fe..1b6243e027 100644 --- a/SRC/dgttrs.f +++ b/SRC/dgttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtts2.f b/SRC/dgtts2.f index 3be6bb0c4c..d079fb270d 100644 --- a/SRC/dgtts2.f +++ b/SRC/dgtts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/dhgeqz.f b/SRC/dhgeqz.f index f812ba3b67..23c4fdf133 100644 --- a/SRC/dhgeqz.f +++ b/SRC/dhgeqz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dhsein.f b/SRC/dhsein.f index 82d4660bf9..e9866740a8 100644 --- a/SRC/dhsein.f +++ b/SRC/dhsein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/dhseqr.f b/SRC/dhseqr.f index 19df29913c..2898061c2e 100644 --- a/SRC/dhseqr.f +++ b/SRC/dhseqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/disnan.f b/SRC/disnan.f index fd59cfd5c1..6f66991733 100644 --- a/SRC/disnan.f +++ b/SRC/disnan.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DISNAN tests input for NaN. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbamv.f b/SRC/dla_gbamv.f index 5abeb4a146..2cf80df48d 100644 --- a/SRC/dla_gbamv.f +++ b/SRC/dla_gbamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrcond.f b/SRC/dla_gbrcond.f index bddd55f13a..921151c05d 100644 --- a/SRC/dla_gbrcond.f +++ b/SRC/dla_gbrcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GBRCOND estimates the Skeel condition number for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrfsx_extended.f b/SRC/dla_gbrfsx_extended.f index e344785d28..628a7c1448 100644 --- a/SRC/dla_gbrfsx_extended.f +++ b/SRC/dla_gbrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrpvgrw.f b/SRC/dla_gbrpvgrw.f index 8bc8dc2702..1dae92692d 100644 --- a/SRC/dla_gbrpvgrw.f +++ b/SRC/dla_gbrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_geamv.f b/SRC/dla_geamv.f index faa08ef3eb..3d747502d6 100644 --- a/SRC/dla_geamv.f +++ b/SRC/dla_geamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gercond.f b/SRC/dla_gercond.f index 1c61604ed6..8ff83f7e32 100644 --- a/SRC/dla_gercond.f +++ b/SRC/dla_gercond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GERCOND estimates the Skeel condition number for a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gerfsx_extended.f b/SRC/dla_gerfsx_extended.f index c31afd446d..e482f6f19f 100644 --- a/SRC/dla_gerfsx_extended.f +++ b/SRC/dla_gerfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GERFSX_EXTENDED improves the computed solution to a system of linear equations for general matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gerpvgrw.f b/SRC/dla_gerpvgrw.f index d0f7868766..bbade21c3e 100644 --- a/SRC/dla_gerpvgrw.f +++ b/SRC/dla_gerpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_GERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_lin_berr.f b/SRC/dla_lin_berr.f index 3b3891c7c4..dcf8eb285c 100644 --- a/SRC/dla_lin_berr.f +++ b/SRC/dla_lin_berr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porcond.f b/SRC/dla_porcond.f index 62b8dbc909..997cffe14c 100644 --- a/SRC/dla_porcond.f +++ b/SRC/dla_porcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porfsx_extended.f b/SRC/dla_porfsx_extended.f index f074e738a3..33e73fa43a 100644 --- a/SRC/dla_porfsx_extended.f +++ b/SRC/dla_porfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porpvgrw.f b/SRC/dla_porpvgrw.f index e2d8b06fcc..46b81d1745 100644 --- a/SRC/dla_porpvgrw.f +++ b/SRC/dla_porpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syamv.f b/SRC/dla_syamv.f index 8172276064..54f006c819 100644 --- a/SRC/dla_syamv.f +++ b/SRC/dla_syamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrcond.f b/SRC/dla_syrcond.f index 51da19d897..bf383056a8 100644 --- a/SRC/dla_syrcond.f +++ b/SRC/dla_syrcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrfsx_extended.f b/SRC/dla_syrfsx_extended.f index 59f112da0b..cbe24023d2 100644 --- a/SRC/dla_syrfsx_extended.f +++ b/SRC/dla_syrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrpvgrw.f b/SRC/dla_syrpvgrw.f index f6a235e531..64a8875a5e 100644 --- a/SRC/dla_syrpvgrw.f +++ b/SRC/dla_syrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_wwaddw.f b/SRC/dla_wwaddw.f index 2acadad65f..6d1c05b6d6 100644 --- a/SRC/dla_wwaddw.f +++ b/SRC/dla_wwaddw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlabad.f b/SRC/dlabad.f index da90494cc6..6dac3c9fd2 100644 --- a/SRC/dlabad.f +++ b/SRC/dlabad.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLABAD * * =========== DOCUMENTATION =========== diff --git a/SRC/dlabrd.f b/SRC/dlabrd.f index 746c10327f..578b7d74f8 100644 --- a/SRC/dlabrd.f +++ b/SRC/dlabrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacn2.f b/SRC/dlacn2.f index d6af03d8c9..5135875803 100644 --- a/SRC/dlacn2.f +++ b/SRC/dlacn2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacon.f b/SRC/dlacon.f index cfef6ba707..3447734c96 100644 --- a/SRC/dlacon.f +++ b/SRC/dlacon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacpy.f b/SRC/dlacpy.f index c6abfc62a5..bdda4bbaf5 100644 --- a/SRC/dlacpy.f +++ b/SRC/dlacpy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/dladiv.f b/SRC/dladiv.f index a0fbe1a618..d48bd85d05 100644 --- a/SRC/dladiv.f +++ b/SRC/dladiv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlae2.f b/SRC/dlae2.f index ab93c46d60..9a8f193f94 100644 --- a/SRC/dlae2.f +++ b/SRC/dlae2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaebz.f b/SRC/dlaebz.f index 9f86752d35..db94799317 100644 --- a/SRC/dlaebz.f +++ b/SRC/dlaebz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed0.f b/SRC/dlaed0.f index 61fe7a3507..b1ec938a94 100644 --- a/SRC/dlaed0.f +++ b/SRC/dlaed0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED0 used by DSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed1.f b/SRC/dlaed1.f index 4aaaded5eb..15926c53a3 100644 --- a/SRC/dlaed1.f +++ b/SRC/dlaed1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED1 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed2.f b/SRC/dlaed2.f index 45a77b3a23..82994f51ab 100644 --- a/SRC/dlaed2.f +++ b/SRC/dlaed2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED2 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed3.f b/SRC/dlaed3.f index f69169f4ab..2888ff9ae3 100644 --- a/SRC/dlaed3.f +++ b/SRC/dlaed3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED3 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed4.f b/SRC/dlaed4.f index a351d7eb79..84b44d22d6 100644 --- a/SRC/dlaed4.f +++ b/SRC/dlaed4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED4 used by DSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed5.f b/SRC/dlaed5.f index 29e4f707cd..d644e4f57d 100644 --- a/SRC/dlaed5.f +++ b/SRC/dlaed5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED5 used by DSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed6.f b/SRC/dlaed6.f index 345931d5b6..d536da4022 100644 --- a/SRC/dlaed6.f +++ b/SRC/dlaed6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED6 used by DSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed7.f b/SRC/dlaed7.f index c9fd657f7e..d692c35446 100644 --- a/SRC/dlaed7.f +++ b/SRC/dlaed7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED7 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed8.f b/SRC/dlaed8.f index 230951de25..fd845a8778 100644 --- a/SRC/dlaed8.f +++ b/SRC/dlaed8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED8 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed9.f b/SRC/dlaed9.f index 90bdf23219..55cbf656e7 100644 --- a/SRC/dlaed9.f +++ b/SRC/dlaed9.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAED9 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaeda.f b/SRC/dlaeda.f index d45ebfecdb..7416bac1c7 100644 --- a/SRC/dlaeda.f +++ b/SRC/dlaeda.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAEDA used by DSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaein.f b/SRC/dlaein.f index eac15a1b56..919581ef37 100644 --- a/SRC/dlaein.f +++ b/SRC/dlaein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaev2.f b/SRC/dlaev2.f index f646f43299..be61d4cb24 100644 --- a/SRC/dlaev2.f +++ b/SRC/dlaev2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaexc.f b/SRC/dlaexc.f index 79aeeb3a35..04c914ede6 100644 --- a/SRC/dlaexc.f +++ b/SRC/dlaexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlag2.f b/SRC/dlag2.f index a360cba629..531ce8eb3f 100644 --- a/SRC/dlag2.f +++ b/SRC/dlag2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlag2s.f b/SRC/dlag2s.f index aea21fd46d..c84ca0e4ec 100644 --- a/SRC/dlag2s.f +++ b/SRC/dlag2s.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAG2S converts a double precision matrix to a single precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlags2.f b/SRC/dlags2.f index c404cbdd99..34d3b5f398 100644 --- a/SRC/dlags2.f +++ b/SRC/dlags2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagtf.f b/SRC/dlagtf.f index 1270fbef21..de1700272e 100644 --- a/SRC/dlagtf.f +++ b/SRC/dlagtf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagtm.f b/SRC/dlagtm.f index 7051a0f4fd..b0e2f38638 100644 --- a/SRC/dlagtm.f +++ b/SRC/dlagtm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagts.f b/SRC/dlagts.f index d22e1c04fe..6578ac3af1 100644 --- a/SRC/dlagts.f +++ b/SRC/dlagts.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAGTS solves the system of equations (T-λI)x = y *> or (T-λI)^Tx = y, where T is a general tridiagonal matrix *> and λ a scalar, using the LU factorization computed by slagtf. diff --git a/SRC/dlagv2.f b/SRC/dlagv2.f index 97bcd27ac1..3b67ced4b0 100644 --- a/SRC/dlagv2.f +++ b/SRC/dlagv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlahqr.f b/SRC/dlahqr.f index 1aee37e6be..606be1af2f 100644 --- a/SRC/dlahqr.f +++ b/SRC/dlahqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlahr2.f b/SRC/dlahr2.f index 74dd70483a..476bf8d0f9 100644 --- a/SRC/dlahr2.f +++ b/SRC/dlahr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaic1.f b/SRC/dlaic1.f index 8adbcaf496..9a650682b7 100644 --- a/SRC/dlaic1.f +++ b/SRC/dlaic1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaisnan.f b/SRC/dlaisnan.f index d879d9e409..70b8e19d77 100644 --- a/SRC/dlaisnan.f +++ b/SRC/dlaisnan.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAISNAN tests input for NaN by comparing two arguments for inequality. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaln2.f b/SRC/dlaln2.f index aa0f91ca77..69f7cbf100 100644 --- a/SRC/dlaln2.f +++ b/SRC/dlaln2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlals0.f b/SRC/dlals0.f index 44a8106e08..463d2eadb2 100644 --- a/SRC/dlals0.f +++ b/SRC/dlals0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlalsa.f b/SRC/dlalsa.f index c8dc2fa4ae..2a3ec66739 100644 --- a/SRC/dlalsa.f +++ b/SRC/dlalsa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlalsd.f b/SRC/dlalsd.f index c52ae28bd5..ff07f7d929 100644 --- a/SRC/dlalsd.f +++ b/SRC/dlalsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlamrg.f b/SRC/dlamrg.f index 8ecfcc6535..4d34931ffb 100644 --- a/SRC/dlamrg.f +++ b/SRC/dlamrg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f index 07ef1bd57d..204a09429f 100644 --- a/SRC/dlamswlq.f +++ b/SRC/dlamswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAMSWLQ * * Definition: diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f index 023db5ac9b..9e9ca4773d 100644 --- a/SRC/dlamtsqr.f +++ b/SRC/dlamtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAMTSQR * * Definition: diff --git a/SRC/dlaneg.f b/SRC/dlaneg.f index 437fe0f980..455afdf4e0 100644 --- a/SRC/dlaneg.f +++ b/SRC/dlaneg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANEG computes the Sturm count. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlangb.f b/SRC/dlangb.f index ae4f558bbb..cb172c4e92 100644 --- a/SRC/dlangb.f +++ b/SRC/dlangb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlange.f b/SRC/dlange.f index 79c8ad23b2..f9bc4430ae 100644 --- a/SRC/dlange.f +++ b/SRC/dlange.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlangt.f b/SRC/dlangt.f index e8dc74ea84..1757e25795 100644 --- a/SRC/dlangt.f +++ b/SRC/dlangt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanhs.f b/SRC/dlanhs.f index 9a58d1741c..3538a8ebff 100644 --- a/SRC/dlanhs.f +++ b/SRC/dlanhs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansb.f b/SRC/dlansb.f index a7dd29e63a..ef5fbebd59 100644 --- a/SRC/dlansb.f +++ b/SRC/dlansb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansf.f b/SRC/dlansf.f index afdfd47896..bd386b9469 100644 --- a/SRC/dlansf.f +++ b/SRC/dlansf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANSF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansp.f b/SRC/dlansp.f index 71f80d1644..01afa56cfc 100644 --- a/SRC/dlansp.f +++ b/SRC/dlansp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanst.f b/SRC/dlanst.f index 1db8332dab..e339820f1e 100644 --- a/SRC/dlanst.f +++ b/SRC/dlanst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansy.f b/SRC/dlansy.f index 659c40a3fb..d859a1040d 100644 --- a/SRC/dlansy.f +++ b/SRC/dlansy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantb.f b/SRC/dlantb.f index c8a3b10596..4777411af2 100644 --- a/SRC/dlantb.f +++ b/SRC/dlantb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantp.f b/SRC/dlantp.f index b5cba422b3..fc5db75dd1 100644 --- a/SRC/dlantp.f +++ b/SRC/dlantp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantr.f b/SRC/dlantr.f index da858fc5d6..99bd7c5f06 100644 --- a/SRC/dlantr.f +++ b/SRC/dlantr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanv2.f b/SRC/dlanv2.f index c55b0ce510..3d1a997c2f 100644 --- a/SRC/dlanv2.f +++ b/SRC/dlanv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaorhr_col_getrfnp.f b/SRC/dlaorhr_col_getrfnp.f index c4a76d35e1..4ca91f2cbe 100644 --- a/SRC/dlaorhr_col_getrfnp.f +++ b/SRC/dlaorhr_col_getrfnp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAORHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaorhr_col_getrfnp2.f b/SRC/dlaorhr_col_getrfnp2.f index a9b8443346..dc206947c0 100644 --- a/SRC/dlaorhr_col_getrfnp2.f +++ b/SRC/dlaorhr_col_getrfnp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAORHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapll.f b/SRC/dlapll.f index 417d621684..9d8b72ce56 100644 --- a/SRC/dlapll.f +++ b/SRC/dlapll.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapmr.f b/SRC/dlapmr.f index a00db4a753..302e66b565 100644 --- a/SRC/dlapmr.f +++ b/SRC/dlapmr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapmt.f b/SRC/dlapmt.f index 1ace07e47d..f152ffe0aa 100644 --- a/SRC/dlapmt.f +++ b/SRC/dlapmt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapy2.f b/SRC/dlapy2.f index 627cacc92d..ddc37edb23 100644 --- a/SRC/dlapy2.f +++ b/SRC/dlapy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAPY2 returns sqrt(x2+y2). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapy3.f b/SRC/dlapy3.f index b5974fb1c5..bdf2407aeb 100644 --- a/SRC/dlapy3.f +++ b/SRC/dlapy3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAPY3 returns sqrt(x2+y2+z2). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqgb.f b/SRC/dlaqgb.f index aa07ab35ac..592d391450 100644 --- a/SRC/dlaqgb.f +++ b/SRC/dlaqgb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqge.f b/SRC/dlaqge.f index e9cad69a9e..ecba93d132 100644 --- a/SRC/dlaqge.f +++ b/SRC/dlaqge.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqp2.f b/SRC/dlaqp2.f index 2945c296d5..2d2a071e21 100644 --- a/SRC/dlaqp2.f +++ b/SRC/dlaqp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqps.f b/SRC/dlaqps.f index b4411203de..004b6601f4 100644 --- a/SRC/dlaqps.f +++ b/SRC/dlaqps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr0.f b/SRC/dlaqr0.f index 3c8753ca41..9f3aec0eb4 100644 --- a/SRC/dlaqr0.f +++ b/SRC/dlaqr0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr1.f b/SRC/dlaqr1.f index 157a73d6ed..fdc181a1af 100644 --- a/SRC/dlaqr1.f +++ b/SRC/dlaqr1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index b79c995cba..8475b1c076 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr3.f b/SRC/dlaqr3.f index 34057d96d1..aa0255cc6a 100644 --- a/SRC/dlaqr3.f +++ b/SRC/dlaqr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr4.f b/SRC/dlaqr4.f index 8926fb14c6..e4baa39f82 100644 --- a/SRC/dlaqr4.f +++ b/SRC/dlaqr4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr5.f b/SRC/dlaqr5.f index c889488e05..aef7cd1cdd 100644 --- a/SRC/dlaqr5.f +++ b/SRC/dlaqr5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsb.f b/SRC/dlaqsb.f index ff31fa204f..a1dd414a93 100644 --- a/SRC/dlaqsb.f +++ b/SRC/dlaqsb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsp.f b/SRC/dlaqsp.f index 8c48e85b42..3ee6cde1b0 100644 --- a/SRC/dlaqsp.f +++ b/SRC/dlaqsp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsy.f b/SRC/dlaqsy.f index 77eedaefe8..aea09f8e4d 100644 --- a/SRC/dlaqsy.f +++ b/SRC/dlaqsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqtr.f b/SRC/dlaqtr.f index ea3bf2880a..892fc81f89 100644 --- a/SRC/dlaqtr.f +++ b/SRC/dlaqtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz0.f b/SRC/dlaqz0.f index 145d11ac3a..8fb6b23cbd 100644 --- a/SRC/dlaqz0.f +++ b/SRC/dlaqz0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz1.f b/SRC/dlaqz1.f index 9c5f402648..ed6f859610 100644 --- a/SRC/dlaqz1.f +++ b/SRC/dlaqz1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz2.f b/SRC/dlaqz2.f index 825205b4b9..e89e047d9d 100644 --- a/SRC/dlaqz2.f +++ b/SRC/dlaqz2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz3.f b/SRC/dlaqz3.f index c2c5cb28f2..a5cd1f0435 100644 --- a/SRC/dlaqz3.f +++ b/SRC/dlaqz3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz4.f b/SRC/dlaqz4.f index 7b1605e782..2a70409860 100644 --- a/SRC/dlaqz4.f +++ b/SRC/dlaqz4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQZ4 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlar1v.f b/SRC/dlar1v.f index 9cb9f9e548..166ee938f4 100644 --- a/SRC/dlar1v.f +++ b/SRC/dlar1v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlar2v.f b/SRC/dlar2v.f index 8d6f861497..ae2bf44e47 100644 --- a/SRC/dlar2v.f +++ b/SRC/dlar2v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarf.f b/SRC/dlarf.f index 28f6226e37..bbab72ebf8 100644 --- a/SRC/dlarf.f +++ b/SRC/dlarf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfb.f b/SRC/dlarfb.f index 6509253ce2..92d4511397 100644 --- a/SRC/dlarfb.f +++ b/SRC/dlarfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFB applies a block reflector or its transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfb_gett.f b/SRC/dlarfb_gett.f index d8461064d4..c0b0a24c46 100644 --- a/SRC/dlarfb_gett.f +++ b/SRC/dlarfb_gett.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfg.f b/SRC/dlarfg.f index 1d6fb6c8e5..10574887c0 100644 --- a/SRC/dlarfg.f +++ b/SRC/dlarfg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfgp.f b/SRC/dlarfgp.f index a8cf1b31e3..2559178d61 100644 --- a/SRC/dlarfgp.f +++ b/SRC/dlarfgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 7f32f3018b..03b23c14bf 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfx.f b/SRC/dlarfx.f index 04c706d0b2..e9931aa1b7 100644 --- a/SRC/dlarfx.f +++ b/SRC/dlarfx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfy.f b/SRC/dlarfy.f index 7972a62540..ede6f9d7d5 100644 --- a/SRC/dlarfy.f +++ b/SRC/dlarfy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/dlargv.f b/SRC/dlargv.f index 83f522e72f..f9af89c93b 100644 --- a/SRC/dlargv.f +++ b/SRC/dlargv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARGV generates a vector of plane rotations with real cosines and real sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarmm.f b/SRC/dlarmm.f index f276df3655..8707f2c230 100644 --- a/SRC/dlarmm.f +++ b/SRC/dlarmm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARMM * * Definition: diff --git a/SRC/dlarnv.f b/SRC/dlarnv.f index 30b76542e3..43db3e77b7 100644 --- a/SRC/dlarnv.f +++ b/SRC/dlarnv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarra.f b/SRC/dlarra.f index f325d725d5..fc9d219dee 100644 --- a/SRC/dlarra.f +++ b/SRC/dlarra.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRA computes the splitting points with the specified threshold. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrb.f b/SRC/dlarrb.f index 2ebdaeebd2..2578900cab 100644 --- a/SRC/dlarrb.f +++ b/SRC/dlarrb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRB provides limited bisection to locate eigenvalues for more accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrc.f b/SRC/dlarrc.f index 9f3eed0140..f9fd1c7ceb 100644 --- a/SRC/dlarrc.f +++ b/SRC/dlarrc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrd.f b/SRC/dlarrd.f index 198ce2f552..b67c6b9a15 100644 --- a/SRC/dlarrd.f +++ b/SRC/dlarrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarre.f b/SRC/dlarre.f index 5c8ea205ed..ba99dc0de0 100644 --- a/SRC/dlarre.f +++ b/SRC/dlarre.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrf.f b/SRC/dlarrf.f index d7c6195e5b..7478bb9e16 100644 --- a/SRC/dlarrf.f +++ b/SRC/dlarrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrj.f b/SRC/dlarrj.f index 5596af3725..4875392e7c 100644 --- a/SRC/dlarrj.f +++ b/SRC/dlarrj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrk.f b/SRC/dlarrk.f index 347ff0af3b..08728d3da5 100644 --- a/SRC/dlarrk.f +++ b/SRC/dlarrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrr.f b/SRC/dlarrr.f index 23ab364642..87e262715a 100644 --- a/SRC/dlarrr.f +++ b/SRC/dlarrr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrv.f b/SRC/dlarrv.f index 7bf7a3e1d7..ee1ed46a2f 100644 --- a/SRC/dlarrv.f +++ b/SRC/dlarrv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarscl2.f b/SRC/dlarscl2.f index 3857447e6d..33a9c4913e 100644 --- a/SRC/dlarscl2.f +++ b/SRC/dlarscl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartg.f90 b/SRC/dlartg.f90 index b96b8d49fc..12b6e80eba 100644 --- a/SRC/dlartg.f90 +++ b/SRC/dlartg.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b DLARTG generates a plane rotation with real cosine and real sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dlartgp.f b/SRC/dlartgp.f index d437039b77..b73be91073 100644 --- a/SRC/dlartgp.f +++ b/SRC/dlartgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARTGP generates a plane rotation so that the diagonal is nonnegative. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartgs.f b/SRC/dlartgs.f index abfac6e65b..d59290d91f 100644 --- a/SRC/dlartgs.f +++ b/SRC/dlartgs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartv.f b/SRC/dlartv.f index 18f2f9cfc6..1b389aa261 100644 --- a/SRC/dlartv.f +++ b/SRC/dlartv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaruv.f b/SRC/dlaruv.f index 1bacb0bb6f..7ac862c9a9 100644 --- a/SRC/dlaruv.f +++ b/SRC/dlaruv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARUV returns a vector of n random real numbers from a uniform distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarz.f b/SRC/dlarz.f index 329b44a81e..954226b190 100644 --- a/SRC/dlarz.f +++ b/SRC/dlarz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarzb.f b/SRC/dlarzb.f index 0f0f68f828..7a8803d73f 100644 --- a/SRC/dlarzb.f +++ b/SRC/dlarzb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARZB applies a block reflector or its transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarzt.f b/SRC/dlarzt.f index b7fa731d65..22698617a8 100644 --- a/SRC/dlarzt.f +++ b/SRC/dlarzt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlas2.f b/SRC/dlas2.f index 11ae217cf1..082e083173 100644 --- a/SRC/dlas2.f +++ b/SRC/dlas2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAS2 computes singular values of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlascl.f b/SRC/dlascl.f index 0f92c32511..b2ef681691 100644 --- a/SRC/dlascl.f +++ b/SRC/dlascl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlascl2.f b/SRC/dlascl2.f index edb816f0da..3151e671a5 100644 --- a/SRC/dlascl2.f +++ b/SRC/dlascl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd0.f b/SRC/dlasd0.f index a689234b4b..6a1a7aa6f0 100644 --- a/SRC/dlasd0.f +++ b/SRC/dlasd0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd1.f b/SRC/dlasd1.f index 926b26cd2f..259a18eed4 100644 --- a/SRC/dlasd1.f +++ b/SRC/dlasd1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd2.f b/SRC/dlasd2.f index 94f0b1542e..7c5d3398ef 100644 --- a/SRC/dlasd2.f +++ b/SRC/dlasd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd3.f b/SRC/dlasd3.f index f44ac44195..a9d53fdcfe 100644 --- a/SRC/dlasd3.f +++ b/SRC/dlasd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd4.f b/SRC/dlasd4.f index 45a85f476d..2fda08d34a 100644 --- a/SRC/dlasd4.f +++ b/SRC/dlasd4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by dbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd5.f b/SRC/dlasd5.f index df508a60df..5e93b941c8 100644 --- a/SRC/dlasd5.f +++ b/SRC/dlasd5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd6.f b/SRC/dlasd6.f index 9d394629b7..fb21015e97 100644 --- a/SRC/dlasd6.f +++ b/SRC/dlasd6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd7.f b/SRC/dlasd7.f index 3c22ea7c91..a366b68114 100644 --- a/SRC/dlasd7.f +++ b/SRC/dlasd7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd8.f b/SRC/dlasd8.f index 865bbdbf0b..e1772ee71b 100644 --- a/SRC/dlasd8.f +++ b/SRC/dlasd8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasda.f b/SRC/dlasda.f index d75913a0eb..8b75ba3ddc 100644 --- a/SRC/dlasda.f +++ b/SRC/dlasda.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasdq.f b/SRC/dlasdq.f index 072e8a034a..1ca92992c9 100644 --- a/SRC/dlasdq.f +++ b/SRC/dlasdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasdt.f b/SRC/dlasdt.f index 9fc1b77e4f..a0048bc87e 100644 --- a/SRC/dlasdt.f +++ b/SRC/dlasdt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaset.f b/SRC/dlaset.f index e527d794b0..6bcbfc374d 100644 --- a/SRC/dlaset.f +++ b/SRC/dlaset.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq1.f b/SRC/dlasq1.f index e2ad43cc61..08c6e9d4a8 100644 --- a/SRC/dlasq1.f +++ b/SRC/dlasq1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq2.f b/SRC/dlasq2.f index e8b8ec5e1f..2e1fb48e96 100644 --- a/SRC/dlasq2.f +++ b/SRC/dlasq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq3.f b/SRC/dlasq3.f index 67d4d08420..399c4cc498 100644 --- a/SRC/dlasq3.f +++ b/SRC/dlasq3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq4.f b/SRC/dlasq4.f index d96d51ab14..f3eed0ab51 100644 --- a/SRC/dlasq4.f +++ b/SRC/dlasq4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq5.f b/SRC/dlasq5.f index 3e87ef7bc9..f7974af04a 100644 --- a/SRC/dlasq5.f +++ b/SRC/dlasq5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq6.f b/SRC/dlasq6.f index 7aff8f37c0..15842def3b 100644 --- a/SRC/dlasq6.f +++ b/SRC/dlasq6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasr.f b/SRC/dlasr.f index 794b489632..7d8dec44f9 100644 --- a/SRC/dlasr.f +++ b/SRC/dlasr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasrt.f b/SRC/dlasrt.f index 0232f64133..888752c8cf 100644 --- a/SRC/dlasrt.f +++ b/SRC/dlasrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASRT sorts numbers in increasing or decreasing order. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlassq.f90 b/SRC/dlassq.f90 index 37626844b5..2a35ecaa2d 100644 --- a/SRC/dlassq.f90 +++ b/SRC/dlassq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b DLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dlasv2.f b/SRC/dlasv2.f index 4bd6b34a31..de51d1b54a 100644 --- a/SRC/dlasv2.f +++ b/SRC/dlasv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index 636c12dc87..c02c816c49 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASWLQ * * Definition: diff --git a/SRC/dlaswp.f b/SRC/dlaswp.f index 43dcaf8d54..ce32e19ca9 100644 --- a/SRC/dlaswp.f +++ b/SRC/dlaswp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasy2.f b/SRC/dlasy2.f index ba91ae454a..68e900cc48 100644 --- a/SRC/dlasy2.f +++ b/SRC/dlasy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf.f b/SRC/dlasyf.f index 5aa3669788..f0858b1a51 100644 --- a/SRC/dlasyf.f +++ b/SRC/dlasyf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASYF computes a partial factorization of a real symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_aa.f b/SRC/dlasyf_aa.f index 6c5cf6717b..fe876bd483 100644 --- a/SRC/dlasyf_aa.f +++ b/SRC/dlasyf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_rk.f b/SRC/dlasyf_rk.f index 4f30db88a9..40c5f72f53 100644 --- a/SRC/dlasyf_rk.f +++ b/SRC/dlasyf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_rook.f b/SRC/dlasyf_rook.f index fc8092d06f..c7b6498e04 100644 --- a/SRC/dlasyf_rook.f +++ b/SRC/dlasyf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLASYF_ROOK *> DLASYF_ROOK computes a partial factorization of a real symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlat2s.f b/SRC/dlat2s.f index 5dc33838d8..9dc61b752d 100644 --- a/SRC/dlat2s.f +++ b/SRC/dlat2s.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAT2S converts a double-precision triangular matrix to a single-precision triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatbs.f b/SRC/dlatbs.f index 5726596d8c..2775a94a10 100644 --- a/SRC/dlatbs.f +++ b/SRC/dlatbs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatdf.f b/SRC/dlatdf.f index 35083457af..c381cd508b 100644 --- a/SRC/dlatdf.f +++ b/SRC/dlatdf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatps.f b/SRC/dlatps.f index 3dabade7db..79e7fab5ff 100644 --- a/SRC/dlatps.f +++ b/SRC/dlatps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrd.f b/SRC/dlatrd.f index cc815d72d4..774818cfd6 100644 --- a/SRC/dlatrd.f +++ b/SRC/dlatrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrs.f b/SRC/dlatrs.f index f043632229..cf103f59fe 100644 --- a/SRC/dlatrs.f +++ b/SRC/dlatrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrs3.f b/SRC/dlatrs3.f index d18675b2d0..dc1d6631cb 100644 --- a/SRC/dlatrs3.f +++ b/SRC/dlatrs3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/dlatrz.f b/SRC/dlatrz.f index dc94703970..02254f0b5d 100644 --- a/SRC/dlatrz.f +++ b/SRC/dlatrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f index 0000aab68c..d3c6a30d54 100644 --- a/SRC/dlatsqr.f +++ b/SRC/dlatsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLATSQR * * Definition: diff --git a/SRC/dlauu2.f b/SRC/dlauu2.f index e0c9ad84a0..c04ee253b5 100644 --- a/SRC/dlauu2.f +++ b/SRC/dlauu2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlauum.f b/SRC/dlauum.f index 611bd4283b..53da74d78a 100644 --- a/SRC/dlauum.f +++ b/SRC/dlauum.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dopgtr.f b/SRC/dopgtr.f index bf2f6c5fa3..334d86604a 100644 --- a/SRC/dopgtr.f +++ b/SRC/dopgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DOPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dopmtr.f b/SRC/dopmtr.f index a877a51d76..9c35116a9b 100644 --- a/SRC/dopmtr.f +++ b/SRC/dopmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DOPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f index a1c1a68af6..3bd4289006 100644 --- a/SRC/dorbdb.f +++ b/SRC/dorbdb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f index 828b2dd6ca..f562217985 100644 --- a/SRC/dorbdb1.f +++ b/SRC/dorbdb1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f index 3585334ef2..0276a0183b 100644 --- a/SRC/dorbdb2.f +++ b/SRC/dorbdb2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb3.f b/SRC/dorbdb3.f index e22d975bdf..3d0743a97e 100644 --- a/SRC/dorbdb3.f +++ b/SRC/dorbdb3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f index b7f042c81d..63d0a867dc 100644 --- a/SRC/dorbdb4.f +++ b/SRC/dorbdb4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb5.f b/SRC/dorbdb5.f index cbd58ae547..ecfab40dfb 100644 --- a/SRC/dorbdb5.f +++ b/SRC/dorbdb5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb6.f b/SRC/dorbdb6.f index 3e356d0010..106410b091 100644 --- a/SRC/dorbdb6.f +++ b/SRC/dorbdb6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorcsd.f b/SRC/dorcsd.f index 947f401cda..61a2d270f6 100644 --- a/SRC/dorcsd.f +++ b/SRC/dorcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/dorcsd2by1.f b/SRC/dorcsd2by1.f index bf427f94f4..a9387317bc 100644 --- a/SRC/dorcsd2by1.f +++ b/SRC/dorcsd2by1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index 85d6e7c354..9671ebd120 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorg2r.f b/SRC/dorg2r.f index 221b52bb8c..03801ddf7e 100644 --- a/SRC/dorg2r.f +++ b/SRC/dorg2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgbr.f b/SRC/dorgbr.f index 2d1f7868f5..d1fb414e71 100644 --- a/SRC/dorgbr.f +++ b/SRC/dorgbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorghr.f b/SRC/dorghr.f index a228787629..05eca94ab5 100644 --- a/SRC/dorghr.f +++ b/SRC/dorghr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgl2.f b/SRC/dorgl2.f index 98128b25d5..e0ce541a32 100644 --- a/SRC/dorgl2.f +++ b/SRC/dorgl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGL2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorglq.f b/SRC/dorglq.f index 8b3b4deb85..1a926cba1d 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgql.f b/SRC/dorgql.f index 093ecd7fa2..7e84341eda 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f index 99a9c6a8ee..120f9df0bf 100644 --- a/SRC/dorgqr.f +++ b/SRC/dorgqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgr2.f b/SRC/dorgr2.f index 30888bb941..af17a8a9de 100644 --- a/SRC/dorgr2.f +++ b/SRC/dorgr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index 351d015d4c..26f7a3f847 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtr.f b/SRC/dorgtr.f index 2dae658828..d069866bd8 100644 --- a/SRC/dorgtr.f +++ b/SRC/dorgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtsqr.f b/SRC/dorgtsqr.f index 323ffe0aab..ebecefc21f 100644 --- a/SRC/dorgtsqr.f +++ b/SRC/dorgtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtsqr_row.f b/SRC/dorgtsqr_row.f index 95cb02cc2e..29742e4353 100644 --- a/SRC/dorgtsqr_row.f +++ b/SRC/dorgtsqr_row.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/dorhr_col.f b/SRC/dorhr_col.f index 470d3be1b4..476931b7db 100644 --- a/SRC/dorhr_col.f +++ b/SRC/dorhr_col.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm22.f b/SRC/dorm22.f index ab874de5ae..7f78b19385 100644 --- a/SRC/dorm22.f +++ b/SRC/dorm22.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORM22 multiplies a general matrix by a banded orthogonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm2l.f b/SRC/dorm2l.f index b1a27ab21b..31a22cd655 100644 --- a/SRC/dorm2l.f +++ b/SRC/dorm2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index 7bb0a6da21..32ae96e8b0 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormbr.f b/SRC/dormbr.f index d1778c323f..15be46c579 100644 --- a/SRC/dormbr.f +++ b/SRC/dormbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/dormhr.f b/SRC/dormhr.f index 5cac673a47..696969b3d1 100644 --- a/SRC/dormhr.f +++ b/SRC/dormhr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorml2.f b/SRC/dorml2.f index fcdf5b1b13..57f297aa73 100644 --- a/SRC/dorml2.f +++ b/SRC/dorml2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormlq.f b/SRC/dormlq.f index 17eea7fd83..1f86956f23 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormql.f b/SRC/dormql.f index 638f4167f9..9b2fe12733 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/dormqr.f b/SRC/dormqr.f index 1e5d4b38ae..4a0dd3caa3 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dormr2.f b/SRC/dormr2.f index 4d91aca411..1ea570bc78 100644 --- a/SRC/dormr2.f +++ b/SRC/dormr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormr3.f b/SRC/dormr3.f index aad1e8fa03..92023ead15 100644 --- a/SRC/dormr3.f +++ b/SRC/dormr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormrq.f b/SRC/dormrq.f index 2355e0f336..a17e757beb 100644 --- a/SRC/dormrq.f +++ b/SRC/dormrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormrz.f b/SRC/dormrz.f index 2e209f988e..d04bf0961c 100644 --- a/SRC/dormrz.f +++ b/SRC/dormrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormtr.f b/SRC/dormtr.f index 04991866fd..f0dc28891d 100644 --- a/SRC/dormtr.f +++ b/SRC/dormtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DORMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbcon.f b/SRC/dpbcon.f index a450fe299d..fd932c7a71 100644 --- a/SRC/dpbcon.f +++ b/SRC/dpbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbequ.f b/SRC/dpbequ.f index ab7e8eda26..8ef15c496d 100644 --- a/SRC/dpbequ.f +++ b/SRC/dpbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbrfs.f b/SRC/dpbrfs.f index abad05466e..304815835b 100644 --- a/SRC/dpbrfs.f +++ b/SRC/dpbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbstf.f b/SRC/dpbstf.f index 471ddf77d2..04a333620e 100644 --- a/SRC/dpbstf.f +++ b/SRC/dpbstf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbsv.f b/SRC/dpbsv.f index 2ea8ec188e..b5c81f4033 100644 --- a/SRC/dpbsv.f +++ b/SRC/dpbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbsvx.f b/SRC/dpbsvx.f index 8a307d76a4..8b1b326ee1 100644 --- a/SRC/dpbsvx.f +++ b/SRC/dpbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtf2.f b/SRC/dpbtf2.f index b2b4956110..3d1cf2b139 100644 --- a/SRC/dpbtf2.f +++ b/SRC/dpbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtrf.f b/SRC/dpbtrf.f index 12271285bd..f7a6b1bdca 100644 --- a/SRC/dpbtrf.f +++ b/SRC/dpbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtrs.f b/SRC/dpbtrs.f index 532b48d9a3..c1e6256d5d 100644 --- a/SRC/dpbtrs.f +++ b/SRC/dpbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftrf.f b/SRC/dpftrf.f index 8d0cae7f83..64ca2ffb65 100644 --- a/SRC/dpftrf.f +++ b/SRC/dpftrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftri.f b/SRC/dpftri.f index 95d858cd57..6b9f83d047 100644 --- a/SRC/dpftri.f +++ b/SRC/dpftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftrs.f b/SRC/dpftrs.f index abbf0cc0f4..b7fffe88fd 100644 --- a/SRC/dpftrs.f +++ b/SRC/dpftrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpocon.f b/SRC/dpocon.f index 8a654380bd..a542ebeeff 100644 --- a/SRC/dpocon.f +++ b/SRC/dpocon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpoequ.f b/SRC/dpoequ.f index a04fb13277..140face34a 100644 --- a/SRC/dpoequ.f +++ b/SRC/dpoequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpoequb.f b/SRC/dpoequb.f index d8936c4099..191656944c 100644 --- a/SRC/dpoequb.f +++ b/SRC/dpoequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dporfs.f b/SRC/dporfs.f index 1950d1a55a..25b6022539 100644 --- a/SRC/dporfs.f +++ b/SRC/dporfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dporfsx.f b/SRC/dporfsx.f index ba56232b7a..edb30f2eb1 100644 --- a/SRC/dporfsx.f +++ b/SRC/dporfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dposv.f b/SRC/dposv.f index 62a60645ce..1fb180be2c 100644 --- a/SRC/dposv.f +++ b/SRC/dposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dposvx.f b/SRC/dposvx.f index 0b8264336d..8ba02e42b2 100644 --- a/SRC/dposvx.f +++ b/SRC/dposvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dposvxx.f b/SRC/dposvxx.f index 18b800eb86..7df488b067 100644 --- a/SRC/dposvxx.f +++ b/SRC/dposvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotf2.f b/SRC/dpotf2.f index 3255ec8f5f..f3b354573c 100644 --- a/SRC/dpotf2.f +++ b/SRC/dpotf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrf.f b/SRC/dpotrf.f index 561291b7a9..34c66b1e16 100644 --- a/SRC/dpotrf.f +++ b/SRC/dpotrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrf2.f b/SRC/dpotrf2.f index 5f06352175..9e19ee8acf 100644 --- a/SRC/dpotrf2.f +++ b/SRC/dpotrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotri.f b/SRC/dpotri.f index d3bf8ee2d3..614422456a 100644 --- a/SRC/dpotri.f +++ b/SRC/dpotri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrs.f b/SRC/dpotrs.f index 596e9869e7..6bc53048dc 100644 --- a/SRC/dpotrs.f +++ b/SRC/dpotrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dppcon.f b/SRC/dppcon.f index 11299587a7..b4c6a1b263 100644 --- a/SRC/dppcon.f +++ b/SRC/dppcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dppequ.f b/SRC/dppequ.f index 518dc7727a..00fdb6778c 100644 --- a/SRC/dppequ.f +++ b/SRC/dppequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpprfs.f b/SRC/dpprfs.f index 0277880a39..1a82618295 100644 --- a/SRC/dpprfs.f +++ b/SRC/dpprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dppsv.f b/SRC/dppsv.f index 5b30aa6b83..8a1def83f9 100644 --- a/SRC/dppsv.f +++ b/SRC/dppsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dppsvx.f b/SRC/dppsvx.f index 184abad312..2f0542d8c2 100644 --- a/SRC/dppsvx.f +++ b/SRC/dppsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptrf.f b/SRC/dpptrf.f index 0fb22c6dd5..354580c92e 100644 --- a/SRC/dpptrf.f +++ b/SRC/dpptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptri.f b/SRC/dpptri.f index 3ac5876c3c..82367901a0 100644 --- a/SRC/dpptri.f +++ b/SRC/dpptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptrs.f b/SRC/dpptrs.f index 21c71adedd..b021c5b9e3 100644 --- a/SRC/dpptrs.f +++ b/SRC/dpptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpstf2.f b/SRC/dpstf2.f index eef3b58439..5475ceb6fe 100644 --- a/SRC/dpstf2.f +++ b/SRC/dpstf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dpstrf.f b/SRC/dpstrf.f index baaccc9345..d577cabd10 100644 --- a/SRC/dpstrf.f +++ b/SRC/dpstrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * diff --git a/SRC/dptcon.f b/SRC/dptcon.f index 094a5b49de..3cd557dcbf 100644 --- a/SRC/dptcon.f +++ b/SRC/dptcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpteqr.f b/SRC/dpteqr.f index 952a13f90c..382509b78e 100644 --- a/SRC/dpteqr.f +++ b/SRC/dpteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dptrfs.f b/SRC/dptrfs.f index b94e76fb86..5afc530793 100644 --- a/SRC/dptrfs.f +++ b/SRC/dptrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dptsv.f b/SRC/dptsv.f index 25494833c2..9895f23321 100644 --- a/SRC/dptsv.f +++ b/SRC/dptsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dptsvx.f b/SRC/dptsvx.f index a8d6be19d1..137faf17ec 100644 --- a/SRC/dptsvx.f +++ b/SRC/dptsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpttrf.f b/SRC/dpttrf.f index 66ec3a4b43..c08db2f601 100644 --- a/SRC/dpttrf.f +++ b/SRC/dpttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpttrs.f b/SRC/dpttrs.f index 48244e63af..6448392e7c 100644 --- a/SRC/dpttrs.f +++ b/SRC/dpttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dptts2.f b/SRC/dptts2.f index f00f23bd6d..50e2da9b02 100644 --- a/SRC/dptts2.f +++ b/SRC/dptts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/drscl.f b/SRC/drscl.f index 840957bbab..7e10aa32fd 100644 --- a/SRC/drscl.f +++ b/SRC/drscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f index 05e3ccda99..327cdeb291 100644 --- a/SRC/dsb2st_kernels.f +++ b/SRC/dsb2st_kernels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec 7 08:22:39 2016 diff --git a/SRC/dsbev.f b/SRC/dsbev.f index e417ff4eac..e05322ccc5 100644 --- a/SRC/dsbev.f +++ b/SRC/dsbev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbev_2stage.f b/SRC/dsbev_2stage.f index eb35eb0332..4261823861 100644 --- a/SRC/dsbev_2stage.f +++ b/SRC/dsbev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbevd.f b/SRC/dsbevd.f index 60042788d4..429114b86e 100644 --- a/SRC/dsbevd.f +++ b/SRC/dsbevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbevd_2stage.f b/SRC/dsbevd_2stage.f index 4301ec80be..f0d0ce2ccc 100644 --- a/SRC/dsbevd_2stage.f +++ b/SRC/dsbevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbevx.f b/SRC/dsbevx.f index ceb4cd5e43..ead24537c1 100644 --- a/SRC/dsbevx.f +++ b/SRC/dsbevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbevx_2stage.f b/SRC/dsbevx_2stage.f index 23d9d94780..b7c494e0ad 100644 --- a/SRC/dsbevx_2stage.f +++ b/SRC/dsbevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbgst.f b/SRC/dsbgst.f index 88e8ab8d80..9d3a720954 100644 --- a/SRC/dsbgst.f +++ b/SRC/dsbgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgv.f b/SRC/dsbgv.f index c218b04cc4..cc318ecfb7 100644 --- a/SRC/dsbgv.f +++ b/SRC/dsbgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgvd.f b/SRC/dsbgvd.f index 74287f088b..f0347dfc0d 100644 --- a/SRC/dsbgvd.f +++ b/SRC/dsbgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgvx.f b/SRC/dsbgvx.f index 733a7471a7..57114609e2 100644 --- a/SRC/dsbgvx.f +++ b/SRC/dsbgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbtrd.f b/SRC/dsbtrd.f index b791aba0cc..48a664ba66 100644 --- a/SRC/dsbtrd.f +++ b/SRC/dsbtrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsfrk.f b/SRC/dsfrk.f index 17a0fc5779..5356cdfdfc 100644 --- a/SRC/dsfrk.f +++ b/SRC/dsfrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSFRK performs a symmetric rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsgesv.f b/SRC/dsgesv.f index f6269e49a6..00dce352fe 100644 --- a/SRC/dsgesv.f +++ b/SRC/dsgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision with iterative refinement) * * =========== DOCUMENTATION =========== diff --git a/SRC/dspcon.f b/SRC/dspcon.f index 4885e30b5d..d7de9042b8 100644 --- a/SRC/dspcon.f +++ b/SRC/dspcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dspev.f b/SRC/dspev.f index 1c1807775e..55f6faf8f0 100644 --- a/SRC/dspev.f +++ b/SRC/dspev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspevd.f b/SRC/dspevd.f index 7b7d979a8f..fcd44eee94 100644 --- a/SRC/dspevd.f +++ b/SRC/dspevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspevx.f b/SRC/dspevx.f index 6e34895ba0..8fcdd58b14 100644 --- a/SRC/dspevx.f +++ b/SRC/dspevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgst.f b/SRC/dspgst.f index 188a1125b1..3a5c460a4f 100644 --- a/SRC/dspgst.f +++ b/SRC/dspgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgv.f b/SRC/dspgv.f index 15a1c57e87..91b49b46f8 100644 --- a/SRC/dspgv.f +++ b/SRC/dspgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgvd.f b/SRC/dspgvd.f index 902472dd6d..dbe818e852 100644 --- a/SRC/dspgvd.f +++ b/SRC/dspgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgvx.f b/SRC/dspgvx.f index 632c0deae9..b8f8782a45 100644 --- a/SRC/dspgvx.f +++ b/SRC/dspgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsposv.f b/SRC/dsposv.f index 3299d36678..75672633ac 100644 --- a/SRC/dsposv.f +++ b/SRC/dsposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsprfs.f b/SRC/dsprfs.f index 6e6b9c59d8..2bfd0d2eee 100644 --- a/SRC/dsprfs.f +++ b/SRC/dsprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dspsv.f b/SRC/dspsv.f index 2abf736562..d296d99b3f 100644 --- a/SRC/dspsv.f +++ b/SRC/dspsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspsvx.f b/SRC/dspsvx.f index 2f2f6a83e5..0eafdb340a 100644 --- a/SRC/dspsvx.f +++ b/SRC/dspsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrd.f b/SRC/dsptrd.f index f12c10a57a..d0369698e8 100644 --- a/SRC/dsptrd.f +++ b/SRC/dsptrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrf.f b/SRC/dsptrf.f index bd952ec34c..83c01e47d1 100644 --- a/SRC/dsptrf.f +++ b/SRC/dsptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptri.f b/SRC/dsptri.f index 47ed2640a1..03aa3d3dd1 100644 --- a/SRC/dsptri.f +++ b/SRC/dsptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrs.f b/SRC/dsptrs.f index 8f6f033ce4..92e8531bcc 100644 --- a/SRC/dsptrs.f +++ b/SRC/dsptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dstebz.f b/SRC/dstebz.f index 433145e382..f16f86a9a0 100644 --- a/SRC/dstebz.f +++ b/SRC/dstebz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEBZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dstedc.f b/SRC/dstedc.f index 971aeadd39..1d47289c25 100644 --- a/SRC/dstedc.f +++ b/SRC/dstedc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/dstegr.f b/SRC/dstegr.f index 9688c69839..b1ada9d2b6 100644 --- a/SRC/dstegr.f +++ b/SRC/dstegr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/dstein.f b/SRC/dstein.f index 520ec73319..2e8b45c25c 100644 --- a/SRC/dstein.f +++ b/SRC/dstein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/dstemr.f b/SRC/dstemr.f index 44a33423e2..e2fc88b318 100644 --- a/SRC/dstemr.f +++ b/SRC/dstemr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/dsteqr.f b/SRC/dsteqr.f index eed53fde4a..328dea4180 100644 --- a/SRC/dsteqr.f +++ b/SRC/dsteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dsterf.f b/SRC/dsterf.f index b8de31620f..2fb0ad2a56 100644 --- a/SRC/dsterf.f +++ b/SRC/dsterf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSTERF * * =========== DOCUMENTATION =========== diff --git a/SRC/dstev.f b/SRC/dstev.f index bc0d4e5d73..ba74b70784 100644 --- a/SRC/dstev.f +++ b/SRC/dstev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevd.f b/SRC/dstevd.f index 482c9399d9..2f6668aead 100644 --- a/SRC/dstevd.f +++ b/SRC/dstevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevr.f b/SRC/dstevr.f index ccb01a6d86..d2b5e20800 100644 --- a/SRC/dstevr.f +++ b/SRC/dstevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevx.f b/SRC/dstevx.f index ce2833c486..15f02ade3f 100644 --- a/SRC/dstevx.f +++ b/SRC/dstevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon.f b/SRC/dsycon.f index 4072dd4165..7beec0f6fb 100644 --- a/SRC/dsycon.f +++ b/SRC/dsycon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon_3.f b/SRC/dsycon_3.f index b4650c784f..169cf12064 100644 --- a/SRC/dsycon_3.f +++ b/SRC/dsycon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon_rook.f b/SRC/dsycon_rook.f index 81de95638a..6ac6622301 100644 --- a/SRC/dsycon_rook.f +++ b/SRC/dsycon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconv.f b/SRC/dsyconv.f index e4c9b0f005..c28da86552 100644 --- a/SRC/dsyconv.f +++ b/SRC/dsyconv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconvf.f b/SRC/dsyconvf.f index b772d11a5b..7e9adc07fc 100644 --- a/SRC/dsyconvf.f +++ b/SRC/dsyconvf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconvf_rook.f b/SRC/dsyconvf_rook.f index a8fcf90d82..a2ccbe313c 100644 --- a/SRC/dsyconvf_rook.f +++ b/SRC/dsyconvf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyequb.f b/SRC/dsyequb.f index 229968e687..69e092e0a6 100644 --- a/SRC/dsyequb.f +++ b/SRC/dsyequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyev.f b/SRC/dsyev.f index 0fcedbdd02..4c2e15a345 100644 --- a/SRC/dsyev.f +++ b/SRC/dsyev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyev_2stage.f b/SRC/dsyev_2stage.f index 286366bfec..17ea86256c 100644 --- a/SRC/dsyev_2stage.f +++ b/SRC/dsyev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevd.f b/SRC/dsyevd.f index adcfcb3731..e83e86b0c7 100644 --- a/SRC/dsyevd.f +++ b/SRC/dsyevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevd_2stage.f b/SRC/dsyevd_2stage.f index 8f15f31dc8..db96461dfa 100644 --- a/SRC/dsyevd_2stage.f +++ b/SRC/dsyevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 8647b0162c..23182c5574 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 63d5e31598..3a763fc4c6 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevx.f b/SRC/dsyevx.f index fd6a78e320..8b7f9a20ac 100644 --- a/SRC/dsyevx.f +++ b/SRC/dsyevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevx_2stage.f b/SRC/dsyevx_2stage.f index be158485fb..bde4ff533e 100644 --- a/SRC/dsyevx_2stage.f +++ b/SRC/dsyevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsygs2.f b/SRC/dsygs2.f index 235666dd51..4050e9813f 100644 --- a/SRC/dsygs2.f +++ b/SRC/dsygs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygst.f b/SRC/dsygst.f index d4035fcaae..f92f5f090d 100644 --- a/SRC/dsygst.f +++ b/SRC/dsygst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygv.f b/SRC/dsygv.f index 79ba852a16..f11057e59c 100644 --- a/SRC/dsygv.f +++ b/SRC/dsygv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygv_2stage.f b/SRC/dsygv_2stage.f index 47a8df1589..aae7b9843c 100644 --- a/SRC/dsygv_2stage.f +++ b/SRC/dsygv_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGV_2STAGE * * @precisions fortran d -> s diff --git a/SRC/dsygvd.f b/SRC/dsygvd.f index ffbe92028e..e8e8b02abf 100644 --- a/SRC/dsygvd.f +++ b/SRC/dsygvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygvx.f b/SRC/dsygvx.f index f24735cd54..b1f38f3ea7 100644 --- a/SRC/dsygvx.f +++ b/SRC/dsygvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyrfs.f b/SRC/dsyrfs.f index 21a8f2b82a..08502e0368 100644 --- a/SRC/dsyrfs.f +++ b/SRC/dsyrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyrfsx.f b/SRC/dsyrfsx.f index c8d3bf3052..8da24eee66 100644 --- a/SRC/dsyrfsx.f +++ b/SRC/dsyrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv.f b/SRC/dsysv.f index c94a763509..2a4d7d0334 100644 --- a/SRC/dsysv.f +++ b/SRC/dsysv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f index 0a96ecd7e5..f12f603d8b 100644 --- a/SRC/dsysv_aa.f +++ b/SRC/dsysv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_aa_2stage.f b/SRC/dsysv_aa_2stage.f index 90dd0a38ae..1730e2c4aa 100644 --- a/SRC/dsysv_aa_2stage.f +++ b/SRC/dsysv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * @generated from SRC/chesv_aa_2stage.f, fortran c -> d, Tue Oct 31 11:22:31 2017 diff --git a/SRC/dsysv_rk.f b/SRC/dsysv_rk.f index ab81ccf0f9..8804b18cd8 100644 --- a/SRC/dsysv_rk.f +++ b/SRC/dsysv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_rook.f b/SRC/dsysv_rook.f index 95091bdfbe..fb366123ec 100644 --- a/SRC/dsysv_rook.f +++ b/SRC/dsysv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysvx.f b/SRC/dsysvx.f index b2b8210ca4..b9e2bde2b9 100644 --- a/SRC/dsysvx.f +++ b/SRC/dsysvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief DSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysvxx.f b/SRC/dsysvxx.f index 94ff30cb97..1b9a02a3d0 100644 --- a/SRC/dsysvxx.f +++ b/SRC/dsysvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYSVXX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyswapr.f b/SRC/dsyswapr.f index 9048c0fc67..d208610ee8 100644 --- a/SRC/dsyswapr.f +++ b/SRC/dsyswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytd2.f b/SRC/dsytd2.f index c2fa0353ed..5ee0866f9c 100644 --- a/SRC/dsytd2.f +++ b/SRC/dsytd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2.f b/SRC/dsytf2.f index a4767f61b9..9065407b74 100644 --- a/SRC/dsytf2.f +++ b/SRC/dsytf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2_rk.f b/SRC/dsytf2_rk.f index 032f5d5061..8a67b8762c 100644 --- a/SRC/dsytf2_rk.f +++ b/SRC/dsytf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2_rook.f b/SRC/dsytf2_rook.f index b823ca8a93..f9a6859bbe 100644 --- a/SRC/dsytf2_rook.f +++ b/SRC/dsytf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd.f b/SRC/dsytrd.f index 58d4b633b8..a611760419 100644 --- a/SRC/dsytrd.f +++ b/SRC/dsytrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd_2stage.f b/SRC/dsytrd_2stage.f index a88ac1c73f..e68282cade 100644 --- a/SRC/dsytrd_2stage.f +++ b/SRC/dsytrd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> d, Sun Nov 6 19:34:06 2016 diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index 04d03d587a..b6afe75dbc 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index 38acc71f1f..bd17e90bbb 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRD_SY2SB * * @generated from zhetrd_he2hb.f, fortran z -> d, Wed Dec 7 08:22:39 2016 diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f index 2a1a2d4dc4..84f50ad278 100644 --- a/SRC/dsytrf.f +++ b/SRC/dsytrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 924d4c1650..006365de2b 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_aa_2stage.f b/SRC/dsytrf_aa_2stage.f index fae95bab24..8f56296394 100644 --- a/SRC/dsytrf_aa_2stage.f +++ b/SRC/dsytrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_rk.f b/SRC/dsytrf_rk.f index 0717eb0765..9e58d15ad6 100644 --- a/SRC/dsytrf_rk.f +++ b/SRC/dsytrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_rook.f b/SRC/dsytrf_rook.f index 3166634857..63f4dc9fc0 100644 --- a/SRC/dsytrf_rook.f +++ b/SRC/dsytrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri.f b/SRC/dsytri.f index c633f6e21a..4f0f1385a0 100644 --- a/SRC/dsytri.f +++ b/SRC/dsytri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f index 5960d39928..8aada0bfe3 100644 --- a/SRC/dsytri2.f +++ b/SRC/dsytri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri2x.f b/SRC/dsytri2x.f index cb9ed24716..cad9dcb432 100644 --- a/SRC/dsytri2x.f +++ b/SRC/dsytri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_3.f b/SRC/dsytri_3.f index 50834c605e..29d7d53c7b 100644 --- a/SRC/dsytri_3.f +++ b/SRC/dsytri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_3x.f b/SRC/dsytri_3x.f index 1eb6df25a0..921ea4af3a 100644 --- a/SRC/dsytri_3x.f +++ b/SRC/dsytri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_rook.f b/SRC/dsytri_rook.f index 472c0f37b4..d854650775 100644 --- a/SRC/dsytri_rook.f +++ b/SRC/dsytri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs.f b/SRC/dsytrs.f index 2d0c6069fb..276fc38f45 100644 --- a/SRC/dsytrs.f +++ b/SRC/dsytrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs2.f b/SRC/dsytrs2.f index 76e8c02539..3bf9aae84d 100644 --- a/SRC/dsytrs2.f +++ b/SRC/dsytrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_3.f b/SRC/dsytrs_3.f index 6f42572dc2..619f30a063 100644 --- a/SRC/dsytrs_3.f +++ b/SRC/dsytrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_aa.f b/SRC/dsytrs_aa.f index f0016cb7f7..dfede5a39b 100644 --- a/SRC/dsytrs_aa.f +++ b/SRC/dsytrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_aa_2stage.f b/SRC/dsytrs_aa_2stage.f index 9dc368af67..fc6db7b706 100644 --- a/SRC/dsytrs_aa_2stage.f +++ b/SRC/dsytrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_rook.f b/SRC/dsytrs_rook.f index 4c61d1a4f1..609217b06f 100644 --- a/SRC/dsytrs_rook.f +++ b/SRC/dsytrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbcon.f b/SRC/dtbcon.f index 0ec9316b55..5e7df9bf5a 100644 --- a/SRC/dtbcon.f +++ b/SRC/dtbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbrfs.f b/SRC/dtbrfs.f index 0de2d60084..c27d2ed2f0 100644 --- a/SRC/dtbrfs.f +++ b/SRC/dtbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbtrs.f b/SRC/dtbtrs.f index 637817e2ed..ef5268daab 100644 --- a/SRC/dtbtrs.f +++ b/SRC/dtbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfsm.f b/SRC/dtfsm.f index af14784947..a16d76dd8e 100644 --- a/SRC/dtfsm.f +++ b/SRC/dtfsm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtftri.f b/SRC/dtftri.f index 6af5158799..acc162cb26 100644 --- a/SRC/dtftri.f +++ b/SRC/dtftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfttp.f b/SRC/dtfttp.f index fd7e44ae0c..3dd092e577 100644 --- a/SRC/dtfttp.f +++ b/SRC/dtfttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfttr.f b/SRC/dtfttr.f index 9c68544ffb..1f44f86665 100644 --- a/SRC/dtfttr.f +++ b/SRC/dtfttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgevc.f b/SRC/dtgevc.f index 6d7384ff52..25b17078f6 100644 --- a/SRC/dtgevc.f +++ b/SRC/dtgevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgex2.f b/SRC/dtgex2.f index 6425317240..0944162e0c 100644 --- a/SRC/dtgex2.f +++ b/SRC/dtgex2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgexc.f b/SRC/dtgexc.f index 42e1f244cc..e1a84c2ed6 100644 --- a/SRC/dtgexc.f +++ b/SRC/dtgexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsen.f b/SRC/dtgsen.f index e454e3481d..945d4b0133 100644 --- a/SRC/dtgsen.f +++ b/SRC/dtgsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsja.f b/SRC/dtgsja.f index 1264e08575..25c1f0316e 100644 --- a/SRC/dtgsja.f +++ b/SRC/dtgsja.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsna.f b/SRC/dtgsna.f index f31150507d..5c99bb5cf6 100644 --- a/SRC/dtgsna.f +++ b/SRC/dtgsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsy2.f b/SRC/dtgsy2.f index e908a33ba0..99a08c9f45 100644 --- a/SRC/dtgsy2.f +++ b/SRC/dtgsy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsyl.f b/SRC/dtgsyl.f index f1a988c777..9cbcf7a65c 100644 --- a/SRC/dtgsyl.f +++ b/SRC/dtgsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpcon.f b/SRC/dtpcon.f index 0b2959b2e3..a597f9fdde 100644 --- a/SRC/dtpcon.f +++ b/SRC/dtpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtplqt.f b/SRC/dtplqt.f index e6a0556e0b..c16f7b56f3 100644 --- a/SRC/dtplqt.f +++ b/SRC/dtplqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtplqt2.f b/SRC/dtplqt2.f index fd25cbf415..cb2671b3e1 100644 --- a/SRC/dtplqt2.f +++ b/SRC/dtplqt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f index 5f03395934..794ecf7694 100644 --- a/SRC/dtpmlqt.f +++ b/SRC/dtpmlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpmqrt.f b/SRC/dtpmqrt.f index c78b45b227..6378bf5aa3 100644 --- a/SRC/dtpmqrt.f +++ b/SRC/dtpmqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpqrt.f b/SRC/dtpqrt.f index 2ce21342e6..251518414e 100644 --- a/SRC/dtpqrt.f +++ b/SRC/dtpqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpqrt2.f b/SRC/dtpqrt2.f index e38d462611..9931648460 100644 --- a/SRC/dtpqrt2.f +++ b/SRC/dtpqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtprfb.f b/SRC/dtprfb.f index 18a132ddba..272ec6bebb 100644 --- a/SRC/dtprfb.f +++ b/SRC/dtprfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPRFB applies a real "triangular-pentagonal" block reflector to a real matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtprfs.f b/SRC/dtprfs.f index abeb49e065..ff7acb5777 100644 --- a/SRC/dtprfs.f +++ b/SRC/dtprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtptri.f b/SRC/dtptri.f index 34706941b3..2396a564ae 100644 --- a/SRC/dtptri.f +++ b/SRC/dtptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtptrs.f b/SRC/dtptrs.f index 8503d23838..bc79145ea8 100644 --- a/SRC/dtptrs.f +++ b/SRC/dtptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpttf.f b/SRC/dtpttf.f index 7764174af6..332fd1e11c 100644 --- a/SRC/dtpttf.f +++ b/SRC/dtpttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpttr.f b/SRC/dtpttr.f index 5599762e77..3a1020573b 100644 --- a/SRC/dtpttr.f +++ b/SRC/dtpttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrcon.f b/SRC/dtrcon.f index cfa2919091..b166eba65b 100644 --- a/SRC/dtrcon.f +++ b/SRC/dtrcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrevc.f b/SRC/dtrevc.f index 82cd89ec54..8c5c526913 100644 --- a/SRC/dtrevc.f +++ b/SRC/dtrevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrevc3.f b/SRC/dtrevc3.f index f1e6f25706..c411980a4b 100644 --- a/SRC/dtrevc3.f +++ b/SRC/dtrevc3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrexc.f b/SRC/dtrexc.f index 26933861b2..30a358efab 100644 --- a/SRC/dtrexc.f +++ b/SRC/dtrexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrrfs.f b/SRC/dtrrfs.f index 6384d958c9..fa3e7546ca 100644 --- a/SRC/dtrrfs.f +++ b/SRC/dtrrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsen.f b/SRC/dtrsen.f index 3d78c11ab7..e0ee7cbafe 100644 --- a/SRC/dtrsen.f +++ b/SRC/dtrsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsna.f b/SRC/dtrsna.f index 1676a7ecd3..adc19079bd 100644 --- a/SRC/dtrsna.f +++ b/SRC/dtrsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsyl.f b/SRC/dtrsyl.f index d8828557c3..8f45dfb6ff 100644 --- a/SRC/dtrsyl.f +++ b/SRC/dtrsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index 31a5230ba5..37397c86e5 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRSYL3 * * Definition: diff --git a/SRC/dtrti2.f b/SRC/dtrti2.f index 20fa063461..0f8da2b6a3 100644 --- a/SRC/dtrti2.f +++ b/SRC/dtrti2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrtri.f b/SRC/dtrtri.f index 04f7abc1e2..7368a184bf 100644 --- a/SRC/dtrtri.f +++ b/SRC/dtrtri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrtrs.f b/SRC/dtrtrs.f index 5cdd78b2b1..e79264f47e 100644 --- a/SRC/dtrtrs.f +++ b/SRC/dtrtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrttf.f b/SRC/dtrttf.f index 44be78a19c..311dd58be7 100644 --- a/SRC/dtrttf.f +++ b/SRC/dtrttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrttp.f b/SRC/dtrttp.f index 072fcc325d..4a32f4241f 100644 --- a/SRC/dtrttp.f +++ b/SRC/dtrttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtzrzf.f b/SRC/dtzrzf.f index 0ede8a292e..1fa7b0f9fe 100644 --- a/SRC/dtzrzf.f +++ b/SRC/dtzrzf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/dzsum1.f b/SRC/dzsum1.f index 4fc95d002b..83a5415ba8 100644 --- a/SRC/dzsum1.f +++ b/SRC/dzsum1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DZSUM1 forms the 1-norm of the complex vector using the true absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/icmax1.f b/SRC/icmax1.f index a17dbed86d..3ee188ff99 100644 --- a/SRC/icmax1.f +++ b/SRC/icmax1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ICMAX1 finds the index of the first vector element of maximum absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/ieeeck.f b/SRC/ieeeck.f index 9b9e8fabc4..216b90147f 100644 --- a/SRC/ieeeck.f +++ b/SRC/ieeeck.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b IEEECK * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaclc.f b/SRC/ilaclc.f index fff4dda2f6..fa8169d990 100644 --- a/SRC/ilaclc.f +++ b/SRC/ilaclc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILACLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaclr.f b/SRC/ilaclr.f index a40bf57aec..58894d7e7c 100644 --- a/SRC/ilaclr.f +++ b/SRC/ilaclr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILACLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/iladiag.f b/SRC/iladiag.f index 2941f67ef5..340af2c601 100644 --- a/SRC/iladiag.f +++ b/SRC/iladiag.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILADIAG * * =========== DOCUMENTATION =========== diff --git a/SRC/iladlc.f b/SRC/iladlc.f index c5ef963c4b..b0784db4cc 100644 --- a/SRC/iladlc.f +++ b/SRC/iladlc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILADLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/iladlr.f b/SRC/iladlr.f index 900df1c1a7..ece39b1007 100644 --- a/SRC/iladlr.f +++ b/SRC/iladlr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILADLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaenv.f b/SRC/ilaenv.f index e74a2b35ec..cc1ab4df2d 100644 --- a/SRC/ilaenv.f +++ b/SRC/ilaenv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAENV * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaenv2stage.f b/SRC/ilaenv2stage.f index 6f07b84fb3..5f4f29915d 100644 --- a/SRC/ilaenv2stage.f +++ b/SRC/ilaenv2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAENV2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaprec.f b/SRC/ilaprec.f index d9bfe1ebef..d19778ddb9 100644 --- a/SRC/ilaprec.f +++ b/SRC/ilaprec.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAPREC * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaslc.f b/SRC/ilaslc.f index 791d49c35f..8fdabd2b6c 100644 --- a/SRC/ilaslc.f +++ b/SRC/ilaslc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILASLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaslr.f b/SRC/ilaslr.f index db37d2a539..cd7787e784 100644 --- a/SRC/ilaslr.f +++ b/SRC/ilaslr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILASLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilatrans.f b/SRC/ilatrans.f index 183757485d..8f38046880 100644 --- a/SRC/ilatrans.f +++ b/SRC/ilatrans.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILATRANS * * =========== DOCUMENTATION =========== diff --git a/SRC/ilauplo.f b/SRC/ilauplo.f index af23a0218f..b23396a4ce 100644 --- a/SRC/ilauplo.f +++ b/SRC/ilauplo.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAUPLO * * =========== DOCUMENTATION =========== diff --git a/SRC/ilazlc.f b/SRC/ilazlc.f index 359f0ae2d3..dccd84385f 100644 --- a/SRC/ilazlc.f +++ b/SRC/ilazlc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAZLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilazlr.f b/SRC/ilazlr.f index f4359bd56e..e152d2f949 100644 --- a/SRC/ilazlr.f +++ b/SRC/ilazlr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ILAZLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/iparam2stage.F b/SRC/iparam2stage.F index 9aafb16ea9..4b7d054556 100644 --- a/SRC/iparam2stage.F +++ b/SRC/iparam2stage.F @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b IPARAM2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/iparmq.f b/SRC/iparmq.f index 481115575e..07f89d1ae4 100644 --- a/SRC/iparmq.f +++ b/SRC/iparmq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b IPARMQ * * =========== DOCUMENTATION =========== diff --git a/SRC/izmax1.f b/SRC/izmax1.f index 6474711e13..f76df1f4d5 100644 --- a/SRC/izmax1.f +++ b/SRC/izmax1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b IZMAX1 finds the index of the first vector element of maximum absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 3970e3a055..9f0ee99cc5 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b LA_CONSTANTS is a module for the scaling constants for the compiled Fortran single and double precisions ! ! =========== DOCUMENTATION =========== diff --git a/SRC/la_xisnan.F90 b/SRC/la_xisnan.F90 index 50966a5c18..9bf63519b7 100644 --- a/SRC/la_xisnan.F90 +++ b/SRC/la_xisnan.F90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" module LA_XISNAN interface LA_ISNAN diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h new file mode 100644 index 0000000000..38b6dac3c4 --- /dev/null +++ b/SRC/lapack_64.h @@ -0,0 +1,2255 @@ +#ifndef LAPACK_64_H +#define LAPACK_64_H +#ifdef LAPACK_64 + +#define BLAS_CGBMV_X BLAS_CGBMV_X_64 +#define BLAS_CGEMV_X BLAS_CGEMV_X_64 +#define BLAS_CHEMV_X BLAS_CHEMV_X_64 +#define BLAS_CSYMV_X BLAS_CSYMV_X_64 +#define BLAS_DGBMV_X BLAS_DGBMV_X_64 +#define BLAS_DGEMV_X BLAS_DGEMV_X_64 +#define BLAS_DSYMV_X BLAS_DSYMV_X_64 +#define BLAS_SGBMV_X BLAS_SGBMV_X_64 +#define BLAS_SGEMV_X BLAS_SGEMV_X_64 +#define BLAS_SSYMV_X BLAS_SSYMV_X_64 +#define BLAS_ZGBMV_X BLAS_ZGBMV_X_64 +#define BLAS_ZGEMV_X BLAS_ZGEMV_X_64 +#define BLAS_ZHEMV_X BLAS_ZHEMV_X_64 +#define BLAS_ZSYMV_X BLAS_ZSYMV_X_64 +#define CAXPY CAXPY_64 +#define CBBCSD CBBCSD_64 +#define CBDSQR CBDSQR_64 +#define CCOPY CCOPY_64 +#define CDOTC CDOTC_64 +#define CDOTU CDOTU_64 +#define CGBBRD CGBBRD_64 +#define CGBCON CGBCON_64 +#define CGBEQU CGBEQU_64 +#define CGBEQUB CGBEQUB_64 +#define CGBMV CGBMV_64 +#define CGBRFS CGBRFS_64 +#define CGBRFSX CGBRFSX_64 +#define CGBSV CGBSV_64 +#define CGBSVX CGBSVX_64 +#define CGBSVXX CGBSVXX_64 +#define CGBTF2 CGBTF2_64 +#define CGBTRF CGBTRF_64 +#define CGBTRS CGBTRS_64 +#define CGEBAK CGEBAK_64 +#define CGEBAL CGEBAL_64 +#define CGEBD2 CGEBD2_64 +#define CGEBRD CGEBRD_64 +#define CGECON CGECON_64 +#define CGEDMD CGEDMD_64 +#define CGEDMDQ CGEDMDQ_64 +#define CGEEQU CGEEQU_64 +#define CGEEQUB CGEEQUB_64 +#define CGEES CGEES_64 +#define CGEESX CGEESX_64 +#define CGEEV CGEEV_64 +#define CGEEVX CGEEVX_64 +#define CGEGS CGEGS_64 +#define CGEGV CGEGV_64 +#define CGEHD2 CGEHD2_64 +#define CGEHRD CGEHRD_64 +#define CGEJSV CGEJSV_64 +#define CGELQ CGELQ_64 +#define CGELQ2 CGELQ2_64 +#define CGELQF CGELQF_64 +#define CGELQT CGELQT_64 +#define CGELQT3 CGELQT3_64 +#define CGELS CGELS_64 +#define CGELSD CGELSD_64 +#define CGELSS CGELSS_64 +#define CGELST CGELST_64 +#define CGELSX CGELSX_64 +#define CGELSY CGELSY_64 +#define CGEMLQ CGEMLQ_64 +#define CGEMLQT CGEMLQT_64 +#define CGEMM CGEMM_64 +#define CGEMQR CGEMQR_64 +#define CGEMQRT CGEMQRT_64 +#define CGEMV CGEMV_64 +#define CGEQL2 CGEQL2_64 +#define CGEQLF CGEQLF_64 +#define CGEQP3 CGEQP3_64 +#define CGEQPF CGEQPF_64 +#define CGEQR CGEQR_64 +#define CGEQR2 CGEQR2_64 +#define CGEQR2P CGEQR2P_64 +#define CGEQRF CGEQRF_64 +#define CGEQRF CGEQRF_64 +#define CGEQRFP CGEQRFP_64 +#define CGEQRT CGEQRT_64 +#define CGEQRT2 CGEQRT2_64 +#define CGEQRT3 CGEQRT3_64 +#define CGERC CGERC_64 +#define CGERFS CGERFS_64 +#define CGERFSX CGERFSX_64 +#define CGERQ2 CGERQ2_64 +#define CGERQF CGERQF_64 +#define CGERU CGERU_64 +#define CGESC2 CGESC2_64 +#define CGESDD CGESDD_64 +#define CGESV CGESV_64 +#define CGESVD CGESVD_64 +#define CGESVDQ CGESVDQ_64 +#define CGESVDX CGESVDX_64 +#define CGESVJ CGESVJ_64 +#define CGESVX CGESVX_64 +#define CGESVXX CGESVXX_64 +#define CGETC2 CGETC2_64 +#define CGETF2 CGETF2_64 +#define CGETRF CGETRF_64 +#define CGETRF CGETRF_64 +#define CGETRF2 CGETRF2_64 +#define CGETRI CGETRI_64 +#define CGETRS CGETRS_64 +#define CGETSLS CGETSLS_64 +#define CGETSQRHRT CGETSQRHRT_64 +#define CGGBAK CGGBAK_64 +#define CGGBAL CGGBAL_64 +#define CGGES CGGES_64 +#define CGGES3 CGGES3_64 +#define CGGESX CGGESX_64 +#define CGGEV CGGEV_64 +#define CGGEV3 CGGEV3_64 +#define CGGEVX CGGEVX_64 +#define CGGGLM CGGGLM_64 +#define CGGHD3 CGGHD3_64 +#define CGGHRD CGGHRD_64 +#define CGGLSE CGGLSE_64 +#define CGGQRF CGGQRF_64 +#define CGGRQF CGGRQF_64 +#define CGGSVD CGGSVD_64 +#define CGGSVD3 CGGSVD3_64 +#define CGGSVP CGGSVP_64 +#define CGGSVP3 CGGSVP3_64 +#define CGSVJ0 CGSVJ0_64 +#define CGSVJ1 CGSVJ1_64 +#define CGTCON CGTCON_64 +#define CGTRFS CGTRFS_64 +#define CGTSV CGTSV_64 +#define CGTSVX CGTSVX_64 +#define CGTTRF CGTTRF_64 +#define CGTTRS CGTTRS_64 +#define CGTTS2 CGTTS2_64 +#define CHB2ST_KERNELS CHB2ST_KERNELS_64 +#define CHBEV CHBEV_64 +#define CHBEV_2STAGE CHBEV_2STAGE_64 +#define CHBEVD CHBEVD_64 +#define CHBEVD_2STAGE CHBEVD_2STAGE_64 +#define CHBEVX CHBEVX_64 +#define CHBEVX_2STAGE CHBEVX_2STAGE_64 +#define CHBGST CHBGST_64 +#define CHBGV CHBGV_64 +#define CHBGVD CHBGVD_64 +#define CHBGVX CHBGVX_64 +#define CHBMV CHBMV_64 +#define CHBTRD CHBTRD_64 +#define CHECON CHECON_64 +#define CHECON_3 CHECON_3_64 +#define CHECON_ROOK CHECON_ROOK_64 +#define CHEEQUB CHEEQUB_64 +#define CHEEV CHEEV_64 +#define CHEEV_2STAGE CHEEV_2STAGE_64 +#define CHEEVD CHEEVD_64 +#define CHEEVD_2STAGE CHEEVD_2STAGE_64 +#define CHEEVR CHEEVR_64 +#define CHEEVR_2STAGE CHEEVR_2STAGE_64 +#define CHEEVX CHEEVX_64 +#define CHEEVX_2STAGE CHEEVX_2STAGE_64 +#define CHEGS2 CHEGS2_64 +#define CHEGST CHEGST_64 +#define CHEGV CHEGV_64 +#define CHEGV_2STAGE CHEGV_2STAGE_64 +#define CHEGVD CHEGVD_64 +#define CHEGVX CHEGVX_64 +#define CHEMM CHEMM_64 +#define CHEMV CHEMV_64 +#define CHER CHER_64 +#define CHER2 CHER2_64 +#define CHER2K CHER2K_64 +#define CHERFS CHERFS_64 +#define CHERFSX CHERFSX_64 +#define CHERK CHERK_64 +#define CHESV CHESV_64 +#define CHESV_AA CHESV_AA_64 +#define CHESV_AA_2STAGE CHESV_AA_2STAGE_64 +#define CHESV_RK CHESV_RK_64 +#define CHESV_ROOK CHESV_ROOK_64 +#define CHESVX CHESVX_64 +#define CHESVXX CHESVXX_64 +#define CHESWAPR CHESWAPR_64 +#define CHETD2 CHETD2_64 +#define CHETF2 CHETF2_64 +#define CHETF2_RK CHETF2_RK_64 +#define CHETF2_ROOK CHETF2_ROOK_64 +#define CHETRD CHETRD_64 +#define CHETRD_2STAGE CHETRD_2STAGE_64 +#define CHETRD_HB2ST CHETRD_HB2ST_64 +#define CHETRD_HE2HB CHETRD_HE2HB_64 +#define CHETRF CHETRF_64 +#define CHETRF_AA CHETRF_AA_64 +#define CHETRF_AA_2STAGE CHETRF_AA_2STAGE_64 +#define CHETRF_RK CHETRF_RK_64 +#define CHETRF_ROOK CHETRF_ROOK_64 +#define CHETRI CHETRI_64 +#define CHETRI2 CHETRI2_64 +#define CHETRI2X CHETRI2X_64 +#define CHETRI_3 CHETRI_3_64 +#define CHETRI_3X CHETRI_3X_64 +#define CHETRI_ROOK CHETRI_ROOK_64 +#define CHETRS CHETRS_64 +#define CHETRS2 CHETRS2_64 +#define CHETRS_3 CHETRS_3_64 +#define CHETRS_AA CHETRS_AA_64 +#define CHETRS_AA_2STAGE CHETRS_AA_2STAGE_64 +#define CHETRS_ROOK CHETRS_ROOK_64 +#define CHFRK CHFRK_64 +#define CHGEQZ CHGEQZ_64 +#define CHLA_TRANSTYPE CHLA_TRANSTYPE_64 +#define CHPCON CHPCON_64 +#define CHPEV CHPEV_64 +#define CHPEVD CHPEVD_64 +#define CHPEVX CHPEVX_64 +#define CHPGST CHPGST_64 +#define CHPGV CHPGV_64 +#define CHPGVD CHPGVD_64 +#define CHPGVX CHPGVX_64 +#define CHPMV CHPMV_64 +#define CHPR CHPR_64 +#define CHPR2 CHPR2_64 +#define CHPRFS CHPRFS_64 +#define CHPSV CHPSV_64 +#define CHPSVX CHPSVX_64 +#define CHPTRD CHPTRD_64 +#define CHPTRF CHPTRF_64 +#define CHPTRI CHPTRI_64 +#define CHPTRS CHPTRS_64 +#define CHSEIN CHSEIN_64 +#define CHSEQR CHSEQR_64 +#define CLABRD CLABRD_64 +#define CLACGV CLACGV_64 +#define CLACN2 CLACN2_64 +#define CLACON CLACON_64 +#define CLACP2 CLACP2_64 +#define CLACPY CLACPY_64 +#define CLACRM CLACRM_64 +#define CLACRT CLACRT_64 +#define CLADIV CLADIV_64 +#define CLAED0 CLAED0_64 +#define CLAED7 CLAED7_64 +#define CLAED8 CLAED8_64 +#define CLAEIN CLAEIN_64 +#define CLAESY CLAESY_64 +#define CLAEV2 CLAEV2_64 +#define CLAG2Z CLAG2Z_64 +#define CLA_GBAMV CLA_GBAMV_64 +#define CLA_GBRCOND_C CLA_GBRCOND_C_64 +#define CLA_GBRCOND_X CLA_GBRCOND_X_64 +#define CLA_GBRFSX_EXTENDED CLA_GBRFSX_EXTENDED_64 +#define CLA_GBRPVGRW CLA_GBRPVGRW_64 +#define CLA_GEAMV CLA_GEAMV_64 +#define CLA_GERCOND_C CLA_GERCOND_C_64 +#define CLA_GERCOND_X CLA_GERCOND_X_64 +#define CLA_GERFSX_EXTENDED CLA_GERFSX_EXTENDED_64 +#define CLA_GERPVGRW CLA_GERPVGRW_64 +#define CLAGS2 CLAGS2_64 +#define CLAGTM CLAGTM_64 +#define CLA_HEAMV CLA_HEAMV_64 +#define CLAHEF CLAHEF_64 +#define CLAHEF_AA CLAHEF_AA_64 +#define CLAHEF_RK CLAHEF_RK_64 +#define CLAHEF_ROOK CLAHEF_ROOK_64 +#define CLA_HERCOND_C CLA_HERCOND_C_64 +#define CLA_HERCOND_X CLA_HERCOND_X_64 +#define CLA_HERFSX_EXTENDED CLA_HERFSX_EXTENDED_64 +#define CLA_HERPVGRW CLA_HERPVGRW_64 +#define CLAHQR CLAHQR_64 +#define CLAHR2 CLAHR2_64 +#define CLAHRD CLAHRD_64 +#define CLAIC1 CLAIC1_64 +#define CLA_LIN_BERR CLA_LIN_BERR_64 +#define CLALS0 CLALS0_64 +#define CLALSA CLALSA_64 +#define CLALSD CLALSD_64 +#define CLAMSWLQ CLAMSWLQ_64 +#define CLAMTSQR CLAMTSQR_64 +#define CLANGB CLANGB_64 +#define CLANGE CLANGE_64 +#define CLANGT CLANGT_64 +#define CLANHB CLANHB_64 +#define CLANHE CLANHE_64 +#define CLANHF CLANHF_64 +#define CLANHP CLANHP_64 +#define CLANHS CLANHS_64 +#define CLANHT CLANHT_64 +#define CLANSB CLANSB_64 +#define CLANSP CLANSP_64 +#define CLANSY CLANSY_64 +#define CLANTB CLANTB_64 +#define CLANTP CLANTP_64 +#define CLANTR CLANTR_64 +#define CLAPLL CLAPLL_64 +#define CLAPMR CLAPMR_64 +#define CLAPMT CLAPMT_64 +#define CLA_PORCOND_C CLA_PORCOND_C_64 +#define CLA_PORCOND_X CLA_PORCOND_X_64 +#define CLA_PORFSX_EXTENDED CLA_PORFSX_EXTENDED_64 +#define CLA_PORPVGRW CLA_PORPVGRW_64 +#define CLAQGB CLAQGB_64 +#define CLAQGE CLAQGE_64 +#define CLAQHB CLAQHB_64 +#define CLAQHE CLAQHE_64 +#define CLAQHP CLAQHP_64 +#define CLAQP2 CLAQP2_64 +#define CLAQPS CLAQPS_64 +#define CLAQR0 CLAQR0_64 +#define CLAQR1 CLAQR1_64 +#define CLAQR2 CLAQR2_64 +#define CLAQR3 CLAQR3_64 +#define CLAQR4 CLAQR4_64 +#define CLAQR5 CLAQR5_64 +#define CLAQSB CLAQSB_64 +#define CLAQSP CLAQSP_64 +#define CLAQSY CLAQSY_64 +#define CLAQZ0 CLAQZ0_64 +#define CLAQZ1 CLAQZ1_64 +#define CLAQZ2 CLAQZ2_64 +#define CLAQZ3 CLAQZ3_64 +#define CLAR1V CLAR1V_64 +#define CLAR2V CLAR2V_64 +#define CLARCM CLARCM_64 +#define CLARF CLARF_64 +#define CLARFB CLARFB_64 +#define CLARFB_GETT CLARFB_GETT_64 +#define CLARFG CLARFG_64 +#define CLARFGP CLARFGP_64 +#define CLARFT CLARFT_64 +#define CLARFX CLARFX_64 +#define CLARFY CLARFY_64 +#define CLARGV CLARGV_64 +#define CLARNV CLARNV_64 +#define CLARRV CLARRV_64 +#define CLARSCL2 CLARSCL2_64 +#define CLARTG CLARTG_64 +#define CLARTV CLARTV_64 +#define CLARZ CLARZ_64 +#define CLARZB CLARZB_64 +#define CLARZT CLARZT_64 +#define CLASCL CLASCL_64 +#define CLASCL2 CLASCL2_64 +#define CLASET CLASET_64 +#define CLASR CLASR_64 +#define CLASSQ CLASSQ_64 +#define CLASWLQ CLASWLQ_64 +#define CLASWP CLASWP_64 +#define CLA_SYAMV CLA_SYAMV_64 +#define CLASYF CLASYF_64 +#define CLASYF_AA CLASYF_AA_64 +#define CLASYF_RK CLASYF_RK_64 +#define CLASYF_ROOK CLASYF_ROOK_64 +#define CLA_SYRCOND_C CLA_SYRCOND_C_64 +#define CLA_SYRCOND_X CLA_SYRCOND_X_64 +#define CLA_SYRFSX_EXTENDED CLA_SYRFSX_EXTENDED_64 +#define CLA_SYRPVGRW CLA_SYRPVGRW_64 +#define CLATBS CLATBS_64 +#define CLATDF CLATDF_64 +#define CLATPS CLATPS_64 +#define CLATRD CLATRD_64 +#define CLATRS CLATRS_64 +#define CLATRS3 CLATRS3_64 +#define CLATRZ CLATRZ_64 +#define CLATSQR CLATSQR_64 +#define CLATZM CLATZM_64 +#define CLAUNHR_COL_GETRFNP CLAUNHR_COL_GETRFNP_64 +#define CLAUNHR_COL_GETRFNP2 CLAUNHR_COL_GETRFNP2_64 +#define CLAUU2 CLAUU2_64 +#define CLAUUM CLAUUM_64 +#define CLA_WWADDW CLA_WWADDW_64 +#define CPBCON CPBCON_64 +#define CPBEQU CPBEQU_64 +#define CPBRFS CPBRFS_64 +#define CPBSTF CPBSTF_64 +#define CPBSV CPBSV_64 +#define CPBSVX CPBSVX_64 +#define CPBTF2 CPBTF2_64 +#define CPBTRF CPBTRF_64 +#define CPBTRS CPBTRS_64 +#define CPFTRF CPFTRF_64 +#define CPFTRI CPFTRI_64 +#define CPFTRS CPFTRS_64 +#define CPOCON CPOCON_64 +#define CPOEQU CPOEQU_64 +#define CPOEQUB CPOEQUB_64 +#define CPORFS CPORFS_64 +#define CPORFSX CPORFSX_64 +#define CPOSV CPOSV_64 +#define CPOSVX CPOSVX_64 +#define CPOSVXX CPOSVXX_64 +#define CPOTF2 CPOTF2_64 +#define CPOTRF CPOTRF_64 +#define CPOTRF CPOTRF_64 +#define CPOTRF2 CPOTRF2_64 +#define CPOTRI CPOTRI_64 +#define CPOTRS CPOTRS_64 +#define CPPCON CPPCON_64 +#define CPPEQU CPPEQU_64 +#define CPPRFS CPPRFS_64 +#define CPPSV CPPSV_64 +#define CPPSVX CPPSVX_64 +#define CPPTRF CPPTRF_64 +#define CPPTRI CPPTRI_64 +#define CPPTRS CPPTRS_64 +#define CPSTF2 CPSTF2_64 +#define CPSTRF CPSTRF_64 +#define CPTCON CPTCON_64 +#define CPTEQR CPTEQR_64 +#define CPTRFS CPTRFS_64 +#define CPTSV CPTSV_64 +#define CPTSVX CPTSVX_64 +#define CPTTRF CPTTRF_64 +#define CPTTRS CPTTRS_64 +#define CPTTS2 CPTTS2_64 +#define CROT CROT_64 +#define CRSCL CRSCL_64 +#define CSCAL CSCAL_64 +#define CSPCON CSPCON_64 +#define CSPMV CSPMV_64 +#define CSPR CSPR_64 +#define CSPRFS CSPRFS_64 +#define CSPSV CSPSV_64 +#define CSPSVX CSPSVX_64 +#define CSPTRF CSPTRF_64 +#define CSPTRI CSPTRI_64 +#define CSPTRS CSPTRS_64 +#define CSROT CSROT_64 +#define CSRSCL CSRSCL_64 +#define CSSCAL CSSCAL_64 +#define CSTEDC CSTEDC_64 +#define CSTEGR CSTEGR_64 +#define CSTEIN CSTEIN_64 +#define CSTEMR CSTEMR_64 +#define CSTEQR CSTEQR_64 +#define CSWAP CSWAP_64 +#define CSYCON CSYCON_64 +#define CSYCON_3 CSYCON_3_64 +#define CSYCON_ROOK CSYCON_ROOK_64 +#define CSYCONV CSYCONV_64 +#define CSYCONVF CSYCONVF_64 +#define CSYCONVF_ROOK CSYCONVF_ROOK_64 +#define CSYEQUB CSYEQUB_64 +#define CSYMV CSYMV_64 +#define CSYR CSYR_64 +#define CSYRFS CSYRFS_64 +#define CSYRFSX CSYRFSX_64 +#define CSYSV CSYSV_64 +#define CSYSV_AA CSYSV_AA_64 +#define CSYSV_AA_2STAGE CSYSV_AA_2STAGE_64 +#define CSYSV_RK CSYSV_RK_64 +#define CSYSV_ROOK CSYSV_ROOK_64 +#define CSYSVX CSYSVX_64 +#define CSYSVXX CSYSVXX_64 +#define CSYSWAPR CSYSWAPR_64 +#define CSYTF2 CSYTF2_64 +#define CSYTF2_RK CSYTF2_RK_64 +#define CSYTF2_ROOK CSYTF2_ROOK_64 +#define CSYTRF CSYTRF_64 +#define CSYTRF_AA CSYTRF_AA_64 +#define CSYTRF_AA_2STAGE CSYTRF_AA_2STAGE_64 +#define CSYTRF_RK CSYTRF_RK_64 +#define CSYTRF_ROOK CSYTRF_ROOK_64 +#define CSYTRI CSYTRI_64 +#define CSYTRI2 CSYTRI2_64 +#define CSYTRI2X CSYTRI2X_64 +#define CSYTRI_3 CSYTRI_3_64 +#define CSYTRI_3X CSYTRI_3X_64 +#define CSYTRI_ROOK CSYTRI_ROOK_64 +#define CSYTRS CSYTRS_64 +#define CSYTRS2 CSYTRS2_64 +#define CSYTRS_3 CSYTRS_3_64 +#define CSYTRS_AA CSYTRS_AA_64 +#define CSYTRS_AA_2STAGE CSYTRS_AA_2STAGE_64 +#define CSYTRS_ROOK CSYTRS_ROOK_64 +#define CTBCON CTBCON_64 +#define CTBMV CTBMV_64 +#define CTBRFS CTBRFS_64 +#define CTBSV CTBSV_64 +#define CTBTRS CTBTRS_64 +#define CTFSM CTFSM_64 +#define CTFTRI CTFTRI_64 +#define CTFTTP CTFTTP_64 +#define CTFTTR CTFTTR_64 +#define CTGEVC CTGEVC_64 +#define CTGEX2 CTGEX2_64 +#define CTGEXC CTGEXC_64 +#define CTGSEN CTGSEN_64 +#define CTGSJA CTGSJA_64 +#define CTGSNA CTGSNA_64 +#define CTGSY2 CTGSY2_64 +#define CTGSYL CTGSYL_64 +#define CTPCON CTPCON_64 +#define CTPLQT CTPLQT_64 +#define CTPLQT2 CTPLQT2_64 +#define CTPMLQT CTPMLQT_64 +#define CTPMQRT CTPMQRT_64 +#define CTPMV CTPMV_64 +#define CTPQRT CTPQRT_64 +#define CTPQRT2 CTPQRT2_64 +#define CTPRFB CTPRFB_64 +#define CTPRFS CTPRFS_64 +#define CTPSV CTPSV_64 +#define CTPTRI CTPTRI_64 +#define CTPTRS CTPTRS_64 +#define CTPTTF CTPTTF_64 +#define CTPTTR CTPTTR_64 +#define CTRCON CTRCON_64 +#define CTREVC CTREVC_64 +#define CTREVC3 CTREVC3_64 +#define CTREXC CTREXC_64 +#define CTRMM CTRMM_64 +#define CTRMV CTRMV_64 +#define CTRRFS CTRRFS_64 +#define CTRSEN CTRSEN_64 +#define CTRSM CTRSM_64 +#define CTRSNA CTRSNA_64 +#define CTRSV CTRSV_64 +#define CTRSYL CTRSYL_64 +#define CTRSYL3 CTRSYL3_64 +#define CTRTI2 CTRTI2_64 +#define CTRTRI CTRTRI_64 +#define CTRTRS CTRTRS_64 +#define CTRTTF CTRTTF_64 +#define CTRTTP CTRTTP_64 +#define CTZRQF CTZRQF_64 +#define CTZRZF CTZRZF_64 +#define CUNBDB CUNBDB_64 +#define CUNBDB1 CUNBDB1_64 +#define CUNBDB2 CUNBDB2_64 +#define CUNBDB3 CUNBDB3_64 +#define CUNBDB4 CUNBDB4_64 +#define CUNBDB5 CUNBDB5_64 +#define CUNBDB6 CUNBDB6_64 +#define CUNCSD CUNCSD_64 +#define CUNCSD2BY1 CUNCSD2BY1_64 +#define CUNG2L CUNG2L_64 +#define CUNG2R CUNG2R_64 +#define CUNGBR CUNGBR_64 +#define CUNGHR CUNGHR_64 +#define CUNGL2 CUNGL2_64 +#define CUNGLQ CUNGLQ_64 +#define CUNGQL CUNGQL_64 +#define CUNGQR CUNGQR_64 +#define CUNGR2 CUNGR2_64 +#define CUNGRQ CUNGRQ_64 +#define CUNGTR CUNGTR_64 +#define CUNGTSQR CUNGTSQR_64 +#define CUNGTSQR_ROW CUNGTSQR_ROW_64 +#define CUNHR_COL CUNHR_COL_64 +#define CUNM22 CUNM22_64 +#define CUNM2L CUNM2L_64 +#define CUNM2R CUNM2R_64 +#define CUNMBR CUNMBR_64 +#define CUNMHR CUNMHR_64 +#define CUNML2 CUNML2_64 +#define CUNMLQ CUNMLQ_64 +#define CUNMQL CUNMQL_64 +#define CUNMQR CUNMQR_64 +#define CUNMR2 CUNMR2_64 +#define CUNMR3 CUNMR3_64 +#define CUNMRQ CUNMRQ_64 +#define CUNMRZ CUNMRZ_64 +#define CUNMTR CUNMTR_64 +#define CUPGTR CUPGTR_64 +#define CUPMTR CUPMTR_64 +#define DASUM DASUM_64 +#define DAXPY DAXPY_64 +#define DBBCSD DBBCSD_64 +#define DBDSDC DBDSDC_64 +#define DBDSQR DBDSQR_64 +#define DBDSVDX DBDSVDX_64 +#define DCOPY DCOPY_64 +#define DDISNA DDISNA_64 +#define DDOT DDOT_64 +#define DGBBRD DGBBRD_64 +#define DGBCON DGBCON_64 +#define DGBEQU DGBEQU_64 +#define DGBEQUB DGBEQUB_64 +#define DGBMV DGBMV_64 +#define DGBRFS DGBRFS_64 +#define DGBRFSX DGBRFSX_64 +#define DGBSV DGBSV_64 +#define DGBSVX DGBSVX_64 +#define DGBSVXX DGBSVXX_64 +#define DGBTF2 DGBTF2_64 +#define DGBTRF DGBTRF_64 +#define DGBTRS DGBTRS_64 +#define DGEBAK DGEBAK_64 +#define DGEBAL DGEBAL_64 +#define DGEBD2 DGEBD2_64 +#define DGEBRD DGEBRD_64 +#define DGECON DGECON_64 +#define DGEDMD DGEDMD_64 +#define DGEDMD DGEDMD_64 +#define DGEDMDQ DGEDMDQ_64 +#define DGEEQU DGEEQU_64 +#define DGEEQUB DGEEQUB_64 +#define DGEES DGEES_64 +#define DGEESX DGEESX_64 +#define DGEEV DGEEV_64 +#define DGEEVX DGEEVX_64 +#define DGEGS DGEGS_64 +#define DGEGV DGEGV_64 +#define DGEHD2 DGEHD2_64 +#define DGEHRD DGEHRD_64 +#define DGEJSV DGEJSV_64 +#define DGELQ DGELQ_64 +#define DGELQ2 DGELQ2_64 +#define DGELQF DGELQF_64 +#define DGELQT DGELQT_64 +#define DGELQT3 DGELQT3_64 +#define DGELS DGELS_64 +#define DGELSD DGELSD_64 +#define DGELSS DGELSS_64 +#define DGELST DGELST_64 +#define DGELSX DGELSX_64 +#define DGELSY DGELSY_64 +#define DGEMLQ DGEMLQ_64 +#define DGEMLQT DGEMLQT_64 +#define DGEMM DGEMM_64 +#define DGEMQR DGEMQR_64 +#define DGEMQRT DGEMQRT_64 +#define DGEMV DGEMV_64 +#define DGEQL2 DGEQL2_64 +#define DGEQLF DGEQLF_64 +#define DGEQP3 DGEQP3_64 +#define DGEQPF DGEQPF_64 +#define DGEQR DGEQR_64 +#define DGEQR2 DGEQR2_64 +#define DGEQR2P DGEQR2P_64 +#define DGEQRF DGEQRF_64 +#define DGEQRF DGEQRF_64 +#define DGEQRFP DGEQRFP_64 +#define DGEQRT DGEQRT_64 +#define DGEQRT2 DGEQRT2_64 +#define DGEQRT3 DGEQRT3_64 +#define DGER DGER_64 +#define DGERFS DGERFS_64 +#define DGERFSX DGERFSX_64 +#define DGERQ2 DGERQ2_64 +#define DGERQF DGERQF_64 +#define DGESC2 DGESC2_64 +#define DGESDD DGESDD_64 +#define DGESV DGESV_64 +#define DGESVD DGESVD_64 +#define DGESVDQ DGESVDQ_64 +#define DGESVDX DGESVDX_64 +#define DGESVJ DGESVJ_64 +#define DGESVX DGESVX_64 +#define DGESVXX DGESVXX_64 +#define DGETC2 DGETC2_64 +#define DGETF2 DGETF2_64 +#define DGETRF DGETRF_64 +#define DGETRF DGETRF_64 +#define DGETRF2 DGETRF2_64 +#define DGETRI DGETRI_64 +#define DGETRS DGETRS_64 +#define DGETSLS DGETSLS_64 +#define DGETSQRHRT DGETSQRHRT_64 +#define DGGBAK DGGBAK_64 +#define DGGBAL DGGBAL_64 +#define DGGES DGGES_64 +#define DGGES3 DGGES3_64 +#define DGGESX DGGESX_64 +#define DGGEV DGGEV_64 +#define DGGEV3 DGGEV3_64 +#define DGGEVX DGGEVX_64 +#define DGGGLM DGGGLM_64 +#define DGGHD3 DGGHD3_64 +#define DGGHRD DGGHRD_64 +#define DGGLSE DGGLSE_64 +#define DGGQRF DGGQRF_64 +#define DGGRQF DGGRQF_64 +#define DGGSVD DGGSVD_64 +#define DGGSVD3 DGGSVD3_64 +#define DGGSVP DGGSVP_64 +#define DGGSVP3 DGGSVP3_64 +#define DGSVJ0 DGSVJ0_64 +#define DGSVJ1 DGSVJ1_64 +#define DGTCON DGTCON_64 +#define DGTRFS DGTRFS_64 +#define DGTSV DGTSV_64 +#define DGTSVX DGTSVX_64 +#define DGTTRF DGTTRF_64 +#define DGTTRS DGTTRS_64 +#define DGTTS2 DGTTS2_64 +#define DHGEQZ DHGEQZ_64 +#define DHSEIN DHSEIN_64 +#define DHSEQR DHSEQR_64 +#define DISNAN DISNAN_64 +#define DLABAD DLABAD_64 +#define DLABRD DLABRD_64 +#define DLACN2 DLACN2_64 +#define DLACON DLACON_64 +#define DLACPY DLACPY_64 +#define DLADIV DLADIV_64 +#define DLADIV1 DLADIV1_64 +#define DLADIV2 DLADIV2_64 +#define DLAE2 DLAE2_64 +#define DLAEBZ DLAEBZ_64 +#define DLAED0 DLAED0_64 +#define DLAED1 DLAED1_64 +#define DLAED2 DLAED2_64 +#define DLAED3 DLAED3_64 +#define DLAED4 DLAED4_64 +#define DLAED5 DLAED5_64 +#define DLAED6 DLAED6_64 +#define DLAED7 DLAED7_64 +#define DLAED8 DLAED8_64 +#define DLAED9 DLAED9_64 +#define DLAEDA DLAEDA_64 +#define DLAEIN DLAEIN_64 +#define DLAEV2 DLAEV2_64 +#define DLAEXC DLAEXC_64 +#define DLAG2 DLAG2_64 +#define DLAG2S DLAG2S_64 +#define DLA_GBAMV DLA_GBAMV_64 +#define DLA_GBRCOND DLA_GBRCOND_64 +#define DLA_GBRFSX_EXTENDED DLA_GBRFSX_EXTENDED_64 +#define DLA_GBRPVGRW DLA_GBRPVGRW_64 +#define DLA_GEAMV DLA_GEAMV_64 +#define DLA_GERCOND DLA_GERCOND_64 +#define DLA_GERFSX_EXTENDED DLA_GERFSX_EXTENDED_64 +#define DLA_GERPVGRW DLA_GERPVGRW_64 +#define DLAGS2 DLAGS2_64 +#define DLAGTF DLAGTF_64 +#define DLAGTM DLAGTM_64 +#define DLAGTS DLAGTS_64 +#define DLAGV2 DLAGV2_64 +#define DLAHQR DLAHQR_64 +#define DLAHR2 DLAHR2_64 +#define DLAHRD DLAHRD_64 +#define DLAIC1 DLAIC1_64 +#define DLAISNAN DLAISNAN_64 +#define DLA_LIN_BERR DLA_LIN_BERR_64 +#define DLALN2 DLALN2_64 +#define DLALS0 DLALS0_64 +#define DLALSA DLALSA_64 +#define DLALSD DLALSD_64 +#define DLAMC3 DLAMC3_64 +#define DLAMCH DLAMCH_64 +#define DLAMRG DLAMRG_64 +#define DLAMSWLQ DLAMSWLQ_64 +#define DLAMTSQR DLAMTSQR_64 +#define DLANEG DLANEG_64 +#define DLANGB DLANGB_64 +#define DLANGE DLANGE_64 +#define DLANGT DLANGT_64 +#define DLANHS DLANHS_64 +#define DLANSB DLANSB_64 +#define DLANSF DLANSF_64 +#define DLANSP DLANSP_64 +#define DLANST DLANST_64 +#define DLANSY DLANSY_64 +#define DLANTB DLANTB_64 +#define DLANTP DLANTP_64 +#define DLANTR DLANTR_64 +#define DLANV2 DLANV2_64 +#define DLAORHR_COL_GETRFNP DLAORHR_COL_GETRFNP_64 +#define DLAORHR_COL_GETRFNP2 DLAORHR_COL_GETRFNP2_64 +#define DLAPLL DLAPLL_64 +#define DLAPMR DLAPMR_64 +#define DLAPMT DLAPMT_64 +#define DLA_PORCOND DLA_PORCOND_64 +#define DLA_PORFSX_EXTENDED DLA_PORFSX_EXTENDED_64 +#define DLA_PORPVGRW DLA_PORPVGRW_64 +#define DLAPY2 DLAPY2_64 +#define DLAPY3 DLAPY3_64 +#define DLAQGB DLAQGB_64 +#define DLAQGE DLAQGE_64 +#define DLAQP2 DLAQP2_64 +#define DLAQPS DLAQPS_64 +#define DLAQR0 DLAQR0_64 +#define DLAQR1 DLAQR1_64 +#define DLAQR2 DLAQR2_64 +#define DLAQR3 DLAQR3_64 +#define DLAQR4 DLAQR4_64 +#define DLAQR5 DLAQR5_64 +#define DLAQSB DLAQSB_64 +#define DLAQSP DLAQSP_64 +#define DLAQSY DLAQSY_64 +#define DLAQTR DLAQTR_64 +#define DLAQZ0 DLAQZ0_64 +#define DLAQZ1 DLAQZ1_64 +#define DLAQZ2 DLAQZ2_64 +#define DLAQZ3 DLAQZ3_64 +#define DLAQZ4 DLAQZ4_64 +#define DLAR1V DLAR1V_64 +#define DLAR2V DLAR2V_64 +#define DLARF DLARF_64 +#define DLARFB DLARFB_64 +#define DLARFB_GETT DLARFB_GETT_64 +#define DLARFG DLARFG_64 +#define DLARFGP DLARFGP_64 +#define DLARFT DLARFT_64 +#define DLARFX DLARFX_64 +#define DLARFY DLARFY_64 +#define DLARGV DLARGV_64 +#define DLARMM DLARMM_64 +#define DLARNV DLARNV_64 +#define DLARRA DLARRA_64 +#define DLARRB DLARRB_64 +#define DLARRC DLARRC_64 +#define DLARRD DLARRD_64 +#define DLARRE DLARRE_64 +#define DLARRF DLARRF_64 +#define DLARRJ DLARRJ_64 +#define DLARRK DLARRK_64 +#define DLARRR DLARRR_64 +#define DLARRV DLARRV_64 +#define DLARSCL2 DLARSCL2_64 +#define DLARTG DLARTG_64 +#define DLARTGP DLARTGP_64 +#define DLARTGS DLARTGS_64 +#define DLARTV DLARTV_64 +#define DLARUV DLARUV_64 +#define DLARZ DLARZ_64 +#define DLARZB DLARZB_64 +#define DLARZT DLARZT_64 +#define DLAS2 DLAS2_64 +#define DLASCL DLASCL_64 +#define DLASCL2 DLASCL2_64 +#define DLASD0 DLASD0_64 +#define DLASD1 DLASD1_64 +#define DLASD2 DLASD2_64 +#define DLASD3 DLASD3_64 +#define DLASD4 DLASD4_64 +#define DLASD5 DLASD5_64 +#define DLASD6 DLASD6_64 +#define DLASD7 DLASD7_64 +#define DLASD8 DLASD8_64 +#define DLASDA DLASDA_64 +#define DLASDQ DLASDQ_64 +#define DLASDT DLASDT_64 +#define DLASET DLASET_64 +#define DLASQ1 DLASQ1_64 +#define DLASQ2 DLASQ2_64 +#define DLASQ3 DLASQ3_64 +#define DLASQ4 DLASQ4_64 +#define DLASQ5 DLASQ5_64 +#define DLASQ6 DLASQ6_64 +#define DLASR DLASR_64 +#define DLASRT DLASRT_64 +#define DLASSQ DLASSQ_64 +#define DLASV2 DLASV2_64 +#define DLASWLQ DLASWLQ_64 +#define DLASWP DLASWP_64 +#define DLASY2 DLASY2_64 +#define DLA_SYAMV DLA_SYAMV_64 +#define DLASYF DLASYF_64 +#define DLASYF_AA DLASYF_AA_64 +#define DLASYF_RK DLASYF_RK_64 +#define DLASYF_ROOK DLASYF_ROOK_64 +#define DLA_SYRCOND DLA_SYRCOND_64 +#define DLA_SYRFSX_EXTENDED DLA_SYRFSX_EXTENDED_64 +#define DLA_SYRPVGRW DLA_SYRPVGRW_64 +#define DLAT2S DLAT2S_64 +#define DLATBS DLATBS_64 +#define DLATDF DLATDF_64 +#define DLATPS DLATPS_64 +#define DLATRD DLATRD_64 +#define DLATRS DLATRS_64 +#define DLATRS3 DLATRS3_64 +#define DLATRZ DLATRZ_64 +#define DLATSQR DLATSQR_64 +#define DLATZM DLATZM_64 +#define DLAUU2 DLAUU2_64 +#define DLAUUM DLAUUM_64 +#define DLA_WWADDW DLA_WWADDW_64 +#define DNRM2 DNRM2_64 +#define DOPGTR DOPGTR_64 +#define DOPMTR DOPMTR_64 +#define DORBDB DORBDB_64 +#define DORBDB1 DORBDB1_64 +#define DORBDB2 DORBDB2_64 +#define DORBDB3 DORBDB3_64 +#define DORBDB4 DORBDB4_64 +#define DORBDB5 DORBDB5_64 +#define DORBDB6 DORBDB6_64 +#define DORCSD DORCSD_64 +#define DORCSD2BY1 DORCSD2BY1_64 +#define DORG2L DORG2L_64 +#define DORG2R DORG2R_64 +#define DORGBR DORGBR_64 +#define DORGHR DORGHR_64 +#define DORGL2 DORGL2_64 +#define DORGLQ DORGLQ_64 +#define DORGQL DORGQL_64 +#define DORGQR DORGQR_64 +#define DORGR2 DORGR2_64 +#define DORGRQ DORGRQ_64 +#define DORGTR DORGTR_64 +#define DORGTSQR DORGTSQR_64 +#define DORGTSQR_ROW DORGTSQR_ROW_64 +#define DORHR_COL DORHR_COL_64 +#define DORM22 DORM22_64 +#define DORM2L DORM2L_64 +#define DORM2R DORM2R_64 +#define DORMBR DORMBR_64 +#define DORMHR DORMHR_64 +#define DORML2 DORML2_64 +#define DORMLQ DORMLQ_64 +#define DORMQL DORMQL_64 +#define DORMQR DORMQR_64 +#define DORMR2 DORMR2_64 +#define DORMR3 DORMR3_64 +#define DORMRQ DORMRQ_64 +#define DORMRZ DORMRZ_64 +#define DORMTR DORMTR_64 +#define DPBCON DPBCON_64 +#define DPBEQU DPBEQU_64 +#define DPBRFS DPBRFS_64 +#define DPBSTF DPBSTF_64 +#define DPBSV DPBSV_64 +#define DPBSVX DPBSVX_64 +#define DPBTF2 DPBTF2_64 +#define DPBTRF DPBTRF_64 +#define DPBTRS DPBTRS_64 +#define DPFTRF DPFTRF_64 +#define DPFTRI DPFTRI_64 +#define DPFTRS DPFTRS_64 +#define DPOCON DPOCON_64 +#define DPOEQU DPOEQU_64 +#define DPOEQUB DPOEQUB_64 +#define DPORFS DPORFS_64 +#define DPORFSX DPORFSX_64 +#define DPOSV DPOSV_64 +#define DPOSVX DPOSVX_64 +#define DPOSVXX DPOSVXX_64 +#define DPOTF2 DPOTF2_64 +#define DPOTRF DPOTRF_64 +#define DPOTRF DPOTRF_64 +#define DPOTRF2 DPOTRF2_64 +#define DPOTRI DPOTRI_64 +#define DPOTRS DPOTRS_64 +#define DPPCON DPPCON_64 +#define DPPEQU DPPEQU_64 +#define DPPRFS DPPRFS_64 +#define DPPSV DPPSV_64 +#define DPPSVX DPPSVX_64 +#define DPPTRF DPPTRF_64 +#define DPPTRI DPPTRI_64 +#define DPPTRS DPPTRS_64 +#define DPSTF2 DPSTF2_64 +#define DPSTRF DPSTRF_64 +#define DPTCON DPTCON_64 +#define DPTEQR DPTEQR_64 +#define DPTRFS DPTRFS_64 +#define DPTSV DPTSV_64 +#define DPTSVX DPTSVX_64 +#define DPTTRF DPTTRF_64 +#define DPTTRS DPTTRS_64 +#define DPTTS2 DPTTS2_64 +#define DROT DROT_64 +#define DROTM DROTM_64 +#define DROUNDUP_LWORK DROUNDUP_LWORK_64 +#define DRSCL DRSCL_64 +#define DSB2ST_KERNELS DSB2ST_KERNELS_64 +#define DSBEV DSBEV_64 +#define DSBEV_2STAGE DSBEV_2STAGE_64 +#define DSBEVD DSBEVD_64 +#define DSBEVD_2STAGE DSBEVD_2STAGE_64 +#define DSBEVX DSBEVX_64 +#define DSBEVX_2STAGE DSBEVX_2STAGE_64 +#define DSBGST DSBGST_64 +#define DSBGV DSBGV_64 +#define DSBGVD DSBGVD_64 +#define DSBGVX DSBGVX_64 +#define DSBMV DSBMV_64 +#define DSBTRD DSBTRD_64 +#define DSCAL DSCAL_64 +#define DSFRK DSFRK_64 +#define DSGESV DSGESV_64 +#define DSPCON DSPCON_64 +#define DSPEV DSPEV_64 +#define DSPEVD DSPEVD_64 +#define DSPEVX DSPEVX_64 +#define DSPGST DSPGST_64 +#define DSPGV DSPGV_64 +#define DSPGVD DSPGVD_64 +#define DSPGVX DSPGVX_64 +#define DSPMV DSPMV_64 +#define DSPOSV DSPOSV_64 +#define DSPR DSPR_64 +#define DSPR2 DSPR2_64 +#define DSPRFS DSPRFS_64 +#define DSPSV DSPSV_64 +#define DSPSVX DSPSVX_64 +#define DSPTRD DSPTRD_64 +#define DSPTRF DSPTRF_64 +#define DSPTRI DSPTRI_64 +#define DSPTRS DSPTRS_64 +#define DSTEBZ DSTEBZ_64 +#define DSTEDC DSTEDC_64 +#define DSTEGR DSTEGR_64 +#define DSTEIN DSTEIN_64 +#define DSTEMR DSTEMR_64 +#define DSTEQR DSTEQR_64 +#define DSTERF DSTERF_64 +#define DSTEV DSTEV_64 +#define DSTEVD DSTEVD_64 +#define DSTEVR DSTEVR_64 +#define DSTEVX DSTEVX_64 +#define DSWAP DSWAP_64 +#define DSYCON DSYCON_64 +#define DSYCON_3 DSYCON_3_64 +#define DSYCON_ROOK DSYCON_ROOK_64 +#define DSYCONV DSYCONV_64 +#define DSYCONVF DSYCONVF_64 +#define DSYCONVF_ROOK DSYCONVF_ROOK_64 +#define DSYEQUB DSYEQUB_64 +#define DSYEV DSYEV_64 +#define DSYEV_2STAGE DSYEV_2STAGE_64 +#define DSYEVD DSYEVD_64 +#define DSYEVD_2STAGE DSYEVD_2STAGE_64 +#define DSYEVR DSYEVR_64 +#define DSYEVR_2STAGE DSYEVR_2STAGE_64 +#define DSYEVX DSYEVX_64 +#define DSYEVX_2STAGE DSYEVX_2STAGE_64 +#define DSYGS2 DSYGS2_64 +#define DSYGST DSYGST_64 +#define DSYGV DSYGV_64 +#define DSYGV_2STAGE DSYGV_2STAGE_64 +#define DSYGVD DSYGVD_64 +#define DSYGVX DSYGVX_64 +#define DSYMM DSYMM_64 +#define DSYMV DSYMV_64 +#define DSYR DSYR_64 +#define DSYR2 DSYR2_64 +#define DSYR2K DSYR2K_64 +#define DSYRFS DSYRFS_64 +#define DSYRFSX DSYRFSX_64 +#define DSYRK DSYRK_64 +#define DSYSV DSYSV_64 +#define DSYSV_AA DSYSV_AA_64 +#define DSYSV_AA_2STAGE DSYSV_AA_2STAGE_64 +#define DSYSV_RK DSYSV_RK_64 +#define DSYSV_ROOK DSYSV_ROOK_64 +#define DSYSVX DSYSVX_64 +#define DSYSVXX DSYSVXX_64 +#define DSYSWAPR DSYSWAPR_64 +#define DSYTD2 DSYTD2_64 +#define DSYTF2 DSYTF2_64 +#define DSYTF2_RK DSYTF2_RK_64 +#define DSYTF2_ROOK DSYTF2_ROOK_64 +#define DSYTRD DSYTRD_64 +#define DSYTRD_2STAGE DSYTRD_2STAGE_64 +#define DSYTRD_SB2ST DSYTRD_SB2ST_64 +#define DSYTRD_SY2SB DSYTRD_SY2SB_64 +#define DSYTRF DSYTRF_64 +#define DSYTRF_AA DSYTRF_AA_64 +#define DSYTRF_AA_2STAGE DSYTRF_AA_2STAGE_64 +#define DSYTRF_RK DSYTRF_RK_64 +#define DSYTRF_ROOK DSYTRF_ROOK_64 +#define DSYTRI DSYTRI_64 +#define DSYTRI2 DSYTRI2_64 +#define DSYTRI2X DSYTRI2X_64 +#define DSYTRI_3 DSYTRI_3_64 +#define DSYTRI_3X DSYTRI_3X_64 +#define DSYTRI_ROOK DSYTRI_ROOK_64 +#define DSYTRS DSYTRS_64 +#define DSYTRS2 DSYTRS2_64 +#define DSYTRS_3 DSYTRS_3_64 +#define DSYTRS_AA DSYTRS_AA_64 +#define DSYTRS_AA_2STAGE DSYTRS_AA_2STAGE_64 +#define DSYTRS_ROOK DSYTRS_ROOK_64 +#define DTBCON DTBCON_64 +#define DTBMV DTBMV_64 +#define DTBRFS DTBRFS_64 +#define DTBSV DTBSV_64 +#define DTBTRS DTBTRS_64 +#define DTFSM DTFSM_64 +#define DTFTRI DTFTRI_64 +#define DTFTTP DTFTTP_64 +#define DTFTTR DTFTTR_64 +#define DTGEVC DTGEVC_64 +#define DTGEX2 DTGEX2_64 +#define DTGEXC DTGEXC_64 +#define DTGSEN DTGSEN_64 +#define DTGSJA DTGSJA_64 +#define DTGSNA DTGSNA_64 +#define DTGSY2 DTGSY2_64 +#define DTGSYL DTGSYL_64 +#define DTPCON DTPCON_64 +#define DTPLQT DTPLQT_64 +#define DTPLQT2 DTPLQT2_64 +#define DTPMLQT DTPMLQT_64 +#define DTPMQRT DTPMQRT_64 +#define DTPMV DTPMV_64 +#define DTPQRT DTPQRT_64 +#define DTPQRT2 DTPQRT2_64 +#define DTPRFB DTPRFB_64 +#define DTPRFS DTPRFS_64 +#define DTPSV DTPSV_64 +#define DTPTRI DTPTRI_64 +#define DTPTRS DTPTRS_64 +#define DTPTTF DTPTTF_64 +#define DTPTTR DTPTTR_64 +#define DTRCON DTRCON_64 +#define DTREVC DTREVC_64 +#define DTREVC3 DTREVC3_64 +#define DTREXC DTREXC_64 +#define DTRMM DTRMM_64 +#define DTRMV DTRMV_64 +#define DTRRFS DTRRFS_64 +#define DTRSEN DTRSEN_64 +#define DTRSM DTRSM_64 +#define DTRSNA DTRSNA_64 +#define DTRSV DTRSV_64 +#define DTRSYL DTRSYL_64 +#define DTRSYL3 DTRSYL3_64 +#define DTRTI2 DTRTI2_64 +#define DTRTRI DTRTRI_64 +#define DTRTRS DTRTRS_64 +#define DTRTTF DTRTTF_64 +#define DTRTTP DTRTTP_64 +#define DTZRQF DTZRQF_64 +#define DTZRZF DTZRZF_64 +#define DZASUM DZASUM_64 +#define DZNRM2 DZNRM2_64 +#define DZSUM1 DZSUM1_64 +#define ICAMAX ICAMAX_64 +#define ICMAX1 ICMAX1_64 +#define IDAMAX IDAMAX_64 +#define IEEECK IEEECK_64 +#define ILACLC ILACLC_64 +#define ILACLR ILACLR_64 +#define ILADIAG ILADIAG_64 +#define ILADLC ILADLC_64 +#define ILADLR ILADLR_64 +#define ILAENV ILAENV_64 +#define ILAENV2STAGE ILAENV2STAGE_64 +#define ILAPREC ILAPREC_64 +#define ILASLC ILASLC_64 +#define ILASLR ILASLR_64 +#define ILATRANS ILATRANS_64 +#define ILAUPLO ILAUPLO_64 +#define ILAVER ILAVER_64 +#define ILAZLC ILAZLC_64 +#define ILAZLR ILAZLR_64 +#define IPARAM2STAGE IPARAM2STAGE_64 +#define IPARMQ IPARMQ_64 +#define ISAMAX ISAMAX_64 +#define IZAMAX IZAMAX_64 +#define IZMAX1 IZMAX1_64 +#define LSAME LSAME_64 +#define LSAMEN LSAMEN_64 +#define SASUM SASUM_64 +#define SAXPY SAXPY_64 +#define SBBCSD SBBCSD_64 +#define SBDSDC SBDSDC_64 +#define SBDSQR SBDSQR_64 +#define SBDSVDX SBDSVDX_64 +#define SCASUM SCASUM_64 +#define SCNRM2 SCNRM2_64 +#define SCOPY SCOPY_64 +#define SCSUM1 SCSUM1_64 +#define SDISNA SDISNA_64 +#define SDOT SDOT_64 +#define SGBBRD SGBBRD_64 +#define SGBCON SGBCON_64 +#define SGBEQU SGBEQU_64 +#define SGBEQUB SGBEQUB_64 +#define SGBMV SGBMV_64 +#define SGBRFS SGBRFS_64 +#define SGBRFSX SGBRFSX_64 +#define SGBSV SGBSV_64 +#define SGBSVX SGBSVX_64 +#define SGBSVXX SGBSVXX_64 +#define SGBTF2 SGBTF2_64 +#define SGBTRF SGBTRF_64 +#define SGBTRS SGBTRS_64 +#define SGEBAK SGEBAK_64 +#define SGEBAL SGEBAL_64 +#define SGEBD2 SGEBD2_64 +#define SGEBRD SGEBRD_64 +#define SGECON SGECON_64 +#define SGEDMD SGEDMD_64 +#define SGEDMD SGEDMD_64 +#define SGEDMDQ SGEDMDQ_64 +#define SGEEQU SGEEQU_64 +#define SGEEQUB SGEEQUB_64 +#define SGEES SGEES_64 +#define SGEESX SGEESX_64 +#define SGEEV SGEEV_64 +#define SGEEVX SGEEVX_64 +#define SGEGS SGEGS_64 +#define SGEGV SGEGV_64 +#define SGEHD2 SGEHD2_64 +#define SGEHRD SGEHRD_64 +#define SGEJSV SGEJSV_64 +#define SGELQ SGELQ_64 +#define SGELQ2 SGELQ2_64 +#define SGELQF SGELQF_64 +#define SGELQT SGELQT_64 +#define SGELQT3 SGELQT3_64 +#define SGELS SGELS_64 +#define SGELSD SGELSD_64 +#define SGELSS SGELSS_64 +#define SGELST SGELST_64 +#define SGELSX SGELSX_64 +#define SGELSY SGELSY_64 +#define SGEMLQ SGEMLQ_64 +#define SGEMLQT SGEMLQT_64 +#define SGEMM SGEMM_64 +#define SGEMQR SGEMQR_64 +#define SGEMQRT SGEMQRT_64 +#define SGEMV SGEMV_64 +#define SGEQL2 SGEQL2_64 +#define SGEQLF SGEQLF_64 +#define SGEQP3 SGEQP3_64 +#define SGEQPF SGEQPF_64 +#define SGEQR SGEQR_64 +#define SGEQR2 SGEQR2_64 +#define SGEQR2P SGEQR2P_64 +#define SGEQRF SGEQRF_64 +#define SGEQRF SGEQRF_64 +#define SGEQRFP SGEQRFP_64 +#define SGEQRT SGEQRT_64 +#define SGEQRT2 SGEQRT2_64 +#define SGEQRT3 SGEQRT3_64 +#define SGER SGER_64 +#define SGERFS SGERFS_64 +#define SGERFSX SGERFSX_64 +#define SGERQ2 SGERQ2_64 +#define SGERQF SGERQF_64 +#define SGESC2 SGESC2_64 +#define SGESDD SGESDD_64 +#define SGESV SGESV_64 +#define SGESVD SGESVD_64 +#define SGESVDQ SGESVDQ_64 +#define SGESVDX SGESVDX_64 +#define SGESVJ SGESVJ_64 +#define SGESVX SGESVX_64 +#define SGESVXX SGESVXX_64 +#define SGETC2 SGETC2_64 +#define SGETF2 SGETF2_64 +#define SGETRF SGETRF_64 +#define SGETRF SGETRF_64 +#define SGETRF2 SGETRF2_64 +#define SGETRI SGETRI_64 +#define SGETRS SGETRS_64 +#define SGETSLS SGETSLS_64 +#define SGETSQRHRT SGETSQRHRT_64 +#define SGGBAK SGGBAK_64 +#define SGGBAL SGGBAL_64 +#define SGGES SGGES_64 +#define SGGES3 SGGES3_64 +#define SGGESX SGGESX_64 +#define SGGEV SGGEV_64 +#define SGGEV3 SGGEV3_64 +#define SGGEVX SGGEVX_64 +#define SGGGLM SGGGLM_64 +#define SGGHD3 SGGHD3_64 +#define SGGHRD SGGHRD_64 +#define SGGLSE SGGLSE_64 +#define SGGQRF SGGQRF_64 +#define SGGRQF SGGRQF_64 +#define SGGSVD SGGSVD_64 +#define SGGSVD3 SGGSVD3_64 +#define SGGSVP SGGSVP_64 +#define SGGSVP3 SGGSVP3_64 +#define SGSVJ0 SGSVJ0_64 +#define SGSVJ1 SGSVJ1_64 +#define SGTCON SGTCON_64 +#define SGTRFS SGTRFS_64 +#define SGTSV SGTSV_64 +#define SGTSVX SGTSVX_64 +#define SGTTRF SGTTRF_64 +#define SGTTRS SGTTRS_64 +#define SGTTS2 SGTTS2_64 +#define SHGEQZ SHGEQZ_64 +#define SHSEIN SHSEIN_64 +#define SHSEQR SHSEQR_64 +#define SISNAN SISNAN_64 +#define SLABAD SLABAD_64 +#define SLABRD SLABRD_64 +#define SLACN2 SLACN2_64 +#define SLACON SLACON_64 +#define SLACPY SLACPY_64 +#define SLADIV SLADIV_64 +#define SLADIV1 SLADIV1_64 +#define SLADIV2 SLADIV2_64 +#define SLAE2 SLAE2_64 +#define SLAEBZ SLAEBZ_64 +#define SLAED0 SLAED0_64 +#define SLAED1 SLAED1_64 +#define SLAED2 SLAED2_64 +#define SLAED3 SLAED3_64 +#define SLAED4 SLAED4_64 +#define SLAED5 SLAED5_64 +#define SLAED6 SLAED6_64 +#define SLAED7 SLAED7_64 +#define SLAED8 SLAED8_64 +#define SLAED9 SLAED9_64 +#define SLAEDA SLAEDA_64 +#define SLAEIN SLAEIN_64 +#define SLAEV2 SLAEV2_64 +#define SLAEXC SLAEXC_64 +#define SLAG2 SLAG2_64 +#define SLAG2D SLAG2D_64 +#define SLA_GBAMV SLA_GBAMV_64 +#define SLA_GBRCOND SLA_GBRCOND_64 +#define SLA_GBRFSX_EXTENDED SLA_GBRFSX_EXTENDED_64 +#define SLA_GBRPVGRW SLA_GBRPVGRW_64 +#define SLA_GEAMV SLA_GEAMV_64 +#define SLA_GERCOND SLA_GERCOND_64 +#define SLA_GERFSX_EXTENDED SLA_GERFSX_EXTENDED_64 +#define SLA_GERPVGRW SLA_GERPVGRW_64 +#define SLAGS2 SLAGS2_64 +#define SLAGTF SLAGTF_64 +#define SLAGTM SLAGTM_64 +#define SLAGTS SLAGTS_64 +#define SLAGV2 SLAGV2_64 +#define SLAHQR SLAHQR_64 +#define SLAHR2 SLAHR2_64 +#define SLAHRD SLAHRD_64 +#define SLAIC1 SLAIC1_64 +#define SLAISNAN SLAISNAN_64 +#define SLA_LIN_BERR SLA_LIN_BERR_64 +#define SLALN2 SLALN2_64 +#define SLALS0 SLALS0_64 +#define SLALSA SLALSA_64 +#define SLALSD SLALSD_64 +#define SLAMC3 SLAMC3_64 +#define SLAMCH SLAMCH_64 +#define SLAMRG SLAMRG_64 +#define SLAMSWLQ SLAMSWLQ_64 +#define SLAMTSQR SLAMTSQR_64 +#define SLANEG SLANEG_64 +#define SLANGB SLANGB_64 +#define SLANGE SLANGE_64 +#define SLANGT SLANGT_64 +#define SLANHS SLANHS_64 +#define SLANSB SLANSB_64 +#define SLANSF SLANSF_64 +#define SLANSP SLANSP_64 +#define SLANST SLANST_64 +#define SLANSY SLANSY_64 +#define SLANTB SLANTB_64 +#define SLANTP SLANTP_64 +#define SLANTR SLANTR_64 +#define SLANV2 SLANV2_64 +#define SLAORHR_COL_GETRFNP SLAORHR_COL_GETRFNP_64 +#define SLAORHR_COL_GETRFNP2 SLAORHR_COL_GETRFNP2_64 +#define SLAPLL SLAPLL_64 +#define SLAPMR SLAPMR_64 +#define SLAPMT SLAPMT_64 +#define SLA_PORCOND SLA_PORCOND_64 +#define SLA_PORFSX_EXTENDED SLA_PORFSX_EXTENDED_64 +#define SLA_PORPVGRW SLA_PORPVGRW_64 +#define SLAPY2 SLAPY2_64 +#define SLAPY3 SLAPY3_64 +#define SLAQGB SLAQGB_64 +#define SLAQGE SLAQGE_64 +#define SLAQP2 SLAQP2_64 +#define SLAQPS SLAQPS_64 +#define SLAQR0 SLAQR0_64 +#define SLAQR1 SLAQR1_64 +#define SLAQR2 SLAQR2_64 +#define SLAQR3 SLAQR3_64 +#define SLAQR4 SLAQR4_64 +#define SLAQR5 SLAQR5_64 +#define SLAQSB SLAQSB_64 +#define SLAQSP SLAQSP_64 +#define SLAQSY SLAQSY_64 +#define SLAQTR SLAQTR_64 +#define SLAQZ0 SLAQZ0_64 +#define SLAQZ1 SLAQZ1_64 +#define SLAQZ2 SLAQZ2_64 +#define SLAQZ3 SLAQZ3_64 +#define SLAQZ4 SLAQZ4_64 +#define SLAR1V SLAR1V_64 +#define SLAR2V SLAR2V_64 +#define SLARF SLARF_64 +#define SLARFB SLARFB_64 +#define SLARFB_GETT SLARFB_GETT_64 +#define SLARFG SLARFG_64 +#define SLARFGP SLARFGP_64 +#define SLARFT SLARFT_64 +#define SLARFX SLARFX_64 +#define SLARFY SLARFY_64 +#define SLARGV SLARGV_64 +#define SLARMM SLARMM_64 +#define SLARNV SLARNV_64 +#define SLARRA SLARRA_64 +#define SLARRB SLARRB_64 +#define SLARRC SLARRC_64 +#define SLARRD SLARRD_64 +#define SLARRE SLARRE_64 +#define SLARRF SLARRF_64 +#define SLARRJ SLARRJ_64 +#define SLARRK SLARRK_64 +#define SLARRR SLARRR_64 +#define SLARRV SLARRV_64 +#define SLARSCL2 SLARSCL2_64 +#define SLARTG SLARTG_64 +#define SLARTGP SLARTGP_64 +#define SLARTGS SLARTGS_64 +#define SLARTV SLARTV_64 +#define SLARUV SLARUV_64 +#define SLARZ SLARZ_64 +#define SLARZB SLARZB_64 +#define SLARZT SLARZT_64 +#define SLAS2 SLAS2_64 +#define SLASCL SLASCL_64 +#define SLASCL2 SLASCL2_64 +#define SLASD0 SLASD0_64 +#define SLASD1 SLASD1_64 +#define SLASD2 SLASD2_64 +#define SLASD3 SLASD3_64 +#define SLASD4 SLASD4_64 +#define SLASD5 SLASD5_64 +#define SLASD6 SLASD6_64 +#define SLASD7 SLASD7_64 +#define SLASD8 SLASD8_64 +#define SLASDA SLASDA_64 +#define SLASDQ SLASDQ_64 +#define SLASDT SLASDT_64 +#define SLASET SLASET_64 +#define SLASQ1 SLASQ1_64 +#define SLASQ2 SLASQ2_64 +#define SLASQ3 SLASQ3_64 +#define SLASQ4 SLASQ4_64 +#define SLASQ5 SLASQ5_64 +#define SLASQ6 SLASQ6_64 +#define SLASR SLASR_64 +#define SLASRT SLASRT_64 +#define SLASSQ SLASSQ_64 +#define SLASV2 SLASV2_64 +#define SLASWLQ SLASWLQ_64 +#define SLASWP SLASWP_64 +#define SLASY2 SLASY2_64 +#define SLA_SYAMV SLA_SYAMV_64 +#define SLASYF SLASYF_64 +#define SLASYF_AA SLASYF_AA_64 +#define SLASYF_RK SLASYF_RK_64 +#define SLASYF_ROOK SLASYF_ROOK_64 +#define SLA_SYRCOND SLA_SYRCOND_64 +#define SLA_SYRFSX_EXTENDED SLA_SYRFSX_EXTENDED_64 +#define SLA_SYRPVGRW SLA_SYRPVGRW_64 +#define SLATBS SLATBS_64 +#define SLATDF SLATDF_64 +#define SLATPS SLATPS_64 +#define SLATRD SLATRD_64 +#define SLATRS SLATRS_64 +#define SLATRS3 SLATRS3_64 +#define SLATRZ SLATRZ_64 +#define SLATSQR SLATSQR_64 +#define SLATZM SLATZM_64 +#define SLAUU2 SLAUU2_64 +#define SLAUUM SLAUUM_64 +#define SLA_WWADDW SLA_WWADDW_64 +#define SNRM2 SNRM2_64 +#define SOPGTR SOPGTR_64 +#define SOPMTR SOPMTR_64 +#define SORBDB SORBDB_64 +#define SORBDB1 SORBDB1_64 +#define SORBDB2 SORBDB2_64 +#define SORBDB3 SORBDB3_64 +#define SORBDB4 SORBDB4_64 +#define SORBDB5 SORBDB5_64 +#define SORBDB6 SORBDB6_64 +#define SORCSD SORCSD_64 +#define SORCSD2BY1 SORCSD2BY1_64 +#define SORG2L SORG2L_64 +#define SORG2R SORG2R_64 +#define SORGBR SORGBR_64 +#define SORGHR SORGHR_64 +#define SORGL2 SORGL2_64 +#define SORGLQ SORGLQ_64 +#define SORGQL SORGQL_64 +#define SORGQR SORGQR_64 +#define SORGR2 SORGR2_64 +#define SORGRQ SORGRQ_64 +#define SORGTR SORGTR_64 +#define SORGTSQR SORGTSQR_64 +#define SORGTSQR_ROW SORGTSQR_ROW_64 +#define SORHR_COL SORHR_COL_64 +#define SORM22 SORM22_64 +#define SORM2L SORM2L_64 +#define SORM2R SORM2R_64 +#define SORMBR SORMBR_64 +#define SORMHR SORMHR_64 +#define SORML2 SORML2_64 +#define SORMLQ SORMLQ_64 +#define SORMQL SORMQL_64 +#define SORMQR SORMQR_64 +#define SORMR2 SORMR2_64 +#define SORMR3 SORMR3_64 +#define SORMRQ SORMRQ_64 +#define SORMRZ SORMRZ_64 +#define SORMTR SORMTR_64 +#define SPBCON SPBCON_64 +#define SPBEQU SPBEQU_64 +#define SPBRFS SPBRFS_64 +#define SPBSTF SPBSTF_64 +#define SPBSV SPBSV_64 +#define SPBSVX SPBSVX_64 +#define SPBTF2 SPBTF2_64 +#define SPBTRF SPBTRF_64 +#define SPBTRS SPBTRS_64 +#define SPFTRF SPFTRF_64 +#define SPFTRI SPFTRI_64 +#define SPFTRS SPFTRS_64 +#define SPOCON SPOCON_64 +#define SPOEQU SPOEQU_64 +#define SPOEQUB SPOEQUB_64 +#define SPORFS SPORFS_64 +#define SPORFSX SPORFSX_64 +#define SPOSV SPOSV_64 +#define SPOSVX SPOSVX_64 +#define SPOSVXX SPOSVXX_64 +#define SPOTF2 SPOTF2_64 +#define SPOTRF SPOTRF_64 +#define SPOTRF SPOTRF_64 +#define SPOTRF2 SPOTRF2_64 +#define SPOTRI SPOTRI_64 +#define SPOTRS SPOTRS_64 +#define SPPCON SPPCON_64 +#define SPPEQU SPPEQU_64 +#define SPPRFS SPPRFS_64 +#define SPPSV SPPSV_64 +#define SPPSVX SPPSVX_64 +#define SPPTRF SPPTRF_64 +#define SPPTRI SPPTRI_64 +#define SPPTRS SPPTRS_64 +#define SPSTF2 SPSTF2_64 +#define SPSTRF SPSTRF_64 +#define SPTCON SPTCON_64 +#define SPTEQR SPTEQR_64 +#define SPTRFS SPTRFS_64 +#define SPTSV SPTSV_64 +#define SPTSVX SPTSVX_64 +#define SPTTRF SPTTRF_64 +#define SPTTRS SPTTRS_64 +#define SPTTS2 SPTTS2_64 +#define SROT SROT_64 +#define SROTM SROTM_64 +#define SROUNDUP_LWORK SROUNDUP_LWORK_64 +#define SRSCL SRSCL_64 +#define SSB2ST_KERNELS SSB2ST_KERNELS_64 +#define SSBEV SSBEV_64 +#define SSBEV_2STAGE SSBEV_2STAGE_64 +#define SSBEVD SSBEVD_64 +#define SSBEVD_2STAGE SSBEVD_2STAGE_64 +#define SSBEVX SSBEVX_64 +#define SSBEVX_2STAGE SSBEVX_2STAGE_64 +#define SSBGST SSBGST_64 +#define SSBGV SSBGV_64 +#define SSBGVD SSBGVD_64 +#define SSBGVX SSBGVX_64 +#define SSBMV SSBMV_64 +#define SSBTRD SSBTRD_64 +#define SSCAL SSCAL_64 +#define SSFRK SSFRK_64 +#define SSPCON SSPCON_64 +#define SSPEV SSPEV_64 +#define SSPEVD SSPEVD_64 +#define SSPEVX SSPEVX_64 +#define SSPGST SSPGST_64 +#define SSPGV SSPGV_64 +#define SSPGVD SSPGVD_64 +#define SSPGVX SSPGVX_64 +#define SSPMV SSPMV_64 +#define SSPR SSPR_64 +#define SSPR2 SSPR2_64 +#define SSPRFS SSPRFS_64 +#define SSPSV SSPSV_64 +#define SSPSVX SSPSVX_64 +#define SSPTRD SSPTRD_64 +#define SSPTRF SSPTRF_64 +#define SSPTRI SSPTRI_64 +#define SSPTRS SSPTRS_64 +#define SSTEBZ SSTEBZ_64 +#define SSTEDC SSTEDC_64 +#define SSTEGR SSTEGR_64 +#define SSTEIN SSTEIN_64 +#define SSTEMR SSTEMR_64 +#define SSTEQR SSTEQR_64 +#define SSTERF SSTERF_64 +#define SSTEV SSTEV_64 +#define SSTEVD SSTEVD_64 +#define SSTEVR SSTEVR_64 +#define SSTEVX SSTEVX_64 +#define SSWAP SSWAP_64 +#define SSYCON SSYCON_64 +#define SSYCON_3 SSYCON_3_64 +#define SSYCON_ROOK SSYCON_ROOK_64 +#define SSYCONV SSYCONV_64 +#define SSYCONVF SSYCONVF_64 +#define SSYCONVF_ROOK SSYCONVF_ROOK_64 +#define SSYEQUB SSYEQUB_64 +#define SSYEV SSYEV_64 +#define SSYEV_2STAGE SSYEV_2STAGE_64 +#define SSYEVD SSYEVD_64 +#define SSYEVD_2STAGE SSYEVD_2STAGE_64 +#define SSYEVR SSYEVR_64 +#define SSYEVR_2STAGE SSYEVR_2STAGE_64 +#define SSYEVX SSYEVX_64 +#define SSYEVX_2STAGE SSYEVX_2STAGE_64 +#define SSYGS2 SSYGS2_64 +#define SSYGST SSYGST_64 +#define SSYGV SSYGV_64 +#define SSYGV_2STAGE SSYGV_2STAGE_64 +#define SSYGVD SSYGVD_64 +#define SSYGVX SSYGVX_64 +#define SSYMM SSYMM_64 +#define SSYMV SSYMV_64 +#define SSYR SSYR_64 +#define SSYR2 SSYR2_64 +#define SSYR2K SSYR2K_64 +#define SSYRFS SSYRFS_64 +#define SSYRFSX SSYRFSX_64 +#define SSYRK SSYRK_64 +#define SSYSV SSYSV_64 +#define SSYSV_AA SSYSV_AA_64 +#define SSYSV_AA_2STAGE SSYSV_AA_2STAGE_64 +#define SSYSV_RK SSYSV_RK_64 +#define SSYSV_ROOK SSYSV_ROOK_64 +#define SSYSVX SSYSVX_64 +#define SSYSVXX SSYSVXX_64 +#define SSYSWAPR SSYSWAPR_64 +#define SSYTD2 SSYTD2_64 +#define SSYTF2 SSYTF2_64 +#define SSYTF2_RK SSYTF2_RK_64 +#define SSYTF2_ROOK SSYTF2_ROOK_64 +#define SSYTRD SSYTRD_64 +#define SSYTRD_2STAGE SSYTRD_2STAGE_64 +#define SSYTRD_SB2ST SSYTRD_SB2ST_64 +#define SSYTRD_SY2SB SSYTRD_SY2SB_64 +#define SSYTRF SSYTRF_64 +#define SSYTRF_AA SSYTRF_AA_64 +#define SSYTRF_AA_2STAGE SSYTRF_AA_2STAGE_64 +#define SSYTRF_RK SSYTRF_RK_64 +#define SSYTRF_ROOK SSYTRF_ROOK_64 +#define SSYTRI SSYTRI_64 +#define SSYTRI2 SSYTRI2_64 +#define SSYTRI2X SSYTRI2X_64 +#define SSYTRI_3 SSYTRI_3_64 +#define SSYTRI_3X SSYTRI_3X_64 +#define SSYTRI_ROOK SSYTRI_ROOK_64 +#define SSYTRS SSYTRS_64 +#define SSYTRS2 SSYTRS2_64 +#define SSYTRS_3 SSYTRS_3_64 +#define SSYTRS_AA SSYTRS_AA_64 +#define SSYTRS_AA_2STAGE SSYTRS_AA_2STAGE_64 +#define SSYTRS_ROOK SSYTRS_ROOK_64 +#define STBCON STBCON_64 +#define STBMV STBMV_64 +#define STBRFS STBRFS_64 +#define STBSV STBSV_64 +#define STBTRS STBTRS_64 +#define STFSM STFSM_64 +#define STFTRI STFTRI_64 +#define STFTTP STFTTP_64 +#define STFTTR STFTTR_64 +#define STGEVC STGEVC_64 +#define STGEX2 STGEX2_64 +#define STGEXC STGEXC_64 +#define STGSEN STGSEN_64 +#define STGSJA STGSJA_64 +#define STGSNA STGSNA_64 +#define STGSY2 STGSY2_64 +#define STGSYL STGSYL_64 +#define STPCON STPCON_64 +#define STPLQT STPLQT_64 +#define STPLQT2 STPLQT2_64 +#define STPMLQT STPMLQT_64 +#define STPMQRT STPMQRT_64 +#define STPMV STPMV_64 +#define STPQRT STPQRT_64 +#define STPQRT2 STPQRT2_64 +#define STPRFB STPRFB_64 +#define STPRFS STPRFS_64 +#define STPSV STPSV_64 +#define STPTRI STPTRI_64 +#define STPTRS STPTRS_64 +#define STPTTF STPTTF_64 +#define STPTTR STPTTR_64 +#define STRCON STRCON_64 +#define STREVC STREVC_64 +#define STREVC3 STREVC3_64 +#define STREXC STREXC_64 +#define STRMM STRMM_64 +#define STRMV STRMV_64 +#define STRRFS STRRFS_64 +#define STRSEN STRSEN_64 +#define STRSM STRSM_64 +#define STRSNA STRSNA_64 +#define STRSV STRSV_64 +#define STRSYL STRSYL_64 +#define STRSYL3 STRSYL3_64 +#define STRTI2 STRTI2_64 +#define STRTRI STRTRI_64 +#define STRTRS STRTRS_64 +#define STRTTF STRTTF_64 +#define STRTTP STRTTP_64 +#define STZRQF STZRQF_64 +#define STZRZF STZRZF_64 +#define XERBLA XERBLA_64 +#define XERBLA_ARRAY XERBLA_ARRAY_64 +#define ZAXPY ZAXPY_64 +#define ZBBCSD ZBBCSD_64 +#define ZBDSQR ZBDSQR_64 +#define ZCGESV ZCGESV_64 +#define ZCOPY ZCOPY_64 +#define ZCPOSV ZCPOSV_64 +#define ZDOTC ZDOTC_64 +#define ZDOTU ZDOTU_64 +#define ZDROT ZDROT_64 +#define ZDRSCL ZDRSCL_64 +#define ZDSCAL ZDSCAL_64 +#define ZGBBRD ZGBBRD_64 +#define ZGBCON ZGBCON_64 +#define ZGBEQU ZGBEQU_64 +#define ZGBEQUB ZGBEQUB_64 +#define ZGBMV ZGBMV_64 +#define ZGBRFS ZGBRFS_64 +#define ZGBRFSX ZGBRFSX_64 +#define ZGBSV ZGBSV_64 +#define ZGBSVX ZGBSVX_64 +#define ZGBSVXX ZGBSVXX_64 +#define ZGBTF2 ZGBTF2_64 +#define ZGBTRF ZGBTRF_64 +#define ZGBTRS ZGBTRS_64 +#define ZGEBAK ZGEBAK_64 +#define ZGEBAL ZGEBAL_64 +#define ZGEBD2 ZGEBD2_64 +#define ZGEBRD ZGEBRD_64 +#define ZGECON ZGECON_64 +#define ZGEDMD ZGEDMD_64 +#define ZGEDMD ZGEDMD_64 +#define ZGEDMDQ ZGEDMDQ_64 +#define ZGEEQU ZGEEQU_64 +#define ZGEEQUB ZGEEQUB_64 +#define ZGEES ZGEES_64 +#define ZGEESX ZGEESX_64 +#define ZGEEV ZGEEV_64 +#define ZGEEVX ZGEEVX_64 +#define ZGEGS ZGEGS_64 +#define ZGEGV ZGEGV_64 +#define ZGEHD2 ZGEHD2_64 +#define ZGEHRD ZGEHRD_64 +#define ZGEJSV ZGEJSV_64 +#define ZGELQ ZGELQ_64 +#define ZGELQ2 ZGELQ2_64 +#define ZGELQF ZGELQF_64 +#define ZGELQT ZGELQT_64 +#define ZGELQT3 ZGELQT3_64 +#define ZGELS ZGELS_64 +#define ZGELSD ZGELSD_64 +#define ZGELSS ZGELSS_64 +#define ZGELST ZGELST_64 +#define ZGELSX ZGELSX_64 +#define ZGELSY ZGELSY_64 +#define ZGEMLQ ZGEMLQ_64 +#define ZGEMLQT ZGEMLQT_64 +#define ZGEMM ZGEMM_64 +#define ZGEMQR ZGEMQR_64 +#define ZGEMQRT ZGEMQRT_64 +#define ZGEMV ZGEMV_64 +#define ZGEQL2 ZGEQL2_64 +#define ZGEQLF ZGEQLF_64 +#define ZGEQP3 ZGEQP3_64 +#define ZGEQPF ZGEQPF_64 +#define ZGEQR ZGEQR_64 +#define ZGEQR2 ZGEQR2_64 +#define ZGEQR2P ZGEQR2P_64 +#define ZGEQRF ZGEQRF_64 +#define ZGEQRF ZGEQRF_64 +#define ZGEQRFP ZGEQRFP_64 +#define ZGEQRT ZGEQRT_64 +#define ZGEQRT2 ZGEQRT2_64 +#define ZGEQRT3 ZGEQRT3_64 +#define ZGERC ZGERC_64 +#define ZGERFS ZGERFS_64 +#define ZGERFSX ZGERFSX_64 +#define ZGERQ2 ZGERQ2_64 +#define ZGERQF ZGERQF_64 +#define ZGERU ZGERU_64 +#define ZGESC2 ZGESC2_64 +#define ZGESDD ZGESDD_64 +#define ZGESV ZGESV_64 +#define ZGESVD ZGESVD_64 +#define ZGESVDQ ZGESVDQ_64 +#define ZGESVDX ZGESVDX_64 +#define ZGESVJ ZGESVJ_64 +#define ZGESVX ZGESVX_64 +#define ZGESVXX ZGESVXX_64 +#define ZGETC2 ZGETC2_64 +#define ZGETF2 ZGETF2_64 +#define ZGETRF ZGETRF_64 +#define ZGETRF ZGETRF_64 +#define ZGETRF2 ZGETRF2_64 +#define ZGETRI ZGETRI_64 +#define ZGETRS ZGETRS_64 +#define ZGETSLS ZGETSLS_64 +#define ZGETSQRHRT ZGETSQRHRT_64 +#define ZGGBAK ZGGBAK_64 +#define ZGGBAL ZGGBAL_64 +#define ZGGES ZGGES_64 +#define ZGGES3 ZGGES3_64 +#define ZGGESX ZGGESX_64 +#define ZGGEV ZGGEV_64 +#define ZGGEV3 ZGGEV3_64 +#define ZGGEVX ZGGEVX_64 +#define ZGGGLM ZGGGLM_64 +#define ZGGHD3 ZGGHD3_64 +#define ZGGHRD ZGGHRD_64 +#define ZGGLSE ZGGLSE_64 +#define ZGGQRF ZGGQRF_64 +#define ZGGRQF ZGGRQF_64 +#define ZGGSVD ZGGSVD_64 +#define ZGGSVD3 ZGGSVD3_64 +#define ZGGSVP ZGGSVP_64 +#define ZGGSVP3 ZGGSVP3_64 +#define ZGSVJ0 ZGSVJ0_64 +#define ZGSVJ1 ZGSVJ1_64 +#define ZGTCON ZGTCON_64 +#define ZGTRFS ZGTRFS_64 +#define ZGTSV ZGTSV_64 +#define ZGTSVX ZGTSVX_64 +#define ZGTTRF ZGTTRF_64 +#define ZGTTRS ZGTTRS_64 +#define ZGTTS2 ZGTTS2_64 +#define ZHB2ST_KERNELS ZHB2ST_KERNELS_64 +#define ZHBEV ZHBEV_64 +#define ZHBEV_2STAGE ZHBEV_2STAGE_64 +#define ZHBEVD ZHBEVD_64 +#define ZHBEVD_2STAGE ZHBEVD_2STAGE_64 +#define ZHBEVX ZHBEVX_64 +#define ZHBEVX_2STAGE ZHBEVX_2STAGE_64 +#define ZHBGST ZHBGST_64 +#define ZHBGV ZHBGV_64 +#define ZHBGVD ZHBGVD_64 +#define ZHBGVX ZHBGVX_64 +#define ZHBMV ZHBMV_64 +#define ZHBTRD ZHBTRD_64 +#define ZHECON ZHECON_64 +#define ZHECON_3 ZHECON_3_64 +#define ZHECON_ROOK ZHECON_ROOK_64 +#define ZHEEQUB ZHEEQUB_64 +#define ZHEEV ZHEEV_64 +#define ZHEEV_2STAGE ZHEEV_2STAGE_64 +#define ZHEEVD ZHEEVD_64 +#define ZHEEVD_2STAGE ZHEEVD_2STAGE_64 +#define ZHEEVR ZHEEVR_64 +#define ZHEEVR_2STAGE ZHEEVR_2STAGE_64 +#define ZHEEVX ZHEEVX_64 +#define ZHEEVX_2STAGE ZHEEVX_2STAGE_64 +#define ZHEGS2 ZHEGS2_64 +#define ZHEGST ZHEGST_64 +#define ZHEGV ZHEGV_64 +#define ZHEGV_2STAGE ZHEGV_2STAGE_64 +#define ZHEGVD ZHEGVD_64 +#define ZHEGVX ZHEGVX_64 +#define ZHEMM ZHEMM_64 +#define ZHEMV ZHEMV_64 +#define ZHER ZHER_64 +#define ZHER2 ZHER2_64 +#define ZHER2K ZHER2K_64 +#define ZHERFS ZHERFS_64 +#define ZHERFSX ZHERFSX_64 +#define ZHERK ZHERK_64 +#define ZHESV ZHESV_64 +#define ZHESV_AA ZHESV_AA_64 +#define ZHESV_AA_2STAGE ZHESV_AA_2STAGE_64 +#define ZHESV_RK ZHESV_RK_64 +#define ZHESV_ROOK ZHESV_ROOK_64 +#define ZHESVX ZHESVX_64 +#define ZHESVXX ZHESVXX_64 +#define ZHESWAPR ZHESWAPR_64 +#define ZHETD2 ZHETD2_64 +#define ZHETF2 ZHETF2_64 +#define ZHETF2_RK ZHETF2_RK_64 +#define ZHETF2_ROOK ZHETF2_ROOK_64 +#define ZHETRD ZHETRD_64 +#define ZHETRD_2STAGE ZHETRD_2STAGE_64 +#define ZHETRD_HB2ST ZHETRD_HB2ST_64 +#define ZHETRD_HE2HB ZHETRD_HE2HB_64 +#define ZHETRF ZHETRF_64 +#define ZHETRF_AA ZHETRF_AA_64 +#define ZHETRF_AA_2STAGE ZHETRF_AA_2STAGE_64 +#define ZHETRF_RK ZHETRF_RK_64 +#define ZHETRF_ROOK ZHETRF_ROOK_64 +#define ZHETRI ZHETRI_64 +#define ZHETRI2 ZHETRI2_64 +#define ZHETRI2X ZHETRI2X_64 +#define ZHETRI_3 ZHETRI_3_64 +#define ZHETRI_3X ZHETRI_3X_64 +#define ZHETRI_ROOK ZHETRI_ROOK_64 +#define ZHETRS ZHETRS_64 +#define ZHETRS2 ZHETRS2_64 +#define ZHETRS_3 ZHETRS_3_64 +#define ZHETRS_AA ZHETRS_AA_64 +#define ZHETRS_AA_2STAGE ZHETRS_AA_2STAGE_64 +#define ZHETRS_ROOK ZHETRS_ROOK_64 +#define ZHFRK ZHFRK_64 +#define ZHGEQZ ZHGEQZ_64 +#define ZHPCON ZHPCON_64 +#define ZHPEV ZHPEV_64 +#define ZHPEVD ZHPEVD_64 +#define ZHPEVX ZHPEVX_64 +#define ZHPGST ZHPGST_64 +#define ZHPGV ZHPGV_64 +#define ZHPGVD ZHPGVD_64 +#define ZHPGVX ZHPGVX_64 +#define ZHPMV ZHPMV_64 +#define ZHPR ZHPR_64 +#define ZHPR2 ZHPR2_64 +#define ZHPRFS ZHPRFS_64 +#define ZHPSV ZHPSV_64 +#define ZHPSVX ZHPSVX_64 +#define ZHPTRD ZHPTRD_64 +#define ZHPTRF ZHPTRF_64 +#define ZHPTRI ZHPTRI_64 +#define ZHPTRS ZHPTRS_64 +#define ZHSEIN ZHSEIN_64 +#define ZHSEQR ZHSEQR_64 +#define ZLABRD ZLABRD_64 +#define ZLACGV ZLACGV_64 +#define ZLACN2 ZLACN2_64 +#define ZLACON ZLACON_64 +#define ZLACP2 ZLACP2_64 +#define ZLACPY ZLACPY_64 +#define ZLACRM ZLACRM_64 +#define ZLACRT ZLACRT_64 +#define ZLADIV ZLADIV_64 +#define ZLAED0 ZLAED0_64 +#define ZLAED7 ZLAED7_64 +#define ZLAED8 ZLAED8_64 +#define ZLAEIN ZLAEIN_64 +#define ZLAESY ZLAESY_64 +#define ZLAEV2 ZLAEV2_64 +#define ZLAG2C ZLAG2C_64 +#define ZLA_GBAMV ZLA_GBAMV_64 +#define ZLA_GBRCOND_C ZLA_GBRCOND_C_64 +#define ZLA_GBRCOND_X ZLA_GBRCOND_X_64 +#define ZLA_GBRFSX_EXTENDED ZLA_GBRFSX_EXTENDED_64 +#define ZLA_GBRPVGRW ZLA_GBRPVGRW_64 +#define ZLA_GEAMV ZLA_GEAMV_64 +#define ZLA_GERCOND_C ZLA_GERCOND_C_64 +#define ZLA_GERCOND_X ZLA_GERCOND_X_64 +#define ZLA_GERFSX_EXTENDED ZLA_GERFSX_EXTENDED_64 +#define ZLA_GERPVGRW ZLA_GERPVGRW_64 +#define ZLAGS2 ZLAGS2_64 +#define ZLAGTM ZLAGTM_64 +#define ZLA_HEAMV ZLA_HEAMV_64 +#define ZLAHEF ZLAHEF_64 +#define ZLAHEF_AA ZLAHEF_AA_64 +#define ZLAHEF_RK ZLAHEF_RK_64 +#define ZLAHEF_ROOK ZLAHEF_ROOK_64 +#define ZLA_HERCOND_C ZLA_HERCOND_C_64 +#define ZLA_HERCOND_X ZLA_HERCOND_X_64 +#define ZLA_HERFSX_EXTENDED ZLA_HERFSX_EXTENDED_64 +#define ZLA_HERPVGRW ZLA_HERPVGRW_64 +#define ZLAHQR ZLAHQR_64 +#define ZLAHR2 ZLAHR2_64 +#define ZLAHRD ZLAHRD_64 +#define ZLAIC1 ZLAIC1_64 +#define ZLA_LIN_BERR ZLA_LIN_BERR_64 +#define ZLALS0 ZLALS0_64 +#define ZLALSA ZLALSA_64 +#define ZLALSD ZLALSD_64 +#define ZLAMSWLQ ZLAMSWLQ_64 +#define ZLAMTSQR ZLAMTSQR_64 +#define ZLANGB ZLANGB_64 +#define ZLANGE ZLANGE_64 +#define ZLANGT ZLANGT_64 +#define ZLANHB ZLANHB_64 +#define ZLANHE ZLANHE_64 +#define ZLANHF ZLANHF_64 +#define ZLANHP ZLANHP_64 +#define ZLANHS ZLANHS_64 +#define ZLANHT ZLANHT_64 +#define ZLANSB ZLANSB_64 +#define ZLANSP ZLANSP_64 +#define ZLANSY ZLANSY_64 +#define ZLANTB ZLANTB_64 +#define ZLANTP ZLANTP_64 +#define ZLANTR ZLANTR_64 +#define ZLAPLL ZLAPLL_64 +#define ZLAPMR ZLAPMR_64 +#define ZLAPMT ZLAPMT_64 +#define ZLA_PORCOND_C ZLA_PORCOND_C_64 +#define ZLA_PORCOND_X ZLA_PORCOND_X_64 +#define ZLA_PORFSX_EXTENDED ZLA_PORFSX_EXTENDED_64 +#define ZLA_PORPVGRW ZLA_PORPVGRW_64 +#define ZLAQGB ZLAQGB_64 +#define ZLAQGE ZLAQGE_64 +#define ZLAQHB ZLAQHB_64 +#define ZLAQHE ZLAQHE_64 +#define ZLAQHP ZLAQHP_64 +#define ZLAQP2 ZLAQP2_64 +#define ZLAQPS ZLAQPS_64 +#define ZLAQR0 ZLAQR0_64 +#define ZLAQR1 ZLAQR1_64 +#define ZLAQR2 ZLAQR2_64 +#define ZLAQR3 ZLAQR3_64 +#define ZLAQR4 ZLAQR4_64 +#define ZLAQR5 ZLAQR5_64 +#define ZLAQSB ZLAQSB_64 +#define ZLAQSP ZLAQSP_64 +#define ZLAQSY ZLAQSY_64 +#define ZLAQZ0 ZLAQZ0_64 +#define ZLAQZ1 ZLAQZ1_64 +#define ZLAQZ2 ZLAQZ2_64 +#define ZLAQZ3 ZLAQZ3_64 +#define ZLAR1V ZLAR1V_64 +#define ZLAR2V ZLAR2V_64 +#define ZLARCM ZLARCM_64 +#define ZLARF ZLARF_64 +#define ZLARFB ZLARFB_64 +#define ZLARFB_GETT ZLARFB_GETT_64 +#define ZLARFG ZLARFG_64 +#define ZLARFGP ZLARFGP_64 +#define ZLARFT ZLARFT_64 +#define ZLARFX ZLARFX_64 +#define ZLARFY ZLARFY_64 +#define ZLARGV ZLARGV_64 +#define ZLARNV ZLARNV_64 +#define ZLARRV ZLARRV_64 +#define ZLARSCL2 ZLARSCL2_64 +#define ZLARTG ZLARTG_64 +#define ZLARTV ZLARTV_64 +#define ZLARZ ZLARZ_64 +#define ZLARZB ZLARZB_64 +#define ZLARZT ZLARZT_64 +#define ZLASCL ZLASCL_64 +#define ZLASCL2 ZLASCL2_64 +#define ZLASET ZLASET_64 +#define ZLASR ZLASR_64 +#define ZLASSQ ZLASSQ_64 +#define ZLASWLQ ZLASWLQ_64 +#define ZLASWP ZLASWP_64 +#define ZLA_SYAMV ZLA_SYAMV_64 +#define ZLASYF ZLASYF_64 +#define ZLASYF_AA ZLASYF_AA_64 +#define ZLASYF_RK ZLASYF_RK_64 +#define ZLASYF_ROOK ZLASYF_ROOK_64 +#define ZLA_SYRCOND_C ZLA_SYRCOND_C_64 +#define ZLA_SYRCOND_X ZLA_SYRCOND_X_64 +#define ZLA_SYRFSX_EXTENDED ZLA_SYRFSX_EXTENDED_64 +#define ZLA_SYRPVGRW ZLA_SYRPVGRW_64 +#define ZLAT2C ZLAT2C_64 +#define ZLATBS ZLATBS_64 +#define ZLATDF ZLATDF_64 +#define ZLATPS ZLATPS_64 +#define ZLATRD ZLATRD_64 +#define ZLATRS ZLATRS_64 +#define ZLATRS3 ZLATRS3_64 +#define ZLATRZ ZLATRZ_64 +#define ZLATSQR ZLATSQR_64 +#define ZLATZM ZLATZM_64 +#define ZLAUNHR_COL_GETRFNP ZLAUNHR_COL_GETRFNP_64 +#define ZLAUNHR_COL_GETRFNP2 ZLAUNHR_COL_GETRFNP2_64 +#define ZLAUU2 ZLAUU2_64 +#define ZLAUUM ZLAUUM_64 +#define ZLA_WWADDW ZLA_WWADDW_64 +#define ZPBCON ZPBCON_64 +#define ZPBEQU ZPBEQU_64 +#define ZPBRFS ZPBRFS_64 +#define ZPBSTF ZPBSTF_64 +#define ZPBSV ZPBSV_64 +#define ZPBSVX ZPBSVX_64 +#define ZPBTF2 ZPBTF2_64 +#define ZPBTRF ZPBTRF_64 +#define ZPBTRS ZPBTRS_64 +#define ZPFTRF ZPFTRF_64 +#define ZPFTRI ZPFTRI_64 +#define ZPFTRS ZPFTRS_64 +#define ZPOCON ZPOCON_64 +#define ZPOEQU ZPOEQU_64 +#define ZPOEQUB ZPOEQUB_64 +#define ZPORFS ZPORFS_64 +#define ZPORFSX ZPORFSX_64 +#define ZPOSV ZPOSV_64 +#define ZPOSVX ZPOSVX_64 +#define ZPOSVXX ZPOSVXX_64 +#define ZPOTF2 ZPOTF2_64 +#define ZPOTRF ZPOTRF_64 +#define ZPOTRF ZPOTRF_64 +#define ZPOTRF2 ZPOTRF2_64 +#define ZPOTRI ZPOTRI_64 +#define ZPOTRS ZPOTRS_64 +#define ZPPCON ZPPCON_64 +#define ZPPEQU ZPPEQU_64 +#define ZPPRFS ZPPRFS_64 +#define ZPPSV ZPPSV_64 +#define ZPPSVX ZPPSVX_64 +#define ZPPTRF ZPPTRF_64 +#define ZPPTRI ZPPTRI_64 +#define ZPPTRS ZPPTRS_64 +#define ZPSTF2 ZPSTF2_64 +#define ZPSTRF ZPSTRF_64 +#define ZPTCON ZPTCON_64 +#define ZPTEQR ZPTEQR_64 +#define ZPTRFS ZPTRFS_64 +#define ZPTSV ZPTSV_64 +#define ZPTSVX ZPTSVX_64 +#define ZPTTRF ZPTTRF_64 +#define ZPTTRS ZPTTRS_64 +#define ZPTTS2 ZPTTS2_64 +#define ZROT ZROT_64 +#define ZRSCL ZRSCL_64 +#define ZSCAL ZSCAL_64 +#define ZSPCON ZSPCON_64 +#define ZSPMV ZSPMV_64 +#define ZSPR ZSPR_64 +#define ZSPRFS ZSPRFS_64 +#define ZSPSV ZSPSV_64 +#define ZSPSVX ZSPSVX_64 +#define ZSPTRF ZSPTRF_64 +#define ZSPTRI ZSPTRI_64 +#define ZSPTRS ZSPTRS_64 +#define ZSTEDC ZSTEDC_64 +#define ZSTEGR ZSTEGR_64 +#define ZSTEIN ZSTEIN_64 +#define ZSTEMR ZSTEMR_64 +#define ZSTEQR ZSTEQR_64 +#define ZSWAP ZSWAP_64 +#define ZSYCON ZSYCON_64 +#define ZSYCON_3 ZSYCON_3_64 +#define ZSYCON_ROOK ZSYCON_ROOK_64 +#define ZSYCONV ZSYCONV_64 +#define ZSYCONVF ZSYCONVF_64 +#define ZSYCONVF_ROOK ZSYCONVF_ROOK_64 +#define ZSYEQUB ZSYEQUB_64 +#define ZSYMV ZSYMV_64 +#define ZSYR ZSYR_64 +#define ZSYRFS ZSYRFS_64 +#define ZSYRFSX ZSYRFSX_64 +#define ZSYSV ZSYSV_64 +#define ZSYSV_AA ZSYSV_AA_64 +#define ZSYSV_AA_2STAGE ZSYSV_AA_2STAGE_64 +#define ZSYSV_RK ZSYSV_RK_64 +#define ZSYSV_ROOK ZSYSV_ROOK_64 +#define ZSYSVX ZSYSVX_64 +#define ZSYSVXX ZSYSVXX_64 +#define ZSYSWAPR ZSYSWAPR_64 +#define ZSYTF2 ZSYTF2_64 +#define ZSYTF2_RK ZSYTF2_RK_64 +#define ZSYTF2_ROOK ZSYTF2_ROOK_64 +#define ZSYTRF ZSYTRF_64 +#define ZSYTRF_AA ZSYTRF_AA_64 +#define ZSYTRF_AA_2STAGE ZSYTRF_AA_2STAGE_64 +#define ZSYTRF_RK ZSYTRF_RK_64 +#define ZSYTRF_ROOK ZSYTRF_ROOK_64 +#define ZSYTRI ZSYTRI_64 +#define ZSYTRI2 ZSYTRI2_64 +#define ZSYTRI2X ZSYTRI2X_64 +#define ZSYTRI_3 ZSYTRI_3_64 +#define ZSYTRI_3X ZSYTRI_3X_64 +#define ZSYTRI_ROOK ZSYTRI_ROOK_64 +#define ZSYTRS ZSYTRS_64 +#define ZSYTRS2 ZSYTRS2_64 +#define ZSYTRS_3 ZSYTRS_3_64 +#define ZSYTRS_AA ZSYTRS_AA_64 +#define ZSYTRS_AA_2STAGE ZSYTRS_AA_2STAGE_64 +#define ZSYTRS_ROOK ZSYTRS_ROOK_64 +#define ZTBCON ZTBCON_64 +#define ZTBMV ZTBMV_64 +#define ZTBRFS ZTBRFS_64 +#define ZTBSV ZTBSV_64 +#define ZTBTRS ZTBTRS_64 +#define ZTFSM ZTFSM_64 +#define ZTFTRI ZTFTRI_64 +#define ZTFTTP ZTFTTP_64 +#define ZTFTTR ZTFTTR_64 +#define ZTGEVC ZTGEVC_64 +#define ZTGEX2 ZTGEX2_64 +#define ZTGEXC ZTGEXC_64 +#define ZTGSEN ZTGSEN_64 +#define ZTGSJA ZTGSJA_64 +#define ZTGSNA ZTGSNA_64 +#define ZTGSY2 ZTGSY2_64 +#define ZTGSYL ZTGSYL_64 +#define ZTPCON ZTPCON_64 +#define ZTPLQT ZTPLQT_64 +#define ZTPLQT2 ZTPLQT2_64 +#define ZTPMLQT ZTPMLQT_64 +#define ZTPMQRT ZTPMQRT_64 +#define ZTPMV ZTPMV_64 +#define ZTPQRT ZTPQRT_64 +#define ZTPQRT2 ZTPQRT2_64 +#define ZTPRFB ZTPRFB_64 +#define ZTPRFS ZTPRFS_64 +#define ZTPSV ZTPSV_64 +#define ZTPTRI ZTPTRI_64 +#define ZTPTRS ZTPTRS_64 +#define ZTPTTF ZTPTTF_64 +#define ZTPTTR ZTPTTR_64 +#define ZTRCON ZTRCON_64 +#define ZTREVC ZTREVC_64 +#define ZTREVC3 ZTREVC3_64 +#define ZTREXC ZTREXC_64 +#define ZTRMM ZTRMM_64 +#define ZTRMV ZTRMV_64 +#define ZTRRFS ZTRRFS_64 +#define ZTRSEN ZTRSEN_64 +#define ZTRSM ZTRSM_64 +#define ZTRSNA ZTRSNA_64 +#define ZTRSV ZTRSV_64 +#define ZTRSYL ZTRSYL_64 +#define ZTRSYL3 ZTRSYL3_64 +#define ZTRTI2 ZTRTI2_64 +#define ZTRTRI ZTRTRI_64 +#define ZTRTRS ZTRTRS_64 +#define ZTRTTF ZTRTTF_64 +#define ZTRTTP ZTRTTP_64 +#define ZTZRQF ZTZRQF_64 +#define ZTZRZF ZTZRZF_64 +#define ZUNBDB ZUNBDB_64 +#define ZUNBDB1 ZUNBDB1_64 +#define ZUNBDB2 ZUNBDB2_64 +#define ZUNBDB3 ZUNBDB3_64 +#define ZUNBDB4 ZUNBDB4_64 +#define ZUNBDB5 ZUNBDB5_64 +#define ZUNBDB6 ZUNBDB6_64 +#define ZUNCSD ZUNCSD_64 +#define ZUNCSD2BY1 ZUNCSD2BY1_64 +#define ZUNG2L ZUNG2L_64 +#define ZUNG2R ZUNG2R_64 +#define ZUNGBR ZUNGBR_64 +#define ZUNGHR ZUNGHR_64 +#define ZUNGL2 ZUNGL2_64 +#define ZUNGLQ ZUNGLQ_64 +#define ZUNGQL ZUNGQL_64 +#define ZUNGQR ZUNGQR_64 +#define ZUNGR2 ZUNGR2_64 +#define ZUNGRQ ZUNGRQ_64 +#define ZUNGTR ZUNGTR_64 +#define ZUNGTSQR ZUNGTSQR_64 +#define ZUNGTSQR_ROW ZUNGTSQR_ROW_64 +#define ZUNHR_COL ZUNHR_COL_64 +#define ZUNM22 ZUNM22_64 +#define ZUNM2L ZUNM2L_64 +#define ZUNM2R ZUNM2R_64 +#define ZUNMBR ZUNMBR_64 +#define ZUNMHR ZUNMHR_64 +#define ZUNML2 ZUNML2_64 +#define ZUNMLQ ZUNMLQ_64 +#define ZUNMQL ZUNMQL_64 +#define ZUNMQR ZUNMQR_64 +#define ZUNMR2 ZUNMR2_64 +#define ZUNMR3 ZUNMR3_64 +#define ZUNMRQ ZUNMRQ_64 +#define ZUNMRZ ZUNMRZ_64 +#define ZUNMTR ZUNMTR_64 +#define ZUPGTR ZUPGTR_64 +#define ZUPMTR ZUPMTR_64 + +#endif +#endif diff --git a/SRC/lsamen.f b/SRC/lsamen.f index 91447b4101..440eefa7e3 100644 --- a/SRC/lsamen.f +++ b/SRC/lsamen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b LSAMEN * * =========== DOCUMENTATION =========== diff --git a/SRC/sbbcsd.f b/SRC/sbbcsd.f index 0e84bff8be..99d52da2f1 100644 --- a/SRC/sbbcsd.f +++ b/SRC/sbbcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsdc.f b/SRC/sbdsdc.f index 9f60301a2b..0b9641def3 100644 --- a/SRC/sbdsdc.f +++ b/SRC/sbdsdc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SBDSDC * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index 4ce0fe55c9..cf0009038b 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsvdx.f b/SRC/sbdsvdx.f index d922d0e502..28dbf5c2fe 100644 --- a/SRC/sbdsvdx.f +++ b/SRC/sbdsvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SBDSVDX * * =========== DOCUMENTATION =========== diff --git a/SRC/scsum1.f b/SRC/scsum1.f index d93baf233d..4d09fc6eef 100644 --- a/SRC/scsum1.f +++ b/SRC/scsum1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SCSUM1 forms the 1-norm of the complex vector using the true absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/sdisna.f b/SRC/sdisna.f index 9bb63c0c3f..e7b17964af 100644 --- a/SRC/sdisna.f +++ b/SRC/sdisna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SDISNA * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbbrd.f b/SRC/sgbbrd.f index 7a22f4f6f8..fabcdb1658 100644 --- a/SRC/sgbbrd.f +++ b/SRC/sgbbrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBBRD * * =========== DOCUMENTATION =========== @@ -230,7 +231,8 @@ SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, WANTC = NCC.GT.0 KLU1 = KL + KU + 1 INFO = 0 - IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) ) + IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. + $ .NOT.LSAME( VECT, 'N' ) ) $ THEN INFO = -1 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/sgbcon.f b/SRC/sgbcon.f index 0b0e6cf42b..f1f3f086d2 100644 --- a/SRC/sgbcon.f +++ b/SRC/sgbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBCON * * =========== DOCUMENTATION =========== @@ -141,8 +142,8 @@ *> \ingroup gbcon * * ===================================================================== - SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, - $ WORK, IWORK, INFO ) + SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, + $ RCOND, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -249,7 +250,8 @@ SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK( JP ) = WORK( J ) WORK( J ) = T END IF - CALL SAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 ) + CALL SAXPY( LM, -T, AB( KD+1, J ), 1, + $ WORK( J+1 ), 1 ) 20 CONTINUE END IF * diff --git a/SRC/sgbequ.f b/SRC/sgbequ.f index e9e37fa94e..35cfafdbd5 100644 --- a/SRC/sgbequ.f +++ b/SRC/sgbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbequb.f b/SRC/sgbequb.f index 7bb5cbc733..a5656643e8 100644 --- a/SRC/sgbequb.f +++ b/SRC/sgbequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbrfs.f b/SRC/sgbrfs.f index 236c2856d2..3155e4ff87 100644 --- a/SRC/sgbrfs.f +++ b/SRC/sgbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbrfsx.f b/SRC/sgbrfsx.f index bb25047b78..655dd45652 100644 --- a/SRC/sgbrfsx.f +++ b/SRC/sgbrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsv.f b/SRC/sgbsv.f index 46cf311f11..be49686de8 100644 --- a/SRC/sgbsv.f +++ b/SRC/sgbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsvx.f b/SRC/sgbsvx.f index efc5622f45..5432a9ea11 100644 --- a/SRC/sgbsvx.f +++ b/SRC/sgbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsvxx.f b/SRC/sgbsvxx.f index 1d41da45f5..8c607a6dda 100644 --- a/SRC/sgbsvxx.f +++ b/SRC/sgbsvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtf2.f b/SRC/sgbtf2.f index 762c50c263..4836dbebe5 100644 --- a/SRC/sgbtf2.f +++ b/SRC/sgbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtrf.f b/SRC/sgbtrf.f index 8cdd3538ae..c3ff28a2e5 100644 --- a/SRC/sgbtrf.f +++ b/SRC/sgbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtrs.f b/SRC/sgbtrs.f index 86888b047a..b0e5e24bd3 100644 --- a/SRC/sgbtrs.f +++ b/SRC/sgbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebak.f b/SRC/sgebak.f index f9045c7397..0c7770ef66 100644 --- a/SRC/sgebak.f +++ b/SRC/sgebak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebal.f b/SRC/sgebal.f index d917cd56f8..a157ff217a 100644 --- a/SRC/sgebal.f +++ b/SRC/sgebal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebd2.f b/SRC/sgebd2.f index 0044b54c52..88fceb8171 100644 --- a/SRC/sgebd2.f +++ b/SRC/sgebd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebrd.f b/SRC/sgebrd.f index b33ad0b1f7..3d53c8c456 100644 --- a/SRC/sgebrd.f +++ b/SRC/sgebrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgecon.f b/SRC/sgecon.f index 82f463ebb1..c5e009b5a9 100644 --- a/SRC/sgecon.f +++ b/SRC/sgecon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index 90d15c3360..c477691e85 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b SGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/sgedmdq.f90 b/SRC/sgedmdq.f90 index 2506149cc7..7996a5f2a9 100644 --- a/SRC/sgedmdq.f90 +++ b/SRC/sgedmdq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/sgeequ.f b/SRC/sgeequ.f index d897366b42..c2467552c1 100644 --- a/SRC/sgeequ.f +++ b/SRC/sgeequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeequb.f b/SRC/sgeequb.f index 8fa6a42cd2..77878e6346 100644 --- a/SRC/sgeequb.f +++ b/SRC/sgeequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sgees.f b/SRC/sgees.f index 4418ea064f..25de49792c 100644 --- a/SRC/sgees.f +++ b/SRC/sgees.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index cabe9f1f79..c626893047 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeev.f b/SRC/sgeev.f index 93f9932651..25d78fd25c 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index b0af786057..924a31a220 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgehd2.f b/SRC/sgehd2.f index 2692e68273..cc630e4810 100644 --- a/SRC/sgehd2.f +++ b/SRC/sgehd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index cfa17e156f..7ba5414e72 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index b4840bac21..dae204d5cf 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelq.f b/SRC/sgelq.f index 75f02675d8..fd35859b1c 100644 --- a/SRC/sgelq.f +++ b/SRC/sgelq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGELQ * * Definition: diff --git a/SRC/sgelq2.f b/SRC/sgelq2.f index dea1335b7f..e4eb7c4e39 100644 --- a/SRC/sgelq2.f +++ b/SRC/sgelq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelqf.f b/SRC/sgelqf.f index 3b3913d843..ed7e1adab2 100644 --- a/SRC/sgelqf.f +++ b/SRC/sgelqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelqt.f b/SRC/sgelqt.f index f941388ece..8650ca33ee 100644 --- a/SRC/sgelqt.f +++ b/SRC/sgelqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGELQT * * Definition: diff --git a/SRC/sgelqt3.f b/SRC/sgelqt3.f index fc62d5b79c..39a24884a4 100644 --- a/SRC/sgelqt3.f +++ b/SRC/sgelqt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGELQT3 * * Definition: diff --git a/SRC/sgels.f b/SRC/sgels.f index b58f70c9ee..8c83d31aad 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelsd.f b/SRC/sgelsd.f index 2818213f4e..7d4b257356 100644 --- a/SRC/sgelsd.f +++ b/SRC/sgelsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelss.f b/SRC/sgelss.f index 2e4b0cdd53..5e46e19ee0 100644 --- a/SRC/sgelss.f +++ b/SRC/sgelss.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelst.f b/SRC/sgelst.f index b89918656d..a00f3fecef 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index c7f5069de4..e14c8dd684 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index 7e4d9bf656..13f3c4ab92 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEMLQ * * Definition: diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f index 7917f6b9c1..21b4217886 100644 --- a/SRC/sgemlqt.f +++ b/SRC/sgemlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEMLQT * * Definition: diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f index 19bf467b8b..934b4bd6e3 100644 --- a/SRC/sgemqr.f +++ b/SRC/sgemqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEMQR * * Definition: diff --git a/SRC/sgemqrt.f b/SRC/sgemqrt.f index cd141ece5c..4e01d8c4a3 100644 --- a/SRC/sgemqrt.f +++ b/SRC/sgemqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeql2.f b/SRC/sgeql2.f index 0948cf4266..9a0289080b 100644 --- a/SRC/sgeql2.f +++ b/SRC/sgeql2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqlf.f b/SRC/sgeqlf.f index 14942b7652..c6e5a49215 100644 --- a/SRC/sgeqlf.f +++ b/SRC/sgeqlf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqp3.f b/SRC/sgeqp3.f index 9f2f40b2e3..9a3fe7f682 100644 --- a/SRC/sgeqp3.f +++ b/SRC/sgeqp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f index 79a515e1c8..5b3418ea05 100644 --- a/SRC/sgeqr.f +++ b/SRC/sgeqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQR * * Definition: diff --git a/SRC/sgeqr2.f b/SRC/sgeqr2.f index 3a78733b7d..62887d8a1b 100644 --- a/SRC/sgeqr2.f +++ b/SRC/sgeqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqr2p.f b/SRC/sgeqr2p.f index 9f3693a631..6e8bb0f738 100644 --- a/SRC/sgeqr2p.f +++ b/SRC/sgeqr2p.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrf.f b/SRC/sgeqrf.f index 689fe1aea2..c8a23b24d8 100644 --- a/SRC/sgeqrf.f +++ b/SRC/sgeqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrfp.f b/SRC/sgeqrfp.f index 37747c5124..acb90e0c2e 100644 --- a/SRC/sgeqrfp.f +++ b/SRC/sgeqrfp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt.f b/SRC/sgeqrt.f index 18a17a02b2..050e920c55 100644 --- a/SRC/sgeqrt.f +++ b/SRC/sgeqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt2.f b/SRC/sgeqrt2.f index 374850531f..9c13eb5b75 100644 --- a/SRC/sgeqrt2.f +++ b/SRC/sgeqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt3.f b/SRC/sgeqrt3.f index cf965353de..82fbe6e70b 100644 --- a/SRC/sgeqrt3.f +++ b/SRC/sgeqrt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerfs.f b/SRC/sgerfs.f index d3129eb58f..1c5b5b79ff 100644 --- a/SRC/sgerfs.f +++ b/SRC/sgerfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerfsx.f b/SRC/sgerfsx.f index c7e0a4b100..2e47f4f980 100644 --- a/SRC/sgerfsx.f +++ b/SRC/sgerfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerq2.f b/SRC/sgerq2.f index 1c612f8f27..9659b55bd1 100644 --- a/SRC/sgerq2.f +++ b/SRC/sgerq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerqf.f b/SRC/sgerqf.f index 1d3400a1fc..ea8b1453a0 100644 --- a/SRC/sgerqf.f +++ b/SRC/sgerqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesc2.f b/SRC/sgesc2.f index dc0c4ff6e1..8d7eca7d18 100644 --- a/SRC/sgesc2.f +++ b/SRC/sgesc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesdd.f b/SRC/sgesdd.f index 3156b59254..2c5fca007d 100644 --- a/SRC/sgesdd.f +++ b/SRC/sgesdd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesv.f b/SRC/sgesv.f index cf17675eb1..1a698161fe 100644 --- a/SRC/sgesv.f +++ b/SRC/sgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \addtogroup gesv *> *> \brief SGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/sgesvd.f b/SRC/sgesvd.f index d3fa945820..8d6f825f88 100644 --- a/SRC/sgesvd.f +++ b/SRC/sgesvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvdq.f b/SRC/sgesvdq.f index a28cffad24..f492cc6d96 100644 --- a/SRC/sgesvdq.f +++ b/SRC/sgesvdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvdx.f b/SRC/sgesvdx.f index 8b55b9b2e9..7e369da3a3 100644 --- a/SRC/sgesvdx.f +++ b/SRC/sgesvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvj.f b/SRC/sgesvj.f index 36aed2853c..79f898a4f3 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvx.f b/SRC/sgesvx.f index ff9d294f98..aa138e9a76 100644 --- a/SRC/sgesvx.f +++ b/SRC/sgesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvxx.f b/SRC/sgesvxx.f index ab79ca0ded..942c4e0e1a 100644 --- a/SRC/sgesvxx.f +++ b/SRC/sgesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetc2.f b/SRC/sgetc2.f index 498bc79d03..09cf2d9ebd 100644 --- a/SRC/sgetc2.f +++ b/SRC/sgetc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetf2.f b/SRC/sgetf2.f index f5bc6f9eb4..bca031e86c 100644 --- a/SRC/sgetf2.f +++ b/SRC/sgetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrf.f b/SRC/sgetrf.f index 379d7099bf..0ebb24f2c4 100644 --- a/SRC/sgetrf.f +++ b/SRC/sgetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrf2.f b/SRC/sgetrf2.f index 22d82e4fc7..0527b33b9d 100644 --- a/SRC/sgetrf2.f +++ b/SRC/sgetrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetri.f b/SRC/sgetri.f index 7b06bb63db..c8628638ae 100644 --- a/SRC/sgetri.f +++ b/SRC/sgetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrs.f b/SRC/sgetrs.f index fe47acbec7..2e0a1af81a 100644 --- a/SRC/sgetrs.f +++ b/SRC/sgetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index 08a427a8b3..c34edfff9c 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETSLS * * Definition: diff --git a/SRC/sgetsqrhrt.f b/SRC/sgetsqrhrt.f index 7ade8a66c1..18d94615f0 100644 --- a/SRC/sgetsqrhrt.f +++ b/SRC/sgetsqrhrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sggbak.f b/SRC/sggbak.f index c1fbb6d7e4..602a7edc31 100644 --- a/SRC/sggbak.f +++ b/SRC/sggbak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/sggbal.f b/SRC/sggbal.f index 13d10a50e1..ba32485306 100644 --- a/SRC/sggbal.f +++ b/SRC/sggbal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/sgges.f b/SRC/sgges.f index 8f42882ddd..acb79cb682 100644 --- a/SRC/sgges.f +++ b/SRC/sgges.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgges3.f b/SRC/sgges3.f index e90cd6947e..2bb7a26b05 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/sggesx.f b/SRC/sggesx.f index e5a14fc195..d8e6c179ca 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggev.f b/SRC/sggev.f index cacad7cacd..0775613305 100644 --- a/SRC/sggev.f +++ b/SRC/sggev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggev3.f b/SRC/sggev3.f index d788d11472..786eb2006d 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/sggevx.f b/SRC/sggevx.f index 63164a021f..58403490dc 100644 --- a/SRC/sggevx.f +++ b/SRC/sggevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggglm.f b/SRC/sggglm.f index 37094e4f26..26d531900c 100644 --- a/SRC/sggglm.f +++ b/SRC/sggglm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/sgghd3.f b/SRC/sgghd3.f index 01e57088ad..054d5a3053 100644 --- a/SRC/sgghd3.f +++ b/SRC/sgghd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgghrd.f b/SRC/sgghrd.f index c4712a031b..701a0a2edb 100644 --- a/SRC/sgghrd.f +++ b/SRC/sgghrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgglse.f b/SRC/sgglse.f index 53e3f8e45b..2c5049fa06 100644 --- a/SRC/sgglse.f +++ b/SRC/sgglse.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggqrf.f b/SRC/sggqrf.f index d32b484100..b257e2a2a5 100644 --- a/SRC/sggqrf.f +++ b/SRC/sggqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sggrqf.f b/SRC/sggrqf.f index b3842ec2ab..4ec99b22ed 100644 --- a/SRC/sggrqf.f +++ b/SRC/sggrqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index cee630593e..ab7b781b40 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggsvp3.f b/SRC/sggsvp3.f index 8e90d770cc..44c59952f4 100644 --- a/SRC/sggsvp3.f +++ b/SRC/sggsvp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgsvj0.f b/SRC/sgsvj0.f index a987e1d366..b18ec5acd0 100644 --- a/SRC/sgsvj0.f +++ b/SRC/sgsvj0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGSVJ0 pre-processor for the routine sgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgsvj1.f b/SRC/sgsvj1.f index e8da21c953..2c39fc4563 100644 --- a/SRC/sgsvj1.f +++ b/SRC/sgsvj1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtcon.f b/SRC/sgtcon.f index c45965fc3b..28e0695fd7 100644 --- a/SRC/sgtcon.f +++ b/SRC/sgtcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtrfs.f b/SRC/sgtrfs.f index 2668e3e76c..42a5c26d9b 100644 --- a/SRC/sgtrfs.f +++ b/SRC/sgtrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtsv.f b/SRC/sgtsv.f index bbb65c870f..a206838072 100644 --- a/SRC/sgtsv.f +++ b/SRC/sgtsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtsvx.f b/SRC/sgtsvx.f index ded93bf4de..88c3995723 100644 --- a/SRC/sgtsvx.f +++ b/SRC/sgtsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgttrf.f b/SRC/sgttrf.f index ccdf145141..d6cc506827 100644 --- a/SRC/sgttrf.f +++ b/SRC/sgttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgttrs.f b/SRC/sgttrs.f index dbfe5e7397..b940e5efe2 100644 --- a/SRC/sgttrs.f +++ b/SRC/sgttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtts2.f b/SRC/sgtts2.f index 56cda79c57..3640794700 100644 --- a/SRC/sgtts2.f +++ b/SRC/sgtts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/shgeqz.f b/SRC/shgeqz.f index 9ad64d2bf3..8b8ac80f0c 100644 --- a/SRC/shgeqz.f +++ b/SRC/shgeqz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/shsein.f b/SRC/shsein.f index 76c0bb5566..db4ccdc3fc 100644 --- a/SRC/shsein.f +++ b/SRC/shsein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/shseqr.f b/SRC/shseqr.f index 68b9fe6bde..99752b7a5a 100644 --- a/SRC/shseqr.f +++ b/SRC/shseqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sisnan.f b/SRC/sisnan.f index 510a9ff9d0..e24d1e3dae 100644 --- a/SRC/sisnan.f +++ b/SRC/sisnan.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SISNAN tests input for NaN. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbamv.f b/SRC/sla_gbamv.f index eaeebfa575..46e0801568 100644 --- a/SRC/sla_gbamv.f +++ b/SRC/sla_gbamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrcond.f b/SRC/sla_gbrcond.f index 659c9ba709..b33c81b787 100644 --- a/SRC/sla_gbrcond.f +++ b/SRC/sla_gbrcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GBRCOND estimates the Skeel condition number for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrfsx_extended.f b/SRC/sla_gbrfsx_extended.f index b0d8a301c8..36f9e28080 100644 --- a/SRC/sla_gbrfsx_extended.f +++ b/SRC/sla_gbrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrpvgrw.f b/SRC/sla_gbrpvgrw.f index cbc43d2301..21c4c7464e 100644 --- a/SRC/sla_gbrpvgrw.f +++ b/SRC/sla_gbrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_geamv.f b/SRC/sla_geamv.f index 76adf2167a..44308b9fc9 100644 --- a/SRC/sla_geamv.f +++ b/SRC/sla_geamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gercond.f b/SRC/sla_gercond.f index 7870233713..5ee9d4da0f 100644 --- a/SRC/sla_gercond.f +++ b/SRC/sla_gercond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GERCOND estimates the Skeel condition number for a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gerfsx_extended.f b/SRC/sla_gerfsx_extended.f index 16a277e351..61019af521 100644 --- a/SRC/sla_gerfsx_extended.f +++ b/SRC/sla_gerfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GERFSX_EXTENDED improves the computed solution to a system of linear equations for general matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gerpvgrw.f b/SRC/sla_gerpvgrw.f index f041c5dd2c..90863f6593 100644 --- a/SRC/sla_gerpvgrw.f +++ b/SRC/sla_gerpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_GERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_lin_berr.f b/SRC/sla_lin_berr.f index bc876eac39..53c9bc01f5 100644 --- a/SRC/sla_lin_berr.f +++ b/SRC/sla_lin_berr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porcond.f b/SRC/sla_porcond.f index 53dc5a8bde..01ab43bafe 100644 --- a/SRC/sla_porcond.f +++ b/SRC/sla_porcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porfsx_extended.f b/SRC/sla_porfsx_extended.f index d67f9706db..5f1bdfd6f5 100644 --- a/SRC/sla_porfsx_extended.f +++ b/SRC/sla_porfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porpvgrw.f b/SRC/sla_porpvgrw.f index c829bc6b57..a82fd68da6 100644 --- a/SRC/sla_porpvgrw.f +++ b/SRC/sla_porpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syamv.f b/SRC/sla_syamv.f index 1a2ac1394f..4ea8fe739a 100644 --- a/SRC/sla_syamv.f +++ b/SRC/sla_syamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrcond.f b/SRC/sla_syrcond.f index e2147029a7..e3222b6610 100644 --- a/SRC/sla_syrcond.f +++ b/SRC/sla_syrcond.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrfsx_extended.f b/SRC/sla_syrfsx_extended.f index 2f18ade88a..2a357171cc 100644 --- a/SRC/sla_syrfsx_extended.f +++ b/SRC/sla_syrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrpvgrw.f b/SRC/sla_syrpvgrw.f index f279ad2fbd..086eb3d0c8 100644 --- a/SRC/sla_syrpvgrw.f +++ b/SRC/sla_syrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_wwaddw.f b/SRC/sla_wwaddw.f index 480c7d5eef..47d85855c3 100644 --- a/SRC/sla_wwaddw.f +++ b/SRC/sla_wwaddw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/slabad.f b/SRC/slabad.f index 896fe6fef9..a70d8de1ea 100644 --- a/SRC/slabad.f +++ b/SRC/slabad.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLABAD * * =========== DOCUMENTATION =========== diff --git a/SRC/slabrd.f b/SRC/slabrd.f index 1a408bc0e3..b21f77823d 100644 --- a/SRC/slabrd.f +++ b/SRC/slabrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacn2.f b/SRC/slacn2.f index 07682f8216..c00e742ac3 100644 --- a/SRC/slacn2.f +++ b/SRC/slacn2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacon.f b/SRC/slacon.f index 025c9fc674..6b3b2b4155 100644 --- a/SRC/slacon.f +++ b/SRC/slacon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacpy.f b/SRC/slacpy.f index 2ae16e608b..c41c1acb08 100644 --- a/SRC/slacpy.f +++ b/SRC/slacpy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/sladiv.f b/SRC/sladiv.f index fbea4626e3..4ded68e8a7 100644 --- a/SRC/sladiv.f +++ b/SRC/sladiv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slae2.f b/SRC/slae2.f index 2bbc1da887..d8dfbeb3f7 100644 --- a/SRC/slae2.f +++ b/SRC/slae2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaebz.f b/SRC/slaebz.f index c764b09a2d..14b8684c2c 100644 --- a/SRC/slaebz.f +++ b/SRC/slaebz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed0.f b/SRC/slaed0.f index 915b7ecc0f..1a18b47be4 100644 --- a/SRC/slaed0.f +++ b/SRC/slaed0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED0 used by SSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed1.f b/SRC/slaed1.f index 4cf149264d..4e1e4d1035 100644 --- a/SRC/slaed1.f +++ b/SRC/slaed1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED1 used by SSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed2.f b/SRC/slaed2.f index 3c7f9f6854..c01fb17a39 100644 --- a/SRC/slaed2.f +++ b/SRC/slaed2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED2 used by SSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed3.f b/SRC/slaed3.f index a66b2f4f56..3332a923e5 100644 --- a/SRC/slaed3.f +++ b/SRC/slaed3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED3 used by SSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed4.f b/SRC/slaed4.f index f2a09beb8d..b4884ab5db 100644 --- a/SRC/slaed4.f +++ b/SRC/slaed4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED4 used by SSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed5.f b/SRC/slaed5.f index cb435ae714..b7dcfbd549 100644 --- a/SRC/slaed5.f +++ b/SRC/slaed5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED5 used by SSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed6.f b/SRC/slaed6.f index 9072e5b155..889c83d4fa 100644 --- a/SRC/slaed6.f +++ b/SRC/slaed6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED6 used by SSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed7.f b/SRC/slaed7.f index b83604a322..a68d6cf3e5 100644 --- a/SRC/slaed7.f +++ b/SRC/slaed7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED7 used by SSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed8.f b/SRC/slaed8.f index 8b83757402..5bd0e1ae47 100644 --- a/SRC/slaed8.f +++ b/SRC/slaed8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED8 used by SSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed9.f b/SRC/slaed9.f index 03cf5400a9..260a3cd32b 100644 --- a/SRC/slaed9.f +++ b/SRC/slaed9.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAED9 used by SSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaeda.f b/SRC/slaeda.f index 699db278b1..df6cc6beeb 100644 --- a/SRC/slaeda.f +++ b/SRC/slaeda.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAEDA used by SSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaein.f b/SRC/slaein.f index 6a257fd74b..c44a104335 100644 --- a/SRC/slaein.f +++ b/SRC/slaein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaev2.f b/SRC/slaev2.f index 99fa18e4ad..ce97cd16c9 100644 --- a/SRC/slaev2.f +++ b/SRC/slaev2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaexc.f b/SRC/slaexc.f index ff7e587cb8..f0d85c948f 100644 --- a/SRC/slaexc.f +++ b/SRC/slaexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slag2.f b/SRC/slag2.f index 443ed10906..bbf0f26c58 100644 --- a/SRC/slag2.f +++ b/SRC/slag2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slag2d.f b/SRC/slag2d.f index 0edfa1ae26..ff4d2bc774 100644 --- a/SRC/slag2d.f +++ b/SRC/slag2d.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAG2D converts a single precision matrix to a double precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slags2.f b/SRC/slags2.f index a603fc58c2..c80af499ef 100644 --- a/SRC/slags2.f +++ b/SRC/slags2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagtf.f b/SRC/slagtf.f index 28c6081bcc..9fe7cfa5ce 100644 --- a/SRC/slagtf.f +++ b/SRC/slagtf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagtm.f b/SRC/slagtm.f index 853d270d2d..2eaf8e57fe 100644 --- a/SRC/slagtm.f +++ b/SRC/slagtm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagts.f b/SRC/slagts.f index 236d7af69d..73ff03d401 100644 --- a/SRC/slagts.f +++ b/SRC/slagts.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAGTS solves the system of equations (T-λI)x = y *> or (T-λI)^Tx = y, where T is a general tridiagonal matrix *> and λ a scalar, using the LU factorization computed by slagtf. diff --git a/SRC/slagv2.f b/SRC/slagv2.f index 786b67bc5e..0f067cbdf7 100644 --- a/SRC/slagv2.f +++ b/SRC/slagv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular. * * =========== DOCUMENTATION =========== diff --git a/SRC/slahqr.f b/SRC/slahqr.f index 8dc3f9601b..5f25218748 100644 --- a/SRC/slahqr.f +++ b/SRC/slahqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/slahr2.f b/SRC/slahr2.f index aed178882f..87764409b2 100644 --- a/SRC/slahr2.f +++ b/SRC/slahr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaic1.f b/SRC/slaic1.f index cf1c421912..7db0335d4e 100644 --- a/SRC/slaic1.f +++ b/SRC/slaic1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaisnan.f b/SRC/slaisnan.f index 01a7f17aef..a4e5920d0f 100644 --- a/SRC/slaisnan.f +++ b/SRC/slaisnan.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAISNAN tests input for NaN by comparing two arguments for inequality. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaln2.f b/SRC/slaln2.f index b849895f73..10efacde15 100644 --- a/SRC/slaln2.f +++ b/SRC/slaln2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slals0.f b/SRC/slals0.f index 5d6a943e03..b0b1995605 100644 --- a/SRC/slals0.f +++ b/SRC/slals0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/slalsa.f b/SRC/slalsa.f index 34e5782cac..fe1215a420 100644 --- a/SRC/slalsa.f +++ b/SRC/slalsa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/slalsd.f b/SRC/slalsd.f index 39adc57fde..2a2336a323 100644 --- a/SRC/slalsd.f +++ b/SRC/slalsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/slamrg.f b/SRC/slamrg.f index 9672fee916..c827db73cc 100644 --- a/SRC/slamrg.f +++ b/SRC/slamrg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order. * * =========== DOCUMENTATION =========== diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index 432afadedf..4ffb269a85 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAMSWLQ * * Definition: diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f index f9b167aea3..1882381c56 100644 --- a/SRC/slamtsqr.f +++ b/SRC/slamtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAMTSQR * * Definition: diff --git a/SRC/slaneg.f b/SRC/slaneg.f index 76017d72d5..56e74f1670 100644 --- a/SRC/slaneg.f +++ b/SRC/slaneg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANEG computes the Sturm count. * * =========== DOCUMENTATION =========== diff --git a/SRC/slangb.f b/SRC/slangb.f index 1af2037be7..2508e176ba 100644 --- a/SRC/slangb.f +++ b/SRC/slangb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slange.f b/SRC/slange.f index 32e8bbab49..296c88af4e 100644 --- a/SRC/slange.f +++ b/SRC/slange.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slangt.f b/SRC/slangt.f index 5288508a3b..e6a363f910 100644 --- a/SRC/slangt.f +++ b/SRC/slangt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanhs.f b/SRC/slanhs.f index 68a5d70787..36564c456f 100644 --- a/SRC/slanhs.f +++ b/SRC/slanhs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansb.f b/SRC/slansb.f index beeb06904f..f91f7a7558 100644 --- a/SRC/slansb.f +++ b/SRC/slansb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansf.f b/SRC/slansf.f index 82b5ae93e7..1d245e918e 100644 --- a/SRC/slansf.f +++ b/SRC/slansf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANSF * * =========== DOCUMENTATION =========== diff --git a/SRC/slansp.f b/SRC/slansp.f index f78d7872a8..95149fe408 100644 --- a/SRC/slansp.f +++ b/SRC/slansp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanst.f b/SRC/slanst.f index fca0b395c9..6798707af7 100644 --- a/SRC/slanst.f +++ b/SRC/slanst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansy.f b/SRC/slansy.f index fb1ef1216d..d0ffd6eebc 100644 --- a/SRC/slansy.f +++ b/SRC/slansy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantb.f b/SRC/slantb.f index 765ac5b6e6..23b9c5f9bd 100644 --- a/SRC/slantb.f +++ b/SRC/slantb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantp.f b/SRC/slantp.f index a91259fc8a..5e0a140b74 100644 --- a/SRC/slantp.f +++ b/SRC/slantp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantr.f b/SRC/slantr.f index cb9719099c..a3d2721f43 100644 --- a/SRC/slantr.f +++ b/SRC/slantr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanv2.f b/SRC/slanv2.f index ac1a197822..3de4023dfb 100644 --- a/SRC/slanv2.f +++ b/SRC/slanv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaorhr_col_getrfnp.f b/SRC/slaorhr_col_getrfnp.f index fc373e8c66..840f25c392 100644 --- a/SRC/slaorhr_col_getrfnp.f +++ b/SRC/slaorhr_col_getrfnp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAORHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/slaorhr_col_getrfnp2.f b/SRC/slaorhr_col_getrfnp2.f index 53f4300d7f..ba21dfa69b 100644 --- a/SRC/slaorhr_col_getrfnp2.f +++ b/SRC/slaorhr_col_getrfnp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAORHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/slapll.f b/SRC/slapll.f index e260e3d766..4f213dce9f 100644 --- a/SRC/slapll.f +++ b/SRC/slapll.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapmr.f b/SRC/slapmr.f index 566dc04923..17fb57612e 100644 --- a/SRC/slapmr.f +++ b/SRC/slapmr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapmt.f b/SRC/slapmt.f index ebd5b0b93d..85a8f6b055 100644 --- a/SRC/slapmt.f +++ b/SRC/slapmt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapy2.f b/SRC/slapy2.f index 51d5155f69..cacefc093c 100644 --- a/SRC/slapy2.f +++ b/SRC/slapy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAPY2 returns sqrt(x2+y2). * * =========== DOCUMENTATION =========== diff --git a/SRC/slapy3.f b/SRC/slapy3.f index b1ea75ceef..8068bf65f2 100644 --- a/SRC/slapy3.f +++ b/SRC/slapy3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAPY3 returns sqrt(x2+y2+z2). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqgb.f b/SRC/slaqgb.f index 6cc3a0c6c0..b2f0513c6c 100644 --- a/SRC/slaqgb.f +++ b/SRC/slaqgb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqge.f b/SRC/slaqge.f index 50182fbf36..56c8a675cb 100644 --- a/SRC/slaqge.f +++ b/SRC/slaqge.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqp2.f b/SRC/slaqp2.f index d4d1a80c01..259c45f115 100644 --- a/SRC/slaqp2.f +++ b/SRC/slaqp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqps.f b/SRC/slaqps.f index 8605b3400d..49eb84b271 100644 --- a/SRC/slaqps.f +++ b/SRC/slaqps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr0.f b/SRC/slaqr0.f index 7ffaf9056f..4e74b123f0 100644 --- a/SRC/slaqr0.f +++ b/SRC/slaqr0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr1.f b/SRC/slaqr1.f index c2950609c4..7e4e620caf 100644 --- a/SRC/slaqr1.f +++ b/SRC/slaqr1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr2.f b/SRC/slaqr2.f index caf79fd1c0..ad05d186d2 100644 --- a/SRC/slaqr2.f +++ b/SRC/slaqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr3.f b/SRC/slaqr3.f index d3ffb0f969..81afb2e338 100644 --- a/SRC/slaqr3.f +++ b/SRC/slaqr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr4.f b/SRC/slaqr4.f index d6721df971..be02528269 100644 --- a/SRC/slaqr4.f +++ b/SRC/slaqr4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr5.f b/SRC/slaqr5.f index c27cc46aae..32ebb42c08 100644 --- a/SRC/slaqr5.f +++ b/SRC/slaqr5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsb.f b/SRC/slaqsb.f index df714c8416..516e445e69 100644 --- a/SRC/slaqsb.f +++ b/SRC/slaqsb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsp.f b/SRC/slaqsp.f index dd599545bf..a7c0deda44 100644 --- a/SRC/slaqsp.f +++ b/SRC/slaqsp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsy.f b/SRC/slaqsy.f index 9478144b90..543fe00962 100644 --- a/SRC/slaqsy.f +++ b/SRC/slaqsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqtr.f b/SRC/slaqtr.f index 436724b81a..4dd0600630 100644 --- a/SRC/slaqtr.f +++ b/SRC/slaqtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz0.f b/SRC/slaqz0.f index c128093e43..80eaa3386a 100644 --- a/SRC/slaqz0.f +++ b/SRC/slaqz0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz1.f b/SRC/slaqz1.f index 38991e9866..b2fb2fd5bf 100644 --- a/SRC/slaqz1.f +++ b/SRC/slaqz1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz2.f b/SRC/slaqz2.f index d1205390b1..af908b813f 100644 --- a/SRC/slaqz2.f +++ b/SRC/slaqz2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz3.f b/SRC/slaqz3.f index 9793813644..825fb846cf 100644 --- a/SRC/slaqz3.f +++ b/SRC/slaqz3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz4.f b/SRC/slaqz4.f index 95b2784c51..a2265b2b5a 100644 --- a/SRC/slaqz4.f +++ b/SRC/slaqz4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQZ4 * * =========== DOCUMENTATION =========== diff --git a/SRC/slar1v.f b/SRC/slar1v.f index 970fe5190a..ffa5ddaeff 100644 --- a/SRC/slar1v.f +++ b/SRC/slar1v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/slar2v.f b/SRC/slar2v.f index 5067ae644d..cc35cf2115 100644 --- a/SRC/slar2v.f +++ b/SRC/slar2v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarf.f b/SRC/slarf.f index 519666e47d..8a764a7665 100644 --- a/SRC/slarf.f +++ b/SRC/slarf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfb.f b/SRC/slarfb.f index 879bb1c705..6798095a5d 100644 --- a/SRC/slarfb.f +++ b/SRC/slarfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFB applies a block reflector or its transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfb_gett.f b/SRC/slarfb_gett.f index 72252a5a2c..0f28192068 100644 --- a/SRC/slarfb_gett.f +++ b/SRC/slarfb_gett.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfg.f b/SRC/slarfg.f index 6cd9103386..b2180a247b 100644 --- a/SRC/slarfg.f +++ b/SRC/slarfg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfgp.f b/SRC/slarfgp.f index c28274c2c4..69714f865e 100644 --- a/SRC/slarfgp.f +++ b/SRC/slarfgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarft.f b/SRC/slarft.f index 24e2b8c33c..c65f5e3606 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfx.f b/SRC/slarfx.f index 43e4a66667..35faeac8a1 100644 --- a/SRC/slarfx.f +++ b/SRC/slarfx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfy.f b/SRC/slarfy.f index 060f81a032..a2d1b9f952 100644 --- a/SRC/slarfy.f +++ b/SRC/slarfy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/slargv.f b/SRC/slargv.f index 019317d3de..3d7de5c74a 100644 --- a/SRC/slargv.f +++ b/SRC/slargv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARGV generates a vector of plane rotations with real cosines and real sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarmm.f b/SRC/slarmm.f index 1f454d7fb0..bd52b142b0 100644 --- a/SRC/slarmm.f +++ b/SRC/slarmm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARMM * * Definition: diff --git a/SRC/slarnv.f b/SRC/slarnv.f index dac8ea8285..d641a3694e 100644 --- a/SRC/slarnv.f +++ b/SRC/slarnv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarra.f b/SRC/slarra.f index d7f00ca0fa..a5b35fd70b 100644 --- a/SRC/slarra.f +++ b/SRC/slarra.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRA computes the splitting points with the specified threshold. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrb.f b/SRC/slarrb.f index 8781664281..f311208336 100644 --- a/SRC/slarrb.f +++ b/SRC/slarrb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRB provides limited bisection to locate eigenvalues for more accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrc.f b/SRC/slarrc.f index c1d625030a..197941d8cc 100644 --- a/SRC/slarrc.f +++ b/SRC/slarrc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrd.f b/SRC/slarrd.f index 4fe72f934e..6b0714e854 100644 --- a/SRC/slarrd.f +++ b/SRC/slarrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarre.f b/SRC/slarre.f index 83eea9f77f..38cfbf7b73 100644 --- a/SRC/slarre.f +++ b/SRC/slarre.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrf.f b/SRC/slarrf.f index ff83c80cbe..12868ce644 100644 --- a/SRC/slarrf.f +++ b/SRC/slarrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrj.f b/SRC/slarrj.f index 3daedfd078..42b9ad13d6 100644 --- a/SRC/slarrj.f +++ b/SRC/slarrj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrk.f b/SRC/slarrk.f index 17c8d8d84d..bf8f74d5ba 100644 --- a/SRC/slarrk.f +++ b/SRC/slarrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrr.f b/SRC/slarrr.f index a36644b9dd..0e78bbe8b0 100644 --- a/SRC/slarrr.f +++ b/SRC/slarrr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrv.f b/SRC/slarrv.f index 205af0fc07..2ab86936be 100644 --- a/SRC/slarrv.f +++ b/SRC/slarrv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarscl2.f b/SRC/slarscl2.f index dce4b78e6c..4885c4cfae 100644 --- a/SRC/slarscl2.f +++ b/SRC/slarscl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index fdf4099039..bbfc7f0860 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b SLARTG generates a plane rotation with real cosine and real sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/slartgp.f b/SRC/slartgp.f index e8e8523720..a2faea0c0e 100644 --- a/SRC/slartgp.f +++ b/SRC/slartgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARTGP generates a plane rotation so that the diagonal is nonnegative. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartgs.f b/SRC/slartgs.f index 3985fb497f..6e4f7e7bd6 100644 --- a/SRC/slartgs.f +++ b/SRC/slartgs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartv.f b/SRC/slartv.f index c43750f5a0..b530915b80 100644 --- a/SRC/slartv.f +++ b/SRC/slartv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaruv.f b/SRC/slaruv.f index 3cda4b714d..b41ac48826 100644 --- a/SRC/slaruv.f +++ b/SRC/slaruv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARUV returns a vector of n random real numbers from a uniform distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarz.f b/SRC/slarz.f index e6607d5c4c..a9ec51236d 100644 --- a/SRC/slarz.f +++ b/SRC/slarz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarzb.f b/SRC/slarzb.f index d9d54d5bf9..41bab3c849 100644 --- a/SRC/slarzb.f +++ b/SRC/slarzb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARZB applies a block reflector or its transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarzt.f b/SRC/slarzt.f index a248235593..e805562b60 100644 --- a/SRC/slarzt.f +++ b/SRC/slarzt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/slas2.f b/SRC/slas2.f index c68ca75959..285dae69f9 100644 --- a/SRC/slas2.f +++ b/SRC/slas2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAS2 computes singular values of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slascl.f b/SRC/slascl.f index 48b8315d9f..e959e97101 100644 --- a/SRC/slascl.f +++ b/SRC/slascl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/slascl2.f b/SRC/slascl2.f index 03e9cb5cf8..1312774b6a 100644 --- a/SRC/slascl2.f +++ b/SRC/slascl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd0.f b/SRC/slasd0.f index 68d3ccd20e..b5e77bd470 100644 --- a/SRC/slasd0.f +++ b/SRC/slasd0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd1.f b/SRC/slasd1.f index 0ec9782011..38210be62e 100644 --- a/SRC/slasd1.f +++ b/SRC/slasd1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd2.f b/SRC/slasd2.f index 9570f7c2fb..eb93fd595a 100644 --- a/SRC/slasd2.f +++ b/SRC/slasd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd3.f b/SRC/slasd3.f index 474b0d8afa..fbc63ace38 100644 --- a/SRC/slasd3.f +++ b/SRC/slasd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd4.f b/SRC/slasd4.f index d8374c30b7..c3a07f8ef0 100644 --- a/SRC/slasd4.f +++ b/SRC/slasd4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd5.f b/SRC/slasd5.f index 0eecf1df2b..9fb27ec562 100644 --- a/SRC/slasd5.f +++ b/SRC/slasd5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd6.f b/SRC/slasd6.f index 67b33a48f2..cd4c7e79c8 100644 --- a/SRC/slasd6.f +++ b/SRC/slasd6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd7.f b/SRC/slasd7.f index a0e2a84fb2..c1b20edd02 100644 --- a/SRC/slasd7.f +++ b/SRC/slasd7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd8.f b/SRC/slasd8.f index bf653a5d0c..244e526cbd 100644 --- a/SRC/slasd8.f +++ b/SRC/slasd8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasda.f b/SRC/slasda.f index 743da05ad1..949d5eaa25 100644 --- a/SRC/slasda.f +++ b/SRC/slasda.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasdq.f b/SRC/slasdq.f index 2734197f71..c38f168571 100644 --- a/SRC/slasdq.f +++ b/SRC/slasdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasdt.f b/SRC/slasdt.f index f5192cfdaa..d99ece00d0 100644 --- a/SRC/slasdt.f +++ b/SRC/slasdt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaset.f b/SRC/slaset.f index 1f9754366a..99e3fd295a 100644 --- a/SRC/slaset.f +++ b/SRC/slaset.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq1.f b/SRC/slasq1.f index 42aef6e838..84334858a7 100644 --- a/SRC/slasq1.f +++ b/SRC/slasq1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq2.f b/SRC/slasq2.f index 574ade37dc..06a1d5e114 100644 --- a/SRC/slasq2.f +++ b/SRC/slasq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq3.f b/SRC/slasq3.f index 695235e7fe..d2be71666d 100644 --- a/SRC/slasq3.f +++ b/SRC/slasq3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq4.f b/SRC/slasq4.f index 941b17a77f..2fdeb89b8c 100644 --- a/SRC/slasq4.f +++ b/SRC/slasq4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq5.f b/SRC/slasq5.f index 4af9d60d59..a952737cc2 100644 --- a/SRC/slasq5.f +++ b/SRC/slasq5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq6.f b/SRC/slasq6.f index dbf967a39f..cb29232602 100644 --- a/SRC/slasq6.f +++ b/SRC/slasq6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasr.f b/SRC/slasr.f index c3a9fd4005..544bb81281 100644 --- a/SRC/slasr.f +++ b/SRC/slasr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasrt.f b/SRC/slasrt.f index 925e138c3c..365ad98314 100644 --- a/SRC/slasrt.f +++ b/SRC/slasrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASRT sorts numbers in increasing or decreasing order. * * =========== DOCUMENTATION =========== diff --git a/SRC/slassq.f90 b/SRC/slassq.f90 index c8959f4a7b..e96189f866 100644 --- a/SRC/slassq.f90 +++ b/SRC/slassq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b SLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/slasv2.f b/SRC/slasv2.f index 5832e801dc..5af0f86c39 100644 --- a/SRC/slasv2.f +++ b/SRC/slasv2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index 594c646db3..31641836f7 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASWLQ * * Definition: diff --git a/SRC/slaswp.f b/SRC/slaswp.f index 9ac0b731c3..fcdce24d7f 100644 --- a/SRC/slaswp.f +++ b/SRC/slaswp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasy2.f b/SRC/slasy2.f index 42b08cde2e..c781ed979f 100644 --- a/SRC/slasy2.f +++ b/SRC/slasy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf.f b/SRC/slasyf.f index 8ea539c1f7..a87f311f76 100644 --- a/SRC/slasyf.f +++ b/SRC/slasyf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASYF computes a partial factorization of a real symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_aa.f b/SRC/slasyf_aa.f index f2514dbfe5..d368ec200e 100644 --- a/SRC/slasyf_aa.f +++ b/SRC/slasyf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_rk.f b/SRC/slasyf_rk.f index 0db08b0476..38bde7d800 100644 --- a/SRC/slasyf_rk.f +++ b/SRC/slasyf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_rook.f b/SRC/slasyf_rook.f index e88961853e..26949c6700 100644 --- a/SRC/slasyf_rook.f +++ b/SRC/slasyf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLASYF_ROOK computes a partial factorization of a real symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatbs.f b/SRC/slatbs.f index b27e5d28fd..ca5521823e 100644 --- a/SRC/slatbs.f +++ b/SRC/slatbs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatdf.f b/SRC/slatdf.f index c5122811ae..96865caa0f 100644 --- a/SRC/slatdf.f +++ b/SRC/slatdf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatps.f b/SRC/slatps.f index 78231070b9..462ea920b4 100644 --- a/SRC/slatps.f +++ b/SRC/slatps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrd.f b/SRC/slatrd.f index e0d2b663ad..cfc2e6b6a5 100644 --- a/SRC/slatrd.f +++ b/SRC/slatrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrs.f b/SRC/slatrs.f index 5d49ffaf91..7bc8877673 100644 --- a/SRC/slatrs.f +++ b/SRC/slatrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrs3.f b/SRC/slatrs3.f index 17052289ee..8a2ce83ed6 100644 --- a/SRC/slatrs3.f +++ b/SRC/slatrs3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/slatrz.f b/SRC/slatrz.f index 4d058cb8a9..998c047711 100644 --- a/SRC/slatrz.f +++ b/SRC/slatrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f index 4730815b5f..d7e490b8ac 100644 --- a/SRC/slatsqr.f +++ b/SRC/slatsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLATSQR * * Definition: diff --git a/SRC/slauu2.f b/SRC/slauu2.f index ca7a853403..548e0614fc 100644 --- a/SRC/slauu2.f +++ b/SRC/slauu2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/slauum.f b/SRC/slauum.f index 531f7d5074..5c8cc45080 100644 --- a/SRC/slauum.f +++ b/SRC/slauum.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sopgtr.f b/SRC/sopgtr.f index c61a5c329f..02ccefe7b6 100644 --- a/SRC/sopgtr.f +++ b/SRC/sopgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SOPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sopmtr.f b/SRC/sopmtr.f index d140130ba8..df009e0f2e 100644 --- a/SRC/sopmtr.f +++ b/SRC/sopmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SOPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index fc0dc97cf6..086bfc4f90 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index 5b56f4dd6d..e83aee8e15 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index 322b4923b3..ecfadf568f 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index 9533468f84..6f2455a231 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index 507e1b76d5..a91d2bdce1 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb5.f b/SRC/sorbdb5.f index 8fb88876fe..548e2a8cd0 100644 --- a/SRC/sorbdb5.f +++ b/SRC/sorbdb5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb6.f b/SRC/sorbdb6.f index eac1777225..53fe439578 100644 --- a/SRC/sorbdb6.f +++ b/SRC/sorbdb6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorcsd.f b/SRC/sorcsd.f index ae918869f0..a9e1558bda 100644 --- a/SRC/sorcsd.f +++ b/SRC/sorcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f index 04528bb11a..5a1034de53 100644 --- a/SRC/sorcsd2by1.f +++ b/SRC/sorcsd2by1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorg2l.f b/SRC/sorg2l.f index 397ca51d97..c42677c470 100644 --- a/SRC/sorg2l.f +++ b/SRC/sorg2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorg2r.f b/SRC/sorg2r.f index 67d35d950e..42ef85c8ff 100644 --- a/SRC/sorg2r.f +++ b/SRC/sorg2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgbr.f b/SRC/sorgbr.f index 46f4ab1300..28a553e92a 100644 --- a/SRC/sorgbr.f +++ b/SRC/sorgbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorghr.f b/SRC/sorghr.f index 624ede282f..21678cbb5a 100644 --- a/SRC/sorghr.f +++ b/SRC/sorghr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgl2.f b/SRC/sorgl2.f index 2f03d32e53..f56d8e8c2a 100644 --- a/SRC/sorgl2.f +++ b/SRC/sorgl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGL2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorglq.f b/SRC/sorglq.f index 30f6d5d48b..b5bb9bb1e2 100644 --- a/SRC/sorglq.f +++ b/SRC/sorglq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgql.f b/SRC/sorgql.f index f104e64b23..982ce81da3 100644 --- a/SRC/sorgql.f +++ b/SRC/sorgql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgqr.f b/SRC/sorgqr.f index a87ea6c65c..af4e1e23ee 100644 --- a/SRC/sorgqr.f +++ b/SRC/sorgqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgr2.f b/SRC/sorgr2.f index 38a3a41b13..76170fb3e1 100644 --- a/SRC/sorgr2.f +++ b/SRC/sorgr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgrq.f b/SRC/sorgrq.f index 331f209043..0bd5a3fa71 100644 --- a/SRC/sorgrq.f +++ b/SRC/sorgrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtr.f b/SRC/sorgtr.f index 6a1dc3034c..a6366b3264 100644 --- a/SRC/sorgtr.f +++ b/SRC/sorgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtsqr.f b/SRC/sorgtsqr.f index 0be27af77c..93f605564d 100644 --- a/SRC/sorgtsqr.f +++ b/SRC/sorgtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtsqr_row.f b/SRC/sorgtsqr_row.f index 5a1e1ff072..1e6b62d2d5 100644 --- a/SRC/sorgtsqr_row.f +++ b/SRC/sorgtsqr_row.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/sorhr_col.f b/SRC/sorhr_col.f index 006503928c..4264b3f546 100644 --- a/SRC/sorhr_col.f +++ b/SRC/sorhr_col.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm22.f b/SRC/sorm22.f index 886adb2cfe..1ed2eda2a7 100644 --- a/SRC/sorm22.f +++ b/SRC/sorm22.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORM22 multiplies a general matrix by a banded orthogonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm2l.f b/SRC/sorm2l.f index bdd883c6c7..12ca1ad701 100644 --- a/SRC/sorm2l.f +++ b/SRC/sorm2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm2r.f b/SRC/sorm2r.f index f1560e016b..c901f8bff6 100644 --- a/SRC/sorm2r.f +++ b/SRC/sorm2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormbr.f b/SRC/sormbr.f index e2dccc3632..8041890956 100644 --- a/SRC/sormbr.f +++ b/SRC/sormbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/sormhr.f b/SRC/sormhr.f index e033feb386..e47cc4dfeb 100644 --- a/SRC/sormhr.f +++ b/SRC/sormhr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorml2.f b/SRC/sorml2.f index 27f970fcdb..d18a437cad 100644 --- a/SRC/sorml2.f +++ b/SRC/sorml2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormlq.f b/SRC/sormlq.f index 1a32568b6d..5fba349794 100644 --- a/SRC/sormlq.f +++ b/SRC/sormlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormql.f b/SRC/sormql.f index 9564d41414..c96b815243 100644 --- a/SRC/sormql.f +++ b/SRC/sormql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/sormqr.f b/SRC/sormqr.f index adb1203dfb..5d5252951d 100644 --- a/SRC/sormqr.f +++ b/SRC/sormqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sormr2.f b/SRC/sormr2.f index 5e71a483aa..dcd5073776 100644 --- a/SRC/sormr2.f +++ b/SRC/sormr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormr3.f b/SRC/sormr3.f index 4077088edd..a3d5435536 100644 --- a/SRC/sormr3.f +++ b/SRC/sormr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormrq.f b/SRC/sormrq.f index f091f05078..9edf6e1785 100644 --- a/SRC/sormrq.f +++ b/SRC/sormrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormrz.f b/SRC/sormrz.f index b037a984b7..63069e06cf 100644 --- a/SRC/sormrz.f +++ b/SRC/sormrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormtr.f b/SRC/sormtr.f index 1bc87768fd..a6bd77b600 100644 --- a/SRC/sormtr.f +++ b/SRC/sormtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SORMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/spbcon.f b/SRC/spbcon.f index 2bbda00b01..e433702929 100644 --- a/SRC/spbcon.f +++ b/SRC/spbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spbequ.f b/SRC/spbequ.f index e2ae89d343..354e9606bb 100644 --- a/SRC/spbequ.f +++ b/SRC/spbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spbrfs.f b/SRC/spbrfs.f index 744908b299..b1514136a8 100644 --- a/SRC/spbrfs.f +++ b/SRC/spbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/spbstf.f b/SRC/spbstf.f index 030652cc5d..786dbcdb89 100644 --- a/SRC/spbstf.f +++ b/SRC/spbstf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/spbsv.f b/SRC/spbsv.f index 70339b9b25..37fb80d131 100644 --- a/SRC/spbsv.f +++ b/SRC/spbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spbsvx.f b/SRC/spbsvx.f index 342633b3e2..4c47f9f6a0 100644 --- a/SRC/spbsvx.f +++ b/SRC/spbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtf2.f b/SRC/spbtf2.f index 1128c7d925..aa88fb6e5c 100644 --- a/SRC/spbtf2.f +++ b/SRC/spbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtrf.f b/SRC/spbtrf.f index 0e19fd372a..640edcce52 100644 --- a/SRC/spbtrf.f +++ b/SRC/spbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtrs.f b/SRC/spbtrs.f index eb5886ef8a..7d60c9e759 100644 --- a/SRC/spbtrs.f +++ b/SRC/spbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spftrf.f b/SRC/spftrf.f index 6e9c071653..cab1a24ccd 100644 --- a/SRC/spftrf.f +++ b/SRC/spftrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spftri.f b/SRC/spftri.f index 3b1ad1207c..c3a12c50dc 100644 --- a/SRC/spftri.f +++ b/SRC/spftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spftrs.f b/SRC/spftrs.f index 55834fcd0c..f803969a21 100644 --- a/SRC/spftrs.f +++ b/SRC/spftrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spocon.f b/SRC/spocon.f index 840a44514a..1c471a7228 100644 --- a/SRC/spocon.f +++ b/SRC/spocon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spoequ.f b/SRC/spoequ.f index ee88598a41..6b755a7fd7 100644 --- a/SRC/spoequ.f +++ b/SRC/spoequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spoequb.f b/SRC/spoequb.f index 57a6e053bc..ea674a24ba 100644 --- a/SRC/spoequb.f +++ b/SRC/spoequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sporfs.f b/SRC/sporfs.f index 082b2dd036..378aea95a5 100644 --- a/SRC/sporfs.f +++ b/SRC/sporfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sporfsx.f b/SRC/sporfsx.f index 108aac39a0..c3984f8d7e 100644 --- a/SRC/sporfsx.f +++ b/SRC/sporfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sposv.f b/SRC/sposv.f index 6140f95fb9..fd1f9e81bc 100644 --- a/SRC/sposv.f +++ b/SRC/sposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sposvx.f b/SRC/sposvx.f index 499b5f51a8..97a31d5b87 100644 --- a/SRC/sposvx.f +++ b/SRC/sposvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sposvxx.f b/SRC/sposvxx.f index 40f60c862c..587bc5b3b2 100644 --- a/SRC/sposvxx.f +++ b/SRC/sposvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spotf2.f b/SRC/spotf2.f index 75e8d19dcf..635c18fd71 100644 --- a/SRC/spotf2.f +++ b/SRC/spotf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrf.f b/SRC/spotrf.f index c3019658b5..56cbecd878 100644 --- a/SRC/spotrf.f +++ b/SRC/spotrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrf2.f b/SRC/spotrf2.f index 0f28783334..cffd19ee7a 100644 --- a/SRC/spotrf2.f +++ b/SRC/spotrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/spotri.f b/SRC/spotri.f index c803560ee8..6adc26e57f 100644 --- a/SRC/spotri.f +++ b/SRC/spotri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrs.f b/SRC/spotrs.f index f99e86e607..5754fdc558 100644 --- a/SRC/spotrs.f +++ b/SRC/spotrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sppcon.f b/SRC/sppcon.f index 3b14e43fe8..9f1289e117 100644 --- a/SRC/sppcon.f +++ b/SRC/sppcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sppequ.f b/SRC/sppequ.f index 3cb760bd89..d6a9ecc842 100644 --- a/SRC/sppequ.f +++ b/SRC/sppequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spprfs.f b/SRC/spprfs.f index fb787466a7..d66f3f24c0 100644 --- a/SRC/spprfs.f +++ b/SRC/spprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sppsv.f b/SRC/sppsv.f index 41351cfd1d..d821f9eaba 100644 --- a/SRC/sppsv.f +++ b/SRC/sppsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sppsvx.f b/SRC/sppsvx.f index b3772da113..9870332f64 100644 --- a/SRC/sppsvx.f +++ b/SRC/sppsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spptrf.f b/SRC/spptrf.f index 1fdbeb48d1..20e747bae1 100644 --- a/SRC/spptrf.f +++ b/SRC/spptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spptri.f b/SRC/spptri.f index c5414c5d4f..8d23713871 100644 --- a/SRC/spptri.f +++ b/SRC/spptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spptrs.f b/SRC/spptrs.f index acd7e1b00e..9a9f274edf 100644 --- a/SRC/spptrs.f +++ b/SRC/spptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spstf2.f b/SRC/spstf2.f index ec7be0c638..3721569eaa 100644 --- a/SRC/spstf2.f +++ b/SRC/spstf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/spstrf.f b/SRC/spstrf.f index 7192d4f5a7..355e9fcf20 100644 --- a/SRC/spstrf.f +++ b/SRC/spstrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sptcon.f b/SRC/sptcon.f index 8ec3b5e519..bf5125b5a6 100644 --- a/SRC/sptcon.f +++ b/SRC/sptcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spteqr.f b/SRC/spteqr.f index 505d34cf1c..ee1b5d502a 100644 --- a/SRC/spteqr.f +++ b/SRC/spteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sptrfs.f b/SRC/sptrfs.f index d8e360420f..68ab1e351b 100644 --- a/SRC/sptrfs.f +++ b/SRC/sptrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sptsv.f b/SRC/sptsv.f index cd8e7ed494..0507df3942 100644 --- a/SRC/sptsv.f +++ b/SRC/sptsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sptsvx.f b/SRC/sptsvx.f index 0b2153a517..31e336a047 100644 --- a/SRC/sptsvx.f +++ b/SRC/sptsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spttrf.f b/SRC/spttrf.f index 87cfd3e2c7..ef413453b3 100644 --- a/SRC/spttrf.f +++ b/SRC/spttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spttrs.f b/SRC/spttrs.f index 73e5a5be6b..44f876dfd9 100644 --- a/SRC/spttrs.f +++ b/SRC/spttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sptts2.f b/SRC/sptts2.f index 0a7b2626b0..7a33fba3c6 100644 --- a/SRC/sptts2.f +++ b/SRC/sptts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/srscl.f b/SRC/srscl.f index 786c72e79c..f73c7ad928 100644 --- a/SRC/srscl.f +++ b/SRC/srscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f index 8fb4ea3c10..ad9ee7ce9e 100644 --- a/SRC/ssb2st_kernels.f +++ b/SRC/ssb2st_kernels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> s, Wed Dec 7 08:22:40 2016 diff --git a/SRC/ssbev.f b/SRC/ssbev.f index e63234a398..05d19f1a71 100644 --- a/SRC/ssbev.f +++ b/SRC/ssbev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbev_2stage.f b/SRC/ssbev_2stage.f index 71ace4e27e..d9440374a9 100644 --- a/SRC/ssbev_2stage.f +++ b/SRC/ssbev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbev_2stage.f, fortran d -> s, Sat Nov 5 23:58:09 2016 diff --git a/SRC/ssbevd.f b/SRC/ssbevd.f index e4118dbedf..806287b7eb 100644 --- a/SRC/ssbevd.f +++ b/SRC/ssbevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbevd_2stage.f b/SRC/ssbevd_2stage.f index de3f1c010e..44fa3ab9a2 100644 --- a/SRC/ssbevd_2stage.f +++ b/SRC/ssbevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbevd_2stage.f, fortran d -> s, Sat Nov 5 23:58:03 2016 diff --git a/SRC/ssbevx.f b/SRC/ssbevx.f index 32030d2744..5ec2ca3210 100644 --- a/SRC/ssbevx.f +++ b/SRC/ssbevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbevx_2stage.f b/SRC/ssbevx_2stage.f index d25d3639a5..cd4fa826a3 100644 --- a/SRC/ssbevx_2stage.f +++ b/SRC/ssbevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbevx_2stage.f, fortran d -> s, Sat Nov 5 23:58:06 2016 diff --git a/SRC/ssbgst.f b/SRC/ssbgst.f index 76a55836ff..e203dfa5e7 100644 --- a/SRC/ssbgst.f +++ b/SRC/ssbgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgv.f b/SRC/ssbgv.f index a6f501260e..7dbdcaff76 100644 --- a/SRC/ssbgv.f +++ b/SRC/ssbgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgvd.f b/SRC/ssbgvd.f index f872e5464e..9f6e393e62 100644 --- a/SRC/ssbgvd.f +++ b/SRC/ssbgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgvx.f b/SRC/ssbgvx.f index d8c5750237..717d4d8593 100644 --- a/SRC/ssbgvx.f +++ b/SRC/ssbgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbtrd.f b/SRC/ssbtrd.f index 2d59542bb5..c883ca2073 100644 --- a/SRC/ssbtrd.f +++ b/SRC/ssbtrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssfrk.f b/SRC/ssfrk.f index 3e8bdee4c3..4f0d84a0a0 100644 --- a/SRC/ssfrk.f +++ b/SRC/ssfrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSFRK performs a symmetric rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/sspcon.f b/SRC/sspcon.f index abc14b4089..d5c5d74970 100644 --- a/SRC/sspcon.f +++ b/SRC/sspcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sspev.f b/SRC/sspev.f index 42479aae14..f7532df44a 100644 --- a/SRC/sspev.f +++ b/SRC/sspev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspevd.f b/SRC/sspevd.f index 1aae48d1db..9d685b12ac 100644 --- a/SRC/sspevd.f +++ b/SRC/sspevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspevx.f b/SRC/sspevx.f index 10b15aa73f..6bb00d096d 100644 --- a/SRC/sspevx.f +++ b/SRC/sspevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgst.f b/SRC/sspgst.f index 653ef63a18..89d98d8e20 100644 --- a/SRC/sspgst.f +++ b/SRC/sspgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgv.f b/SRC/sspgv.f index 762a4a6c6a..ae3b455683 100644 --- a/SRC/sspgv.f +++ b/SRC/sspgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgvd.f b/SRC/sspgvd.f index c1e14594b1..a902280606 100644 --- a/SRC/sspgvd.f +++ b/SRC/sspgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgvx.f b/SRC/sspgvx.f index 8a1148262e..0b19c5b789 100644 --- a/SRC/sspgvx.f +++ b/SRC/sspgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssprfs.f b/SRC/ssprfs.f index 9299f37ff4..45b8461601 100644 --- a/SRC/ssprfs.f +++ b/SRC/ssprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sspsv.f b/SRC/sspsv.f index f298c1967b..5c9ef2c945 100644 --- a/SRC/sspsv.f +++ b/SRC/sspsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspsvx.f b/SRC/sspsvx.f index 79f26aa8de..149a0c006f 100644 --- a/SRC/sspsvx.f +++ b/SRC/sspsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrd.f b/SRC/ssptrd.f index 214d23760b..9b388f8df1 100644 --- a/SRC/ssptrd.f +++ b/SRC/ssptrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrf.f b/SRC/ssptrf.f index ce0ed89694..d6114aa57d 100644 --- a/SRC/ssptrf.f +++ b/SRC/ssptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptri.f b/SRC/ssptri.f index 580a4c6a02..c5dfd64051 100644 --- a/SRC/ssptri.f +++ b/SRC/ssptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrs.f b/SRC/ssptrs.f index 0b455c0c19..b80c6560d2 100644 --- a/SRC/ssptrs.f +++ b/SRC/ssptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sstebz.f b/SRC/sstebz.f index 0136a5aaa0..1c88830760 100644 --- a/SRC/sstebz.f +++ b/SRC/sstebz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEBZ * * =========== DOCUMENTATION =========== diff --git a/SRC/sstedc.f b/SRC/sstedc.f index 0e1cb4258d..5e3afaca7c 100644 --- a/SRC/sstedc.f +++ b/SRC/sstedc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/sstegr.f b/SRC/sstegr.f index 3b68957acd..3f14df64e5 100644 --- a/SRC/sstegr.f +++ b/SRC/sstegr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/sstein.f b/SRC/sstein.f index d237bb49d1..e66a1bedd5 100644 --- a/SRC/sstein.f +++ b/SRC/sstein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/sstemr.f b/SRC/sstemr.f index 62cfa3d4dd..973fd83723 100644 --- a/SRC/sstemr.f +++ b/SRC/sstemr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/ssteqr.f b/SRC/ssteqr.f index 643bac632a..21f80e940c 100644 --- a/SRC/ssteqr.f +++ b/SRC/ssteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/ssterf.f b/SRC/ssterf.f index 7b386cfd75..8b02cd4140 100644 --- a/SRC/ssterf.f +++ b/SRC/ssterf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSTERF * * =========== DOCUMENTATION =========== diff --git a/SRC/sstev.f b/SRC/sstev.f index 3cd17ab21b..2a5760f0c9 100644 --- a/SRC/sstev.f +++ b/SRC/sstev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevd.f b/SRC/sstevd.f index 4fc2a6311b..1201829cdd 100644 --- a/SRC/sstevd.f +++ b/SRC/sstevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevr.f b/SRC/sstevr.f index 42f49b11b2..de99212897 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevx.f b/SRC/sstevx.f index 1157a2cc2d..b492a91515 100644 --- a/SRC/sstevx.f +++ b/SRC/sstevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon.f b/SRC/ssycon.f index 6ccabc5fca..678baf09ea 100644 --- a/SRC/ssycon.f +++ b/SRC/ssycon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon_3.f b/SRC/ssycon_3.f index b17157a5a2..c3f88df39c 100644 --- a/SRC/ssycon_3.f +++ b/SRC/ssycon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon_rook.f b/SRC/ssycon_rook.f index 71ef5b3d43..e1380b469a 100644 --- a/SRC/ssycon_rook.f +++ b/SRC/ssycon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconv.f b/SRC/ssyconv.f index 809a108620..3c32583e0f 100644 --- a/SRC/ssyconv.f +++ b/SRC/ssyconv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconvf.f b/SRC/ssyconvf.f index 8847438551..f42e9f142c 100644 --- a/SRC/ssyconvf.f +++ b/SRC/ssyconvf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconvf_rook.f b/SRC/ssyconvf_rook.f index f83acf5a08..de02f2c386 100644 --- a/SRC/ssyconvf_rook.f +++ b/SRC/ssyconvf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyequb.f b/SRC/ssyequb.f index 9f26062443..81f1ffec42 100644 --- a/SRC/ssyequb.f +++ b/SRC/ssyequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyev.f b/SRC/ssyev.f index 638445f041..e6af75587e 100644 --- a/SRC/ssyev.f +++ b/SRC/ssyev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyev_2stage.f b/SRC/ssyev_2stage.f index 519ee334d3..aaadc82666 100644 --- a/SRC/ssyev_2stage.f +++ b/SRC/ssyev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyev_2stage.f, fortran d -> s, Sat Nov 5 23:55:51 2016 diff --git a/SRC/ssyevd.f b/SRC/ssyevd.f index 2ae44fc813..8bb05b62c7 100644 --- a/SRC/ssyevd.f +++ b/SRC/ssyevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevd_2stage.f b/SRC/ssyevd_2stage.f index 061da79bd4..eb50dc0a13 100644 --- a/SRC/ssyevd_2stage.f +++ b/SRC/ssyevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevd_2stage.f, fortran d -> s, Sat Nov 5 23:55:54 2016 diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 870facd606..f55268cd82 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 471e259776..dcae905380 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevr_2stage.f, fortran d -> s, Sat Nov 5 23:50:10 2016 diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index aaed6dad57..1bea52dbb0 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevx_2stage.f b/SRC/ssyevx_2stage.f index a8585e5f76..72ef53fb2f 100644 --- a/SRC/ssyevx_2stage.f +++ b/SRC/ssyevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevx_2stage.f, fortran d -> s, Sat Nov 5 23:55:46 2016 diff --git a/SRC/ssygs2.f b/SRC/ssygs2.f index 2d3d8c13d3..63243bbe23 100644 --- a/SRC/ssygs2.f +++ b/SRC/ssygs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygst.f b/SRC/ssygst.f index aaf66bf665..90cff39d9f 100644 --- a/SRC/ssygst.f +++ b/SRC/ssygst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGST * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygv.f b/SRC/ssygv.f index 3a79f54315..cd6c5b10a7 100644 --- a/SRC/ssygv.f +++ b/SRC/ssygv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygv_2stage.f b/SRC/ssygv_2stage.f index 8719d8c7a8..fdea246d74 100644 --- a/SRC/ssygv_2stage.f +++ b/SRC/ssygv_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGV_2STAGE * * @generated from dsygv_2stage.f, fortran d -> s, Sun Nov 6 12:54:29 2016 diff --git a/SRC/ssygvd.f b/SRC/ssygvd.f index a90d1afb70..85b817eed0 100644 --- a/SRC/ssygvd.f +++ b/SRC/ssygvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygvx.f b/SRC/ssygvx.f index 16adefa229..be45b22382 100644 --- a/SRC/ssygvx.f +++ b/SRC/ssygvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyrfs.f b/SRC/ssyrfs.f index ae5ba06c7b..aa4b9717f4 100644 --- a/SRC/ssyrfs.f +++ b/SRC/ssyrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyrfsx.f b/SRC/ssyrfsx.f index b580ce6a13..a4e8eee98c 100644 --- a/SRC/ssyrfsx.f +++ b/SRC/ssyrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv.f b/SRC/ssysv.f index 523ea66c1c..a0742346b6 100644 --- a/SRC/ssysv.f +++ b/SRC/ssysv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f index 711a275e13..7e3a7f8dd8 100644 --- a/SRC/ssysv_aa.f +++ b/SRC/ssysv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_aa_2stage.f b/SRC/ssysv_aa_2stage.f index fb068b3bf7..fcbcda58c1 100644 --- a/SRC/ssysv_aa_2stage.f +++ b/SRC/ssysv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_rk.f b/SRC/ssysv_rk.f index abf862d66b..e3165c1d94 100644 --- a/SRC/ssysv_rk.f +++ b/SRC/ssysv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_rook.f b/SRC/ssysv_rook.f index c5c77e5623..0da9cfab94 100644 --- a/SRC/ssysv_rook.f +++ b/SRC/ssysv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysvx.f b/SRC/ssysvx.f index 06a6413f19..8d2754f0b2 100644 --- a/SRC/ssysvx.f +++ b/SRC/ssysvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief SSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysvxx.f b/SRC/ssysvxx.f index 0786257212..03b16863d4 100644 --- a/SRC/ssysvxx.f +++ b/SRC/ssysvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYSVXX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyswapr.f b/SRC/ssyswapr.f index 5d2b15a15c..e54e61d8d5 100644 --- a/SRC/ssyswapr.f +++ b/SRC/ssyswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytd2.f b/SRC/ssytd2.f index 8972430acf..f63252ed49 100644 --- a/SRC/ssytd2.f +++ b/SRC/ssytd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2.f b/SRC/ssytf2.f index 939a6d15ac..d4b8e5e011 100644 --- a/SRC/ssytf2.f +++ b/SRC/ssytf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2_rk.f b/SRC/ssytf2_rk.f index 3806cfda67..ceccd36f16 100644 --- a/SRC/ssytf2_rk.f +++ b/SRC/ssytf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2_rook.f b/SRC/ssytf2_rook.f index 7643e168ac..6d0f958f67 100644 --- a/SRC/ssytf2_rook.f +++ b/SRC/ssytf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd.f b/SRC/ssytrd.f index f4fbecdc94..d9bd7e02f5 100644 --- a/SRC/ssytrd.f +++ b/SRC/ssytrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f index 5b401c3d04..c2892764ed 100644 --- a/SRC/ssytrd_2stage.f +++ b/SRC/ssytrd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> s, Sun Nov 6 19:34:06 2016 diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index 111eaa93ec..f9751e2b7d 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index 3996e07bba..47f885e83f 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRD_SY2SB * * @generated from zhetrd_he2hb.f, fortran z -> s, Wed Dec 7 08:22:40 2016 diff --git a/SRC/ssytrf.f b/SRC/ssytrf.f index 55f3a4f0fe..a6e8af3f30 100644 --- a/SRC/ssytrf.f +++ b/SRC/ssytrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index af32fb064a..4ffaadde50 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_aa_2stage.f b/SRC/ssytrf_aa_2stage.f index 6b5cdee1bc..024f6e7ef5 100644 --- a/SRC/ssytrf_aa_2stage.f +++ b/SRC/ssytrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_rk.f b/SRC/ssytrf_rk.f index 89ecf38fde..d80e685676 100644 --- a/SRC/ssytrf_rk.f +++ b/SRC/ssytrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_rook.f b/SRC/ssytrf_rook.f index 7c2cbbc57e..06a94d0fd0 100644 --- a/SRC/ssytrf_rook.f +++ b/SRC/ssytrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri.f b/SRC/ssytri.f index 1137a537e5..6fe4445e14 100644 --- a/SRC/ssytri.f +++ b/SRC/ssytri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri2.f b/SRC/ssytri2.f index fd1c53473d..a6140aba02 100644 --- a/SRC/ssytri2.f +++ b/SRC/ssytri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri2x.f b/SRC/ssytri2x.f index fe9cbc7869..3c49240cea 100644 --- a/SRC/ssytri2x.f +++ b/SRC/ssytri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_3.f b/SRC/ssytri_3.f index f0152a1499..fb36f4e2ca 100644 --- a/SRC/ssytri_3.f +++ b/SRC/ssytri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_3x.f b/SRC/ssytri_3x.f index f02ce8b80d..60a631a6e4 100644 --- a/SRC/ssytri_3x.f +++ b/SRC/ssytri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_rook.f b/SRC/ssytri_rook.f index 40de33e960..cbe9e4dd6b 100644 --- a/SRC/ssytri_rook.f +++ b/SRC/ssytri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs.f b/SRC/ssytrs.f index ee8b9de0ff..baa23c8009 100644 --- a/SRC/ssytrs.f +++ b/SRC/ssytrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs2.f b/SRC/ssytrs2.f index 26ed9fd4f9..9e99aa065d 100644 --- a/SRC/ssytrs2.f +++ b/SRC/ssytrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_3.f b/SRC/ssytrs_3.f index 48e23925d7..3cf3e6c48c 100644 --- a/SRC/ssytrs_3.f +++ b/SRC/ssytrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_aa.f b/SRC/ssytrs_aa.f index 265cf0c1dd..d7def08060 100644 --- a/SRC/ssytrs_aa.f +++ b/SRC/ssytrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_aa_2stage.f b/SRC/ssytrs_aa_2stage.f index d5db097ef7..fc2296628b 100644 --- a/SRC/ssytrs_aa_2stage.f +++ b/SRC/ssytrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_rook.f b/SRC/ssytrs_rook.f index 9bb41a6e59..e1b1a684d7 100644 --- a/SRC/ssytrs_rook.f +++ b/SRC/ssytrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/stbcon.f b/SRC/stbcon.f index 41b4b9ae03..3530a9b295 100644 --- a/SRC/stbcon.f +++ b/SRC/stbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/stbrfs.f b/SRC/stbrfs.f index 5ef22438ef..ac34a39e11 100644 --- a/SRC/stbrfs.f +++ b/SRC/stbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/stbtrs.f b/SRC/stbtrs.f index 7692cde6eb..c0d8b8a866 100644 --- a/SRC/stbtrs.f +++ b/SRC/stbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/stfsm.f b/SRC/stfsm.f index 7a5201a89b..a91580e9c0 100644 --- a/SRC/stfsm.f +++ b/SRC/stfsm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/stftri.f b/SRC/stftri.f index 87cb0226cc..249d4b8ec3 100644 --- a/SRC/stftri.f +++ b/SRC/stftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/stfttp.f b/SRC/stfttp.f index bfb8b8faec..b8640eebbd 100644 --- a/SRC/stfttp.f +++ b/SRC/stfttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/stfttr.f b/SRC/stfttr.f index 8f5b066d00..1751967e9a 100644 --- a/SRC/stfttr.f +++ b/SRC/stfttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/stgevc.f b/SRC/stgevc.f index d63bbf79d5..7fbbe4fa5d 100644 --- a/SRC/stgevc.f +++ b/SRC/stgevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/stgex2.f b/SRC/stgex2.f index 7773bc0d9b..a59053a64d 100644 --- a/SRC/stgex2.f +++ b/SRC/stgex2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/stgexc.f b/SRC/stgexc.f index d68eb5fc7d..3d31fb811e 100644 --- a/SRC/stgexc.f +++ b/SRC/stgexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsen.f b/SRC/stgsen.f index ac9c4677ad..cb4996c189 100644 --- a/SRC/stgsen.f +++ b/SRC/stgsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsja.f b/SRC/stgsja.f index 40d2bd6344..cd20877f16 100644 --- a/SRC/stgsja.f +++ b/SRC/stgsja.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsna.f b/SRC/stgsna.f index e8cb28b953..d9dcac1f85 100644 --- a/SRC/stgsna.f +++ b/SRC/stgsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsy2.f b/SRC/stgsy2.f index 87f2866fbd..2d3c49c4ba 100644 --- a/SRC/stgsy2.f +++ b/SRC/stgsy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsyl.f b/SRC/stgsyl.f index 07a82e3800..486b42ffb1 100644 --- a/SRC/stgsyl.f +++ b/SRC/stgsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/stpcon.f b/SRC/stpcon.f index e65d9be835..9a6ed3d4b5 100644 --- a/SRC/stpcon.f +++ b/SRC/stpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/stplqt.f b/SRC/stplqt.f index bee065ee0e..425734a3a0 100644 --- a/SRC/stplqt.f +++ b/SRC/stplqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/stplqt2.f b/SRC/stplqt2.f index a22427b379..529a200a79 100644 --- a/SRC/stplqt2.f +++ b/SRC/stplqt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f index fbe5b6d771..99046c021e 100644 --- a/SRC/stpmlqt.f +++ b/SRC/stpmlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpmqrt.f b/SRC/stpmqrt.f index 1015835d30..f6140921a7 100644 --- a/SRC/stpmqrt.f +++ b/SRC/stpmqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpqrt.f b/SRC/stpqrt.f index bcfa8395a8..43d92b80a4 100644 --- a/SRC/stpqrt.f +++ b/SRC/stpqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpqrt2.f b/SRC/stpqrt2.f index 13479ec3ba..571e4be14b 100644 --- a/SRC/stpqrt2.f +++ b/SRC/stpqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/stprfb.f b/SRC/stprfb.f index 97eb016366..bc5fa8f058 100644 --- a/SRC/stprfb.f +++ b/SRC/stprfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPRFB applies a real "triangular-pentagonal" block reflector to a real matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/stprfs.f b/SRC/stprfs.f index 35c1b67907..6c9787ec07 100644 --- a/SRC/stprfs.f +++ b/SRC/stprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/stptri.f b/SRC/stptri.f index 1e8e7529e0..c141c48689 100644 --- a/SRC/stptri.f +++ b/SRC/stptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/stptrs.f b/SRC/stptrs.f index ef16314b48..2edae4671e 100644 --- a/SRC/stptrs.f +++ b/SRC/stptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/stpttf.f b/SRC/stpttf.f index 271388f0a8..cc9cbe579f 100644 --- a/SRC/stpttf.f +++ b/SRC/stpttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/stpttr.f b/SRC/stpttr.f index 0490a471bb..d5b9fca3a6 100644 --- a/SRC/stpttr.f +++ b/SRC/stpttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/strcon.f b/SRC/strcon.f index de37691773..714913ba84 100644 --- a/SRC/strcon.f +++ b/SRC/strcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/strevc.f b/SRC/strevc.f index 8ae96f7461..36a1a7b77b 100644 --- a/SRC/strevc.f +++ b/SRC/strevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/strevc3.f b/SRC/strevc3.f index 47eaf41fa3..49dec0950d 100644 --- a/SRC/strevc3.f +++ b/SRC/strevc3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/strexc.f b/SRC/strexc.f index d4c5b61f40..eb5303060d 100644 --- a/SRC/strexc.f +++ b/SRC/strexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/strrfs.f b/SRC/strrfs.f index 91cb17b7b4..9c14a63b6b 100644 --- a/SRC/strrfs.f +++ b/SRC/strrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/strsen.f b/SRC/strsen.f index f7a05ae8b7..5e3de5c6db 100644 --- a/SRC/strsen.f +++ b/SRC/strsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/strsna.f b/SRC/strsna.f index 6e15577407..f494ba7047 100644 --- a/SRC/strsna.f +++ b/SRC/strsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/strsyl.f b/SRC/strsyl.f index 6255868958..d8483b266f 100644 --- a/SRC/strsyl.f +++ b/SRC/strsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index ef3f2da830..eac21821e7 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRSYL3 * * Definition: diff --git a/SRC/strti2.f b/SRC/strti2.f index 03a00d7102..be1a42b017 100644 --- a/SRC/strti2.f +++ b/SRC/strti2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/strtri.f b/SRC/strtri.f index a809db5278..21981d73a0 100644 --- a/SRC/strtri.f +++ b/SRC/strtri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/strtrs.f b/SRC/strtrs.f index a31c4fcbb8..af82956fa4 100644 --- a/SRC/strtrs.f +++ b/SRC/strtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/strttf.f b/SRC/strttf.f index 9863d141b2..6731b50658 100644 --- a/SRC/strttf.f +++ b/SRC/strttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/strttp.f b/SRC/strttp.f index f27fe3b094..b9c81a2e29 100644 --- a/SRC/strttp.f +++ b/SRC/strttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/stzrzf.f b/SRC/stzrzf.f index 516bea5d46..69a1d11a33 100644 --- a/SRC/stzrzf.f +++ b/SRC/stzrzf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b STZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/xerbla.f b/SRC/xerbla.f index 96de0ef24a..841961b31f 100644 --- a/SRC/xerbla.f +++ b/SRC/xerbla.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b XERBLA * * =========== DOCUMENTATION =========== diff --git a/SRC/xerbla_array.f b/SRC/xerbla_array.f index e27ed8c932..3c34c09657 100644 --- a/SRC/xerbla_array.f +++ b/SRC/xerbla_array.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b XERBLA_ARRAY * * =========== DOCUMENTATION =========== diff --git a/SRC/zbbcsd.f b/SRC/zbbcsd.f index 67f3cbdb90..a343e2c0b4 100644 --- a/SRC/zbbcsd.f +++ b/SRC/zbbcsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index 865bb9dd59..17d3e9ba17 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zcgesv.f b/SRC/zcgesv.f index 63d6d4be47..2be757824d 100644 --- a/SRC/zcgesv.f +++ b/SRC/zcgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZCGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision with iterative refinement) * * =========== DOCUMENTATION =========== diff --git a/SRC/zcposv.f b/SRC/zcposv.f index 8e9cb46fc2..5ac9dfba65 100644 --- a/SRC/zcposv.f +++ b/SRC/zcposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZCPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zdrscl.f b/SRC/zdrscl.f index 00653c75a4..e809e954e5 100644 --- a/SRC/zdrscl.f +++ b/SRC/zdrscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbbrd.f b/SRC/zgbbrd.f index 58fcf52e0f..bdf736bcf7 100644 --- a/SRC/zgbbrd.f +++ b/SRC/zgbbrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbcon.f b/SRC/zgbcon.f index 26219bf462..1aec7e1538 100644 --- a/SRC/zgbcon.f +++ b/SRC/zgbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbequ.f b/SRC/zgbequ.f index 1917100a77..ba5ff7b4e2 100644 --- a/SRC/zgbequ.f +++ b/SRC/zgbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbequb.f b/SRC/zgbequb.f index 28794bfc97..ae16a74bb2 100644 --- a/SRC/zgbequb.f +++ b/SRC/zgbequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbrfs.f b/SRC/zgbrfs.f index 393cae327c..6976cd1095 100644 --- a/SRC/zgbrfs.f +++ b/SRC/zgbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbrfsx.f b/SRC/zgbrfsx.f index 3ed5554c8a..fa91f96aae 100644 --- a/SRC/zgbrfsx.f +++ b/SRC/zgbrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsv.f b/SRC/zgbsv.f index 87af5bedcb..7908bb0b8e 100644 --- a/SRC/zgbsv.f +++ b/SRC/zgbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsvx.f b/SRC/zgbsvx.f index e39fbe7128..c1fce0b3aa 100644 --- a/SRC/zgbsvx.f +++ b/SRC/zgbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsvxx.f b/SRC/zgbsvxx.f index 1f98f02336..b7e8a9d917 100644 --- a/SRC/zgbsvxx.f +++ b/SRC/zgbsvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtf2.f b/SRC/zgbtf2.f index e66329ffc9..2e602db364 100644 --- a/SRC/zgbtf2.f +++ b/SRC/zgbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtrf.f b/SRC/zgbtrf.f index 50bc12413b..306863299d 100644 --- a/SRC/zgbtrf.f +++ b/SRC/zgbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtrs.f b/SRC/zgbtrs.f index 19cb9b7b87..79e1d305cd 100644 --- a/SRC/zgbtrs.f +++ b/SRC/zgbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebak.f b/SRC/zgebak.f index 6144fc3465..897f66d19d 100644 --- a/SRC/zgebak.f +++ b/SRC/zgebak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebal.f b/SRC/zgebal.f index 9349f1e214..356394a744 100644 --- a/SRC/zgebal.f +++ b/SRC/zgebal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebd2.f b/SRC/zgebd2.f index ec1142954b..b6601399c7 100644 --- a/SRC/zgebd2.f +++ b/SRC/zgebd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebrd.f b/SRC/zgebrd.f index c1a6169a77..1cd6e014bd 100644 --- a/SRC/zgebrd.f +++ b/SRC/zgebrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgecon.f b/SRC/zgecon.f index ef567d7c2a..98120bb645 100644 --- a/SRC/zgecon.f +++ b/SRC/zgecon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index a2af6e04b9..3dad610e5a 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b ZGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index c16288d0fa..f74007614d 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zgeequ.f b/SRC/zgeequ.f index 0802647831..7d66783fac 100644 --- a/SRC/zgeequ.f +++ b/SRC/zgeequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeequb.f b/SRC/zgeequb.f index 0e1c777b86..db5ab6d0ea 100644 --- a/SRC/zgeequb.f +++ b/SRC/zgeequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zgees.f b/SRC/zgees.f index 7a3e222950..c7001bd782 100644 --- a/SRC/zgees.f +++ b/SRC/zgees.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f index 1930821152..dd6cdbe60e 100644 --- a/SRC/zgeesx.f +++ b/SRC/zgeesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeev.f b/SRC/zgeev.f index aba60d0cda..5007e12c20 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index 7f69af7a9c..1e4343cffa 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgehd2.f b/SRC/zgehd2.f index dc2c1bf08d..1cd124deaa 100644 --- a/SRC/zgehd2.f +++ b/SRC/zgehd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 0f4424ded6..01687ff3b6 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgejsv.f b/SRC/zgejsv.f index 262a797547..c4bf3cb0a2 100644 --- a/SRC/zgejsv.f +++ b/SRC/zgejsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelq.f b/SRC/zgelq.f index 86610e8019..09d5a36e3f 100644 --- a/SRC/zgelq.f +++ b/SRC/zgelq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGELQ * * Definition: diff --git a/SRC/zgelq2.f b/SRC/zgelq2.f index 952c66d1dc..c83499f55d 100644 --- a/SRC/zgelq2.f +++ b/SRC/zgelq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqf.f b/SRC/zgelqf.f index e988ea818a..cc238b1fe0 100644 --- a/SRC/zgelqf.f +++ b/SRC/zgelqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqt.f b/SRC/zgelqt.f index 4c2b6d9dc4..32ff7f958c 100644 --- a/SRC/zgelqt.f +++ b/SRC/zgelqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGELQT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqt3.f b/SRC/zgelqt3.f index b07e59d14f..71b5b6be7c 100644 --- a/SRC/zgelqt3.f +++ b/SRC/zgelqt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgels.f b/SRC/zgels.f index 618f9a9fc0..9296547979 100644 --- a/SRC/zgels.f +++ b/SRC/zgels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelsd.f b/SRC/zgelsd.f index 8eed1e0af9..0a274f94ca 100644 --- a/SRC/zgelsd.f +++ b/SRC/zgelsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelss.f b/SRC/zgelss.f index afdbaecf0a..b38dae114c 100644 --- a/SRC/zgelss.f +++ b/SRC/zgelss.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelst.f b/SRC/zgelst.f index 90884d8175..f265213d22 100644 --- a/SRC/zgelst.f +++ b/SRC/zgelst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelsy.f b/SRC/zgelsy.f index 380ba6c820..664e8b49a2 100644 --- a/SRC/zgelsy.f +++ b/SRC/zgelsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f index 11489087a4..929d59c6ad 100644 --- a/SRC/zgemlq.f +++ b/SRC/zgemlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEMLQ * * Definition: diff --git a/SRC/zgemlqt.f b/SRC/zgemlqt.f index d85651b1ec..c358e9be67 100644 --- a/SRC/zgemlqt.f +++ b/SRC/zgemlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f index d14d74fe28..919c81fb6b 100644 --- a/SRC/zgemqr.f +++ b/SRC/zgemqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEMQR * * Definition: diff --git a/SRC/zgemqrt.f b/SRC/zgemqrt.f index 3e6c467d0f..75077c2f2e 100644 --- a/SRC/zgemqrt.f +++ b/SRC/zgemqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeql2.f b/SRC/zgeql2.f index cdac186e98..caf1815fa3 100644 --- a/SRC/zgeql2.f +++ b/SRC/zgeql2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqlf.f b/SRC/zgeqlf.f index a27612c640..fdb70aeb1f 100644 --- a/SRC/zgeqlf.f +++ b/SRC/zgeqlf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqp3.f b/SRC/zgeqp3.f index 50a024cf98..c6e896f957 100644 --- a/SRC/zgeqp3.f +++ b/SRC/zgeqp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f index 7df9c2403d..0bb0b82533 100644 --- a/SRC/zgeqr.f +++ b/SRC/zgeqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQR * * Definition: diff --git a/SRC/zgeqr2.f b/SRC/zgeqr2.f index 457404ad91..c14f5ded6c 100644 --- a/SRC/zgeqr2.f +++ b/SRC/zgeqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqr2p.f b/SRC/zgeqr2p.f index 93451faec8..1ec2304115 100644 --- a/SRC/zgeqr2p.f +++ b/SRC/zgeqr2p.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrf.f b/SRC/zgeqrf.f index 2ef06633e8..5ac3e1fd34 100644 --- a/SRC/zgeqrf.f +++ b/SRC/zgeqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrfp.f b/SRC/zgeqrfp.f index 3562de36ec..b32142060f 100644 --- a/SRC/zgeqrfp.f +++ b/SRC/zgeqrfp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt.f b/SRC/zgeqrt.f index 3c77cb4e0d..8425895db8 100644 --- a/SRC/zgeqrt.f +++ b/SRC/zgeqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt2.f b/SRC/zgeqrt2.f index 3cdcf5353d..fcd486d88a 100644 --- a/SRC/zgeqrt2.f +++ b/SRC/zgeqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt3.f b/SRC/zgeqrt3.f index da23cff85c..7637ca38e6 100644 --- a/SRC/zgeqrt3.f +++ b/SRC/zgeqrt3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerfs.f b/SRC/zgerfs.f index 8892cabfed..b22d1871d0 100644 --- a/SRC/zgerfs.f +++ b/SRC/zgerfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerfsx.f b/SRC/zgerfsx.f index 088e64c663..43b03f9974 100644 --- a/SRC/zgerfsx.f +++ b/SRC/zgerfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerq2.f b/SRC/zgerq2.f index f7bac6d570..3b8b429219 100644 --- a/SRC/zgerq2.f +++ b/SRC/zgerq2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerqf.f b/SRC/zgerqf.f index 8ea363c38f..feb95dc78f 100644 --- a/SRC/zgerqf.f +++ b/SRC/zgerqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesc2.f b/SRC/zgesc2.f index d90249c640..60579a8e49 100644 --- a/SRC/zgesc2.f +++ b/SRC/zgesc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesdd.f b/SRC/zgesdd.f index dd8da82022..bccbeda77e 100644 --- a/SRC/zgesdd.f +++ b/SRC/zgesdd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesv.f b/SRC/zgesv.f index 816ce90769..19616e39ce 100644 --- a/SRC/zgesv.f +++ b/SRC/zgesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \addtogroup gesv *> *> \brief ZGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/zgesvd.f b/SRC/zgesvd.f index 1a127b3ee7..a6253b796a 100644 --- a/SRC/zgesvd.f +++ b/SRC/zgesvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvdq.f b/SRC/zgesvdq.f index 3230faddde..c3b359396f 100644 --- a/SRC/zgesvdq.f +++ b/SRC/zgesvdq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvdx.f b/SRC/zgesvdx.f index b96ba4f73b..5668812da3 100644 --- a/SRC/zgesvdx.f +++ b/SRC/zgesvdx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index 2be45d826e..696178aa57 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvx.f b/SRC/zgesvx.f index c31675f2df..acb21005a4 100644 --- a/SRC/zgesvx.f +++ b/SRC/zgesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvxx.f b/SRC/zgesvxx.f index 5e39938830..1372234850 100644 --- a/SRC/zgesvxx.f +++ b/SRC/zgesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetc2.f b/SRC/zgetc2.f index 649820bc56..2e86f694e2 100644 --- a/SRC/zgetc2.f +++ b/SRC/zgetc2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetf2.f b/SRC/zgetf2.f index 7c63dbbeee..c953988fd2 100644 --- a/SRC/zgetf2.f +++ b/SRC/zgetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrf.f b/SRC/zgetrf.f index 6a99def47e..73f7cb0318 100644 --- a/SRC/zgetrf.f +++ b/SRC/zgetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrf2.f b/SRC/zgetrf2.f index a493bf5c42..a0dd98e1bb 100644 --- a/SRC/zgetrf2.f +++ b/SRC/zgetrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetri.f b/SRC/zgetri.f index f3806a77c2..7af365a363 100644 --- a/SRC/zgetri.f +++ b/SRC/zgetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrs.f b/SRC/zgetrs.f index ab2e3d2f32..31fd537427 100644 --- a/SRC/zgetrs.f +++ b/SRC/zgetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index 26311c611b..0de8270ad4 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETSLS * * Definition: diff --git a/SRC/zgetsqrhrt.f b/SRC/zgetsqrhrt.f index e7ce993aa3..fc982199f0 100644 --- a/SRC/zgetsqrhrt.f +++ b/SRC/zgetsqrhrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zggbak.f b/SRC/zggbak.f index 6daf1811c8..d181858b7d 100644 --- a/SRC/zggbak.f +++ b/SRC/zggbak.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/zggbal.f b/SRC/zggbal.f index 7e871d35db..0cb35c358d 100644 --- a/SRC/zggbal.f +++ b/SRC/zggbal.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/zgges.f b/SRC/zgges.f index ad1a2f947e..cb13022767 100644 --- a/SRC/zgges.f +++ b/SRC/zgges.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgges3.f b/SRC/zgges3.f index 8235c2543a..cd9f4cbea4 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/zggesx.f b/SRC/zggesx.f index dbcb8d446e..4e24451173 100644 --- a/SRC/zggesx.f +++ b/SRC/zggesx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggev.f b/SRC/zggev.f index 6f16db4482..76ac26ac01 100644 --- a/SRC/zggev.f +++ b/SRC/zggev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggev3.f b/SRC/zggev3.f index 0cc0734708..9929fbd904 100644 --- a/SRC/zggev3.f +++ b/SRC/zggev3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/zggevx.f b/SRC/zggevx.f index cfa5232fff..1ff2ae146b 100644 --- a/SRC/zggevx.f +++ b/SRC/zggevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggglm.f b/SRC/zggglm.f index 3eea191ec9..cb975bc622 100644 --- a/SRC/zggglm.f +++ b/SRC/zggglm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index 08343688de..c7002cee3e 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgghrd.f b/SRC/zgghrd.f index da77796ceb..5bc5aa25e6 100644 --- a/SRC/zgghrd.f +++ b/SRC/zgghrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgglse.f b/SRC/zgglse.f index c5cd0ca94c..511e47d50c 100644 --- a/SRC/zgglse.f +++ b/SRC/zgglse.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggqrf.f b/SRC/zggqrf.f index d8636d6635..516d1641e7 100644 --- a/SRC/zggqrf.f +++ b/SRC/zggqrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zggrqf.f b/SRC/zggrqf.f index 69c14af245..76b5488841 100644 --- a/SRC/zggrqf.f +++ b/SRC/zggrqf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zggsvd3.f b/SRC/zggsvd3.f index 40624f5beb..3b8ac4c973 100644 --- a/SRC/zggsvd3.f +++ b/SRC/zggsvd3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggsvp3.f b/SRC/zggsvp3.f index 7b465aaeea..2c194b9d1d 100644 --- a/SRC/zggsvp3.f +++ b/SRC/zggsvp3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgsvj0.f b/SRC/zgsvj0.f index 1447ceb109..15b90d9411 100644 --- a/SRC/zgsvj0.f +++ b/SRC/zgsvj0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGSVJ0 pre-processor for the routine zgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgsvj1.f b/SRC/zgsvj1.f index 750c29643f..a47dd8c72e 100644 --- a/SRC/zgsvj1.f +++ b/SRC/zgsvj1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGSVJ1 pre-processor for the routine zgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtcon.f b/SRC/zgtcon.f index 7248b4248a..c5ae8749d8 100644 --- a/SRC/zgtcon.f +++ b/SRC/zgtcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtrfs.f b/SRC/zgtrfs.f index d866eae9d2..e371ad881e 100644 --- a/SRC/zgtrfs.f +++ b/SRC/zgtrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtsv.f b/SRC/zgtsv.f index 08b640b33e..14cbad988c 100644 --- a/SRC/zgtsv.f +++ b/SRC/zgtsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtsvx.f b/SRC/zgtsvx.f index 53153439d4..0c25085931 100644 --- a/SRC/zgtsvx.f +++ b/SRC/zgtsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgttrf.f b/SRC/zgttrf.f index 3529288aba..585484b4c6 100644 --- a/SRC/zgttrf.f +++ b/SRC/zgttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgttrs.f b/SRC/zgttrs.f index d1344f6a43..64910b1570 100644 --- a/SRC/zgttrs.f +++ b/SRC/zgttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtts2.f b/SRC/zgtts2.f index 57f606ffba..a22a94e7e3 100644 --- a/SRC/zgtts2.f +++ b/SRC/zgtts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f index 4a4c554da9..2405900b42 100644 --- a/SRC/zhb2st_kernels.f +++ b/SRC/zhb2st_kernels.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHB2ST_KERNELS * * @precisions fortran z -> s d c diff --git a/SRC/zhbev.f b/SRC/zhbev.f index a74844af0b..037d57b06e 100644 --- a/SRC/zhbev.f +++ b/SRC/zhbev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbev_2stage.f b/SRC/zhbev_2stage.f index db01aa6670..6a424d9734 100644 --- a/SRC/zhbev_2stage.f +++ b/SRC/zhbev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbevd.f b/SRC/zhbevd.f index 02119c3b3e..3c948d8089 100644 --- a/SRC/zhbevd.f +++ b/SRC/zhbevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbevd_2stage.f b/SRC/zhbevd_2stage.f index 0e0a723c3b..d568f10b03 100644 --- a/SRC/zhbevd_2stage.f +++ b/SRC/zhbevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbevx.f b/SRC/zhbevx.f index afbe0cea46..0c541407b7 100644 --- a/SRC/zhbevx.f +++ b/SRC/zhbevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbevx_2stage.f b/SRC/zhbevx_2stage.f index 0a60aa43ff..679ad46f1b 100644 --- a/SRC/zhbevx_2stage.f +++ b/SRC/zhbevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbgst.f b/SRC/zhbgst.f index da6dd6c1cd..a74ee30fcf 100644 --- a/SRC/zhbgst.f +++ b/SRC/zhbgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgv.f b/SRC/zhbgv.f index 9504ef4d2c..c74c0e4a83 100644 --- a/SRC/zhbgv.f +++ b/SRC/zhbgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgvd.f b/SRC/zhbgvd.f index 0d33cf648d..adeadecf89 100644 --- a/SRC/zhbgvd.f +++ b/SRC/zhbgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgvx.f b/SRC/zhbgvx.f index f18ef2b6d1..a62f001fb0 100644 --- a/SRC/zhbgvx.f +++ b/SRC/zhbgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbtrd.f b/SRC/zhbtrd.f index 7c1006b5b0..15e409c76f 100644 --- a/SRC/zhbtrd.f +++ b/SRC/zhbtrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon.f b/SRC/zhecon.f index 4b5172ba19..6e80d5ede9 100644 --- a/SRC/zhecon.f +++ b/SRC/zhecon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHECON * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon_3.f b/SRC/zhecon_3.f index eb739fe1c1..d5aaf57971 100644 --- a/SRC/zhecon_3.f +++ b/SRC/zhecon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHECON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon_rook.f b/SRC/zhecon_rook.f index c282ba59ec..099f72ef0e 100644 --- a/SRC/zhecon_rook.f +++ b/SRC/zhecon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/zheequb.f b/SRC/zheequb.f index 1cc675540c..d1c8032f6e 100644 --- a/SRC/zheequb.f +++ b/SRC/zheequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zheev.f b/SRC/zheev.f index 7e38bead1e..4d357f2e79 100644 --- a/SRC/zheev.f +++ b/SRC/zheev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheev_2stage.f b/SRC/zheev_2stage.f index 02d1b56e1b..bc5f9fccc0 100644 --- a/SRC/zheev_2stage.f +++ b/SRC/zheev_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevd.f b/SRC/zheevd.f index 8e86b9e88a..f0960190a6 100644 --- a/SRC/zheevd.f +++ b/SRC/zheevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevd_2stage.f b/SRC/zheevd_2stage.f index 1ddaa5c17c..661e07efa2 100644 --- a/SRC/zheevd_2stage.f +++ b/SRC/zheevd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevr.f b/SRC/zheevr.f index fe6e1a85f7..22d269c221 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index b1cc7175fa..a86c447ed2 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevx.f b/SRC/zheevx.f index f194ff50e3..8556ecbfde 100644 --- a/SRC/zheevx.f +++ b/SRC/zheevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevx_2stage.f b/SRC/zheevx_2stage.f index 17499c650f..09a15b5df7 100644 --- a/SRC/zheevx_2stage.f +++ b/SRC/zheevx_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhegs2.f b/SRC/zhegs2.f index 9ee15f5efb..c84aa0d041 100644 --- a/SRC/zhegs2.f +++ b/SRC/zhegs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorization results obtained from cpotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegst.f b/SRC/zhegst.f index 46712bec3d..d8f9b25523 100644 --- a/SRC/zhegst.f +++ b/SRC/zhegst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegv.f b/SRC/zhegv.f index 9a27e83ae5..528b15b024 100644 --- a/SRC/zhegv.f +++ b/SRC/zhegv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegv_2stage.f b/SRC/zhegv_2stage.f index 3d8cd1f515..2fe72d4c99 100644 --- a/SRC/zhegv_2stage.f +++ b/SRC/zhegv_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGV_2STAGE * * @precisions fortran z -> c diff --git a/SRC/zhegvd.f b/SRC/zhegvd.f index 4d554d8a28..9bc226019e 100644 --- a/SRC/zhegvd.f +++ b/SRC/zhegvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegvx.f b/SRC/zhegvx.f index ac36ce12f5..232726e8fa 100644 --- a/SRC/zhegvx.f +++ b/SRC/zhegvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHEGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zherfs.f b/SRC/zherfs.f index 4527a1f0ea..08061edafa 100644 --- a/SRC/zherfs.f +++ b/SRC/zherfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zherfsx.f b/SRC/zherfsx.f index b688c74e99..babde2f8d5 100644 --- a/SRC/zherfsx.f +++ b/SRC/zherfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv.f b/SRC/zhesv.f index 03efbdc5ec..3d69ca48a0 100644 --- a/SRC/zhesv.f +++ b/SRC/zhesv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESV computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f index b3d4b37256..6eb2dff814 100644 --- a/SRC/zhesv_aa.f +++ b/SRC/zhesv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESV_AA computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_aa_2stage.f b/SRC/zhesv_aa_2stage.f index c503b5554d..c3ffe9693d 100644 --- a/SRC/zhesv_aa_2stage.f +++ b/SRC/zhesv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_rk.f b/SRC/zhesv_rk.f index 8ef4ee9c13..8bbc539c65 100644 --- a/SRC/zhesv_rk.f +++ b/SRC/zhesv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_rook.f b/SRC/zhesv_rook.f index 4c099face0..d510f48489 100644 --- a/SRC/zhesv_rook.f +++ b/SRC/zhesv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the bounded Bunch-Kaufman ("rook") diagonal pivoting method * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesvx.f b/SRC/zhesvx.f index 64aa166749..464be28afd 100644 --- a/SRC/zhesvx.f +++ b/SRC/zhesvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESVX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesvxx.f b/SRC/zhesvxx.f index f8580db056..17aa580f09 100644 --- a/SRC/zhesvxx.f +++ b/SRC/zhesvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHESVXX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheswapr.f b/SRC/zheswapr.f index e8966ca125..c59fb63f04 100644 --- a/SRC/zheswapr.f +++ b/SRC/zheswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetd2.f b/SRC/zhetd2.f index 1b1a523b55..3558b49450 100644 --- a/SRC/zhetd2.f +++ b/SRC/zhetd2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2.f b/SRC/zhetf2.f index 5c3e8a3f6f..97811d3363 100644 --- a/SRC/zhetf2.f +++ b/SRC/zhetf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (unblocked algorithm, calling Level 2 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2_rk.f b/SRC/zhetf2_rk.f index af47fb4893..f91a36e901 100644 --- a/SRC/zhetf2_rk.f +++ b/SRC/zhetf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2_rook.f b/SRC/zhetf2_rook.f index 10e7194fdf..00e7f48bb3 100644 --- a/SRC/zhetf2_rook.f +++ b/SRC/zhetf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd.f b/SRC/zhetrd.f index a1010bdfb4..e26a79e1ca 100644 --- a/SRC/zhetrd.f +++ b/SRC/zhetrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd_2stage.f b/SRC/zhetrd_2stage.f index ab444894b9..39bdd5e100 100644 --- a/SRC/zhetrd_2stage.f +++ b/SRC/zhetrd_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRD_2STAGE * * @precisions fortran z -> s d c diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 247497ab67..78ebf35c12 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index 3e3bfa374c..75ca612fe8 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRD_HE2HB * * @precisions fortran z -> s d c diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f index 433887108b..258c42f384 100644 --- a/SRC/zhetrf.f +++ b/SRC/zhetrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index 381c87d51c..47462a581b 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_aa_2stage.f b/SRC/zhetrf_aa_2stage.f index bab13a99d8..ac4d23c8b2 100644 --- a/SRC/zhetrf_aa_2stage.f +++ b/SRC/zhetrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f index 7c505fa4de..e87b743ab1 100644 --- a/SRC/zhetrf_rk.f +++ b/SRC/zhetrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_rook.f b/SRC/zhetrf_rook.f index a563490927..5d72e0d613 100644 --- a/SRC/zhetrf_rook.f +++ b/SRC/zhetrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri.f b/SRC/zhetri.f index d2f2e51e30..09bfb50054 100644 --- a/SRC/zhetri.f +++ b/SRC/zhetri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f index 1d932b866c..d5d51cd83c 100644 --- a/SRC/zhetri2.f +++ b/SRC/zhetri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri2x.f b/SRC/zhetri2x.f index 44ea8aa870..0a2a128720 100644 --- a/SRC/zhetri2x.f +++ b/SRC/zhetri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_3.f b/SRC/zhetri_3.f index 30b82e6d68..2c901d8132 100644 --- a/SRC/zhetri_3.f +++ b/SRC/zhetri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_3x.f b/SRC/zhetri_3x.f index cb8108f8f2..60c83c74cb 100644 --- a/SRC/zhetri_3x.f +++ b/SRC/zhetri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_rook.f b/SRC/zhetri_rook.f index 0fa7d11d74..4401a3a889 100644 --- a/SRC/zhetri_rook.f +++ b/SRC/zhetri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs.f b/SRC/zhetrs.f index 54ce9711c4..6eee3f245a 100644 --- a/SRC/zhetrs.f +++ b/SRC/zhetrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs2.f b/SRC/zhetrs2.f index a67f3d8cb3..b7c0613622 100644 --- a/SRC/zhetrs2.f +++ b/SRC/zhetrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_3.f b/SRC/zhetrs_3.f index f269a8cc7c..b8e7542427 100644 --- a/SRC/zhetrs_3.f +++ b/SRC/zhetrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f index b7a1f7f07b..84045ac617 100644 --- a/SRC/zhetrs_aa.f +++ b/SRC/zhetrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_aa_2stage.f b/SRC/zhetrs_aa_2stage.f index 9c2b5362ea..3a1a6203d2 100644 --- a/SRC/zhetrs_aa_2stage.f +++ b/SRC/zhetrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS_AA_2STAGE * * @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017 diff --git a/SRC/zhetrs_rook.f b/SRC/zhetrs_rook.f index 3907f2c873..91514608ec 100644 --- a/SRC/zhetrs_rook.f +++ b/SRC/zhetrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/zhfrk.f b/SRC/zhfrk.f index 9e1874bcbb..ede0c78cf3 100644 --- a/SRC/zhfrk.f +++ b/SRC/zhfrk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHFRK performs a Hermitian rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhgeqz.f b/SRC/zhgeqz.f index 0b37d7d970..2ebb49abd1 100644 --- a/SRC/zhgeqz.f +++ b/SRC/zhgeqz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpcon.f b/SRC/zhpcon.f index 6d61a696f7..3f0994205f 100644 --- a/SRC/zhpcon.f +++ b/SRC/zhpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpev.f b/SRC/zhpev.f index 2878284a44..3d9fd6a342 100644 --- a/SRC/zhpev.f +++ b/SRC/zhpev.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpevd.f b/SRC/zhpevd.f index 9250cc4a42..3edd21f6e5 100644 --- a/SRC/zhpevd.f +++ b/SRC/zhpevd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpevx.f b/SRC/zhpevx.f index c72647e090..76e50e4fab 100644 --- a/SRC/zhpevx.f +++ b/SRC/zhpevx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgst.f b/SRC/zhpgst.f index 16a37e2504..8fecb637c6 100644 --- a/SRC/zhpgst.f +++ b/SRC/zhpgst.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgv.f b/SRC/zhpgv.f index 2e004bb594..745b5dc6cd 100644 --- a/SRC/zhpgv.f +++ b/SRC/zhpgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgvd.f b/SRC/zhpgvd.f index b2c7451f9c..0382bf7533 100644 --- a/SRC/zhpgvd.f +++ b/SRC/zhpgvd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgvx.f b/SRC/zhpgvx.f index 711888c3d6..3955446357 100644 --- a/SRC/zhpgvx.f +++ b/SRC/zhpgvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhprfs.f b/SRC/zhprfs.f index 097b3f561c..928e6b5db8 100644 --- a/SRC/zhprfs.f +++ b/SRC/zhprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpsv.f b/SRC/zhpsv.f index 1af382199d..652f3370d8 100644 --- a/SRC/zhpsv.f +++ b/SRC/zhpsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpsvx.f b/SRC/zhpsvx.f index 0278f1ccfb..b8cea58439 100644 --- a/SRC/zhpsvx.f +++ b/SRC/zhpsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrd.f b/SRC/zhptrd.f index 3cf8adc6b5..9b0c68af66 100644 --- a/SRC/zhptrd.f +++ b/SRC/zhptrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrf.f b/SRC/zhptrf.f index 4cf3ba52af..6abb174fcb 100644 --- a/SRC/zhptrf.f +++ b/SRC/zhptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptri.f b/SRC/zhptri.f index 7c37ece0e8..51e5c8b55b 100644 --- a/SRC/zhptri.f +++ b/SRC/zhptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrs.f b/SRC/zhptrs.f index edeea0972f..0e060bf4dd 100644 --- a/SRC/zhptrs.f +++ b/SRC/zhptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhsein.f b/SRC/zhsein.f index 959b0fdcf6..f2fb26e93f 100644 --- a/SRC/zhsein.f +++ b/SRC/zhsein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/zhseqr.f b/SRC/zhseqr.f index 2cddf9b760..3438fdea4d 100644 --- a/SRC/zhseqr.f +++ b/SRC/zhseqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbamv.f b/SRC/zla_gbamv.f index 31131b3754..e403c5677e 100644 --- a/SRC/zla_gbamv.f +++ b/SRC/zla_gbamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrcond_c.f b/SRC/zla_gbrcond_c.f index 616680be10..a74a85bff2 100644 --- a/SRC/zla_gbrcond_c.f +++ b/SRC/zla_gbrcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GBRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrcond_x.f b/SRC/zla_gbrcond_x.f index 08e94c7e63..c4b2c9192c 100644 --- a/SRC/zla_gbrcond_x.f +++ b/SRC/zla_gbrcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrfsx_extended.f b/SRC/zla_gbrfsx_extended.f index 3ca0983c49..b403fc4d33 100644 --- a/SRC/zla_gbrfsx_extended.f +++ b/SRC/zla_gbrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrpvgrw.f b/SRC/zla_gbrpvgrw.f index 26bd8b9deb..216cd46e11 100644 --- a/SRC/zla_gbrpvgrw.f +++ b/SRC/zla_gbrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_geamv.f b/SRC/zla_geamv.f index 220bebac2e..139b04848b 100644 --- a/SRC/zla_geamv.f +++ b/SRC/zla_geamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gercond_c.f b/SRC/zla_gercond_c.f index 4b62e225d0..3869a2949a 100644 --- a/SRC/zla_gercond_c.f +++ b/SRC/zla_gercond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gercond_x.f b/SRC/zla_gercond_x.f index e5d3dd32e1..3f2d3d4f8e 100644 --- a/SRC/zla_gercond_x.f +++ b/SRC/zla_gercond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gerfsx_extended.f b/SRC/zla_gerfsx_extended.f index cd9990ffa1..6c8f666463 100644 --- a/SRC/zla_gerfsx_extended.f +++ b/SRC/zla_gerfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GERFSX_EXTENDED * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gerpvgrw.f b/SRC/zla_gerpvgrw.f index b0c502f21c..a9ec9717c7 100644 --- a/SRC/zla_gerpvgrw.f +++ b/SRC/zla_gerpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_GERPVGRW multiplies a square real matrix by a complex matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_heamv.f b/SRC/zla_heamv.f index d17f504ef3..69ef36bfe0 100644 --- a/SRC/zla_heamv.f +++ b/SRC/zla_heamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_hercond_c.f b/SRC/zla_hercond_c.f index 9dcda014fe..6185cc9f35 100644 --- a/SRC/zla_hercond_c.f +++ b/SRC/zla_hercond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_hercond_x.f b/SRC/zla_hercond_x.f index b3650cd808..35932d16ed 100644 --- a/SRC/zla_hercond_x.f +++ b/SRC/zla_hercond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_herfsx_extended.f b/SRC/zla_herfsx_extended.f index 65af0807de..e56dbf11c4 100644 --- a/SRC/zla_herfsx_extended.f +++ b/SRC/zla_herfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_HERFSX_EXTENDED improves the computed solution to a system of linear equations for Hermitian indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_herpvgrw.f b/SRC/zla_herpvgrw.f index daeb94a552..ea99226c94 100644 --- a/SRC/zla_herpvgrw.f +++ b/SRC/zla_herpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_HERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_lin_berr.f b/SRC/zla_lin_berr.f index b07efd568b..cfd4f0cea6 100644 --- a/SRC/zla_lin_berr.f +++ b/SRC/zla_lin_berr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porcond_c.f b/SRC/zla_porcond_c.f index 0376fae742..8d44948fd9 100644 --- a/SRC/zla_porcond_c.f +++ b/SRC/zla_porcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porcond_x.f b/SRC/zla_porcond_x.f index 36e4dc844e..37440e5190 100644 --- a/SRC/zla_porcond_x.f +++ b/SRC/zla_porcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_PORCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porfsx_extended.f b/SRC/zla_porfsx_extended.f index 8cd3f16031..e71b7d15fd 100644 --- a/SRC/zla_porfsx_extended.f +++ b/SRC/zla_porfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porpvgrw.f b/SRC/zla_porpvgrw.f index 11a42e4199..6a2e9ac2de 100644 --- a/SRC/zla_porpvgrw.f +++ b/SRC/zla_porpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syamv.f b/SRC/zla_syamv.f index db8bc95bc0..6b7d376159 100644 --- a/SRC/zla_syamv.f +++ b/SRC/zla_syamv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrcond_c.f b/SRC/zla_syrcond_c.f index 3a4056e7c2..1ffd490027 100644 --- a/SRC/zla_syrcond_c.f +++ b/SRC/zla_syrcond_c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrcond_x.f b/SRC/zla_syrcond_x.f index b5591aadb6..b22c01c970 100644 --- a/SRC/zla_syrcond_x.f +++ b/SRC/zla_syrcond_x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrfsx_extended.f b/SRC/zla_syrfsx_extended.f index 97287999a2..0d8d17759f 100644 --- a/SRC/zla_syrfsx_extended.f +++ b/SRC/zla_syrfsx_extended.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrpvgrw.f b/SRC/zla_syrpvgrw.f index d9e0a8a7ff..5f06c0ab21 100644 --- a/SRC/zla_syrpvgrw.f +++ b/SRC/zla_syrpvgrw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_wwaddw.f b/SRC/zla_wwaddw.f index 18d415967a..8288806f15 100644 --- a/SRC/zla_wwaddw.f +++ b/SRC/zla_wwaddw.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlabrd.f b/SRC/zlabrd.f index e0d4396da6..814665b2d6 100644 --- a/SRC/zlabrd.f +++ b/SRC/zlabrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacgv.f b/SRC/zlacgv.f index 1496def6a1..d28a55d7f0 100644 --- a/SRC/zlacgv.f +++ b/SRC/zlacgv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACGV conjugates a complex vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacn2.f b/SRC/zlacn2.f index 14f437e5ba..88ee1a7a58 100644 --- a/SRC/zlacn2.f +++ b/SRC/zlacn2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacon.f b/SRC/zlacon.f index 687fd8e15f..b6c7c1e9ba 100644 --- a/SRC/zlacon.f +++ b/SRC/zlacon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacp2.f b/SRC/zlacp2.f index 0b32918e07..32c5c01ad1 100644 --- a/SRC/zlacp2.f +++ b/SRC/zlacp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACP2 copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacpy.f b/SRC/zlacpy.f index bb4f3d192b..9f7795c665 100644 --- a/SRC/zlacpy.f +++ b/SRC/zlacpy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacrm.f b/SRC/zlacrm.f index 1d09e34260..1093f3b73c 100644 --- a/SRC/zlacrm.f +++ b/SRC/zlacrm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACRM multiplies a complex matrix by a square real matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacrt.f b/SRC/zlacrt.f index 7d48ec40fb..69935ea97f 100644 --- a/SRC/zlacrt.f +++ b/SRC/zlacrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLACRT performs a linear transformation of a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zladiv.f b/SRC/zladiv.f index 74a5414e5c..f211f30ad5 100644 --- a/SRC/zladiv.f +++ b/SRC/zladiv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed0.f b/SRC/zlaed0.f index 02983d6155..97366cd389 100644 --- a/SRC/zlaed0.f +++ b/SRC/zlaed0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAED0 used by ZSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed7.f b/SRC/zlaed7.f index 215e074e9e..bead2e0f2e 100644 --- a/SRC/zlaed7.f +++ b/SRC/zlaed7.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAED7 used by ZSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed8.f b/SRC/zlaed8.f index 190865649e..56e587ac1a 100644 --- a/SRC/zlaed8.f +++ b/SRC/zlaed8.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAED8 used by ZSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaein.f b/SRC/zlaein.f index dbafa04354..a34ad026d8 100644 --- a/SRC/zlaein.f +++ b/SRC/zlaein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaesy.f b/SRC/zlaesy.f index 2dd3f36a37..d6a5a45c2e 100644 --- a/SRC/zlaesy.f +++ b/SRC/zlaesy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAESY computes the eigenvalues and eigenvectors of a 2-by-2 complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaev2.f b/SRC/zlaev2.f index 2440753644..299ae50c9e 100644 --- a/SRC/zlaev2.f +++ b/SRC/zlaev2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlag2c.f b/SRC/zlag2c.f index f30536854a..6497a33946 100644 --- a/SRC/zlag2c.f +++ b/SRC/zlag2c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAG2C converts a complex double precision matrix to a complex single precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlags2.f b/SRC/zlags2.f index 21b59d26b3..e8bb256e52 100644 --- a/SRC/zlags2.f +++ b/SRC/zlags2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAGS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlagtm.f b/SRC/zlagtm.f index 148a76154c..bb76289617 100644 --- a/SRC/zlagtm.f +++ b/SRC/zlagtm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef.f b/SRC/zlahef.f index 385250bebf..23cc9ae64d 100644 --- a/SRC/zlahef.f +++ b/SRC/zlahef.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAHEF computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kaufman diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_aa.f b/SRC/zlahef_aa.f index 9d687d5a20..18fee92e3e 100644 --- a/SRC/zlahef_aa.f +++ b/SRC/zlahef_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAHEF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_rk.f b/SRC/zlahef_rk.f index 1876934453..40caa457e3 100644 --- a/SRC/zlahef_rk.f +++ b/SRC/zlahef_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_rook.f b/SRC/zlahef_rook.f index 41fece5cf0..936104bf42 100644 --- a/SRC/zlahef_rook.f +++ b/SRC/zlahef_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" * \brief \b ZLAHEF_ROOK computes a partial factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahqr.f b/SRC/zlahqr.f index c5fb344b95..11a2bf68c6 100644 --- a/SRC/zlahqr.f +++ b/SRC/zlahqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahr2.f b/SRC/zlahr2.f index df9e2daac6..6d4cdb0ac4 100644 --- a/SRC/zlahr2.f +++ b/SRC/zlahr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaic1.f b/SRC/zlaic1.f index 4cc4282de3..1d8b454e87 100644 --- a/SRC/zlaic1.f +++ b/SRC/zlaic1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlals0.f b/SRC/zlals0.f index 10341ab6c1..8b72d5d18b 100644 --- a/SRC/zlals0.f +++ b/SRC/zlals0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlalsa.f b/SRC/zlalsa.f index 88a4a2e370..815200bf13 100644 --- a/SRC/zlalsa.f +++ b/SRC/zlalsa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlalsd.f b/SRC/zlalsd.f index a49b44da25..42e9d3c088 100644 --- a/SRC/zlalsd.f +++ b/SRC/zlalsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f index 59a0a55581..a36ddcaefc 100644 --- a/SRC/zlamswlq.f +++ b/SRC/zlamswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAMSWLQ * * Definition: diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f index 03770c06e3..16a6de3beb 100644 --- a/SRC/zlamtsqr.f +++ b/SRC/zlamtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAMTSQR * * Definition: diff --git a/SRC/zlangb.f b/SRC/zlangb.f index 5917c72ebf..9dad180873 100644 --- a/SRC/zlangb.f +++ b/SRC/zlangb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlange.f b/SRC/zlange.f index 4257040707..92178b99ac 100644 --- a/SRC/zlange.f +++ b/SRC/zlange.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlangt.f b/SRC/zlangt.f index 33db121d2d..de859ed673 100644 --- a/SRC/zlangt.f +++ b/SRC/zlangt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhb.f b/SRC/zlanhb.f index 7e2a0290d6..e04ca6dfb8 100644 --- a/SRC/zlanhb.f +++ b/SRC/zlanhb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhe.f b/SRC/zlanhe.f index b4f30c4945..c984fffd2d 100644 --- a/SRC/zlanhe.f +++ b/SRC/zlanhe.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhf.f b/SRC/zlanhf.f index df84bb1d6b..a81113ec9d 100644 --- a/SRC/zlanhf.f +++ b/SRC/zlanhf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhp.f b/SRC/zlanhp.f index 8f25fb7dbf..192b9ca659 100644 --- a/SRC/zlanhp.f +++ b/SRC/zlanhp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhs.f b/SRC/zlanhs.f index 335001b125..1aff115207 100644 --- a/SRC/zlanhs.f +++ b/SRC/zlanhs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanht.f b/SRC/zlanht.f index 4cb4bd075f..35e820a4fc 100644 --- a/SRC/zlanht.f +++ b/SRC/zlanht.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansb.f b/SRC/zlansb.f index 887749dc50..b69d56b325 100644 --- a/SRC/zlansb.f +++ b/SRC/zlansb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansp.f b/SRC/zlansp.f index ff450e3fdc..264a06c596 100644 --- a/SRC/zlansp.f +++ b/SRC/zlansp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansy.f b/SRC/zlansy.f index a384549d5c..069e2da5d2 100644 --- a/SRC/zlansy.f +++ b/SRC/zlansy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantb.f b/SRC/zlantb.f index ece4d68136..dd2d0c31b5 100644 --- a/SRC/zlantb.f +++ b/SRC/zlantb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantp.f b/SRC/zlantp.f index c9d93a640c..c4aa8fb9c7 100644 --- a/SRC/zlantp.f +++ b/SRC/zlantp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantr.f b/SRC/zlantr.f index d365ed4f21..dd91a2a923 100644 --- a/SRC/zlantr.f +++ b/SRC/zlantr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapll.f b/SRC/zlapll.f index ee5111cf00..b567d0e686 100644 --- a/SRC/zlapll.f +++ b/SRC/zlapll.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapmr.f b/SRC/zlapmr.f index f9c0b4ea88..d730c3c95f 100644 --- a/SRC/zlapmr.f +++ b/SRC/zlapmr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapmt.f b/SRC/zlapmt.f index b7fe771467..f382f9c633 100644 --- a/SRC/zlapmt.f +++ b/SRC/zlapmt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqgb.f b/SRC/zlaqgb.f index 230064264a..b83941f8c7 100644 --- a/SRC/zlaqgb.f +++ b/SRC/zlaqgb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqge.f b/SRC/zlaqge.f index 270ed0f9cf..adcc6ac688 100644 --- a/SRC/zlaqge.f +++ b/SRC/zlaqge.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhb.f b/SRC/zlaqhb.f index d844de0ac8..f384307bd5 100644 --- a/SRC/zlaqhb.f +++ b/SRC/zlaqhb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhe.f b/SRC/zlaqhe.f index 5de8e3fc96..0484791cee 100644 --- a/SRC/zlaqhe.f +++ b/SRC/zlaqhe.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQHE scales a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhp.f b/SRC/zlaqhp.f index 1baebbb06d..3eb1550a31 100644 --- a/SRC/zlaqhp.f +++ b/SRC/zlaqhp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQHP scales a Hermitian matrix stored in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqp2.f b/SRC/zlaqp2.f index b406046f7b..d5a0f5c623 100644 --- a/SRC/zlaqp2.f +++ b/SRC/zlaqp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqps.f b/SRC/zlaqps.f index 86f7e6fd05..49ce31f8b4 100644 --- a/SRC/zlaqps.f +++ b/SRC/zlaqps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr0.f b/SRC/zlaqr0.f index 3eae019804..21008d8609 100644 --- a/SRC/zlaqr0.f +++ b/SRC/zlaqr0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr1.f b/SRC/zlaqr1.f index a03645389f..5da941f4ba 100644 --- a/SRC/zlaqr1.f +++ b/SRC/zlaqr1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr2.f b/SRC/zlaqr2.f index 9c016af983..ff0a8ecd7b 100644 --- a/SRC/zlaqr2.f +++ b/SRC/zlaqr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR2 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index d070eee723..951d412f65 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR3 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr4.f b/SRC/zlaqr4.f index 32b0897939..026611eb21 100644 --- a/SRC/zlaqr4.f +++ b/SRC/zlaqr4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr5.f b/SRC/zlaqr5.f index 6ac42761c3..c6beabfa96 100644 --- a/SRC/zlaqr5.f +++ b/SRC/zlaqr5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsb.f b/SRC/zlaqsb.f index 3303d0e7eb..e107018f7c 100644 --- a/SRC/zlaqsb.f +++ b/SRC/zlaqsb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsp.f b/SRC/zlaqsp.f index 14bfe4738f..5e05c83657 100644 --- a/SRC/zlaqsp.f +++ b/SRC/zlaqsp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsy.f b/SRC/zlaqsy.f index be4088e061..426a2de302 100644 --- a/SRC/zlaqsy.f +++ b/SRC/zlaqsy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz0.f b/SRC/zlaqz0.f index f75e67161e..61cfd67dba 100644 --- a/SRC/zlaqz0.f +++ b/SRC/zlaqz0.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz1.f b/SRC/zlaqz1.f index d7405394ef..271c71ccaa 100644 --- a/SRC/zlaqz1.f +++ b/SRC/zlaqz1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz2.f b/SRC/zlaqz2.f index d404ad164e..8e2836f1a4 100644 --- a/SRC/zlaqz2.f +++ b/SRC/zlaqz2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz3.f b/SRC/zlaqz3.f index 1542af3599..e8b7a073f3 100644 --- a/SRC/zlaqz3.f +++ b/SRC/zlaqz3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlar1v.f b/SRC/zlar1v.f index a548af50bd..f49de8441e 100644 --- a/SRC/zlar1v.f +++ b/SRC/zlar1v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlar2v.f b/SRC/zlar2v.f index 84e98d0ae6..2c2839b3da 100644 --- a/SRC/zlar2v.f +++ b/SRC/zlar2v.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAR2V applies a vector of plane rotations with real cosines and complex sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarcm.f b/SRC/zlarcm.f index a717b57d44..b0e8062c7a 100644 --- a/SRC/zlarcm.f +++ b/SRC/zlarcm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARCM copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarf.f b/SRC/zlarf.f index 26dddeac94..a8bbf5f9f4 100644 --- a/SRC/zlarf.f +++ b/SRC/zlarf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfb.f b/SRC/zlarfb.f index 19ffd3ec42..799a836665 100644 --- a/SRC/zlarfb.f +++ b/SRC/zlarfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfb_gett.f b/SRC/zlarfb_gett.f index 63d4390925..9f1481b467 100644 --- a/SRC/zlarfb_gett.f +++ b/SRC/zlarfb_gett.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfg.f b/SRC/zlarfg.f index c3eda21bb0..3e0d2d8d90 100644 --- a/SRC/zlarfg.f +++ b/SRC/zlarfg.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f index d54f2ea5df..a38cb8a8a8 100644 --- a/SRC/zlarfgp.f +++ b/SRC/zlarfgp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarft.f b/SRC/zlarft.f index e151a6efbf..1995019a9a 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfx.f b/SRC/zlarfx.f index f7920bce44..5672e62315 100644 --- a/SRC/zlarfx.f +++ b/SRC/zlarfx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfy.f b/SRC/zlarfy.f index 9f7c56430b..7568127628 100644 --- a/SRC/zlarfy.f +++ b/SRC/zlarfy.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/zlargv.f b/SRC/zlargv.f index a75f44e1a7..9e489933c0 100644 --- a/SRC/zlargv.f +++ b/SRC/zlargv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARGV generates a vector of plane rotations with real cosines and complex sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarnv.f b/SRC/zlarnv.f index 6752b237b7..fef269fc91 100644 --- a/SRC/zlarnv.f +++ b/SRC/zlarnv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarrv.f b/SRC/zlarrv.f index 1bdf3f14b5..46cb6728d4 100644 --- a/SRC/zlarrv.f +++ b/SRC/zlarrv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarscl2.f b/SRC/zlarscl2.f index dcf68e83d0..536122f72e 100644 --- a/SRC/zlarscl2.f +++ b/SRC/zlarscl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlartg.f90 b/SRC/zlartg.f90 index 566b80a260..a71130f811 100644 --- a/SRC/zlartg.f90 +++ b/SRC/zlartg.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b ZLARTG generates a plane rotation with real cosine and complex sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zlartv.f b/SRC/zlartv.f index 5b9346e9b8..44bdc4a526 100644 --- a/SRC/zlartv.f +++ b/SRC/zlartv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARTV applies a vector of plane rotations with real cosines and complex sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarz.f b/SRC/zlarz.f index c7995a9414..3da8cb82d6 100644 --- a/SRC/zlarz.f +++ b/SRC/zlarz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarzb.f b/SRC/zlarzb.f index 9124865d67..7d2102f865 100644 --- a/SRC/zlarzb.f +++ b/SRC/zlarzb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARZB applies a block reflector or its conjugate-transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarzt.f b/SRC/zlarzt.f index 769ca4467e..20a463a83a 100644 --- a/SRC/zlarzt.f +++ b/SRC/zlarzt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlascl.f b/SRC/zlascl.f index 181fa6deee..86b8329dc4 100644 --- a/SRC/zlascl.f +++ b/SRC/zlascl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlascl2.f b/SRC/zlascl2.f index 1309af8125..dc44cbc1a0 100644 --- a/SRC/zlascl2.f +++ b/SRC/zlascl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaset.f b/SRC/zlaset.f index bbeeb50cfb..0de5fc1a81 100644 --- a/SRC/zlaset.f +++ b/SRC/zlaset.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasr.f b/SRC/zlasr.f index 2c807b5598..56e0967615 100644 --- a/SRC/zlasr.f +++ b/SRC/zlasr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlassq.f90 b/SRC/zlassq.f90 index c352147664..f2ab6a4319 100644 --- a/SRC/zlassq.f90 +++ b/SRC/zlassq.f90 @@ -1,3 +1,4 @@ +#include "lapack_64.h" !> \brief \b ZLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f index 7352071320..a7cc0f45df 100644 --- a/SRC/zlaswlq.f +++ b/SRC/zlaswlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASWLQ * * Definition: diff --git a/SRC/zlaswp.f b/SRC/zlaswp.f index 8ec7bd80ac..62cbcfa611 100644 --- a/SRC/zlaswp.f +++ b/SRC/zlaswp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf.f b/SRC/zlasyf.f index 601b17ff3f..f09696a36a 100644 --- a/SRC/zlasyf.f +++ b/SRC/zlasyf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASYF computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_aa.f b/SRC/zlasyf_aa.f index 3788fca31e..4cd0597dd5 100644 --- a/SRC/zlasyf_aa.f +++ b/SRC/zlasyf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_rk.f b/SRC/zlasyf_rk.f index f1bbd2ab99..7c98c27b61 100644 --- a/SRC/zlasyf_rk.f +++ b/SRC/zlasyf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_rook.f b/SRC/zlasyf_rook.f index a2c2d87400..b5d26a7a0a 100644 --- a/SRC/zlasyf_rook.f +++ b/SRC/zlasyf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLASYF_ROOK computes a partial factorization of a complex symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlat2c.f b/SRC/zlat2c.f index 57f0680bff..7c4b455bfb 100644 --- a/SRC/zlat2c.f +++ b/SRC/zlat2c.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAT2C converts a double complex triangular matrix to a complex triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatbs.f b/SRC/zlatbs.f index 467b34fb3a..1c57e1bf5a 100644 --- a/SRC/zlatbs.f +++ b/SRC/zlatbs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatdf.f b/SRC/zlatdf.f index 2ee5984d09..69263c0374 100644 --- a/SRC/zlatdf.f +++ b/SRC/zlatdf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatps.f b/SRC/zlatps.f index 403f7b4276..bb868bfaf5 100644 --- a/SRC/zlatps.f +++ b/SRC/zlatps.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrd.f b/SRC/zlatrd.f index 71584680cf..184c66d0d6 100644 --- a/SRC/zlatrd.f +++ b/SRC/zlatrd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an unitary similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrs.f b/SRC/zlatrs.f index 0c33ea400d..b9e463b575 100644 --- a/SRC/zlatrs.f +++ b/SRC/zlatrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrs3.f b/SRC/zlatrs3.f index 27eac839bc..7dff18f1e8 100644 --- a/SRC/zlatrs3.f +++ b/SRC/zlatrs3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/zlatrz.f b/SRC/zlatrz.f index 99eb04dc46..246470107b 100644 --- a/SRC/zlatrz.f +++ b/SRC/zlatrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATRZ factors an upper trapezoidal matrix by means of unitary transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f index 24d00f28a8..c53a778dfc 100644 --- a/SRC/zlatsqr.f +++ b/SRC/zlatsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLATSQR * * Definition: diff --git a/SRC/zlaunhr_col_getrfnp.f b/SRC/zlaunhr_col_getrfnp.f index 62242cf90a..cce56382a2 100644 --- a/SRC/zlaunhr_col_getrfnp.f +++ b/SRC/zlaunhr_col_getrfnp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAUNHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaunhr_col_getrfnp2.f b/SRC/zlaunhr_col_getrfnp2.f index 41e0e03c4b..cc9b41e70b 100644 --- a/SRC/zlaunhr_col_getrfnp2.f +++ b/SRC/zlaunhr_col_getrfnp2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAUNHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlauu2.f b/SRC/zlauu2.f index 99a3a3eb63..7d4ca49c24 100644 --- a/SRC/zlauu2.f +++ b/SRC/zlauu2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlauum.f b/SRC/zlauum.f index 2bf2fc47e7..6f4ab7746e 100644 --- a/SRC/zlauum.f +++ b/SRC/zlauum.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbcon.f b/SRC/zpbcon.f index 799dcb7827..26c8cb703d 100644 --- a/SRC/zpbcon.f +++ b/SRC/zpbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbequ.f b/SRC/zpbequ.f index 9454dfb512..5f32d3e21d 100644 --- a/SRC/zpbequ.f +++ b/SRC/zpbequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbrfs.f b/SRC/zpbrfs.f index afaad1c610..3ce6f0f223 100644 --- a/SRC/zpbrfs.f +++ b/SRC/zpbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbstf.f b/SRC/zpbstf.f index 34d8e1c6b2..b47d34a8b5 100644 --- a/SRC/zpbstf.f +++ b/SRC/zpbstf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbsv.f b/SRC/zpbsv.f index d059d30787..c591d9a794 100644 --- a/SRC/zpbsv.f +++ b/SRC/zpbsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbsvx.f b/SRC/zpbsvx.f index d54fc9f4c1..73a8291a4a 100644 --- a/SRC/zpbsvx.f +++ b/SRC/zpbsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtf2.f b/SRC/zpbtf2.f index 31deca7dae..bea5650ecb 100644 --- a/SRC/zpbtf2.f +++ b/SRC/zpbtf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtrf.f b/SRC/zpbtrf.f index 212ccb9a6e..3202d0f629 100644 --- a/SRC/zpbtrf.f +++ b/SRC/zpbtrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtrs.f b/SRC/zpbtrs.f index a94ab66ab6..5272697d1a 100644 --- a/SRC/zpbtrs.f +++ b/SRC/zpbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftrf.f b/SRC/zpftrf.f index e901a41806..3c5689c8e7 100644 --- a/SRC/zpftrf.f +++ b/SRC/zpftrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftri.f b/SRC/zpftri.f index f534d45fe3..8aa9bf1fbd 100644 --- a/SRC/zpftri.f +++ b/SRC/zpftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftrs.f b/SRC/zpftrs.f index 50f78db923..def00e3608 100644 --- a/SRC/zpftrs.f +++ b/SRC/zpftrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpocon.f b/SRC/zpocon.f index 709c81f4ce..fc129dd68c 100644 --- a/SRC/zpocon.f +++ b/SRC/zpocon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpoequ.f b/SRC/zpoequ.f index 0c02ad2d36..924d78f26b 100644 --- a/SRC/zpoequ.f +++ b/SRC/zpoequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpoequb.f b/SRC/zpoequb.f index 529cda962a..732cf02388 100644 --- a/SRC/zpoequb.f +++ b/SRC/zpoequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zporfs.f b/SRC/zporfs.f index f210607005..160f0defa8 100644 --- a/SRC/zporfs.f +++ b/SRC/zporfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zporfsx.f b/SRC/zporfsx.f index c5a84c95e0..c81bb097b2 100644 --- a/SRC/zporfsx.f +++ b/SRC/zporfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zposv.f b/SRC/zposv.f index e24d0790a1..82ef534f31 100644 --- a/SRC/zposv.f +++ b/SRC/zposv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zposvx.f b/SRC/zposvx.f index 2b45d96c9b..9a24c28175 100644 --- a/SRC/zposvx.f +++ b/SRC/zposvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zposvxx.f b/SRC/zposvxx.f index 4743d01a74..af6fd4f7f6 100644 --- a/SRC/zposvxx.f +++ b/SRC/zposvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotf2.f b/SRC/zpotf2.f index 496c5e1f8c..32c1eec7e6 100644 --- a/SRC/zpotf2.f +++ b/SRC/zpotf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrf.f b/SRC/zpotrf.f index 30c6a1bd04..593fda039d 100644 --- a/SRC/zpotrf.f +++ b/SRC/zpotrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrf2.f b/SRC/zpotrf2.f index 4cdbb0ac1f..8e79308007 100644 --- a/SRC/zpotrf2.f +++ b/SRC/zpotrf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotri.f b/SRC/zpotri.f index 35e0e15595..6c55166f59 100644 --- a/SRC/zpotri.f +++ b/SRC/zpotri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrs.f b/SRC/zpotrs.f index 3dad5a688f..01dbbf58e8 100644 --- a/SRC/zpotrs.f +++ b/SRC/zpotrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zppcon.f b/SRC/zppcon.f index bab024986f..0d7571b1ad 100644 --- a/SRC/zppcon.f +++ b/SRC/zppcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zppequ.f b/SRC/zppequ.f index 81e870fa75..d4a060c8fa 100644 --- a/SRC/zppequ.f +++ b/SRC/zppequ.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpprfs.f b/SRC/zpprfs.f index 8ea4dc111c..9440b7d55c 100644 --- a/SRC/zpprfs.f +++ b/SRC/zpprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zppsv.f b/SRC/zppsv.f index 680206ed83..8440aaa9c4 100644 --- a/SRC/zppsv.f +++ b/SRC/zppsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zppsvx.f b/SRC/zppsvx.f index c20f865e44..d40bda29dd 100644 --- a/SRC/zppsvx.f +++ b/SRC/zppsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptrf.f b/SRC/zpptrf.f index 8ca436d3b8..c15fced3ea 100644 --- a/SRC/zpptrf.f +++ b/SRC/zpptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptri.f b/SRC/zpptri.f index 39d49d4af7..ac3799793e 100644 --- a/SRC/zpptri.f +++ b/SRC/zpptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptrs.f b/SRC/zpptrs.f index aeeae3649a..599f81ad61 100644 --- a/SRC/zpptrs.f +++ b/SRC/zpptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpstf2.f b/SRC/zpstf2.f index 656fbfe288..3a05b48184 100644 --- a/SRC/zpstf2.f +++ b/SRC/zpstf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPSTF2 computes the Cholesky factorization with complete pivoting of a complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zpstrf.f b/SRC/zpstrf.f index 17b2dc544a..4135f8ed28 100644 --- a/SRC/zpstrf.f +++ b/SRC/zpstrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPSTRF computes the Cholesky factorization with complete pivoting of a complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zptcon.f b/SRC/zptcon.f index c9cf150206..d2a0234862 100644 --- a/SRC/zptcon.f +++ b/SRC/zptcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpteqr.f b/SRC/zpteqr.f index 12cb9c707a..14d2085beb 100644 --- a/SRC/zpteqr.f +++ b/SRC/zpteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zptrfs.f b/SRC/zptrfs.f index 0ec3d87ca3..b791ae3751 100644 --- a/SRC/zptrfs.f +++ b/SRC/zptrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zptsv.f b/SRC/zptsv.f index ea93048547..115f16e312 100644 --- a/SRC/zptsv.f +++ b/SRC/zptsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zptsvx.f b/SRC/zptsvx.f index ccc74602b3..1acd6b6d46 100644 --- a/SRC/zptsvx.f +++ b/SRC/zptsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpttrf.f b/SRC/zpttrf.f index 75a2c62687..eaace87869 100644 --- a/SRC/zpttrf.f +++ b/SRC/zpttrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpttrs.f b/SRC/zpttrs.f index 6cd8dd24dc..9f64fdd644 100644 --- a/SRC/zpttrs.f +++ b/SRC/zpttrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zptts2.f b/SRC/zptts2.f index f63f6a9955..2341f28845 100644 --- a/SRC/zptts2.f +++ b/SRC/zptts2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/zrot.f b/SRC/zrot.f index c39a0484ec..6724d23b29 100644 --- a/SRC/zrot.f +++ b/SRC/zrot.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zrscl.f b/SRC/zrscl.f index 970f6de752..dfa4d293bc 100644 --- a/SRC/zrscl.f +++ b/SRC/zrscl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/zspcon.f b/SRC/zspcon.f index ccf5e6a1db..7234dc6730 100644 --- a/SRC/zspcon.f +++ b/SRC/zspcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zspmv.f b/SRC/zspmv.f index ed356bc337..16eaa11a59 100644 --- a/SRC/zspmv.f +++ b/SRC/zspmv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix * * =========== DOCUMENTATION =========== diff --git a/SRC/zspr.f b/SRC/zspr.f index 2d20eb5758..a4cb5d09b0 100644 --- a/SRC/zspr.f +++ b/SRC/zspr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsprfs.f b/SRC/zsprfs.f index e3fc1bf2ed..e781894505 100644 --- a/SRC/zsprfs.f +++ b/SRC/zsprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zspsv.f b/SRC/zspsv.f index a7eaf29e46..4ec49cce3d 100644 --- a/SRC/zspsv.f +++ b/SRC/zspsv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zspsvx.f b/SRC/zspsvx.f index 5f833b4236..909db72a1a 100644 --- a/SRC/zspsvx.f +++ b/SRC/zspsvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptrf.f b/SRC/zsptrf.f index 66a41913c5..852db0268b 100644 --- a/SRC/zsptrf.f +++ b/SRC/zsptrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptri.f b/SRC/zsptri.f index f8740c3f01..407f857bfa 100644 --- a/SRC/zsptri.f +++ b/SRC/zsptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptrs.f b/SRC/zsptrs.f index 862bace0ea..18373b5ecc 100644 --- a/SRC/zsptrs.f +++ b/SRC/zsptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zstedc.f b/SRC/zstedc.f index 900213c144..24542f0018 100644 --- a/SRC/zstedc.f +++ b/SRC/zstedc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/zstegr.f b/SRC/zstegr.f index 8bd2c29121..d9d6b3eac5 100644 --- a/SRC/zstegr.f +++ b/SRC/zstegr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/zstein.f b/SRC/zstein.f index b2429a5659..91ad5002c8 100644 --- a/SRC/zstein.f +++ b/SRC/zstein.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/zstemr.f b/SRC/zstemr.f index 4eaf5ef974..ff35872f41 100644 --- a/SRC/zstemr.f +++ b/SRC/zstemr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsteqr.f b/SRC/zsteqr.f index fc41317b62..e29c179e00 100644 --- a/SRC/zsteqr.f +++ b/SRC/zsteqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon.f b/SRC/zsycon.f index 05f06ec786..20137e4667 100644 --- a/SRC/zsycon.f +++ b/SRC/zsycon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon_3.f b/SRC/zsycon_3.f index f545593f2c..b59c53cf7a 100644 --- a/SRC/zsycon_3.f +++ b/SRC/zsycon_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon_rook.f b/SRC/zsycon_rook.f index b2844879dc..cb60693be5 100644 --- a/SRC/zsycon_rook.f +++ b/SRC/zsycon_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconv.f b/SRC/zsyconv.f index b0d455f056..aa475b876b 100644 --- a/SRC/zsyconv.f +++ b/SRC/zsyconv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconvf.f b/SRC/zsyconvf.f index 945c489db2..2388021f2d 100644 --- a/SRC/zsyconvf.f +++ b/SRC/zsyconvf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconvf_rook.f b/SRC/zsyconvf_rook.f index 3d8570582b..71bade2e4c 100644 --- a/SRC/zsyconvf_rook.f +++ b/SRC/zsyconvf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyequb.f b/SRC/zsyequb.f index 8320dc59f8..64341cee4e 100644 --- a/SRC/zsyequb.f +++ b/SRC/zsyequb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zsymv.f b/SRC/zsymv.f index 0884231726..776ff393c4 100644 --- a/SRC/zsymv.f +++ b/SRC/zsymv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYMV computes a matrix-vector product for a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyr.f b/SRC/zsyr.f index 9d65e26575..3c44391708 100644 --- a/SRC/zsyr.f +++ b/SRC/zsyr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYR performs the symmetric rank-1 update of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyrfs.f b/SRC/zsyrfs.f index d4ee0d7f28..14348f7759 100644 --- a/SRC/zsyrfs.f +++ b/SRC/zsyrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyrfsx.f b/SRC/zsyrfsx.f index 59d6f74b3e..09bee88dc1 100644 --- a/SRC/zsyrfsx.f +++ b/SRC/zsyrfsx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv.f b/SRC/zsysv.f index eb3cedbfaa..c2aabab7e8 100644 --- a/SRC/zsysv.f +++ b/SRC/zsysv.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_aa.f b/SRC/zsysv_aa.f index 91fdc24f61..01115c35d1 100644 --- a/SRC/zsysv_aa.f +++ b/SRC/zsysv_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_aa_2stage.f b/SRC/zsysv_aa_2stage.f index 643a12942e..39f8704b25 100644 --- a/SRC/zsysv_aa_2stage.f +++ b/SRC/zsysv_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_rk.f b/SRC/zsysv_rk.f index 12ce51253b..a6e45f3325 100644 --- a/SRC/zsysv_rk.f +++ b/SRC/zsysv_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_rook.f b/SRC/zsysv_rook.f index dded748c45..9619e16952 100644 --- a/SRC/zsysv_rook.f +++ b/SRC/zsysv_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysvx.f b/SRC/zsysvx.f index 60d7ce074a..3cea26e180 100644 --- a/SRC/zsysvx.f +++ b/SRC/zsysvx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysvxx.f b/SRC/zsysvxx.f index 45df29af6e..803755dc0e 100644 --- a/SRC/zsysvxx.f +++ b/SRC/zsysvxx.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyswapr.f b/SRC/zsyswapr.f index 892ee215aa..48a1f675a4 100644 --- a/SRC/zsyswapr.f +++ b/SRC/zsyswapr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYSWAPR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2.f b/SRC/zsytf2.f index dd56d35ede..d9b0e45d7e 100644 --- a/SRC/zsytf2.f +++ b/SRC/zsytf2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2_rk.f b/SRC/zsytf2_rk.f index f084f3f247..e97382a851 100644 --- a/SRC/zsytf2_rk.f +++ b/SRC/zsytf2_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2_rook.f b/SRC/zsytf2_rook.f index 31bad88bcf..62bbbf9a30 100644 --- a/SRC/zsytf2_rook.f +++ b/SRC/zsytf2_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf.f b/SRC/zsytrf.f index 9fbe70cd7c..677f4a2dde 100644 --- a/SRC/zsytrf.f +++ b/SRC/zsytrf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f index fbfb40930d..dc017163aa 100644 --- a/SRC/zsytrf_aa.f +++ b/SRC/zsytrf_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_aa_2stage.f b/SRC/zsytrf_aa_2stage.f index 0812d1f1fb..6836d55511 100644 --- a/SRC/zsytrf_aa_2stage.f +++ b/SRC/zsytrf_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_rk.f b/SRC/zsytrf_rk.f index b7c4e676f8..d7a51e3fab 100644 --- a/SRC/zsytrf_rk.f +++ b/SRC/zsytrf_rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_rook.f b/SRC/zsytrf_rook.f index c1f29cd439..059d4d5971 100644 --- a/SRC/zsytrf_rook.f +++ b/SRC/zsytrf_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri.f b/SRC/zsytri.f index e8db7f7523..f3efbb92d0 100644 --- a/SRC/zsytri.f +++ b/SRC/zsytri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri2.f b/SRC/zsytri2.f index 4a208430a3..d417b71caf 100644 --- a/SRC/zsytri2.f +++ b/SRC/zsytri2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri2x.f b/SRC/zsytri2x.f index 41f00bda51..3477b54521 100644 --- a/SRC/zsytri2x.f +++ b/SRC/zsytri2x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_3.f b/SRC/zsytri_3.f index d56331137b..04ed2a2072 100644 --- a/SRC/zsytri_3.f +++ b/SRC/zsytri_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_3x.f b/SRC/zsytri_3x.f index 061db0da11..9cb592f229 100644 --- a/SRC/zsytri_3x.f +++ b/SRC/zsytri_3x.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_rook.f b/SRC/zsytri_rook.f index 42104826ca..16624eaa61 100644 --- a/SRC/zsytri_rook.f +++ b/SRC/zsytri_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs.f b/SRC/zsytrs.f index cf1ec8a526..e5b303d58d 100644 --- a/SRC/zsytrs.f +++ b/SRC/zsytrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs2.f b/SRC/zsytrs2.f index 69da8c3e91..a9c0ad0bf8 100644 --- a/SRC/zsytrs2.f +++ b/SRC/zsytrs2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_3.f b/SRC/zsytrs_3.f index 3ed566b14c..ca49c35753 100644 --- a/SRC/zsytrs_3.f +++ b/SRC/zsytrs_3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_aa.f b/SRC/zsytrs_aa.f index 0c7ecba0bb..26a6eea6df 100644 --- a/SRC/zsytrs_aa.f +++ b/SRC/zsytrs_aa.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_aa_2stage.f b/SRC/zsytrs_aa_2stage.f index 810ac6e7dd..229e1f189f 100644 --- a/SRC/zsytrs_aa_2stage.f +++ b/SRC/zsytrs_aa_2stage.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_rook.f b/SRC/zsytrs_rook.f index 38394de991..961780ad43 100644 --- a/SRC/zsytrs_rook.f +++ b/SRC/zsytrs_rook.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbcon.f b/SRC/ztbcon.f index f4f966d456..6837666bc6 100644 --- a/SRC/ztbcon.f +++ b/SRC/ztbcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbrfs.f b/SRC/ztbrfs.f index 820ad9ab8e..9e2c5a63e6 100644 --- a/SRC/ztbrfs.f +++ b/SRC/ztbrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbtrs.f b/SRC/ztbtrs.f index c906d2669a..bafca1880e 100644 --- a/SRC/ztbtrs.f +++ b/SRC/ztbtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfsm.f b/SRC/ztfsm.f index d007415bfa..79d3bff29a 100644 --- a/SRC/ztfsm.f +++ b/SRC/ztfsm.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztftri.f b/SRC/ztftri.f index 39e1c4d1d9..b37a69c2e2 100644 --- a/SRC/ztftri.f +++ b/SRC/ztftri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfttp.f b/SRC/ztfttp.f index e7b1451d61..41cad97bb3 100644 --- a/SRC/ztfttp.f +++ b/SRC/ztfttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfttr.f b/SRC/ztfttr.f index 72c58d7de0..cc11b7e812 100644 --- a/SRC/ztfttr.f +++ b/SRC/ztfttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgevc.f b/SRC/ztgevc.f index 00431fb403..eb060af98b 100644 --- a/SRC/ztgevc.f +++ b/SRC/ztgevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgex2.f b/SRC/ztgex2.f index f0b47ca2d7..c6f9e2de31 100644 --- a/SRC/ztgex2.f +++ b/SRC/ztgex2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an unitary equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgexc.f b/SRC/ztgexc.f index 563db754b1..f7287ee260 100644 --- a/SRC/ztgexc.f +++ b/SRC/ztgexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsen.f b/SRC/ztgsen.f index 92eaab0321..45d6525df5 100644 --- a/SRC/ztgsen.f +++ b/SRC/ztgsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsja.f b/SRC/ztgsja.f index aaba9be734..b2bb5182d4 100644 --- a/SRC/ztgsja.f +++ b/SRC/ztgsja.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsna.f b/SRC/ztgsna.f index e26696e37a..abbea8cad3 100644 --- a/SRC/ztgsna.f +++ b/SRC/ztgsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsy2.f b/SRC/ztgsy2.f index 40c701d7d7..87fed3a23c 100644 --- a/SRC/ztgsy2.f +++ b/SRC/ztgsy2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsyl.f b/SRC/ztgsyl.f index 9bc1d70745..23f2571f5b 100644 --- a/SRC/ztgsyl.f +++ b/SRC/ztgsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpcon.f b/SRC/ztpcon.f index e118159268..1e3bc4bb7e 100644 --- a/SRC/ztpcon.f +++ b/SRC/ztpcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztplqt.f b/SRC/ztplqt.f index 7bbfd8dced..7918e7ca9f 100644 --- a/SRC/ztplqt.f +++ b/SRC/ztplqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztplqt2.f b/SRC/ztplqt2.f index cc666f88a1..9d912e6dd5 100644 --- a/SRC/ztplqt2.f +++ b/SRC/ztplqt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f index 1b33380037..e5006ed3c9 100644 --- a/SRC/ztpmlqt.f +++ b/SRC/ztpmlqt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpmqrt.f b/SRC/ztpmqrt.f index aa7f2459a6..215242f402 100644 --- a/SRC/ztpmqrt.f +++ b/SRC/ztpmqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpqrt.f b/SRC/ztpqrt.f index 428bf502f0..3d160a407e 100644 --- a/SRC/ztpqrt.f +++ b/SRC/ztpqrt.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpqrt2.f b/SRC/ztpqrt2.f index 1c348dfc9b..f70d68b1fb 100644 --- a/SRC/ztpqrt2.f +++ b/SRC/ztpqrt2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztprfb.f b/SRC/ztprfb.f index 62aec75b94..6d7f05ec42 100644 --- a/SRC/ztprfb.f +++ b/SRC/ztprfb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPRFB applies a complex "triangular-pentagonal" block reflector to a complex matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztprfs.f b/SRC/ztprfs.f index cb6492c0e4..e5ea125763 100644 --- a/SRC/ztprfs.f +++ b/SRC/ztprfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztptri.f b/SRC/ztptri.f index 4527a08acc..352ebf0be8 100644 --- a/SRC/ztptri.f +++ b/SRC/ztptri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztptrs.f b/SRC/ztptrs.f index 99fc33cd4a..4dffcd566b 100644 --- a/SRC/ztptrs.f +++ b/SRC/ztptrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpttf.f b/SRC/ztpttf.f index 3dd0b765c2..00766385b2 100644 --- a/SRC/ztpttf.f +++ b/SRC/ztpttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpttr.f b/SRC/ztpttr.f index a04b7c9448..bd2b69bcd1 100644 --- a/SRC/ztpttr.f +++ b/SRC/ztpttr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrcon.f b/SRC/ztrcon.f index c69a60072e..0e4071e35e 100644 --- a/SRC/ztrcon.f +++ b/SRC/ztrcon.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrevc.f b/SRC/ztrevc.f index 249449eb5f..7a3cf17768 100644 --- a/SRC/ztrevc.f +++ b/SRC/ztrevc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrevc3.f b/SRC/ztrevc3.f index 4c82a54115..eaf39d77a7 100644 --- a/SRC/ztrevc3.f +++ b/SRC/ztrevc3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrexc.f b/SRC/ztrexc.f index b8bd10b152..1ebb18bed7 100644 --- a/SRC/ztrexc.f +++ b/SRC/ztrexc.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrrfs.f b/SRC/ztrrfs.f index 36eee7b698..8399259170 100644 --- a/SRC/ztrrfs.f +++ b/SRC/ztrrfs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsen.f b/SRC/ztrsen.f index 2c199654af..2a3257f6a8 100644 --- a/SRC/ztrsen.f +++ b/SRC/ztrsen.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsna.f b/SRC/ztrsna.f index 47cb12cb74..b2b2362b3a 100644 --- a/SRC/ztrsna.f +++ b/SRC/ztrsna.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsyl.f b/SRC/ztrsyl.f index 857ae3a7fc..0c861be3c9 100644 --- a/SRC/ztrsyl.f +++ b/SRC/ztrsyl.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsyl3.f b/SRC/ztrsyl3.f index b9f7761759..60ed8e28e7 100644 --- a/SRC/ztrsyl3.f +++ b/SRC/ztrsyl3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRSYL3 * * Definition: diff --git a/SRC/ztrti2.f b/SRC/ztrti2.f index 306313ca25..922b77b502 100644 --- a/SRC/ztrti2.f +++ b/SRC/ztrti2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrtri.f b/SRC/ztrtri.f index f6f1cfe170..95bd49a665 100644 --- a/SRC/ztrtri.f +++ b/SRC/ztrtri.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrtrs.f b/SRC/ztrtrs.f index 4ecb9ece80..43ce109ac2 100644 --- a/SRC/ztrtrs.f +++ b/SRC/ztrtrs.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrttf.f b/SRC/ztrttf.f index b1eb814f34..fa03d7640c 100644 --- a/SRC/ztrttf.f +++ b/SRC/ztrttf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrttp.f b/SRC/ztrttp.f index ec3a44718f..78f0fde13a 100644 --- a/SRC/ztrttp.f +++ b/SRC/ztrttp.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztzrzf.f b/SRC/ztzrzf.f index f40619692a..2160ae63d9 100644 --- a/SRC/ztzrzf.f +++ b/SRC/ztzrzf.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb.f b/SRC/zunbdb.f index 603a85e315..ec7a380428 100644 --- a/SRC/zunbdb.f +++ b/SRC/zunbdb.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb1.f b/SRC/zunbdb1.f index fba82d49a7..cf791f87b5 100644 --- a/SRC/zunbdb1.f +++ b/SRC/zunbdb1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb2.f b/SRC/zunbdb2.f index 19fee9b42a..768dc82fc8 100644 --- a/SRC/zunbdb2.f +++ b/SRC/zunbdb2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb3.f b/SRC/zunbdb3.f index ef620fae91..b3681d727a 100644 --- a/SRC/zunbdb3.f +++ b/SRC/zunbdb3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb4.f b/SRC/zunbdb4.f index 6cbadc5c52..c038bc5e5a 100644 --- a/SRC/zunbdb4.f +++ b/SRC/zunbdb4.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb5.f b/SRC/zunbdb5.f index c451ae921a..d53a738ccf 100644 --- a/SRC/zunbdb5.f +++ b/SRC/zunbdb5.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb6.f b/SRC/zunbdb6.f index ddc9dfc61f..9ee659f9cc 100644 --- a/SRC/zunbdb6.f +++ b/SRC/zunbdb6.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/zuncsd.f b/SRC/zuncsd.f index 585bd31a2c..ddb030516c 100644 --- a/SRC/zuncsd.f +++ b/SRC/zuncsd.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/zuncsd2by1.f b/SRC/zuncsd2by1.f index cf2158f72c..08ccc1f6f3 100644 --- a/SRC/zuncsd2by1.f +++ b/SRC/zuncsd2by1.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zung2l.f b/SRC/zung2l.f index cec0759826..9c5061e146 100644 --- a/SRC/zung2l.f +++ b/SRC/zung2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zung2r.f b/SRC/zung2r.f index b73246b2b3..53629c106a 100644 --- a/SRC/zung2r.f +++ b/SRC/zung2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNG2R * * =========== DOCUMENTATION =========== diff --git a/SRC/zungbr.f b/SRC/zungbr.f index 338ed9f20d..edd4768ed6 100644 --- a/SRC/zungbr.f +++ b/SRC/zungbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunghr.f b/SRC/zunghr.f index 9b29f5f4a3..0c1a7697a6 100644 --- a/SRC/zunghr.f +++ b/SRC/zunghr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungl2.f b/SRC/zungl2.f index 83308c59b1..e1817aa1e2 100644 --- a/SRC/zungl2.f +++ b/SRC/zungl2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunglq.f b/SRC/zunglq.f index 08fbe8beb0..f97b566244 100644 --- a/SRC/zunglq.f +++ b/SRC/zunglq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zungql.f b/SRC/zungql.f index 4a3943b77c..3abe20dba8 100644 --- a/SRC/zungql.f +++ b/SRC/zungql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/zungqr.f b/SRC/zungqr.f index 0167255565..a7f6b24fea 100644 --- a/SRC/zungqr.f +++ b/SRC/zungqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungr2.f b/SRC/zungr2.f index 05c5fc74ec..b86e0a3957 100644 --- a/SRC/zungr2.f +++ b/SRC/zungr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zungrq.f b/SRC/zungrq.f index 7839388887..f3ddf10f6f 100644 --- a/SRC/zungrq.f +++ b/SRC/zungrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtr.f b/SRC/zungtr.f index 126de69b81..020763bc39 100644 --- a/SRC/zungtr.f +++ b/SRC/zungtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtsqr.f b/SRC/zungtsqr.f index 6b8aa87604..8ac60f4660 100644 --- a/SRC/zungtsqr.f +++ b/SRC/zungtsqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtsqr_row.f b/SRC/zungtsqr_row.f index 96a27d260b..636a259117 100644 --- a/SRC/zungtsqr_row.f +++ b/SRC/zungtsqr_row.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/zunhr_col.f b/SRC/zunhr_col.f index 72ca97ce7d..7ec5b53bf3 100644 --- a/SRC/zunhr_col.f +++ b/SRC/zunhr_col.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm22.f b/SRC/zunm22.f index 2582d39c57..c11c050d46 100644 --- a/SRC/zunm22.f +++ b/SRC/zunm22.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNM22 multiplies a general matrix by a banded unitary matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm2l.f b/SRC/zunm2l.f index 0e0ed1c067..d41a406198 100644 --- a/SRC/zunm2l.f +++ b/SRC/zunm2l.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm2r.f b/SRC/zunm2r.f index 77e93edf61..385536e87d 100644 --- a/SRC/zunm2r.f +++ b/SRC/zunm2r.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmbr.f b/SRC/zunmbr.f index 482c1031d7..c6d238e920 100644 --- a/SRC/zunmbr.f +++ b/SRC/zunmbr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmhr.f b/SRC/zunmhr.f index 9ecd453ea9..01ec623b3e 100644 --- a/SRC/zunmhr.f +++ b/SRC/zunmhr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunml2.f b/SRC/zunml2.f index 00385dc612..78f870a2ac 100644 --- a/SRC/zunml2.f +++ b/SRC/zunml2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNML2 multiplies a general matrix by the unitary matrix from a LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmlq.f b/SRC/zunmlq.f index e7db7ea439..500121dbcf 100644 --- a/SRC/zunmlq.f +++ b/SRC/zunmlq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmql.f b/SRC/zunmql.f index acd6c57635..a0761f86bf 100644 --- a/SRC/zunmql.f +++ b/SRC/zunmql.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmqr.f b/SRC/zunmqr.f index 3e3efc2094..98ebdb7c25 100644 --- a/SRC/zunmqr.f +++ b/SRC/zunmqr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmr2.f b/SRC/zunmr2.f index f8bf7e0a4a..f6778f1dd9 100644 --- a/SRC/zunmr2.f +++ b/SRC/zunmr2.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMR2 multiplies a general matrix by the unitary matrix from a RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmr3.f b/SRC/zunmr3.f index f2f64a167b..c6c52eb154 100644 --- a/SRC/zunmr3.f +++ b/SRC/zunmr3.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMR3 multiplies a general matrix by the unitary matrix from a RZ factorization determined by ctzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmrq.f b/SRC/zunmrq.f index c4774965e8..8c5c8ded32 100644 --- a/SRC/zunmrq.f +++ b/SRC/zunmrq.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmrz.f b/SRC/zunmrz.f index 09d60dacf0..3be96f466c 100644 --- a/SRC/zunmrz.f +++ b/SRC/zunmrz.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmtr.f b/SRC/zunmtr.f index 5c9e358c27..c0193a8ba5 100644 --- a/SRC/zunmtr.f +++ b/SRC/zunmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUNMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zupgtr.f b/SRC/zupgtr.f index 0040afecd7..c7d3d6a92c 100644 --- a/SRC/zupgtr.f +++ b/SRC/zupgtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zupmtr.f b/SRC/zupmtr.f index 7fbfff67dc..52416c4699 100644 --- a/SRC/zupmtr.f +++ b/SRC/zupmtr.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZUPMTR * * =========== DOCUMENTATION =========== From a1e8cb4845ac81225087023fb5b39ea3bf21e158 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 11 Jul 2023 11:33:55 -0700 Subject: [PATCH 039/206] LAPACK SRC long lines updated by script --- SRC/cbbcsd.f | 36 +++++--- SRC/cbdsqr.f | 39 ++++++--- SRC/cgbbrd.f | 13 ++- SRC/cgbcon.f | 15 ++-- SRC/cgbequ.f | 3 +- SRC/cgbequb.f | 3 +- SRC/cgbrfs.f | 12 ++- SRC/cgbrfsx.f | 21 +++-- SRC/cgbsv.f | 6 +- SRC/cgbsvx.f | 16 ++-- SRC/cgbsvxx.f | 12 ++- SRC/cgbtf2.f | 3 +- SRC/cgbtrf.f | 24 ++++-- SRC/cgbtrs.f | 18 ++-- SRC/cgebak.f | 6 +- SRC/cgebal.f | 15 ++-- SRC/cgebrd.f | 6 +- SRC/cgecon.f | 9 +- SRC/cgees.f | 18 ++-- SRC/cgeesx.f | 24 ++++-- SRC/cgeev.f | 36 +++++--- SRC/cgeevx.f | 42 ++++++--- SRC/cgehd2.f | 3 +- SRC/cgehrd.f | 6 +- SRC/cgejsv.f | 122 +++++++++++++++++--------- SRC/cgelq2.f | 3 +- SRC/cgelqf.f | 3 +- SRC/cgels.f | 30 ++++--- SRC/cgelsd.f | 54 ++++++++---- SRC/cgelss.f | 85 +++++++++++------- SRC/cgelst.f | 18 ++-- SRC/cgelsy.f | 27 ++++-- SRC/cgeqlf.f | 6 +- SRC/cgeqp3.f | 9 +- SRC/cgeqrt.f | 6 +- SRC/cgerfs.f | 9 +- SRC/cgerfsx.f | 18 ++-- SRC/cgerqf.f | 3 +- SRC/cgesdd.f | 171 ++++++++++++++++++++++++------------- SRC/cgesvd.f | 162 +++++++++++++++++++++++------------ SRC/cgesvdq.f | 121 +++++++++++++++++--------- SRC/cgesvdx.f | 33 ++++--- SRC/cgesvj.f | 71 ++++++++++----- SRC/cgesvx.f | 16 ++-- SRC/cgesvxx.f | 6 +- SRC/cgetrf.f | 12 ++- SRC/cgetri.f | 9 +- SRC/cgetrs.f | 6 +- SRC/cgetsqrhrt.f | 9 +- SRC/cggbak.f | 9 +- SRC/cggbal.f | 12 ++- SRC/cgges.f | 21 +++-- SRC/cgges3.f | 15 ++-- SRC/cggesx.f | 18 ++-- SRC/cggev.f | 9 +- SRC/cggev3.f | 9 +- SRC/cggevx.f | 24 ++++-- SRC/cggglm.f | 15 ++-- SRC/cgghd3.f | 30 ++++--- SRC/cgghrd.f | 9 +- SRC/cgglse.f | 12 ++- SRC/cggqrf.f | 3 +- SRC/cggsvd3.f | 3 +- SRC/cggsvp3.f | 33 ++++--- SRC/cgsvj0.f | 45 ++++++---- SRC/cgsvj1.f | 27 ++++-- SRC/cgtrfs.f | 18 ++-- SRC/cgtsvx.f | 12 ++- SRC/cgttrs.f | 6 +- SRC/cgtts2.f | 3 +- SRC/chb2st_kernels.f | 3 +- SRC/chbev.f | 9 +- SRC/chbev_2stage.f | 12 ++- SRC/chbevd.f | 15 ++-- SRC/chbevd_2stage.f | 24 ++++-- SRC/chbevx.f | 12 ++- SRC/chbevx_2stage.f | 9 +- SRC/chbgst.f | 42 ++++++--- SRC/chbgv.f | 6 +- SRC/chbgvd.f | 9 +- SRC/chbgvx.f | 3 +- SRC/chbtrd.f | 30 ++++--- SRC/checon_rook.f | 3 +- SRC/cheequb.f | 6 +- SRC/cheev.f | 6 +- SRC/cheev_2stage.f | 18 ++-- SRC/cheevd.f | 9 +- SRC/cheevd_2stage.f | 6 +- SRC/cheevr.f | 9 +- SRC/cheevr_2stage.f | 6 +- SRC/cheevx.f | 9 +- SRC/cheevx_2stage.f | 6 +- SRC/chegs2.f | 21 +++-- SRC/chegst.f | 21 +++-- SRC/chegv.f | 15 ++-- SRC/chegv_2stage.f | 24 ++++-- SRC/chegvd.f | 9 +- SRC/chegvx.f | 12 ++- SRC/cherfs.f | 15 ++-- SRC/cherfsx.f | 15 ++-- SRC/chesv.f | 3 +- SRC/chesv_aa.f | 3 +- SRC/chesv_rk.f | 12 ++- SRC/chesv_rook.f | 9 +- SRC/chesvx.f | 12 ++- SRC/chesvxx.f | 15 ++-- SRC/chetd2.f | 9 +- SRC/chetf2.f | 12 ++- SRC/chetf2_rk.f | 18 ++-- SRC/chetf2_rook.f | 15 ++-- SRC/chetrd.f | 3 +- SRC/chetrd_2stage.f | 12 ++- SRC/chetrd_he2hb.f | 6 +- SRC/chetrf.f | 12 ++- SRC/chetrf_aa.f | 6 +- SRC/chetrf_aa_2stage.f | 6 +- SRC/chetrf_rk.f | 3 +- SRC/chetrf_rook.f | 3 +- SRC/chetri.f | 27 ++++-- SRC/chetri2x.f | 18 ++-- SRC/chetri_3x.f | 18 ++-- SRC/chetri_rook.f | 36 +++++--- SRC/chetrs.f | 15 ++-- SRC/chetrs2.f | 3 +- SRC/chetrs_3.f | 12 ++- SRC/chetrs_aa.f | 24 ++++-- SRC/chetrs_aa_2stage.f | 12 ++- SRC/chetrs_rook.f | 15 ++-- SRC/chfrk.f | 75 ++++++++++------ SRC/chgeqz.f | 24 ++++-- SRC/chpcon.f | 3 +- SRC/chpev.f | 6 +- SRC/chpevd.f | 12 ++- SRC/chpevx.f | 9 +- SRC/chpgst.f | 12 ++- SRC/chpgv.f | 6 +- SRC/chpgvd.f | 6 +- SRC/chpgvx.f | 6 +- SRC/chprfs.f | 6 +- SRC/chpsv.f | 3 +- SRC/chpsvx.f | 12 ++- SRC/chptrd.f | 9 +- SRC/chptrf.f | 3 +- SRC/chptri.f | 21 +++-- SRC/chptrs.f | 6 +- SRC/chsein.f | 12 ++- SRC/chseqr.f | 21 +++-- SRC/cla_gbrfsx_extended.f | 9 +- SRC/cla_geamv.f | 3 +- SRC/cla_gercond_c.f | 9 +- SRC/cla_gercond_x.f | 9 +- SRC/cla_gerfsx_extended.f | 12 ++- SRC/cla_hercond_c.f | 3 +- SRC/cla_hercond_x.f | 3 +- SRC/cla_herfsx_extended.f | 9 +- SRC/cla_herpvgrw.f | 3 +- SRC/cla_porcond_c.f | 3 +- SRC/cla_porcond_x.f | 3 +- SRC/cla_porfsx_extended.f | 9 +- SRC/cla_porpvgrw.f | 3 +- SRC/cla_syrcond_c.f | 3 +- SRC/cla_syrcond_x.f | 3 +- SRC/cla_syrfsx_extended.f | 6 +- SRC/cla_syrpvgrw.f | 3 +- SRC/clabrd.f | 33 ++++--- SRC/claed0.f | 3 +- SRC/claed7.f | 9 +- SRC/claed8.f | 12 ++- SRC/claein.f | 9 +- SRC/clags2.f | 15 ++-- SRC/clagtm.f | 3 +- SRC/clahef.f | 21 +++-- SRC/clahef_aa.f | 4 +- SRC/clahef_rk.f | 24 ++++-- SRC/clahef_rook.f | 24 ++++-- SRC/clahqr.f | 9 +- SRC/clahr2.f | 6 +- SRC/clals0.f | 21 +++-- SRC/clalsa.f | 24 ++++-- SRC/clalsd.f | 21 +++-- SRC/clangb.f | 6 +- SRC/clange.f | 3 +- SRC/clangt.f | 9 +- SRC/clanhb.f | 9 +- SRC/clanhe.f | 6 +- SRC/clanhf.f | 39 ++++++--- SRC/clanhp.f | 6 +- SRC/clanhs.f | 3 +- SRC/clanht.f | 3 +- SRC/clansb.f | 9 +- SRC/clansp.f | 6 +- SRC/clansy.f | 6 +- SRC/clantb.f | 24 ++++-- SRC/clantp.f | 18 ++-- SRC/clantr.f | 24 ++++-- SRC/claqgb.f | 3 +- SRC/claqhb.f | 3 +- SRC/claqp2.f | 3 +- SRC/claqps.f | 18 ++-- SRC/claqr0.f | 6 +- SRC/claqr2.f | 27 ++++-- SRC/claqr3.f | 36 +++++--- SRC/claqr4.f | 3 +- SRC/claqr5.f | 6 +- SRC/claqsb.f | 3 +- SRC/claqz0.f | 30 ++++--- SRC/claqz1.f | 18 ++-- SRC/claqz2.f | 30 ++++--- SRC/claqz3.f | 51 +++++++---- SRC/clarf.f | 6 +- SRC/clarfb.f | 75 ++++++++++------ SRC/clarfgp.f | 3 +- SRC/clarft.f | 9 +- SRC/clarrv.f | 3 +- SRC/clarz.f | 9 +- SRC/clarzb.f | 12 ++- SRC/clascl.f | 3 +- SRC/clasr.f | 6 +- SRC/clasyf.f | 21 +++-- SRC/clasyf_aa.f | 3 +- SRC/clasyf_rk.f | 24 ++++-- SRC/clasyf_rook.f | 24 ++++-- SRC/clatbs.f | 6 +- SRC/clatdf.f | 6 +- SRC/clatps.f | 6 +- SRC/clatrd.f | 15 ++-- SRC/clatrs.f | 12 ++- SRC/clatrs3.f | 18 ++-- SRC/claunhr_col_getrfnp.f | 9 +- SRC/claunhr_col_getrfnp2.f | 6 +- SRC/clauu2.f | 9 +- SRC/clauum.f | 3 +- SRC/cpbcon.f | 6 +- SRC/cpbequ.f | 3 +- SRC/cpbrfs.f | 9 +- SRC/cpbsv.f | 3 +- SRC/cpbsvx.f | 19 +++-- SRC/cpbtrf.f | 21 +++-- SRC/cpbtrs.f | 12 ++- SRC/cpftrf.f | 24 ++++-- SRC/cpftri.f | 30 ++++--- SRC/cpftrs.f | 12 ++- SRC/cpocon.f | 6 +- SRC/cporfs.f | 6 +- SRC/cporfsx.f | 9 +- SRC/cposv.f | 3 +- SRC/cposvx.f | 16 ++-- SRC/cposvxx.f | 3 +- SRC/cpotf2.f | 6 +- SRC/cpotrf.f | 9 +- SRC/cpotri.f | 3 +- SRC/cpotrs.f | 6 +- SRC/cppcon.f | 9 +- SRC/cpprfs.f | 9 +- SRC/cppsv.f | 3 +- SRC/cppsvx.f | 16 ++-- SRC/cpptrf.f | 3 +- SRC/cpptri.f | 6 +- SRC/cpptrs.f | 6 +- SRC/cpstf2.f | 12 ++- SRC/cpstrf.f | 12 ++- SRC/cptsvx.f | 6 +- SRC/crscl.f | 6 +- SRC/cspcon.f | 3 +- SRC/cspmv.f | 3 +- SRC/cspr.f | 3 +- SRC/csprfs.f | 6 +- SRC/cspsv.f | 3 +- SRC/cspsvx.f | 12 ++- SRC/csptrf.f | 3 +- SRC/csptri.f | 21 +++-- SRC/csptrs.f | 9 +- SRC/cstedc.f | 18 ++-- SRC/cstein.f | 9 +- SRC/cstemr.f | 3 +- SRC/csteqr.f | 27 ++++-- SRC/csycon_rook.f | 3 +- SRC/csyequb.f | 6 +- SRC/csymv.f | 6 +- SRC/csyr.f | 3 +- SRC/csyrfs.f | 15 ++-- SRC/csyrfsx.f | 15 ++-- SRC/csysv.f | 3 +- SRC/csysv_aa.f | 3 +- SRC/csysv_rk.f | 12 ++- SRC/csysv_rook.f | 9 +- SRC/csysvx.f | 12 ++- SRC/csysvxx.f | 9 +- SRC/csytf2.f | 6 +- SRC/csytf2_rk.f | 27 ++++-- SRC/csytf2_rook.f | 24 ++++-- SRC/csytrf.f | 12 ++- SRC/csytrf_aa.f | 3 +- SRC/csytrf_aa_2stage.f | 3 +- SRC/csytrf_rk.f | 3 +- SRC/csytrf_rook.f | 3 +- SRC/csytri.f | 30 ++++--- SRC/csytri2x.f | 18 ++-- SRC/csytri_3x.f | 18 ++-- SRC/csytri_rook.f | 57 ++++++++----- SRC/csytrs.f | 18 ++-- SRC/csytrs2.f | 3 +- SRC/csytrs_3.f | 12 ++- SRC/csytrs_aa.f | 30 ++++--- SRC/csytrs_aa_2stage.f | 12 ++- SRC/csytrs_rook.f | 21 +++-- SRC/ctbcon.f | 9 +- SRC/ctbrfs.f | 3 +- SRC/ctbtrs.f | 6 +- SRC/ctfsm.f | 81 ++++++++++++------ SRC/ctftri.f | 36 +++++--- SRC/ctgevc.f | 3 +- SRC/ctgex2.f | 18 ++-- SRC/ctgexc.f | 6 +- SRC/ctgsen.f | 30 ++++--- SRC/ctgsja.f | 32 ++++--- SRC/ctgsna.f | 12 ++- SRC/ctgsy2.f | 18 ++-- SRC/ctgsyl.f | 30 ++++--- SRC/ctpcon.f | 6 +- SRC/ctpmlqt.f | 3 +- SRC/ctpmqrt.f | 3 +- SRC/ctprfb.f | 6 +- SRC/ctprfs.f | 6 +- SRC/ctptrs.f | 6 +- SRC/ctrcon.f | 3 +- SRC/ctrevc.f | 15 ++-- SRC/ctrevc3.f | 15 ++-- SRC/ctrexc.f | 6 +- SRC/ctrrfs.f | 6 +- SRC/ctrsen.f | 6 +- SRC/ctrsna.f | 15 ++-- SRC/ctrsyl.f | 3 +- SRC/ctrsyl3.f | 9 +- SRC/ctrtri.f | 6 +- SRC/ctrtrs.f | 6 +- SRC/ctzrzf.f | 3 +- SRC/cunbdb.f | 48 +++++++---- SRC/cunbdb1.f | 9 +- SRC/cunbdb2.f | 9 +- SRC/cunbdb3.f | 12 ++- SRC/cunbdb4.f | 24 ++++-- SRC/cunbdb5.f | 3 +- SRC/cunbdb6.f | 15 ++-- SRC/cuncsd.f | 27 ++++-- SRC/cuncsd2by1.f | 42 ++++++--- SRC/cung2l.f | 3 +- SRC/cungbr.f | 3 +- SRC/cunghr.f | 3 +- SRC/cunglq.f | 12 ++- SRC/cungql.f | 3 +- SRC/cungqr.f | 6 +- SRC/cungrq.f | 9 +- SRC/cungtr.f | 3 +- SRC/cunhr_col.f | 3 +- SRC/cunm22.f | 27 ++++-- SRC/cunm2r.f | 3 +- SRC/cunmbr.f | 15 ++-- SRC/cunmhr.f | 3 +- SRC/cunmlq.f | 12 ++- SRC/cunmql.f | 12 ++- SRC/cunmqr.f | 15 ++-- SRC/cunmr2.f | 3 +- SRC/cunmr3.f | 3 +- SRC/cunmrq.f | 9 +- SRC/cunmrz.f | 12 ++- SRC/cunmtr.f | 9 +- SRC/cupmtr.f | 3 +- SRC/dbbcsd.f | 36 +++++--- SRC/dbdsdc.f | 18 ++-- SRC/dbdsqr.f | 42 ++++++--- SRC/dbdsvdx.f | 30 ++++--- SRC/dgbbrd.f | 13 ++- SRC/dgbcon.f | 12 ++- SRC/dgbequ.f | 3 +- SRC/dgbequb.f | 3 +- SRC/dgbrfs.f | 12 ++- SRC/dgbrfsx.f | 15 ++-- SRC/dgbsv.f | 6 +- SRC/dgbsvx.f | 16 ++-- SRC/dgbsvxx.f | 12 ++- SRC/dgbtf2.f | 3 +- SRC/dgbtrf.f | 24 ++++-- SRC/dgbtrs.f | 12 ++- SRC/dgebak.f | 6 +- SRC/dgebal.f | 15 ++-- SRC/dgebd2.f | 12 ++- SRC/dgebrd.f | 6 +- SRC/dgecon.f | 9 +- SRC/dgees.f | 21 +++-- SRC/dgeesx.f | 27 ++++-- SRC/dgeev.f | 51 +++++++---- SRC/dgeevx.f | 55 ++++++++---- SRC/dgehrd.f | 6 +- SRC/dgejsv.f | 87 ++++++++++++------- SRC/dgelq2.f | 3 +- SRC/dgelqf.f | 3 +- SRC/dgels.f | 21 +++-- SRC/dgelsd.f | 54 ++++++++---- SRC/dgelss.f | 70 +++++++++------ SRC/dgelst.f | 21 +++-- SRC/dgelsy.f | 27 ++++-- SRC/dgeql2.f | 3 +- SRC/dgeqlf.f | 3 +- SRC/dgeqp3.f | 9 +- SRC/dgeqrt.f | 6 +- SRC/dgerfs.f | 15 ++-- SRC/dgerfsx.f | 18 ++-- SRC/dgerqf.f | 3 +- SRC/dgesdd.f | 144 ++++++++++++++++++++----------- SRC/dgesvd.f | 156 ++++++++++++++++++++++----------- SRC/dgesvdq.f | 60 ++++++++----- SRC/dgesvdx.f | 45 ++++++---- SRC/dgesvj.f | 98 ++++++++++++++------- SRC/dgesvx.f | 16 ++-- SRC/dgesvxx.f | 6 +- SRC/dgetf2.f | 3 +- SRC/dgetrf.f | 12 ++- SRC/dgetri.f | 9 +- SRC/dgetrs.f | 9 +- SRC/dgetsqrhrt.f | 9 +- SRC/dggbak.f | 9 +- SRC/dggbal.f | 12 ++- SRC/dgges.f | 27 ++++-- SRC/dgges3.f | 21 +++-- SRC/dggesx.f | 21 +++-- SRC/dggev.f | 15 ++-- SRC/dggev3.f | 12 ++- SRC/dggevx.f | 34 +++++--- SRC/dggglm.f | 9 +- SRC/dgghd3.f | 24 ++++-- SRC/dgghrd.f | 12 ++- SRC/dgglse.f | 18 ++-- SRC/dggqrf.f | 3 +- SRC/dggsvd3.f | 3 +- SRC/dggsvp3.f | 18 ++-- SRC/dgsvj0.f | 111 ++++++++++++++++-------- SRC/dgsvj1.f | 63 +++++++++----- SRC/dgtcon.f | 3 +- SRC/dgtrfs.f | 12 ++- SRC/dgtsvx.f | 12 ++- SRC/dgttrs.f | 6 +- SRC/dgtts2.f | 3 +- SRC/dhgeqz.f | 30 ++++--- SRC/dhsein.f | 6 +- SRC/dhseqr.f | 18 ++-- SRC/dla_gbrcond.f | 9 +- SRC/dla_gbrfsx_extended.f | 9 +- SRC/dla_gerfsx_extended.f | 9 +- SRC/dla_porcond.f | 3 +- SRC/dla_porfsx_extended.f | 9 +- SRC/dla_porpvgrw.f | 3 +- SRC/dla_syrcond.f | 15 ++-- SRC/dla_syrfsx_extended.f | 9 +- SRC/dla_syrpvgrw.f | 3 +- SRC/dlabrd.f | 63 +++++++++----- SRC/dlaed0.f | 6 +- SRC/dlaed1.f | 9 +- SRC/dlaed2.f | 6 +- SRC/dlaed3.f | 12 ++- SRC/dlaed4.f | 3 +- SRC/dlaed6.f | 3 +- SRC/dlaed7.f | 9 +- SRC/dlaed8.f | 6 +- SRC/dlaed9.f | 6 +- SRC/dlaeda.f | 6 +- SRC/dlaein.f | 9 +- SRC/dlaexc.f | 18 ++-- SRC/dlags2.f | 3 +- SRC/dlagtm.f | 3 +- SRC/dlagv2.f | 6 +- SRC/dlahqr.f | 6 +- SRC/dlahr2.f | 6 +- SRC/dlals0.f | 24 ++++-- SRC/dlalsa.f | 18 ++-- SRC/dlalsd.f | 27 ++++-- SRC/dlangb.f | 6 +- SRC/dlange.f | 3 +- SRC/dlangt.f | 9 +- SRC/dlanhs.f | 3 +- SRC/dlansb.f | 9 +- SRC/dlansf.f | 48 +++++++---- SRC/dlansp.f | 6 +- SRC/dlanst.f | 3 +- SRC/dlansy.f | 6 +- SRC/dlantb.f | 24 ++++-- SRC/dlantp.f | 18 ++-- SRC/dlantr.f | 24 ++++-- SRC/dlaorhr_col_getrfnp.f | 9 +- SRC/dlaorhr_col_getrfnp2.f | 3 +- SRC/dlaqgb.f | 3 +- SRC/dlaqp2.f | 3 +- SRC/dlaqps.f | 18 ++-- SRC/dlaqr0.f | 9 +- SRC/dlaqr2.f | 33 ++++--- SRC/dlaqr3.f | 36 +++++--- SRC/dlaqr4.f | 9 +- SRC/dlaqr5.f | 3 +- SRC/dlaqsb.f | 3 +- SRC/dlaqtr.f | 30 ++++--- SRC/dlaqz0.f | 36 +++++--- SRC/dlaqz2.f | 21 +++-- SRC/dlaqz3.f | 42 ++++++--- SRC/dlaqz4.f | 66 +++++++++----- SRC/dlarf.f | 3 +- SRC/dlarfb.f | 93 +++++++++++++------- SRC/dlarft.f | 9 +- SRC/dlarrd.f | 3 +- SRC/dlarre.f | 3 +- SRC/dlarrv.f | 3 +- SRC/dlarz.f | 6 +- SRC/dlarzb.f | 12 ++- SRC/dlascl.f | 3 +- SRC/dlasd0.f | 12 ++- SRC/dlasd1.f | 12 ++- SRC/dlasd2.f | 12 ++- SRC/dlasd3.f | 24 ++++-- SRC/dlasd6.f | 6 +- SRC/dlasd7.f | 3 +- SRC/dlasd8.f | 9 +- SRC/dlasda.f | 18 ++-- SRC/dlasdq.f | 9 +- SRC/dlasq1.f | 3 +- SRC/dlasq2.f | 3 +- SRC/dlasq3.f | 3 +- SRC/dlasq5.f | 3 +- SRC/dlasr.f | 6 +- SRC/dlasyf.f | 27 ++++-- SRC/dlasyf_aa.f | 3 +- SRC/dlasyf_rk.f | 24 ++++-- SRC/dlasyf_rook.f | 24 ++++-- SRC/dlatbs.f | 6 +- SRC/dlatdf.f | 6 +- SRC/dlatps.f | 3 +- SRC/dlatrd.f | 30 ++++--- SRC/dlatrs.f | 10 ++- SRC/dlatrs3.f | 18 ++-- SRC/dlauu2.f | 9 +- SRC/dlauum.f | 6 +- SRC/dopmtr.f | 6 +- SRC/dorbdb.f | 81 ++++++++++++------ SRC/dorbdb1.f | 15 ++-- SRC/dorbdb2.f | 9 +- SRC/dorbdb3.f | 18 ++-- SRC/dorbdb4.f | 21 +++-- SRC/dorbdb5.f | 3 +- SRC/dorbdb6.f | 15 ++-- SRC/dorcsd.f | 24 ++++-- SRC/dorcsd2by1.f | 27 ++++-- SRC/dorg2l.f | 3 +- SRC/dorgbr.f | 3 +- SRC/dorghr.f | 3 +- SRC/dorglq.f | 12 ++- SRC/dorgql.f | 3 +- SRC/dorgqr.f | 6 +- SRC/dorgr2.f | 3 +- SRC/dorgrq.f | 9 +- SRC/dorgtr.f | 3 +- SRC/dorhr_col.f | 3 +- SRC/dorm22.f | 27 ++++-- SRC/dorm2r.f | 3 +- SRC/dormbr.f | 3 +- SRC/dormhr.f | 3 +- SRC/dormlq.f | 12 ++- SRC/dormql.f | 12 ++- SRC/dormqr.f | 15 ++-- SRC/dormr3.f | 3 +- SRC/dormrq.f | 9 +- SRC/dormrz.f | 12 ++- SRC/dormtr.f | 9 +- SRC/dpbcon.f | 6 +- SRC/dpbequ.f | 3 +- SRC/dpbrfs.f | 12 ++- SRC/dpbsv.f | 3 +- SRC/dpbsvx.f | 19 +++-- SRC/dpbtrf.f | 15 ++-- SRC/dpbtrs.f | 6 +- SRC/dpftrf.f | 21 +++-- SRC/dpftri.f | 30 ++++--- SRC/dpocon.f | 12 ++- SRC/dporfs.f | 12 ++- SRC/dporfsx.f | 6 +- SRC/dposv.f | 3 +- SRC/dposvx.f | 16 ++-- SRC/dposvxx.f | 9 +- SRC/dpotf2.f | 3 +- SRC/dpotrf.f | 15 ++-- SRC/dpotri.f | 3 +- SRC/dpotrs.f | 6 +- SRC/dppcon.f | 9 +- SRC/dpprfs.f | 12 ++- SRC/dppsv.f | 3 +- SRC/dppsvx.f | 16 ++-- SRC/dpstf2.f | 15 ++-- SRC/dpstrf.f | 15 ++-- SRC/dptsvx.f | 3 +- SRC/dsb2st_kernels.f | 3 +- SRC/dsbev.f | 15 ++-- SRC/dsbev_2stage.f | 15 ++-- SRC/dsbevd.f | 18 ++-- SRC/dsbevd_2stage.f | 24 ++++-- SRC/dsbevx.f | 12 ++- SRC/dsbevx_2stage.f | 15 ++-- SRC/dsbgst.f | 45 ++++++---- SRC/dsbgv.f | 12 ++- SRC/dsbgvd.f | 12 ++- SRC/dsbgvx.f | 3 +- SRC/dsbtrd.f | 30 ++++--- SRC/dsfrk.f | 75 ++++++++++------ SRC/dsgesv.f | 12 ++- SRC/dspcon.f | 3 +- SRC/dspev.f | 12 ++- SRC/dspevd.f | 15 ++-- SRC/dspevx.f | 9 +- SRC/dspgst.f | 6 +- SRC/dspgv.f | 6 +- SRC/dspgvd.f | 6 +- SRC/dspgvx.f | 6 +- SRC/dsposv.f | 9 +- SRC/dsprfs.f | 15 ++-- SRC/dspsv.f | 3 +- SRC/dspsvx.f | 15 ++-- SRC/dsptrd.f | 6 +- SRC/dsptrf.f | 3 +- SRC/dsptri.f | 21 +++-- SRC/dsptrs.f | 9 +- SRC/dstebz.f | 9 +- SRC/dstedc.f | 15 ++-- SRC/dstein.f | 12 ++- SRC/dstemr.f | 3 +- SRC/dsteqr.f | 27 ++++-- SRC/dsterf.f | 6 +- SRC/dstevd.f | 3 +- SRC/dstevr.f | 12 ++- SRC/dstevx.f | 12 ++- SRC/dsycon_rook.f | 3 +- SRC/dsyequb.f | 6 +- SRC/dsyev.f | 9 +- SRC/dsyev_2stage.f | 21 +++-- SRC/dsyevd.f | 9 +- SRC/dsyevd_2stage.f | 6 +- SRC/dsyevr.f | 9 +- SRC/dsyevr_2stage.f | 9 +- SRC/dsyevx.f | 12 ++- SRC/dsyevx_2stage.f | 6 +- SRC/dsygs2.f | 15 ++-- SRC/dsygst.f | 27 ++++-- SRC/dsygv.f | 12 ++- SRC/dsygv_2stage.f | 27 ++++-- SRC/dsygvd.f | 9 +- SRC/dsygvx.f | 12 ++- SRC/dsyrfs.f | 15 ++-- SRC/dsyrfsx.f | 12 ++- SRC/dsysv.f | 3 +- SRC/dsysv_rk.f | 9 +- SRC/dsysv_rook.f | 9 +- SRC/dsysvx.f | 12 ++- SRC/dsysvxx.f | 9 +- SRC/dsytd2.f | 9 +- SRC/dsytf2.f | 12 ++- SRC/dsytf2_rk.f | 27 ++++-- SRC/dsytf2_rook.f | 24 ++++-- SRC/dsytrd.f | 6 +- SRC/dsytrd_sy2sb.f | 6 +- SRC/dsytrf.f | 9 +- SRC/dsytrf_aa.f | 3 +- SRC/dsytrf_rk.f | 3 +- SRC/dsytrf_rook.f | 3 +- SRC/dsytri.f | 21 +++-- SRC/dsytri2x.f | 18 ++-- SRC/dsytri_3x.f | 18 ++-- SRC/dsytri_rook.f | 48 +++++++---- SRC/dsytrs.f | 9 +- SRC/dsytrs2.f | 3 +- SRC/dsytrs_3.f | 12 ++- SRC/dsytrs_aa.f | 30 ++++--- SRC/dsytrs_aa_2stage.f | 12 ++- SRC/dsytrs_rook.f | 6 +- SRC/dtbcon.f | 12 ++- SRC/dtbrfs.f | 6 +- SRC/dtbtrs.f | 6 +- SRC/dtfsm.f | 81 ++++++++++++------ SRC/dtftri.f | 21 +++-- SRC/dtgevc.f | 15 ++-- SRC/dtgex2.f | 81 ++++++++++++------ SRC/dtgexc.f | 24 ++++-- SRC/dtgsen.f | 33 ++++--- SRC/dtgsja.f | 32 ++++--- SRC/dtgsna.f | 21 +++-- SRC/dtgsy2.f | 72 ++++++++++------ SRC/dtgsyl.f | 18 ++-- SRC/dtpcon.f | 6 +- SRC/dtpmlqt.f | 3 +- SRC/dtpmqrt.f | 3 +- SRC/dtprfb.f | 6 +- SRC/dtprfs.f | 12 ++- SRC/dtptrs.f | 6 +- SRC/dtrcon.f | 6 +- SRC/dtrevc.f | 39 ++++++--- SRC/dtrevc3.f | 93 +++++++++++++------- SRC/dtrexc.f | 21 +++-- SRC/dtrrfs.f | 12 ++- SRC/dtrsen.f | 12 ++- SRC/dtrsna.f | 27 ++++-- SRC/dtrsyl.f | 9 +- SRC/dtrsyl3.f | 9 +- SRC/dtrtri.f | 6 +- SRC/dtrtrs.f | 6 +- SRC/dtzrzf.f | 3 +- SRC/ilaenv2stage.f | 3 +- SRC/iparmq.f | 3 +- SRC/la_xisnan.F90 | 1 - SRC/sbbcsd.f | 36 +++++--- SRC/sbdsdc.f | 18 ++-- SRC/sbdsqr.f | 42 ++++++--- SRC/sbdsvdx.f | 30 ++++--- SRC/sgbbrd.f | 9 +- SRC/sgbcon.f | 6 +- SRC/sgbequ.f | 3 +- SRC/sgbequb.f | 3 +- SRC/sgbrfs.f | 12 ++- SRC/sgbrfsx.f | 12 ++- SRC/sgbsv.f | 6 +- SRC/sgbsvx.f | 16 ++-- SRC/sgbsvxx.f | 12 ++- SRC/sgbtf2.f | 3 +- SRC/sgbtrf.f | 24 ++++-- SRC/sgbtrs.f | 12 ++- SRC/sgebak.f | 6 +- SRC/sgebal.f | 15 ++-- SRC/sgebd2.f | 12 ++- SRC/sgebrd.f | 6 +- SRC/sgecon.f | 9 +- SRC/sgees.f | 21 +++-- SRC/sgeesx.f | 27 ++++-- SRC/sgeev.f | 48 +++++++---- SRC/sgeevx.f | 52 +++++++---- SRC/sgehrd.f | 6 +- SRC/sgejsv.f | 87 ++++++++++++------- SRC/sgelq2.f | 3 +- SRC/sgelqf.f | 3 +- SRC/sgels.f | 21 +++-- SRC/sgelsd.f | 54 ++++++++---- SRC/sgelss.f | 70 +++++++++------ SRC/sgelst.f | 18 ++-- SRC/sgelsy.f | 27 ++++-- SRC/sgeql2.f | 3 +- SRC/sgeqlf.f | 3 +- SRC/sgeqp3.f | 9 +- SRC/sgeqrt.f | 6 +- SRC/sgerfs.f | 15 ++-- SRC/sgerfsx.f | 15 ++-- SRC/sgerqf.f | 3 +- SRC/sgesdd.f | 144 ++++++++++++++++++++----------- SRC/sgesvd.f | 159 ++++++++++++++++++++++------------ SRC/sgesvdq.f | 63 +++++++++----- SRC/sgesvdx.f | 45 ++++++---- SRC/sgesvj.f | 98 ++++++++++++++------- SRC/sgesvx.f | 16 ++-- SRC/sgesvxx.f | 6 +- SRC/sgetf2.f | 3 +- SRC/sgetrf.f | 12 ++- SRC/sgetri.f | 9 +- SRC/sgetrs.f | 9 +- SRC/sgetsqrhrt.f | 9 +- SRC/sggbak.f | 9 +- SRC/sggbal.f | 12 ++- SRC/sgges.f | 27 ++++-- SRC/sgges3.f | 21 +++-- SRC/sggesx.f | 21 +++-- SRC/sggev.f | 15 ++-- SRC/sggev3.f | 12 ++- SRC/sggevx.f | 30 ++++--- SRC/sggglm.f | 9 +- SRC/sgghd3.f | 24 ++++-- SRC/sgghrd.f | 12 ++- SRC/sgglse.f | 18 ++-- SRC/sggqrf.f | 3 +- SRC/sggsvd3.f | 3 +- SRC/sggsvp3.f | 18 ++-- SRC/sgsvj0.f | 111 ++++++++++++++++-------- SRC/sgsvj1.f | 63 +++++++++----- SRC/sgtcon.f | 3 +- SRC/sgtrfs.f | 12 ++- SRC/sgtsvx.f | 12 ++- SRC/sgttrs.f | 6 +- SRC/sgtts2.f | 3 +- SRC/shgeqz.f | 27 ++++-- SRC/shsein.f | 6 +- SRC/shseqr.f | 18 ++-- SRC/sla_gbrcond.f | 9 +- SRC/sla_gbrfsx_extended.f | 9 +- SRC/sla_geamv.f | 3 +- SRC/sla_gerfsx_extended.f | 9 +- SRC/sla_porfsx_extended.f | 6 +- SRC/sla_porpvgrw.f | 3 +- SRC/sla_syrcond.f | 15 ++-- SRC/sla_syrfsx_extended.f | 6 +- SRC/sla_syrpvgrw.f | 3 +- SRC/slabrd.f | 63 +++++++++----- SRC/slaed0.f | 6 +- SRC/slaed1.f | 9 +- SRC/slaed2.f | 6 +- SRC/slaed3.f | 12 ++- SRC/slaed4.f | 3 +- SRC/slaed6.f | 3 +- SRC/slaed7.f | 9 +- SRC/slaed8.f | 6 +- SRC/slaed9.f | 6 +- SRC/slaeda.f | 6 +- SRC/slaein.f | 9 +- SRC/slaexc.f | 18 ++-- SRC/slags2.f | 3 +- SRC/slagtm.f | 3 +- SRC/slagv2.f | 6 +- SRC/slahqr.f | 6 +- SRC/slahr2.f | 6 +- SRC/slals0.f | 24 ++++-- SRC/slalsa.f | 18 ++-- SRC/slalsd.f | 27 ++++-- SRC/slangb.f | 6 +- SRC/slange.f | 3 +- SRC/slangt.f | 9 +- SRC/slanhs.f | 3 +- SRC/slansb.f | 9 +- SRC/slansf.f | 45 ++++++---- SRC/slansp.f | 6 +- SRC/slanst.f | 3 +- SRC/slansy.f | 6 +- SRC/slantb.f | 24 ++++-- SRC/slantp.f | 18 ++-- SRC/slantr.f | 24 ++++-- SRC/slaorhr_col_getrfnp.f | 9 +- SRC/slaorhr_col_getrfnp2.f | 3 +- SRC/slaqgb.f | 3 +- SRC/slaqp2.f | 3 +- SRC/slaqps.f | 18 ++-- SRC/slaqr0.f | 9 +- SRC/slaqr2.f | 33 ++++--- SRC/slaqr3.f | 36 +++++--- SRC/slaqr4.f | 9 +- SRC/slaqr5.f | 3 +- SRC/slaqsb.f | 3 +- SRC/slaqtr.f | 30 ++++--- SRC/slaqz0.f | 36 +++++--- SRC/slaqz2.f | 21 +++-- SRC/slaqz3.f | 42 ++++++--- SRC/slaqz4.f | 66 +++++++++----- SRC/slarf.f | 3 +- SRC/slarfb.f | 93 +++++++++++++------- SRC/slarft.f | 9 +- SRC/slarrd.f | 3 +- SRC/slarre.f | 3 +- SRC/slarrv.f | 3 +- SRC/slarz.f | 6 +- SRC/slarzb.f | 12 ++- SRC/slascl.f | 3 +- SRC/slasd0.f | 12 ++- SRC/slasd1.f | 12 ++- SRC/slasd2.f | 12 ++- SRC/slasd3.f | 24 ++++-- SRC/slasd6.f | 6 +- SRC/slasd7.f | 3 +- SRC/slasd8.f | 9 +- SRC/slasda.f | 18 ++-- SRC/slasdq.f | 9 +- SRC/slasq1.f | 3 +- SRC/slasq2.f | 3 +- SRC/slasq3.f | 3 +- SRC/slasq5.f | 3 +- SRC/slasr.f | 6 +- SRC/slasyf.f | 27 ++++-- SRC/slasyf_aa.f | 3 +- SRC/slasyf_rk.f | 24 ++++-- SRC/slasyf_rook.f | 24 ++++-- SRC/slatbs.f | 6 +- SRC/slatdf.f | 6 +- SRC/slatps.f | 3 +- SRC/slatrd.f | 30 ++++--- SRC/slatrs.f | 10 ++- SRC/slatrs3.f | 18 ++-- SRC/slauu2.f | 9 +- SRC/slauum.f | 6 +- SRC/sopmtr.f | 6 +- SRC/sorbdb.f | 81 ++++++++++++------ SRC/sorbdb1.f | 15 ++-- SRC/sorbdb2.f | 9 +- SRC/sorbdb3.f | 18 ++-- SRC/sorbdb4.f | 21 +++-- SRC/sorbdb5.f | 3 +- SRC/sorbdb6.f | 15 ++-- SRC/sorcsd.f | 30 ++++--- SRC/sorcsd2by1.f | 27 ++++-- SRC/sorg2l.f | 3 +- SRC/sorgbr.f | 3 +- SRC/sorghr.f | 3 +- SRC/sorglq.f | 12 ++- SRC/sorgql.f | 3 +- SRC/sorgqr.f | 6 +- SRC/sorgr2.f | 3 +- SRC/sorgrq.f | 9 +- SRC/sorgtr.f | 3 +- SRC/sorhr_col.f | 3 +- SRC/sorm22.f | 27 ++++-- SRC/sorm2r.f | 3 +- SRC/sormbr.f | 3 +- SRC/sormhr.f | 3 +- SRC/sormlq.f | 12 ++- SRC/sormql.f | 12 ++- SRC/sormqr.f | 15 ++-- SRC/sormr3.f | 3 +- SRC/sormrq.f | 9 +- SRC/sormrz.f | 12 ++- SRC/sormtr.f | 9 +- SRC/spbcon.f | 6 +- SRC/spbequ.f | 3 +- SRC/spbrfs.f | 12 ++- SRC/spbsv.f | 3 +- SRC/spbsvx.f | 19 +++-- SRC/spbtrf.f | 15 ++-- SRC/spbtrs.f | 6 +- SRC/spftrf.f | 21 +++-- SRC/spftri.f | 30 ++++--- SRC/spocon.f | 12 ++- SRC/sporfs.f | 12 ++- SRC/sporfsx.f | 3 +- SRC/sposv.f | 3 +- SRC/sposvx.f | 16 ++-- SRC/sposvxx.f | 9 +- SRC/spotf2.f | 3 +- SRC/spotrf.f | 15 ++-- SRC/spotri.f | 3 +- SRC/spotrs.f | 6 +- SRC/sppcon.f | 9 +- SRC/spprfs.f | 12 ++- SRC/sppsv.f | 3 +- SRC/sppsvx.f | 16 ++-- SRC/spstf2.f | 15 ++-- SRC/spstrf.f | 15 ++-- SRC/sptsvx.f | 3 +- SRC/ssb2st_kernels.f | 3 +- SRC/ssbev.f | 15 ++-- SRC/ssbev_2stage.f | 15 ++-- SRC/ssbevd.f | 18 ++-- SRC/ssbevd_2stage.f | 24 ++++-- SRC/ssbevx.f | 12 ++- SRC/ssbevx_2stage.f | 15 ++-- SRC/ssbgst.f | 45 ++++++---- SRC/ssbgv.f | 12 ++- SRC/ssbgvd.f | 12 ++- SRC/ssbgvx.f | 3 +- SRC/ssbtrd.f | 30 ++++--- SRC/ssfrk.f | 75 ++++++++++------ SRC/sspcon.f | 3 +- SRC/sspev.f | 12 ++- SRC/sspevd.f | 15 ++-- SRC/sspevx.f | 9 +- SRC/sspgst.f | 6 +- SRC/sspgv.f | 6 +- SRC/sspgvd.f | 6 +- SRC/sspgvx.f | 6 +- SRC/ssprfs.f | 15 ++-- SRC/sspsv.f | 3 +- SRC/sspsvx.f | 15 ++-- SRC/ssptrd.f | 6 +- SRC/ssptrf.f | 3 +- SRC/ssptri.f | 21 +++-- SRC/ssptrs.f | 9 +- SRC/sstebz.f | 9 +- SRC/sstedc.f | 15 ++-- SRC/sstein.f | 12 ++- SRC/sstemr.f | 3 +- SRC/ssteqr.f | 27 ++++-- SRC/ssterf.f | 6 +- SRC/sstevd.f | 3 +- SRC/sstevr.f | 12 ++- SRC/sstevx.f | 12 ++- SRC/ssycon_rook.f | 3 +- SRC/ssyequb.f | 6 +- SRC/ssyev.f | 9 +- SRC/ssyev_2stage.f | 21 +++-- SRC/ssyevd.f | 9 +- SRC/ssyevd_2stage.f | 6 +- SRC/ssyevr.f | 9 +- SRC/ssyevr_2stage.f | 6 +- SRC/ssyevx.f | 12 ++- SRC/ssyevx_2stage.f | 6 +- SRC/ssygs2.f | 15 ++-- SRC/ssygst.f | 27 ++++-- SRC/ssygv.f | 12 ++- SRC/ssygv_2stage.f | 27 ++++-- SRC/ssygvd.f | 9 +- SRC/ssygvx.f | 12 ++- SRC/ssyrfs.f | 15 ++-- SRC/ssyrfsx.f | 9 +- SRC/ssysv.f | 3 +- SRC/ssysv_rk.f | 9 +- SRC/ssysv_rook.f | 9 +- SRC/ssysvx.f | 12 ++- SRC/ssysvxx.f | 9 +- SRC/ssytd2.f | 9 +- SRC/ssytf2.f | 12 ++- SRC/ssytf2_rk.f | 27 ++++-- SRC/ssytf2_rook.f | 24 ++++-- SRC/ssytrd.f | 6 +- SRC/ssytrd_sy2sb.f | 6 +- SRC/ssytrf.f | 9 +- SRC/ssytrf_aa.f | 3 +- SRC/ssytrf_rk.f | 6 +- SRC/ssytrf_rook.f | 3 +- SRC/ssytri.f | 21 +++-- SRC/ssytri2x.f | 18 ++-- SRC/ssytri_3x.f | 18 ++-- SRC/ssytri_rook.f | 48 +++++++---- SRC/ssytrs.f | 9 +- SRC/ssytrs2.f | 3 +- SRC/ssytrs_3.f | 12 ++- SRC/ssytrs_aa.f | 12 ++- SRC/ssytrs_aa_2stage.f | 12 ++- SRC/ssytrs_rook.f | 6 +- SRC/stbcon.f | 12 ++- SRC/stbrfs.f | 6 +- SRC/stbtrs.f | 6 +- SRC/stfsm.f | 81 ++++++++++++------ SRC/stftri.f | 21 +++-- SRC/stgevc.f | 15 ++-- SRC/stgex2.f | 81 ++++++++++++------ SRC/stgexc.f | 24 ++++-- SRC/stgsen.f | 33 ++++--- SRC/stgsja.f | 32 ++++--- SRC/stgsna.f | 21 +++-- SRC/stgsy2.f | 72 ++++++++++------ SRC/stgsyl.f | 18 ++-- SRC/stpcon.f | 6 +- SRC/stpmlqt.f | 3 +- SRC/stpmqrt.f | 3 +- SRC/stprfb.f | 6 +- SRC/stprfs.f | 12 ++- SRC/stptrs.f | 6 +- SRC/strcon.f | 6 +- SRC/strevc.f | 39 ++++++--- SRC/strevc3.f | 93 +++++++++++++------- SRC/strexc.f | 21 +++-- SRC/strrfs.f | 12 ++- SRC/strsen.f | 12 ++- SRC/strsna.f | 27 ++++-- SRC/strsyl.f | 9 +- SRC/strsyl3.f | 9 +- SRC/strtri.f | 6 +- SRC/strtrs.f | 6 +- SRC/stzrzf.f | 3 +- SRC/zbbcsd.f | 36 +++++--- SRC/zbdsqr.f | 39 ++++++--- SRC/zcgesv.f | 12 ++- SRC/zcposv.f | 9 +- SRC/zgbbrd.f | 13 ++- SRC/zgbcon.f | 15 ++-- SRC/zgbequ.f | 3 +- SRC/zgbequb.f | 3 +- SRC/zgbrfs.f | 12 ++- SRC/zgbrfsx.f | 24 ++++-- SRC/zgbsv.f | 6 +- SRC/zgbsvx.f | 16 ++-- SRC/zgbsvxx.f | 12 ++- SRC/zgbtf2.f | 3 +- SRC/zgbtrf.f | 24 ++++-- SRC/zgbtrs.f | 18 ++-- SRC/zgebak.f | 6 +- SRC/zgebal.f | 15 ++-- SRC/zgebrd.f | 6 +- SRC/zgecon.f | 9 +- SRC/zgees.f | 18 ++-- SRC/zgeesx.f | 24 ++++-- SRC/zgeev.f | 39 ++++++--- SRC/zgeevx.f | 45 ++++++---- SRC/zgehd2.f | 3 +- SRC/zgehrd.f | 6 +- SRC/zgejsv.f | 122 +++++++++++++++++--------- SRC/zgelq2.f | 3 +- SRC/zgelqf.f | 3 +- SRC/zgels.f | 30 ++++--- SRC/zgelsd.f | 57 ++++++++----- SRC/zgelss.f | 85 +++++++++++------- SRC/zgelst.f | 27 ++++-- SRC/zgelsy.f | 27 ++++-- SRC/zgeqlf.f | 6 +- SRC/zgeqp3.f | 9 +- SRC/zgeqrt.f | 6 +- SRC/zgerfs.f | 9 +- SRC/zgerfsx.f | 21 +++-- SRC/zgerqf.f | 3 +- SRC/zgesdd.f | 171 ++++++++++++++++++++++++------------- SRC/zgesvd.f | 159 ++++++++++++++++++++++------------ SRC/zgesvdq.f | 117 ++++++++++++++++--------- SRC/zgesvdx.f | 33 ++++--- SRC/zgesvj.f | 71 ++++++++++----- SRC/zgesvx.f | 16 ++-- SRC/zgesvxx.f | 6 +- SRC/zgetrf.f | 12 ++- SRC/zgetri.f | 9 +- SRC/zgetrs.f | 6 +- SRC/zgetsqrhrt.f | 9 +- SRC/zggbak.f | 9 +- SRC/zggbal.f | 12 ++- SRC/zgges.f | 21 +++-- SRC/zgges3.f | 15 ++-- SRC/zggesx.f | 18 ++-- SRC/zggev.f | 9 +- SRC/zggev3.f | 9 +- SRC/zggevx.f | 24 ++++-- SRC/zggglm.f | 15 ++-- SRC/zgghd3.f | 30 ++++--- SRC/zgghrd.f | 9 +- SRC/zgglse.f | 12 ++- SRC/zggqrf.f | 3 +- SRC/zggsvd3.f | 3 +- SRC/zggsvp3.f | 33 ++++--- SRC/zgsvj0.f | 45 ++++++---- SRC/zgsvj1.f | 27 ++++-- SRC/zgtrfs.f | 18 ++-- SRC/zgtsvx.f | 12 ++- SRC/zgttrs.f | 6 +- SRC/zgtts2.f | 3 +- SRC/zhb2st_kernels.f | 3 +- SRC/zhbev.f | 9 +- SRC/zhbev_2stage.f | 12 ++- SRC/zhbevd.f | 15 ++-- SRC/zhbevd_2stage.f | 24 ++++-- SRC/zhbevx.f | 12 ++- SRC/zhbevx_2stage.f | 9 +- SRC/zhbgst.f | 42 ++++++--- SRC/zhbgv.f | 6 +- SRC/zhbgvd.f | 9 +- SRC/zhbgvx.f | 3 +- SRC/zhbtrd.f | 30 ++++--- SRC/zhecon_rook.f | 3 +- SRC/zheequb.f | 6 +- SRC/zheev.f | 6 +- SRC/zheev_2stage.f | 18 ++-- SRC/zheevd.f | 9 +- SRC/zheevd_2stage.f | 6 +- SRC/zheevr.f | 9 +- SRC/zheevr_2stage.f | 9 +- SRC/zheevx.f | 12 ++- SRC/zheevx_2stage.f | 6 +- SRC/zhegs2.f | 21 +++-- SRC/zhegst.f | 21 +++-- SRC/zhegv.f | 15 ++-- SRC/zhegv_2stage.f | 24 ++++-- SRC/zhegvd.f | 9 +- SRC/zhegvx.f | 12 ++- SRC/zherfs.f | 15 ++-- SRC/zherfsx.f | 18 ++-- SRC/zhesv.f | 3 +- SRC/zhesv_aa_2stage.f | 3 +- SRC/zhesv_rk.f | 12 ++- SRC/zhesv_rook.f | 9 +- SRC/zhesvx.f | 12 ++- SRC/zhesvxx.f | 15 ++-- SRC/zhetd2.f | 9 +- SRC/zhetf2.f | 12 ++- SRC/zhetf2_rk.f | 18 ++-- SRC/zhetf2_rook.f | 15 ++-- SRC/zhetrd.f | 3 +- SRC/zhetrd_he2hb.f | 6 +- SRC/zhetrf.f | 12 ++- SRC/zhetrf_aa.f | 6 +- SRC/zhetrf_aa_2stage.f | 6 +- SRC/zhetrf_rk.f | 3 +- SRC/zhetrf_rook.f | 3 +- SRC/zhetri.f | 27 ++++-- SRC/zhetri2x.f | 18 ++-- SRC/zhetri_3x.f | 18 ++-- SRC/zhetri_rook.f | 36 +++++--- SRC/zhetrs.f | 15 ++-- SRC/zhetrs2.f | 3 +- SRC/zhetrs_3.f | 12 ++- SRC/zhetrs_aa.f | 27 ++++-- SRC/zhetrs_aa_2stage.f | 12 ++- SRC/zhetrs_rook.f | 15 ++-- SRC/zhfrk.f | 75 ++++++++++------ SRC/zhgeqz.f | 24 ++++-- SRC/zhpcon.f | 3 +- SRC/zhpev.f | 6 +- SRC/zhpevd.f | 12 ++- SRC/zhpevx.f | 9 +- SRC/zhpgst.f | 12 ++- SRC/zhpgv.f | 6 +- SRC/zhpgvd.f | 6 +- SRC/zhpgvx.f | 6 +- SRC/zhprfs.f | 6 +- SRC/zhpsv.f | 3 +- SRC/zhpsvx.f | 12 ++- SRC/zhptrd.f | 9 +- SRC/zhptrf.f | 3 +- SRC/zhptri.f | 21 +++-- SRC/zhptrs.f | 6 +- SRC/zhsein.f | 12 ++- SRC/zhseqr.f | 21 +++-- SRC/zla_gbrfsx_extended.f | 9 +- SRC/zla_geamv.f | 3 +- SRC/zla_gercond_c.f | 6 +- SRC/zla_gercond_x.f | 6 +- SRC/zla_gerfsx_extended.f | 12 ++- SRC/zla_herfsx_extended.f | 9 +- SRC/zla_herpvgrw.f | 3 +- SRC/zla_porfsx_extended.f | 9 +- SRC/zla_porpvgrw.f | 3 +- SRC/zla_syrfsx_extended.f | 9 +- SRC/zla_syrpvgrw.f | 3 +- SRC/zlabrd.f | 33 ++++--- SRC/zlaed0.f | 3 +- SRC/zlaed7.f | 9 +- SRC/zlaed8.f | 12 ++- SRC/zlaein.f | 9 +- SRC/zlags2.f | 27 ++++-- SRC/zlagtm.f | 3 +- SRC/zlahef.f | 21 +++-- SRC/zlahef_aa.f | 4 +- SRC/zlahef_rk.f | 24 ++++-- SRC/zlahef_rook.f | 24 ++++-- SRC/zlahqr.f | 6 +- SRC/zlahr2.f | 6 +- SRC/zlals0.f | 24 ++++-- SRC/zlalsa.f | 24 ++++-- SRC/zlalsd.f | 21 +++-- SRC/zlangb.f | 6 +- SRC/zlange.f | 3 +- SRC/zlangt.f | 9 +- SRC/zlanhb.f | 9 +- SRC/zlanhe.f | 6 +- SRC/zlanhf.f | 42 ++++++--- SRC/zlanhp.f | 6 +- SRC/zlanhs.f | 3 +- SRC/zlanht.f | 3 +- SRC/zlansb.f | 9 +- SRC/zlansp.f | 6 +- SRC/zlansy.f | 6 +- SRC/zlantb.f | 24 ++++-- SRC/zlantp.f | 18 ++-- SRC/zlantr.f | 24 ++++-- SRC/zlaqgb.f | 3 +- SRC/zlaqhb.f | 3 +- SRC/zlaqp2.f | 3 +- SRC/zlaqps.f | 18 ++-- SRC/zlaqr0.f | 6 +- SRC/zlaqr2.f | 27 ++++-- SRC/zlaqr3.f | 36 +++++--- SRC/zlaqr4.f | 3 +- SRC/zlaqr5.f | 6 +- SRC/zlaqsb.f | 3 +- SRC/zlaqz0.f | 30 ++++--- SRC/zlaqz1.f | 18 ++-- SRC/zlaqz2.f | 30 ++++--- SRC/zlaqz3.f | 54 ++++++++---- SRC/zlarf.f | 6 +- SRC/zlarfb.f | 75 ++++++++++------ SRC/zlarfgp.f | 3 +- SRC/zlarft.f | 9 +- SRC/zlarrv.f | 3 +- SRC/zlarz.f | 9 +- SRC/zlarzb.f | 12 ++- SRC/zlascl.f | 3 +- SRC/zlasr.f | 6 +- SRC/zlasyf.f | 21 +++-- SRC/zlasyf_aa.f | 3 +- SRC/zlasyf_rk.f | 24 ++++-- SRC/zlasyf_rook.f | 24 ++++-- SRC/zlatbs.f | 6 +- SRC/zlatdf.f | 6 +- SRC/zlatps.f | 6 +- SRC/zlatrd.f | 15 ++-- SRC/zlatrs.f | 12 ++- SRC/zlatrs3.f | 18 ++-- SRC/zlaunhr_col_getrfnp.f | 9 +- SRC/zlaunhr_col_getrfnp2.f | 6 +- SRC/zlauu2.f | 9 +- SRC/zlauum.f | 3 +- SRC/zpbcon.f | 6 +- SRC/zpbequ.f | 3 +- SRC/zpbrfs.f | 9 +- SRC/zpbsv.f | 3 +- SRC/zpbsvx.f | 19 +++-- SRC/zpbtrf.f | 21 +++-- SRC/zpbtrs.f | 12 ++- SRC/zpftrf.f | 24 ++++-- SRC/zpftri.f | 30 ++++--- SRC/zpftrs.f | 12 ++- SRC/zpocon.f | 6 +- SRC/zporfs.f | 6 +- SRC/zporfsx.f | 12 ++- SRC/zposv.f | 3 +- SRC/zposvx.f | 16 ++-- SRC/zposvxx.f | 3 +- SRC/zpotf2.f | 6 +- SRC/zpotrf.f | 9 +- SRC/zpotri.f | 3 +- SRC/zpotrs.f | 6 +- SRC/zppcon.f | 9 +- SRC/zpprfs.f | 9 +- SRC/zppsv.f | 3 +- SRC/zppsvx.f | 16 ++-- SRC/zpptrf.f | 3 +- SRC/zpptri.f | 6 +- SRC/zpptrs.f | 6 +- SRC/zpstf2.f | 12 ++- SRC/zpstrf.f | 12 ++- SRC/zptsvx.f | 6 +- SRC/zrscl.f | 3 +- SRC/zspcon.f | 3 +- SRC/zspmv.f | 3 +- SRC/zspr.f | 3 +- SRC/zsprfs.f | 6 +- SRC/zspsv.f | 3 +- SRC/zspsvx.f | 12 ++- SRC/zsptrf.f | 3 +- SRC/zsptri.f | 21 +++-- SRC/zsptrs.f | 9 +- SRC/zstedc.f | 18 ++-- SRC/zstein.f | 9 +- SRC/zstemr.f | 3 +- SRC/zsteqr.f | 27 ++++-- SRC/zsycon_rook.f | 3 +- SRC/zsyequb.f | 6 +- SRC/zsymv.f | 6 +- SRC/zsyr.f | 3 +- SRC/zsyrfs.f | 15 ++-- SRC/zsyrfsx.f | 18 ++-- SRC/zsysv.f | 3 +- SRC/zsysv_aa.f | 3 +- SRC/zsysv_rk.f | 12 ++- SRC/zsysv_rook.f | 9 +- SRC/zsysvx.f | 12 ++- SRC/zsysvxx.f | 9 +- SRC/zsytf2.f | 6 +- SRC/zsytf2_rk.f | 27 ++++-- SRC/zsytf2_rook.f | 24 ++++-- SRC/zsytrf.f | 12 ++- SRC/zsytrf_aa.f | 3 +- SRC/zsytrf_aa_2stage.f | 3 +- SRC/zsytrf_rk.f | 3 +- SRC/zsytrf_rook.f | 3 +- SRC/zsytri.f | 30 ++++--- SRC/zsytri2x.f | 18 ++-- SRC/zsytri_3x.f | 18 ++-- SRC/zsytri_rook.f | 57 ++++++++----- SRC/zsytrs.f | 18 ++-- SRC/zsytrs2.f | 3 +- SRC/zsytrs_3.f | 12 ++- SRC/zsytrs_aa.f | 30 ++++--- SRC/zsytrs_aa_2stage.f | 12 ++- SRC/zsytrs_rook.f | 21 +++-- SRC/ztbcon.f | 9 +- SRC/ztbrfs.f | 3 +- SRC/ztbtrs.f | 6 +- SRC/ztfsm.f | 81 ++++++++++++------ SRC/ztftri.f | 36 +++++--- SRC/ztgevc.f | 3 +- SRC/ztgex2.f | 9 +- SRC/ztgexc.f | 6 +- SRC/ztgsen.f | 30 ++++--- SRC/ztgsja.f | 32 ++++--- SRC/ztgsna.f | 15 ++-- SRC/ztgsy2.f | 18 ++-- SRC/ztgsyl.f | 24 ++++-- SRC/ztpcon.f | 6 +- SRC/ztpmlqt.f | 3 +- SRC/ztpmqrt.f | 3 +- SRC/ztprfb.f | 6 +- SRC/ztprfs.f | 6 +- SRC/ztptrs.f | 6 +- SRC/ztrcon.f | 3 +- SRC/ztrevc.f | 15 ++-- SRC/ztrevc3.f | 18 ++-- SRC/ztrexc.f | 3 +- SRC/ztrrfs.f | 6 +- SRC/ztrsen.f | 6 +- SRC/ztrsna.f | 15 ++-- SRC/ztrsyl.f | 3 +- SRC/ztrsyl3.f | 9 +- SRC/ztrtri.f | 6 +- SRC/ztrtrs.f | 6 +- SRC/ztzrzf.f | 3 +- SRC/zunbdb.f | 66 +++++++++----- SRC/zunbdb1.f | 12 ++- SRC/zunbdb2.f | 15 ++-- SRC/zunbdb3.f | 9 +- SRC/zunbdb4.f | 24 ++++-- SRC/zunbdb5.f | 3 +- SRC/zunbdb6.f | 15 ++-- SRC/zuncsd.f | 27 ++++-- SRC/zuncsd2by1.f | 45 ++++++---- SRC/zung2l.f | 3 +- SRC/zungbr.f | 3 +- SRC/zunghr.f | 3 +- SRC/zunglq.f | 12 ++- SRC/zungql.f | 3 +- SRC/zungqr.f | 6 +- SRC/zungrq.f | 9 +- SRC/zungtr.f | 3 +- SRC/zunhr_col.f | 3 +- SRC/zunm22.f | 27 ++++-- SRC/zunm2r.f | 3 +- SRC/zunmbr.f | 15 ++-- SRC/zunmhr.f | 3 +- SRC/zunmlq.f | 12 ++- SRC/zunmql.f | 12 ++- SRC/zunmqr.f | 15 ++-- SRC/zunmr2.f | 3 +- SRC/zunmr3.f | 3 +- SRC/zunmrq.f | 9 +- SRC/zunmrz.f | 12 ++- SRC/zunmtr.f | 9 +- SRC/zupmtr.f | 3 +- 1414 files changed, 14437 insertions(+), 7213 deletions(-) diff --git a/SRC/cbbcsd.f b/SRC/cbbcsd.f index 21188d9304..b8b61e71bf 100644 --- a/SRC/cbbcsd.f +++ b/SRC/cbbcsd.f @@ -326,7 +326,8 @@ *> \ingroup bbcsd * * ===================================================================== - SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, + $ Q, $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T, $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) @@ -373,7 +374,8 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ UNFL, X1, X2, Y1, Y2 * * .. External Subroutines .. - EXTERNAL CLASR, CSCAL, CSWAP, SLARTGP, SLARTGS, SLAS2, + EXTERNAL CLASR, CSCAL, CSWAP, SLARTGP, SLARTGS, + $ SLAS2, $ XERBLA * .. * .. External Functions .. @@ -560,9 +562,11 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * * Compute shifts for B11 and B21 and use the lesser * - CALL SLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11, + CALL SLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), + $ SIGMA11, $ DUMMY ) - CALL SLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21, + CALL SLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), + $ SIGMA21, $ DUMMY ) * IF( SIGMA11 .LE. SIGMA21 ) THEN @@ -719,10 +723,12 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL SLARTGP( Y2, Y1, RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN - CALL SLARTGP( B12BULGE, B12D(I-1), RWORK(IV2TSN+I-1-1), + CALL SLARTGP( B12BULGE, B12D(I-1), + $ RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN - CALL SLARTGP( B22BULGE, B22D(I-1), RWORK(IV2TSN+I-1-1), + CALL SLARTGP( B22BULGE, B22D(I-1), + $ RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( NU .LT. MU ) THEN CALL SLARTGS( B12E(I-1), B12D(I), NU, @@ -781,7 +787,8 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN - CALL SLARTGP( X2, X1, RWORK(IU1SN+I-1), RWORK(IU1CS+I-1), + CALL SLARTGP( X2, X1, RWORK(IU1SN+I-1), + $ RWORK(IU1CS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN CALL SLARTGP( B11BULGE, B11D(I), RWORK(IU1SN+I-1), @@ -790,14 +797,16 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL SLARTGP( B12BULGE, B12E(I-1), RWORK(IU1SN+I-1), $ RWORK(IU1CS+I-1), R ) ELSE IF( MU .LE. NU ) THEN - CALL SLARTGS( B11E(I), B11D(I+1), MU, RWORK(IU1CS+I-1), + CALL SLARTGS( B11E(I), B11D(I+1), MU, + $ RWORK(IU1CS+I-1), $ RWORK(IU1SN+I-1) ) ELSE CALL SLARTGS( B12D(I), B12E(I), NU, RWORK(IU1CS+I-1), $ RWORK(IU1SN+I-1) ) END IF IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN - CALL SLARTGP( Y2, Y1, RWORK(IU2SN+I-1), RWORK(IU2CS+I-1), + CALL SLARTGP( Y2, Y1, RWORK(IU2SN+I-1), + $ RWORK(IU2CS+I-1), $ R ) ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN CALL SLARTGP( B21BULGE, B21D(I), RWORK(IU2SN+I-1), @@ -806,7 +815,8 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL SLARTGP( B22BULGE, B22E(I-1), RWORK(IU2SN+I-1), $ RWORK(IU2CS+I-1), R ) ELSE IF( NU .LT. MU ) THEN - CALL SLARTGS( B21E(I), B21E(I+1), NU, RWORK(IU2CS+I-1), + CALL SLARTGS( B21E(I), B21E(I+1), NU, + $ RWORK(IU2CS+I-1), $ RWORK(IU2SN+I-1) ) ELSE CALL SLARTGS( B22D(I), B22E(I), MU, RWORK(IU2CS+I-1), @@ -992,7 +1002,8 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( B12D(IMAX)+B22D(IMAX) .LT. 0 ) THEN IF( WANTV2T ) THEN IF( COLMAJOR ) THEN - CALL CSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), LDV2T ) + CALL CSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), + $ LDV2T ) ELSE CALL CSCAL( M-Q, NEGONECOMPLEX, V2T(1,IMAX), 1 ) END IF @@ -1059,7 +1070,8 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( WANTU2 ) $ CALL CSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 ) IF( WANTV1T ) - $ CALL CSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T ) + $ CALL CSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), + $ LDV1T ) IF( WANTV2T ) $ CALL CSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1), $ LDV2T ) diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index 8a9a9086c8..3aeb0bc78c 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -280,7 +280,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, EXTERNAL LSAME, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CLASR, CSROT, CSSCAL, CSWAP, SLARTG, SLAS2, + EXTERNAL CLASR, CSROT, CSSCAL, CSWAP, SLARTG, + $ SLAS2, $ SLASQ1, SLASV2, XERBLA * .. * .. Intrinsic Functions .. @@ -361,10 +362,12 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NRU.GT.0 ) - $ CALL CLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), RWORK( N ), + $ CALL CLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), + $ RWORK( N ), $ U, LDU ) IF( NCC.GT.0 ) - $ CALL CLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), RWORK( N ), + $ CALL CLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), + $ RWORK( N ), $ C, LDC ) END IF * @@ -488,7 +491,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL CSROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, $ COSR, SINR ) IF( NRU.GT.0 ) - $ CALL CSROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL ) + $ CALL CSROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, + $ SINL ) IF( NCC.GT.0 ) $ CALL CSROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL, $ SINL ) @@ -621,7 +625,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL SLARTG( D( I )*CS, E( I ), CS, SN, R ) IF( I.GT.LL ) $ E( I-1 ) = OLDSN*R - CALL SLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL SLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, + $ D( I ) ) RWORK( I-LL+1 ) = CS RWORK( I-LL+1+NM1 ) = SN RWORK( I-LL+1+NM12 ) = OLDCS @@ -637,10 +642,12 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ), $ RWORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL CLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ), + $ CALL CLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ), + $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -659,7 +666,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL SLARTG( D( I )*CS, E( I-1 ), CS, SN, R ) IF( I.LT.M ) $ E( I ) = OLDSN*R - CALL SLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL SLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, + $ D( I ) ) RWORK( I-LL ) = CS RWORK( I-LL+NM1 ) = -SN RWORK( I-LL+NM12 ) = OLDCS @@ -672,7 +680,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors * IF( NCVT.GT.0 ) - $ CALL CLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ), + $ CALL CLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL CLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ), @@ -727,10 +736,12 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ), $ RWORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL CLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ), + $ CALL CLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ), + $ CALL CLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -777,7 +788,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NCVT.GT.0 ) - $ CALL CLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ), + $ CALL CLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL CLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ), @@ -833,7 +845,8 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, IF( NRU.GT.0 ) $ CALL CSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 ) IF( NCC.GT.0 ) - $ CALL CSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC ) + $ CALL CSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), + $ LDC ) END IF 190 CONTINUE GO TO 220 diff --git a/SRC/cgbbrd.f b/SRC/cgbbrd.f index 8c12e1e7ce..f02ab881e3 100644 --- a/SRC/cgbbrd.f +++ b/SRC/cgbbrd.f @@ -223,7 +223,8 @@ SUBROUTINE CGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, COMPLEX RA, RB, RS, T * .. * .. External Subroutines .. - EXTERNAL CLARGV, CLARTG, CLARTV, CLASET, CROT, CSCAL, + EXTERNAL CLARGV, CLARTG, CLARTV, CLASET, CROT, + $ CSCAL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -243,7 +244,9 @@ SUBROUTINE CGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, WANTC = NCC.GT.0 KLU1 = KL + KU + 1 INFO = 0 - IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) ) + IF( .NOT.WANTQ .AND. + $ .NOT.WANTPT .AND. + $ .NOT.LSAME( VECT, 'N' ) ) $ THEN INFO = -1 ELSE IF( M.LT.0 ) THEN @@ -339,7 +342,8 @@ SUBROUTINE CGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL CLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA, + $ CALL CLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), + $ INCA, $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA, $ RWORK( J1 ), WORK( J1 ), KB1 ) 10 CONTINUE @@ -378,7 +382,8 @@ SUBROUTINE CGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, * apply plane rotations to C * DO 30 J = J1, J2, KB1 - CALL CROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC, + CALL CROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), + $ LDC, $ RWORK( J ), WORK( J ) ) 30 CONTINUE END IF diff --git a/SRC/cgbcon.f b/SRC/cgbcon.f index 023ffd11f0..0fa4ce3bfa 100644 --- a/SRC/cgbcon.f +++ b/SRC/cgbcon.f @@ -143,7 +143,8 @@ *> \ingroup gbcon * * ===================================================================== - SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, + SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, + $ RCOND, $ WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -185,7 +186,8 @@ SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, EXTERNAL LSAME, ICAMAX, SLAMCH, CDOTC * .. * .. External Subroutines .. - EXTERNAL CAXPY, CLACN2, CLATBS, CSRSCL, XERBLA + EXTERNAL CAXPY, CLACN2, CLATBS, CSRSCL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MIN, REAL @@ -260,13 +262,15 @@ SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK( JP ) = WORK( J ) WORK( J ) = T END IF - CALL CAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 ) + CALL CAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), + $ 1 ) 20 CONTINUE END IF * * Multiply by inv(U). * - CALL CLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KL+KU, AB, LDAB, WORK, SCALE, RWORK, INFO ) ELSE * @@ -281,7 +285,8 @@ SUBROUTINE CGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, IF( LNOTI ) THEN DO 30 J = N - 1, 1, -1 LM = MIN( KL, N-J ) - WORK( J ) = WORK( J ) - CDOTC( LM, AB( KD+1, J ), 1, + WORK( J ) = WORK( J ) - CDOTC( LM, AB( KD+1, J ), + $ 1, $ WORK( J+1 ), 1 ) JP = IPIV( J ) IF( JP.NE.J ) THEN diff --git a/SRC/cgbequ.f b/SRC/cgbequ.f index ffcf335e8a..fb749583f6 100644 --- a/SRC/cgbequ.f +++ b/SRC/cgbequ.f @@ -150,7 +150,8 @@ *> \ingroup gbequ * * ===================================================================== - SUBROUTINE CGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE CGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/cgbequb.f b/SRC/cgbequb.f index 69bcc0069b..e625d3f706 100644 --- a/SRC/cgbequb.f +++ b/SRC/cgbequb.f @@ -157,7 +157,8 @@ *> \ingroup gbequb * * ===================================================================== - SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/cgbrfs.f b/SRC/cgbrfs.f index a5f576b8e3..2217b1ed20 100644 --- a/SRC/cgbrfs.f +++ b/SRC/cgbrfs.f @@ -201,7 +201,8 @@ *> \ingroup gbrfs * * ===================================================================== - SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, $ INFO ) * @@ -245,7 +246,8 @@ SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGBMV, CGBTRS, CLACN2, XERBLA + EXTERNAL CAXPY, CCOPY, CGBMV, CGBTRS, CLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, MIN, REAL @@ -332,7 +334,8 @@ SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ), 1, + CALL CGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ), + $ 1, $ CONE, WORK, 1 ) * * Compute componentwise relative backward error from formula @@ -390,7 +393,8 @@ SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * * Update solution and try again. * - CALL CGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK, N, + CALL CGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK, + $ N, $ INFO ) CALL CAXPY( N, CONE, WORK, 1, X( 1, J ), 1 ) LSTRES = BERR( J ) diff --git a/SRC/cgbrfsx.f b/SRC/cgbrfsx.f index b7db93b27b..0d6949a3cd 100644 --- a/SRC/cgbrfsx.f +++ b/SRC/cgbrfsx.f @@ -433,7 +433,8 @@ *> \ingroup gbrfsx * * ===================================================================== - SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, @@ -497,7 +498,8 @@ SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, * .. * .. External Functions .. EXTERNAL LSAME, ILATRANS, ILAPREC - EXTERNAL SLAMCH, CLANGB, CLA_GBRCOND_X, CLA_GBRCOND_C + EXTERNAL SLAMCH, CLANGB, CLA_GBRCOND_X, + $ CLA_GBRCOND_C REAL SLAMCH, CLANGB, CLA_GBRCOND_X, CLA_GBRCOND_C LOGICAL LSAME INTEGER ILATRANS, ILAPREC @@ -644,7 +646,8 @@ SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, PREC_TYPE = ILAPREC( 'D' ) IF ( NOTRAN ) THEN - CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1), @@ -652,7 +655,8 @@ SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE, $ INFO ) ELSE - CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1), @@ -668,13 +672,16 @@ SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, C, .TRUE., INFO, WORK, RWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, C, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/cgbsv.f b/SRC/cgbsv.f index 8cfc35a2dd..68635a8498 100644 --- a/SRC/cgbsv.f +++ b/SRC/cgbsv.f @@ -159,7 +159,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) + SUBROUTINE CGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE CGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) * * Solve the system A*X = B, overwriting B with X. * - CALL CGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV, + CALL CGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, + $ IPIV, $ B, LDB, INFO ) END IF RETURN diff --git a/SRC/cgbsvx.f b/SRC/cgbsvx.f index 95fa154b5d..8a39944121 100644 --- a/SRC/cgbsvx.f +++ b/SRC/cgbsvx.f @@ -408,7 +408,8 @@ SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, EXTERNAL LSAME, CLANGB, CLANTB, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGBCON, CGBEQU, CGBRFS, CGBTRF, CGBTRS, + EXTERNAL CCOPY, CGBCON, CGBEQU, CGBRFS, CGBTRF, + $ CGBTRS, $ CLACPY, CLAQGB, XERBLA * .. * .. Intrinsic Functions .. @@ -433,7 +434,9 @@ SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -509,7 +512,8 @@ SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL CLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL CLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -560,7 +564,8 @@ SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) 80 CONTINUE 90 CONTINUE - RPVGRW = CLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), + RPVGRW = CLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, + $ KL+KU ), $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, $ RWORK ) IF( RPVGRW.EQ.ZERO ) THEN @@ -604,7 +609,8 @@ SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, + CALL CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/cgbsvxx.f b/SRC/cgbsvxx.f index 4cfca65d26..a52e38beb1 100644 --- a/SRC/cgbsvxx.f +++ b/SRC/cgbsvxx.f @@ -556,7 +556,8 @@ *> \ingroup gbsvxx * * ===================================================================== - SUBROUTINE CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, $ RCOND, RPVGRW, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, @@ -607,7 +608,8 @@ SUBROUTINE CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, REAL SLAMCH, CLA_GBRPVGRW * .. * .. External Subroutines .. - EXTERNAL CGBEQUB, CGBTRF, CGBTRS, CLACPY, CLAQGB, + EXTERNAL CGBEQUB, CGBTRF, CGBTRS, CLACPY, + $ CLAQGB, $ XERBLA, CLASCL2, CGBRFSX * .. * .. Intrinsic Functions .. @@ -714,7 +716,8 @@ SUBROUTINE CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL CLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL CLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -780,7 +783,8 @@ SUBROUTINE CGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + CALL CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) diff --git a/SRC/cgbtf2.f b/SRC/cgbtf2.f index c8cc452767..156cddf11c 100644 --- a/SRC/cgbtf2.f +++ b/SRC/cgbtf2.f @@ -250,7 +250,8 @@ SUBROUTINE CGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers. * - CALL CSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 ) + CALL CSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), + $ 1 ) * * Update trailing submatrix within the band. * diff --git a/SRC/cgbtrf.f b/SRC/cgbtrf.f index e34cb59811..8d9930d557 100644 --- a/SRC/cgbtrf.f +++ b/SRC/cgbtrf.f @@ -178,7 +178,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) EXTERNAL ICAMAX, ILAENV * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGBTF2, CGEMM, CGERU, CLASWP, CSCAL, + EXTERNAL CCOPY, CGBTF2, CGEMM, CGERU, CLASWP, + $ CSCAL, $ CSWAP, CTRSM, XERBLA * .. * .. Intrinsic Functions .. @@ -326,7 +327,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers * - CALL CSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ), + CALL CSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, + $ JJ ), $ 1 ) * * Update trailing submatrix within the band and within @@ -395,7 +397,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A12 * - CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL CTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J2, ONE, AB( KV+1, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1 ) * @@ -403,7 +406,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A22 * - CALL CGEMM( 'No transpose', 'No transpose', I2, J2, + CALL CGEMM( 'No transpose', 'No transpose', I2, + $ J2, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+1, J+JB ), LDAB-1 ) @@ -413,7 +417,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A32 * - CALL CGEMM( 'No transpose', 'No transpose', I3, J2, + CALL CGEMM( 'No transpose', 'No transpose', I3, + $ J2, $ JB, -ONE, WORK31, LDWORK, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+KL+1-JB, J+JB ), LDAB-1 ) @@ -433,7 +438,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A13 in the work array * - CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL CTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J3, ONE, AB( KV+1, J ), LDAB-1, $ WORK13, LDWORK ) * @@ -441,7 +447,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A23 * - CALL CGEMM( 'No transpose', 'No transpose', I2, J3, + CALL CGEMM( 'No transpose', 'No transpose', I2, + $ J3, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ), $ LDAB-1 ) @@ -451,7 +458,8 @@ SUBROUTINE CGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A33 * - CALL CGEMM( 'No transpose', 'No transpose', I3, J3, + CALL CGEMM( 'No transpose', 'No transpose', I3, + $ J3, $ JB, -ONE, WORK31, LDWORK, WORK13, $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 ) END IF diff --git a/SRC/cgbtrs.f b/SRC/cgbtrs.f index 23591896f1..2b813a8f78 100644 --- a/SRC/cgbtrs.f +++ b/SRC/cgbtrs.f @@ -134,7 +134,8 @@ *> \ingroup gbtrs * * ===================================================================== - SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -165,7 +166,8 @@ SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMV, CGERU, CLACGV, CSWAP, CTBSV, XERBLA + EXTERNAL CGEMV, CGERU, CLACGV, CSWAP, CTBSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -222,7 +224,8 @@ SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, L = IPIV( J ) IF( L.NE.J ) $ CALL CSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) - CALL CGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ), + CALL CGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, + $ 1 ), $ LDB, B( J+1, 1 ), LDB ) 10 CONTINUE END IF @@ -231,7 +234,8 @@ SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U*X = B, overwriting B with X. * - CALL CTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU, + CALL CTBSV( 'Upper', 'No transpose', 'Non-unit', N, + $ KL+KU, $ AB, LDAB, B( 1, I ), 1 ) 20 CONTINUE * @@ -243,7 +247,8 @@ SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**T * X = B, overwriting B with X. * - CALL CTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB, + CALL CTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, + $ AB, $ LDAB, B( 1, I ), 1 ) 30 CONTINUE * @@ -268,7 +273,8 @@ SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**H * X = B, overwriting B with X. * - CALL CTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL CTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ KL+KU, AB, LDAB, B( 1, I ), 1 ) 50 CONTINUE * diff --git a/SRC/cgebak.f b/SRC/cgebak.f index e16506b20c..c0e64a1c4f 100644 --- a/SRC/cgebak.f +++ b/SRC/cgebak.f @@ -172,8 +172,10 @@ SUBROUTINE CGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/cgebal.f b/SRC/cgebal.f index 24c812306d..7e80636697 100644 --- a/SRC/cgebal.f +++ b/SRC/cgebal.f @@ -197,7 +197,8 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) LOGICAL SISNAN, LSAME INTEGER ICAMAX REAL SLAMCH, SCNRM2 - EXTERNAL SISNAN, LSAME, ICAMAX, SLAMCH, SCNRM2 + EXTERNAL SISNAN, LSAME, ICAMAX, SLAMCH, + $ SCNRM2 * .. * .. External Subroutines .. EXTERNAL XERBLA, CSSCAL, CSWAP @@ -208,8 +209,10 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -267,7 +270,8 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( L ) = I IF( I.NE.L ) THEN CALL CSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) - CALL CSWAP( N-K+1, A( I, K ), LDA, A( L, K ), LDA ) + CALL CSWAP( N-K+1, A( I, K ), LDA, A( L, K ), + $ LDA ) END IF NOCONV = .TRUE. * @@ -303,7 +307,8 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( K ) = J IF( J.NE.K ) THEN CALL CSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) - CALL CSWAP( N-K+1, A( J, K ), LDA, A( K, K ), LDA ) + CALL CSWAP( N-K+1, A( J, K ), LDA, A( K, K ), + $ LDA ) END IF NOCONV = .TRUE. * diff --git a/SRC/cgebrd.f b/SRC/cgebrd.f index 5e4528f53e..cfb7476400 100644 --- a/SRC/cgebrd.f +++ b/SRC/cgebrd.f @@ -318,7 +318,8 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * the matrices X and Y which are needed to update the unreduced * part of the matrix * - CALL CLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ), + CALL CLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), + $ E( I ), $ TAUQ( I ), TAUP( I ), WORK, LDWRKX, $ WORK( LDWRKX*NB+1 ), LDWRKY ) * @@ -329,7 +330,8 @@ SUBROUTINE CGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ N-I-NB+1, NB, -ONE, A( I+NB, I ), LDA, $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE, $ A( I+NB, I+NB ), LDA ) - CALL CGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1, + CALL CGEMM( 'No transpose', 'No transpose', M-I-NB+1, + $ N-I-NB+1, $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA, $ ONE, A( I+NB, I+NB ), LDA ) * diff --git a/SRC/cgecon.f b/SRC/cgecon.f index 43e8859e21..917d7fea39 100644 --- a/SRC/cgecon.f +++ b/SRC/cgecon.f @@ -237,12 +237,14 @@ SUBROUTINE CGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(L). * - CALL CLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A, + CALL CLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, + $ A, $ LDA, WORK, SL, RWORK, INFO ) * * Multiply by inv(U). * - CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SU, RWORK( N+1 ), INFO ) ELSE * @@ -254,7 +256,8 @@ SUBROUTINE CGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(L**H). * - CALL CLATRS( 'Lower', 'Conjugate transpose', 'Unit', NORMIN, + CALL CLATRS( 'Lower', 'Conjugate transpose', 'Unit', + $ NORMIN, $ N, A, LDA, WORK, SL, RWORK, INFO ) END IF * diff --git a/SRC/cgees.f b/SRC/cgees.f index 8f26a1229e..eea96744fa 100644 --- a/SRC/cgees.f +++ b/SRC/cgees.f @@ -230,7 +230,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, + EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, + $ CLACPY, $ CLASCL, CTRSEN, CUNGHR, XERBLA * .. * .. External Functions .. @@ -252,7 +253,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, WANTST = LSAME( SORT, 'S' ) IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -4 @@ -288,7 +290,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) ELSE - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'CUNGHR', $ ' ', N, 1, N, -1 ) ) MAXWRK = MAX( MAXWRK, HSWORK ) END IF @@ -362,7 +365,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -391,7 +395,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: none) * (RWorkspace: none) * - CALL CTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM, + CALL CTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, + $ SDIM, $ S, SEP, WORK( IWRK ), LWORK-IWRK+1, ICOND ) END IF * @@ -401,7 +406,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: none) * (RWorkspace: need N) * - CALL CGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS, + CALL CGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index 32e9ec48c4..d09028d7c2 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -234,7 +234,8 @@ *> \ingroup geesx * * ===================================================================== - SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, + SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, + $ W, $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * @@ -274,7 +275,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, + EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, + $ CLACPY, $ CLASCL, CTRSEN, CUNGHR, SLASCL, XERBLA * .. * .. External Functions .. @@ -301,7 +303,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -343,7 +346,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) ELSE - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'CUNGHR', $ ' ', N, 1, N, -1 ) ) MAXWRK = MAX( MAXWRK, HSWORK ) END IF @@ -421,7 +425,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -452,7 +457,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * otherwise, need none ) * (RWorkspace: none) * - CALL CTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM, + CALL CTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, W, + $ SDIM, $ RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1, $ ICOND ) IF( .NOT.WANTSN ) @@ -471,7 +477,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * (CWorkspace: none) * (RWorkspace: need N) * - CALL CGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS, + CALL CGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -483,7 +490,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, CALL CCOPY( N, A, LDA+1, W, 1 ) IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN DUM( 1 ) = RCONDV - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR ) + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, + $ IERR ) RCONDV = DUM( 1 ) END IF END IF diff --git a/SRC/cgeev.f b/SRC/cgeev.f index c4ff74868b..0789a785a3 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -176,7 +176,8 @@ *> \ingroup geev * * ===================================================================== - SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, + SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, + $ LDVR, $ WORK, LWORK, RWORK, INFO ) implicit none * @@ -213,7 +214,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, + EXTERNAL XERBLA, CSSCAL, CGEBAK, CGEBAL, + $ CGEHRD, $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR * .. * .. External Functions .. @@ -236,7 +238,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WANTVR = LSAME( JOBVR, 'V' ) IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 @@ -267,7 +270,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 ) MINWRK = 2*N IF( WANTVL ) THEN - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', + 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, @@ -277,7 +281,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', + 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, @@ -362,7 +367,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL @@ -394,7 +400,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR @@ -428,7 +435,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + 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 @@ -439,7 +447,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: none) * (RWorkspace: need N) * - CALL CGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, LDVL, + CALL CGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, + $ LDVL, $ IERR ) * * Normalize left eigenvectors and make largest component real @@ -464,7 +473,8 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: none) * (RWorkspace: need N) * - CALL CGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, LDVR, + CALL CGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, + $ LDVR, $ IERR ) * * Normalize right eigenvectors and make largest component real @@ -487,10 +497,12 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * 50 CONTINUE IF( SCALEA ) THEN - CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ), + CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ W( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.GT.0 ) THEN - CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR ) + CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, + $ IERR ) END IF END IF * diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index fad00bbf33..335df7e3a4 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -283,7 +283,8 @@ *> \ingroup geevx * * ===================================================================== - SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, + 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 @@ -324,7 +325,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, + EXTERNAL SLASCL, XERBLA, CSSCAL, CGEBAK, + $ CGEBAL, $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, $ CTRSNA, CUNGHR * .. @@ -350,12 +352,15 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR. + 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 + ELSE IF( ( .NOT.WANTVL ) .AND. + $ ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR. $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND. @@ -407,10 +412,12 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ WORK, -1, INFO ) ELSE IF( WNTSNN ) THEN - CALL CHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, + CALL CHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, + $ LDVR, $ WORK, -1, INFO ) ELSE - CALL CHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, LDVR, + CALL CHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, + $ LDVR, $ WORK, -1, INFO ) END IF END IF @@ -428,7 +435,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, IF( .NOT.( WNTSNN .OR. WNTSNE ) ) $ MINWRK = MAX( MINWRK, N*N + 2*N ) MAXWRK = MAX( MAXWRK, HSWORK ) - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'CUNGHR', $ ' ', N, 1, N, -1 ) ) IF( .NOT.( WNTSNN .OR. WNTSNE ) ) $ MAXWRK = MAX( MAXWRK, N*N + 2*N ) @@ -509,7 +517,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL @@ -541,7 +550,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL CUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL CUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR @@ -582,7 +592,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, $ RWORK, N, IERR ) END IF @@ -592,7 +603,8 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (RWorkspace: need 2*N unless SENSE = 'E') * IF( .NOT.WNTSNN ) THEN - CALL CTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL CTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, RWORK, $ ICOND ) END IF @@ -647,14 +659,16 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * 50 CONTINUE IF( SCALEA ) THEN - CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ), + CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ W( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.EQ.0 ) THEN IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 ) $ CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N, $ IERR ) ELSE - CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR ) + CALL CLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, + $ IERR ) END IF END IF * diff --git a/SRC/cgehd2.f b/SRC/cgehd2.f index 4540e5f2b5..513b731b1f 100644 --- a/SRC/cgehd2.f +++ b/SRC/cgehd2.f @@ -199,7 +199,8 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) * ALPHA = A( I+1, I ) - CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) ) + CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, + $ TAU( I ) ) A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index 5cba55ed43..d646898ccf 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -164,7 +164,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -194,7 +195,8 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) COMPLEX EI * .. * .. External Subroutines .. - EXTERNAL CAXPY, CGEHD2, CGEMM, CLAHR2, CLARFB, CTRMM, + EXTERNAL CAXPY, CGEHD2, CGEMM, CLAHR2, CLARFB, + $ CTRMM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f index 8d306d97e4..6cd6b62b85 100644 --- a/SRC/cgejsv.f +++ b/SRC/cgejsv.f @@ -621,10 +621,10 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2 * .. * .. External Subroutines .. - EXTERNAL SLASSQ, CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLAPMR, - $ CLASCL, SLASCL, CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ, - $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, CLACGV, - $ XERBLA + EXTERNAL SLASSQ, CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, + $ CLAPMR, CLASCL, SLASCL, CLASET, CLASSQ, CLASWP, + $ CUNGQR, CUNMLQ, CUNMQR, CPOCON, SSCAL, CSSCAL, + $ CSWAP, CTRSM, CLACGV, XERBLA * EXTERNAL CGESVJ * .. @@ -656,7 +656,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, INFO = - 3 ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN INFO = - 4 - ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN + ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. + $ LSAME(JOBT,'N') ) ) THEN INFO = - 5 ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN INFO = - 6 @@ -723,7 +724,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ ) END IF IF ( LQUERY ) THEN - CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, + CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, + $ V, $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) LWRK_CGESVJ = INT( CDUMMY(1) ) IF ( ERREST ) THEN @@ -867,7 +869,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, $ LDU, CDUMMY, -1, IERR ) LWRK_CUNMQR = INT( CDUMMY(1) ) IF ( .NOT. JRACC ) THEN - CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, + CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, + $ -1, $ RDUMMY, IERR ) LWRK_CGEQP3N = INT( CDUMMY(1) ) CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, @@ -911,10 +914,12 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) LWRK_CGESVJV = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, + CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, + $ CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) LWRK_CUNMQR = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, + CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, + $ U, $ LDU, CDUMMY, -1, IERR ) LWRK_CUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN @@ -1062,8 +1067,10 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL CLACPY( 'A', M, 1, A, LDA, U, LDU ) * computing all M left singular vectors of the M x 1 matrix IF ( N1 .NE. N ) THEN - CALL CGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR ) - CALL CUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR ) + CALL CGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N, + $ IERR ) + CALL CUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N, + $ IERR ) CALL CCOPY( M, A(1,1), 1, U(1,1), 1 ) END IF END IF @@ -1494,7 +1501,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * * .. second preconditioning using the QR factorization * - CALL CGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR ) + CALL CGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, + $ IERR ) * * .. and transpose upper to lower triangular DO 1948 p = 1, NR - 1 @@ -1521,7 +1529,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 1949 CONTINUE 1947 CONTINUE ELSE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA ) + CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), + $ LDA ) END IF * * .. and one-sided Jacobi rotations are started on a lower @@ -1561,7 +1570,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * accumulated product of Jacobi rotations, three are perfect ) * CALL CLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA ) - CALL CGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR) + CALL CGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, + $ IERR) CALL CLACPY( 'L', NR, NR, A, LDA, V, LDV ) CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) CALL CGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), @@ -1577,9 +1587,12 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, SCALEM = RWORK(1) NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - 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 ) + 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 CUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK, @@ -1634,10 +1647,13 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, NUMRANK = NINT(RWORK(2)) * IF ( NR .LT. M ) THEN - CALL CLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU ) + CALL CLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN - CALL CLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU ) - CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU ) + CALL CLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1), + $ LDU ) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1701,7 +1717,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 2968 CONTINUE 2969 CONTINUE ELSE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) + CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), + $ LDV ) END IF * * Estimate the row scaled condition number of R1 @@ -1810,7 +1827,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL CLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR ) DO 4950 p = 1, NR TEMP1 = SCNRM2( p, CWORK(2*N+N*NR+NR+p), NR ) - CALL CSSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR ) + CALL CSSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), + $ NR ) 4950 CONTINUE CALL CPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1, $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR ) @@ -1839,7 +1857,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 4969 CONTINUE 4968 CONTINUE ELSE - CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) END IF * * Second preconditioning finished; continue with Jacobi SVD @@ -1867,7 +1886,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * equation is Q2*V2 = the product of the Jacobi rotations * used in CGESVJ, premultiplied with the orthogonal matrix * from the second QR factorization. - CALL CTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV) + CALL CTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V, + $ LDV) ELSE * .. R1 is well conditioned, but non-square. Adjoint of R2 * is inverted to get the product of the Jacobi rotations @@ -1878,9 +1898,11 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN 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) + 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), + 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) END IF * @@ -1890,7 +1912,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * is Q3^* * V3 = the product of the Jacobi rotations (applied to * the lower triangular L3 from the LQ factorization of * R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL CGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, + CALL CGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, $ RWORK, LRWORK, INFO ) SCALEM = RWORK(1) @@ -1911,9 +1934,12 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 874 CONTINUE 873 CONTINUE IF ( NR .LT. N ) THEN - 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) + 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 ) @@ -1929,15 +1955,19 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * defense ensures that CGEJSV completes the task. * Compute the full SVD of L3 using CGESVJ with explicit * accumulation of Jacobi rotations. - CALL CGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, + CALL CGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, $ RWORK, LRWORK, INFO ) SCALEM = RWORK(1) NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - 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) + 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 ) @@ -1975,7 +2005,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * At this moment, V contains the right singular vectors of A. * Next, assemble the left singular vector matrix U (M x N). IF ( NR .LT. M ) THEN - CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) + CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) CALL CLASET('A',M-NR,N1-NR,CZERO,CONE, @@ -2049,10 +2080,13 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Assemble the left singular vector matrix U (M x N). * IF ( N .LT. M ) THEN - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU ) + CALL CLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), + $ LDU ) IF ( N .LT. N1 ) THEN - CALL CLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU) - CALL CLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU) + CALL CLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1), + $ LDU) + CALL CLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1), + $ LDU) END IF END IF CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, @@ -2164,10 +2198,13 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Next, assemble the left singular vector matrix U (M x N). * IF ( NR .LT. M ) THEN - CALL CLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU ) + CALL CLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU) - CALL CLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU) + CALL CLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1), + $ LDU) + CALL CLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1), + $ LDU) END IF END IF * @@ -2192,7 +2229,8 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL SLASCL( '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/SRC/cgelq2.f b/SRC/cgelq2.f index 1d6e316858..441ac0518a 100644 --- a/SRC/cgelq2.f +++ b/SRC/cgelq2.f @@ -187,7 +187,8 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i+1:m,i:n) from the right * A( I, I ) = ONE - CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ), + CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), $ A( I+1, I ), LDA, WORK ) END IF A( I, I ) = ALPHA diff --git a/SRC/cgelqf.f b/SRC/cgelqf.f index e46aa644f1..e7535b4b4e 100644 --- a/SRC/cgelqf.f +++ b/SRC/cgelqf.f @@ -253,7 +253,8 @@ SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL CLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL CLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/cgels.f b/SRC/cgels.f index 59a60b04a6..ce455c25b7 100644 --- a/SRC/cgels.f +++ b/SRC/cgels.f @@ -178,7 +178,8 @@ *> \ingroup gels * * ===================================================================== - SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -216,7 +217,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CGELQF, CGEQRF, CLASCL, CLASET, CTRTRS, CUNMLQ, + EXTERNAL CGELQF, CGEQRF, CLASCL, CLASET, CTRTRS, + $ CUNMLQ, $ CUNMQR, XERBLA * .. * .. Intrinsic Functions .. @@ -229,7 +231,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'C' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'C' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -289,7 +292,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * Quick return if possible * IF( MIN( M, N, NRHS ).EQ.0 ) THEN - CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, + $ LDB ) RETURN END IF * @@ -347,7 +351,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * compute QR factorization of A * - CALL CGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL CGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least N, optimally N*NB @@ -358,7 +363,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A, + CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, + $ A, $ LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN, $ INFO ) * @@ -366,7 +372,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL CTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL CTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -412,7 +419,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Compute LQ factorization of A * - CALL CGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL CGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least M, optimally M*NB. @@ -423,7 +431,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL CTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL CTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -440,7 +449,8 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := Q(1:N,:)**H * B(1:M,1:NRHS) * - CALL CUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, A, + CALL CUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, + $ A, $ LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN, $ INFO ) * diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index 982530bc0e..be10101a02 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -306,9 +306,11 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * columns. * MM = N - MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'CGEQRF', ' ', M, N, + MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'CGEQRF', ' ', M, + $ N, $ -1, -1 ) ) - MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'CUNMQR', 'LC', M, + MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'CUNMQR', 'LC', + $ M, $ NRHS, N, -1 ) ) END IF IF( M.GE.N ) THEN @@ -340,7 +342,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ 'CGEBRD', ' ', M, M, -1, -1 ) ) MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1, $ 'CUNMBR', 'QLC', M, NRHS, M, -1 ) ) - MAXWRK = MAX( MAXWRK, M*M + 4*M + ( M - 1 )*ILAENV( 1, + MAXWRK = MAX( MAXWRK, + $ M*M + 4*M + ( M - 1 )*ILAENV( 1, $ 'CUNMLQ', 'LC', N, NRHS, M, -1 ) ) IF( NRHS.GT.1 ) THEN MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS ) @@ -356,9 +359,11 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Path 2 - underdetermined. * - MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'CGEBRD', ' ', M, + MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'CGEBRD', ' ', + $ M, $ N, -1, -1 ) - MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1, 'CUNMBR', + MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1, + $ 'CUNMBR', $ 'QLC', M, NRHS, M, -1 ) ) MAXWRK = MAX( MAXWRK, 2*M + M*ILAENV( 1, 'CUNMBR', $ 'PLN', N, NRHS, M, -1 ) ) @@ -432,20 +437,23 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM. * - CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM. * - CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * If M < N make sure B(M+1:N,:) = 0 * IF( M.LT.N ) - $ CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + $ CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) * * Overdetermined case. * @@ -473,7 +481,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (RWorkspace: need N) * (CWorkspace: need NRHS, prefer NRHS*NB) * - CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Zero out below R. @@ -501,7 +510,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors of R. * (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB) * - CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -515,7 +525,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of R. * - CALL CUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ), + CALL CUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+ @@ -580,7 +591,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Zero out below first M rows of B. * - CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) NWORK = ITAU + M * * Multiply transpose(Q) by B. @@ -610,7 +622,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors. * (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB) * - CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -624,7 +637,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of A. * - CALL CUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ), + CALL CUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * END IF @@ -632,18 +646,22 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling. * IF( IASCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 10 CONTINUE diff --git a/SRC/cgelss.f b/SRC/cgelss.f index 87f03f1f98..35a6f0a4a5 100644 --- a/SRC/cgelss.f +++ b/SRC/cgelss.f @@ -213,7 +213,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, COMPLEX DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CBDSQR, CCOPY, CGEBRD, CGELQF, CGEMM, CGEMV, + EXTERNAL CBDSQR, CCOPY, CGEBRD, CGELQF, CGEMM, + $ CGEMV, $ CGEQRF, CLACPY, CLASCL, CLASET, CSRSCL, CUNGBR, $ CUNMBR, CUNMLQ, CUNMQR, SLASCL, SLASET, XERBLA * .. @@ -272,9 +273,11 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ LDB, DUM(1), -1, INFO ) LWORK_CUNMQR = INT( DUM(1) ) MM = N - MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'CGEQRF', ' ', M, + MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'CGEQRF', ' ', + $ M, $ N, -1, -1 ) ) - MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'CUNMQR', 'LC', + MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'CUNMQR', + $ 'LC', $ M, NRHS, N, -1 ) ) END IF IF( M.GE.N ) THEN @@ -282,11 +285,13 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Path 1 - overdetermined or exactly determined * * Compute space needed for CGEBRD - CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), $ -1, INFO ) LWORK_CGEBRD = INT( DUM(1) ) * Compute space needed for CUNMBR - CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), + CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ DUM(1), $ B, LDB, DUM(1), -1, INFO ) LWORK_CUNMBR = INT( DUM(1) ) * Compute space needed for CUNGBR @@ -423,13 +428,15 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -459,7 +466,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need N+NRHS, prefer N+NRHS*NB) * (RWorkspace: none) * - CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Zero out below R @@ -486,7 +494,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB) * (RWorkspace: none) * - CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors of R in A @@ -503,7 +512,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: none) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, N, 0, NRHS, S, RWORK( IE ), A, LDA, DUM, + CALL CBDSQR( 'U', N, N, 0, NRHS, S, RWORK( IE ), A, LDA, + $ DUM, $ 1, B, LDB, RWORK( IRWORK ), INFO ) IF( INFO.NE.0 ) $ GO TO 70 @@ -519,7 +529,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL CSRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 10 CONTINUE * @@ -535,12 +546,14 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CHUNK = LWORK / N DO 20 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL CGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B( 1, I ), + CALL CGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B( 1, + $ I ), $ LDB, CZERO, WORK, N ) CALL CLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB ) 20 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL CGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 ) + CALL CGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, + $ 1 ) CALL CCOPY( N, WORK, 1, B, 1 ) END IF * @@ -596,7 +609,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) * (RWorkspace: none) * - CALL CUNGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ), + CALL CUNGBR( 'P', M, M, M, WORK( IL ), LDWORK, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, INFO ) IRWORK = IE + M * @@ -622,7 +636,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL CSRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 30 CONTINUE IWORK = IL + M*LDWORK @@ -632,27 +647,30 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (RWorkspace: none) * IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN - CALL CGEMM( 'C', 'N', M, NRHS, M, CONE, WORK( IL ), LDWORK, + CALL CGEMM( 'C', 'N', M, NRHS, M, CONE, WORK( IL ), + $ LDWORK, $ B, LDB, CZERO, WORK( IWORK ), LDB ) CALL CLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = ( LWORK-IWORK+1 ) / M DO 40 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL CGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK, + CALL CGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), + $ LDWORK, $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M ) CALL CLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ), $ LDB ) 40 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL CGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ), - $ 1, CZERO, WORK( IWORK ), 1 ) + CALL CGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, + $ 1 ), 1, CZERO, WORK( IWORK ), 1 ) CALL CCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 ) END IF * * Zero out below first M rows of B * - CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + CALL CLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) IWORK = ITAU + M * * Multiply transpose(Q) by B @@ -683,7 +701,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB) * (RWorkspace: none) * - CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors in A @@ -700,7 +719,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: none) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'L', M, N, 0, NRHS, S, RWORK( IE ), A, LDA, DUM, + CALL CBDSQR( 'L', M, N, 0, NRHS, S, RWORK( IE ), A, LDA, + $ DUM, $ 1, B, LDB, RWORK( IRWORK ), INFO ) IF( INFO.NE.0 ) $ GO TO 70 @@ -716,7 +736,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL CSRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL CLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 50 CONTINUE * @@ -732,12 +753,14 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CHUNK = LWORK / N DO 60 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL CGEMM( 'C', 'N', N, BL, M, CONE, A, LDA, B( 1, I ), + CALL CGEMM( 'C', 'N', N, BL, M, CONE, A, LDA, B( 1, + $ I ), $ LDB, CZERO, WORK, N ) CALL CLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB ) 60 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL CGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 ) + CALL CGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, + $ 1 ) CALL CCOPY( N, WORK, 1, B, 1 ) END IF END IF @@ -745,18 +768,22 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF 70 CONTINUE WORK( 1 ) = SROUNDUP_LWORK(MAXWRK) diff --git a/SRC/cgelst.f b/SRC/cgelst.f index cad2fe6eaa..138bd41bb1 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -190,7 +190,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -242,7 +243,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'C' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'C' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -379,13 +381,15 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL CGEMQRT( 'Left', 'Conjugate transpose', M, NRHS, N, NB, + CALL CGEMQRT( 'Left', 'Conjugate transpose', M, NRHS, N, + $ NB, $ A, LDA, WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * * Compute B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL CTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL CTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -452,7 +456,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Block 1: B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL CTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL CTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -472,7 +477,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL CGEMLQT( 'Left', 'Conjugate transpose', N, NRHS, M, NB, + CALL CGEMLQT( 'Left', 'Conjugate transpose', N, NRHS, M, + $ NB, $ A, LDA, WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * diff --git a/SRC/cgelsy.f b/SRC/cgelsy.f index 8c92c702a7..8634a9cc48 100644 --- a/SRC/cgelsy.f +++ b/SRC/cgelsy.f @@ -208,7 +208,8 @@ *> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n *> * ===================================================================== - SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, + SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, $ WORK, LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -245,7 +246,8 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, COMPLEX C1, C2, S1, S2 * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEQP3, CLAIC1, CLASCL, CLASET, CTRSM, + EXTERNAL CCOPY, CGEQP3, CLAIC1, CLASCL, CLASET, + $ CTRSM, $ CTZRZF, CUNMQR, CUNMRZ, XERBLA * .. * .. External Functions .. @@ -338,13 +340,15 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -411,7 +415,8 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA, + CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, + $ LDA, $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) WSIZE = MAX( WSIZE, 2*MN+REAL( WORK( 2*MN+1 ) ) ) * @@ -452,18 +457,22 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/cgeqlf.f b/SRC/cgeqlf.f index 12d89a593c..ee289d6c98 100644 --- a/SRC/cgeqlf.f +++ b/SRC/cgeqlf.f @@ -250,7 +250,8 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the QL factorization of the current block * A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1) * - CALL CGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ), + CALL CGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( N-K+I.GT.1 ) THEN * @@ -262,7 +263,8 @@ SUBROUTINE CGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * - CALL CLARFB( 'Left', 'Conjugate transpose', 'Backward', + CALL CLARFB( 'Left', 'Conjugate transpose', + $ 'Backward', $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB, $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA, $ WORK( IB+1 ), LDWORK ) diff --git a/SRC/cgeqp3.f b/SRC/cgeqp3.f index c7886798dd..f0ffce6223 100644 --- a/SRC/cgeqp3.f +++ b/SRC/cgeqp3.f @@ -183,7 +183,8 @@ SUBROUTINE CGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CLAQP2, CLAQPS, CSWAP, CUNMQR, XERBLA + EXTERNAL CGEQRF, CLAQP2, CLAQPS, CSWAP, CUNMQR, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -266,7 +267,8 @@ SUBROUTINE CGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, *CC CALL CUNM2R( 'Left', 'Conjugate Transpose', M, N-NA, *CC $ NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK, *CC $ INFO ) - CALL CUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, A, + CALL CUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, + $ A, $ LDA, TAU, A( 1, NA+1 ), LDA, WORK, LWORK, $ INFO ) IWS = MAX( IWS, INT( WORK( 1 ) ) ) @@ -308,7 +310,8 @@ SUBROUTINE CGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, * determine the minimum value of NB. * NB = LWORK / ( SN+1 ) - NBMIN = MAX( 2, ILAENV( INBMIN, 'CGEQRF', ' ', SM, SN, + NBMIN = MAX( 2, ILAENV( INBMIN, 'CGEQRF', ' ', SM, + $ SN, $ -1, -1 ) ) * * diff --git a/SRC/cgeqrt.f b/SRC/cgeqrt.f index f1953a39a5..c3571873bb 100644 --- a/SRC/cgeqrt.f +++ b/SRC/cgeqrt.f @@ -196,9 +196,11 @@ SUBROUTINE CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) * Compute the QR factorization of the current block A(I:M,I:I+IB-1) * IF( USE_RECURSIVE_QR ) THEN - CALL CGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL CGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) ELSE - CALL CGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL CGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) END IF IF( I+IB.LE.N ) THEN * diff --git a/SRC/cgerfs.f b/SRC/cgerfs.f index b2aa4ec277..084b9e0fcb 100644 --- a/SRC/cgerfs.f +++ b/SRC/cgerfs.f @@ -182,7 +182,8 @@ *> \ingroup gerfs * * ===================================================================== - SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, EXTERNAL LSAME, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGEMV, CGETRS, CLACN2, XERBLA + EXTERNAL CAXPY, CCOPY, CGEMV, CGETRS, CLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -308,7 +310,8 @@ SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + CALL CGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, + $ WORK, $ 1 ) * * Compute componentwise relative backward error from formula diff --git a/SRC/cgerfsx.f b/SRC/cgerfsx.f index a147d7ca67..4513492ad6 100644 --- a/SRC/cgerfsx.f +++ b/SRC/cgerfsx.f @@ -408,7 +408,8 @@ *> \ingroup gerfsx * * ===================================================================== - SUBROUTINE CGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -474,7 +475,8 @@ SUBROUTINE CGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILATRANS, ILAPREC - EXTERNAL SLAMCH, CLANGE, CLA_GERCOND_X, CLA_GERCOND_C + EXTERNAL SLAMCH, CLANGE, CLA_GERCOND_X, + $ CLA_GERCOND_C REAL SLAMCH, CLANGE, CLA_GERCOND_X, CLA_GERCOND_C LOGICAL LSAME INTEGER ILATRANS, ILAPREC @@ -607,7 +609,8 @@ SUBROUTINE CGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, NORM = '1' END IF ANORM = CLANGE( NORM, N, N, A, LDA, RWORK ) - CALL CGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL CGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Perform refinement on each right-hand side * @@ -640,13 +643,16 @@ SUBROUTINE CGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ C, .TRUE., INFO, WORK, RWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ R, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ C, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/cgerqf.f b/SRC/cgerqf.f index 020f14044a..aaf3b1dc98 100644 --- a/SRC/cgerqf.f +++ b/SRC/cgerqf.f @@ -250,7 +250,8 @@ SUBROUTINE CGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the RQ factorization of the current block * A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1) * - CALL CGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ), + CALL CGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( M-K+I.GT.1 ) THEN * diff --git a/SRC/cgesdd.f b/SRC/cgesdd.f index a9619fd041..558e35699b 100644 --- a/SRC/cgesdd.f +++ b/SRC/cgesdd.f @@ -269,7 +269,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, COMPLEX CDUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF, CLACP2, CLACPY, + EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF, CLACP2, + $ CLACPY, $ CLACRM, CLARCM, CLASCL, CLASET, CUNGBR, CUNGLQ, $ CUNGQR, CUNMBR, SBDSDC, SLASCL, XERBLA * .. @@ -344,7 +345,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ 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 ) + 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), @@ -485,7 +487,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ 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 ) + 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), @@ -675,7 +678,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Zero out below R @@ -692,7 +696,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NRWORK = IE + N @@ -732,13 +737,15 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy R to WORK( IR ), zeroing out below it * CALL CLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ), + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -771,7 +778,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + N IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -783,7 +791,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) - CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, + CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * @@ -794,7 +803,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) - CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, + CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -832,13 +842,15 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL CLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ), + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -871,7 +883,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + N IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -882,7 +895,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) - CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, + CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -893,7 +907,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) - CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, + CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -903,7 +918,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEMM( 'N', 'N', M, N, N, CONE, A, LDA, + $ WORK( IR ), $ LDWRKR, CZERO, U, LDU ) * ELSE IF( WNTQA ) THEN @@ -925,7 +941,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) * @@ -951,7 +968,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IRU = IE + N @@ -964,7 +982,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -996,7 +1015,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need N*N [U] * RWorkspace: need 0 * - CALL CGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), + CALL CGEMM( 'N', 'N', M, N, N, CONE, U, LDU, + $ WORK( IU ), $ LDWRKU, CZERO, A, LDA ) * * Copy left singular vectors of A from A to U @@ -1034,7 +1054,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 @@ -1079,7 +1100,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1102,7 +1124,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRVT DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL CLACRM( CHUNK, N, A( I, 1 ), LDA, RWORK( IRU ), + CALL CLACRM( CHUNK, N, A( I, 1 ), LDA, + $ RWORK( IRU ), $ N, WORK( IU ), LDWRKU, RWORK( NRWORK ) ) CALL CLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, $ A( I, 1 ), LDA ) @@ -1138,7 +1161,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1190,7 +1214,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1270,7 +1295,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1297,12 +1323,14 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL CLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) - CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), + CALL CLACP2( 'F', N, N, RWORK( IRU ), N, + $ WORK( IU ), $ LDWRKU ) CALL CUNMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) - CALL CLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) + CALL CLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, + $ LDA ) ELSE * * Path 6o-slow @@ -1344,7 +1372,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1382,7 +1411,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1440,7 +1470,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Zero out above L @@ -1457,7 +1488,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NRWORK = IE + M @@ -1502,7 +1534,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy L to WORK(IL), zeroing about above it @@ -1541,7 +1574,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1552,7 +1586,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) - CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, + CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1564,7 +1599,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) - CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, + CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * @@ -1576,7 +1612,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL CGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ), M, + CALL CGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ), + $ M, $ A( 1, I ), LDA, CZERO, WORK( IL ), $ LDWRKL ) CALL CLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1602,7 +1639,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy L to WORK(IL), zeroing out above it @@ -1641,7 +1679,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1652,7 +1691,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) - CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, + CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1663,7 +1703,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) - CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, + CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1673,7 +1714,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL CLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) - CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, + CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), + $ LDWRKL, $ A, LDA, CZERO, VT, LDVT ) * ELSE IF( WNTQA ) THEN @@ -1695,7 +1737,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL CGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) * @@ -1721,7 +1764,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -1734,7 +1778,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1766,7 +1811,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need M*M [VT] * RWorkspace: need 0 * - CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, + 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 @@ -1852,7 +1898,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1861,7 +1908,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, + $ WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) CALL CLACPY( 'F', M, M, WORK( IVT ), LDWKVT, U, LDU ) * @@ -1875,7 +1923,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRU DO 50 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL CLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), LDA, + CALL CLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), + $ LDA, $ WORK( IVT ), LDWKVT, RWORK( NRWORK ) ) CALL CLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT, $ A( 1, I ), LDA ) @@ -1910,7 +1959,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1962,7 +2012,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2045,7 +2096,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2070,12 +2122,14 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, + $ WORK( IVT ), $ LDWKVT ) CALL CUNMBR( 'P', 'R', 'C', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) - CALL CLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) + CALL CLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, + $ LDA ) ELSE * * Path 6to-slow @@ -2097,7 +2151,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRU DO 60 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL CLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), + CALL CLARCM( M, BLK, RWORK( IRVT ), M, A( 1, + $ I ), $ LDA, WORK( IVT ), LDWKVT, $ RWORK( NRWORK ) ) CALL CLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT, @@ -2116,7 +2171,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2155,7 +2211,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IRVT + M*M NRWORK = IRU + M*M * - CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * diff --git a/SRC/cgesvd.f b/SRC/cgesvd.f index 4aed3e2a04..45d0837244 100644 --- a/SRC/cgesvd.f +++ b/SRC/cgesvd.f @@ -210,7 +210,8 @@ *> \ingroup gesvd * * ===================================================================== - SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, + SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, + $ LDVT, $ WORK, LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -253,7 +254,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, COMPLEX CDUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CBDSQR, CGEBRD, CGELQF, CGEMM, CGEQRF, CLACPY, + EXTERNAL CBDSQR, CGEBRD, CGELQF, CGEMM, CGEQRF, + $ CLACPY, $ CLASCL, CLASET, CUNGBR, CUNGLQ, CUNGQR, CUNMBR, $ SLASCL, XERBLA * .. @@ -322,9 +324,11 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL CGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) LWORK_CGEQRF = INT( CDUM(1) ) * Compute space needed for CUNGQR - CALL CUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL CUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_CUNGQR_N = INT( CDUM(1) ) - CALL CUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL CUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_CUNGQR_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), @@ -475,7 +479,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL CUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) LWORK_CUNGLQ_N = INT( CDUM(1) ) - CALL CUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL CUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_CUNGLQ_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), @@ -674,13 +679,15 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 2*N, prefer N+N*NB) * (RWorkspace: need 0) * - CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R * IF( N .GT. 1 ) THEN - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, + $ 1 ), $ LDA ) END IF IE = 1 @@ -692,7 +699,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) * (RWorkspace: need N) * - CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), + CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) NCVT = 0 @@ -713,7 +721,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, LDA, + CALL CBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, + $ LDA, $ CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO ) * * If right singular vectors desired in VT, copy them there @@ -763,7 +772,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy R to WORK(IR) and zero out below it * - CALL CLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) + CALL CLACPY( 'U', N, N, A, LDA, WORK( IR ), + $ LDWRKR ) CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, $ WORK( IR+1 ), LDWRKR ) * @@ -782,7 +792,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) * (RWorkspace: need N) * - CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), + CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, + $ RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -800,7 +811,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, 1, + CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + $ 1, $ WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) IU = ITAUQ @@ -812,7 +824,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL CGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ), + CALL CGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, CZERO, $ WORK( IU ), LDWRKU ) CALL CLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -849,7 +862,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, 1, + CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + $ 1, $ A, LDA, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -919,7 +933,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL CGEBRD( N, N, VT, LDVT, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL CLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) + CALL CLACPY( 'L', N, N, VT, LDVT, WORK( IR ), + $ LDWRKR ) * * Generate left vectors bidiagonalizing R in WORK(IR) * (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) @@ -955,7 +970,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL CGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ), + CALL CGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, CZERO, $ WORK( IU ), LDWRKU ) CALL CLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -1105,7 +1121,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), + $ CDUM, $ 1, WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1172,7 +1189,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), + $ CDUM, $ 1, U, LDU, CDUM, 1, RWORK( IRWORK ), $ INFO ) * @@ -1349,7 +1367,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1440,7 +1459,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * prefer N*N+2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1450,7 +1470,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), + $ VT, $ LDVT, WORK( IU ), LDWRKU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1516,7 +1537,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1526,7 +1548,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1610,7 +1633,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + CALL CBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), + $ CDUM, $ 1, WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1682,7 +1706,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + CALL CBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), + $ CDUM, $ 1, U, LDU, CDUM, 1, RWORK( IRWORK ), $ INFO ) * @@ -1863,7 +1888,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1955,7 +1981,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * prefer N*N+2*N+(N-1)*NB) * (RWorkspace: need 0) * - CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1965,7 +1992,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), + $ VT, $ LDVT, WORK( IU ), LDWRKU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2035,7 +2063,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL CUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -2045,7 +2074,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2186,7 +2216,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 2*M, prefer M+M*NB) * (RWorkspace: 0) * - CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL CGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out above L @@ -2202,7 +2233,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*M, prefer 2*M+2*M*NB) * (RWorkspace: need M) * - CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), + CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) IF( WNTUO .OR. WNTUAS ) THEN @@ -2224,7 +2256,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, 1, + CALL CBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, + $ 1, $ A, LDA, CDUM, 1, RWORK( IRWORK ), INFO ) * * If left singular vectors desired in U, copy them there @@ -2277,7 +2310,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy L to WORK(IR) and zero out above it * - CALL CLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR ) + CALL CLACPY( 'L', M, M, A, LDA, WORK( IR ), + $ LDWRKR ) CALL CLASET( 'U', M-1, M-1, CZERO, CZERO, $ WORK( IR+LDWRKR ), LDWRKR ) * @@ -2296,7 +2330,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) * (RWorkspace: need M) * - CALL CGEBRD( M, M, WORK( IR ), LDWRKR, S, RWORK( IE ), + CALL CGEBRD( M, M, WORK( IR ), LDWRKR, S, + $ RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -2326,7 +2361,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL CGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ), + CALL CGEMM( 'N', 'N', M, BLK, M, CONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, CZERO, $ WORK( IU ), LDWRKU ) CALL CLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2363,7 +2399,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, LDA, + CALL CBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, + $ LDA, $ CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -2414,7 +2451,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Copy L to U, zeroing about above it * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL CLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ), + CALL CLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, + $ 2 ), $ LDU ) * * Generate Q in A @@ -2435,7 +2473,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL CGEBRD( M, M, U, LDU, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL CLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) + CALL CLACPY( 'U', M, M, U, LDU, WORK( IR ), + $ LDWRKR ) * * Generate right vectors bidiagonalizing L in WORK(IR) * (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB) @@ -2471,7 +2510,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL CGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ), + CALL CGEMM( 'N', 'N', M, BLK, M, CONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, CZERO, $ WORK( IU ), LDWRKU ) CALL CLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2495,7 +2535,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Copy L to U, zeroing out above it * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL CLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ), + CALL CLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, + $ 2 ), $ LDU ) * * Generate Q in A @@ -2539,7 +2580,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, LDA, + CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, + $ LDA, $ U, LDU, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -2688,7 +2730,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), + $ VT, $ LDVT, CDUM, 1, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2863,7 +2906,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -2873,7 +2917,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, A, LDA, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2954,7 +2999,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3029,7 +3075,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3039,7 +3086,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3194,7 +3242,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), + $ VT, $ LDVT, CDUM, 1, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3373,7 +3422,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3383,7 +3433,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, A, LDA, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3464,7 +3515,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3543,7 +3595,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL CUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL CUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3553,7 +3606,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL CBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * diff --git a/SRC/cgesvdq.f b/SRC/cgesvdq.f index 9c10245f53..d0df8b38f9 100644 --- a/SRC/cgesvdq.f +++ b/SRC/cgesvdq.f @@ -448,9 +448,10 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, REAL RDUMMY(1) * .. * .. External Subroutines (BLAS, LAPACK) - EXTERNAL CGELQF, CGEQP3, CGEQRF, CGESVD, CLACPY, CLAPMT, - $ CLASCL, CLASET, CLASWP, CSSCAL, SLASET, SLASCL, - $ CPOCON, CUNMLQ, CUNMQR, XERBLA + EXTERNAL CGELQF, CGEQP3, CGEQRF, CGESVD, CLACPY, + $ CLAPMT, CLASCL, CLASET, CLASWP, CSSCAL, + $ SLASET, SLASCL, CPOCON, CUNMLQ, CUNMQR, + $ XERBLA * .. * .. External Functions (BLAS, LAPACK) LOGICAL LSAME @@ -675,10 +676,12 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL CGEQRF(N,N/2,U,LDU,CDUMMY,CDUMMY,-1,IERR) LWRK_CGEQRF = INT( CDUMMY(1) ) - CALL CGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + CALL CGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U, + $ LDU, $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) LWRK_CGESVD2 = INT( CDUMMY(1) ) - CALL CUNMQR( 'R', 'C', N, N, N/2, U, LDU, CDUMMY, + CALL CUNMQR( 'R', 'C', N, N, N/2, U, LDU, + $ CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) LWRK_CUNMQR2 = INT( CDUMMY(1) ) OPTWRK2 = MAX( LWRK_CGEQP3, N/2+LWRK_CGEQRF, @@ -697,10 +700,12 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL CGELQF(N/2,N,U,LDU,CDUMMY,CDUMMY,-1,IERR) LWRK_CGELQF = INT( CDUMMY(1) ) - CALL CGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + CALL CGESVD( 'S','O', N/2,N/2, V, LDV, S, U, + $ LDU, $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) LWRK_CGESVD2 = INT( CDUMMY(1) ) - CALL CUNMLQ( 'R', 'N', N, N, N/2, U, LDU, CDUMMY, + CALL CUNMLQ( 'R', 'N', N, N, N/2, U, LDU, + $ CDUMMY, $ V, LDV, CDUMMY,-1,IERR ) LWRK_CUNMLQ = INT( CDUMMY(1) ) OPTWRK2 = MAX( LWRK_CGEQP3, N/2+LWRK_CGELQF, @@ -775,9 +780,12 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * Quick return: A is the M x N zero matrix. NUMRANK = 0 CALL SLASET( 'G', N, 1, ZERO, ZERO, S, N ) - IF ( WNTUS ) CALL CLASET('G', M, N, CZERO, CONE, U, LDU) - IF ( WNTUA ) CALL CLASET('G', M, M, CZERO, CONE, U, LDU) - IF ( WNTVA ) CALL CLASET('G', N, N, CZERO, CONE, V, LDV) + IF ( WNTUS ) CALL CLASET('G', M, N, CZERO, CONE, U, + $ LDU) + IF ( WNTUA ) CALL CLASET('G', M, M, CZERO, CONE, U, + $ LDU) + IF ( WNTVA ) CALL CLASET('G', N, N, CZERO, CONE, V, + $ LDV) IF ( WNTUF ) THEN CALL CLASET( 'G', N, 1, CZERO, CZERO, CWORK, N ) CALL CLASET( 'G', M, N, CZERO, CONE, U, LDU ) @@ -798,7 +806,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RWORK(1) .GT. BIG / SQRT(REAL(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL CLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + CALL CLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF CALL CLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) @@ -820,7 +829,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RTMP .GT. BIG / SQRT(REAL(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL CLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + CALL CLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF END IF @@ -949,7 +959,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. compute the singular values of R = [A](1:NR,1:N) * IF ( NR .GT. 1 ) - $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), LDA ) + $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), + $ LDA ) CALL CGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, $ V, LDV, CWORK, LCWORK, RWORK, INFO ) * @@ -969,7 +980,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1193 CONTINUE 1192 CONTINUE IF ( NR .GT. 1 ) - $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), LDU ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), + $ LDU ) * .. the left singular vectors not computed, the NR right singular * vectors overwrite [U](1:NR,1:NR) as conjugate transposed. These * will be pre-multiplied by Q to build the left singular vectors of A. @@ -990,7 +1002,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [U] and overwrite [U] with the left singular vectors CALL CLACPY( 'U', NR, N, A, LDA, U, LDU ) IF ( NR .GT. 1 ) - $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), LDU ) + $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), + $ LDU ) * .. the right singular vectors not computed, the NR left singular * vectors overwrite [U](1:NR,1:NR) CALL CGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, @@ -1005,7 +1018,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) IF ( NR .LT. N1 ) THEN - CALL CLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), LDU ) + CALL CLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU ) CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1033,7 +1047,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1166 CONTINUE 1165 CONTINUE IF ( NR .GT. 1 ) - $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) * .. the left singular vectors of R**H overwrite V, the right singular * vectors not computed IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1063,7 +1078,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * by padding a zero block. In the case NR << N, a more efficient * way is to first use the QR factorization. For more details * how to implement this, see the " FULL SVD " branch. - CALL CLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), LDV) + CALL CLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), + $ LDV) CALL CGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) * @@ -1083,7 +1099,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into V and overwrite V with the right singular vectors CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), LDV ) + $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), + $ LDV ) * .. the right singular vectors overwrite V, the NR left singular * vectors stored in U(1:NR,1:NR) IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1097,7 +1114,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * by padding a zero block. In the case NR << N, a more efficient * way is to first use the LQ factorization. For more details * how to implement this, see the " FULL SVD " branch. - CALL CLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), LDV) + CALL CLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), + $ LDV) CALL CGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1123,7 +1141,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1169 CONTINUE 1168 CONTINUE IF ( NR .GT. 1 ) - $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) * * .. the left singular vectors of R**H overwrite [V], the NR right * singular vectors of R**H stored in [U](1:NR,1:NR) as conjugate @@ -1158,9 +1177,11 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1117 CONTINUE * IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1183,7 +1204,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1199 CONTINUE 1198 CONTINUE IF ( NR .GT. 1 ) - $ CALL CLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2),LDV) + $ CALL CLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV) * CALL CLASET('A',N,N-NR,CZERO,CZERO,V(1,NR+1),LDV) CALL CGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, @@ -1213,7 +1235,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL CLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1), + $ LDU) CALL CLASET('A',M-N,N1-N,CZERO,CONE, $ U(N+1,N+1), LDU ) END IF @@ -1227,7 +1250,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1197 CONTINUE 1196 CONTINUE IF ( NR .GT. 1 ) - $ CALL CLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2),LDU) + $ CALL CLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2), + $ LDU) CALL CGEQRF( N, NR, U(1,NR+1), LDU, CWORK(N+1), $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) DO 1143 p = 1, NR @@ -1240,16 +1264,19 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V,LDV, CWORK(N+NR+1),LCWORK-N-NR,RWORK, INFO ) 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) + CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1), + $ LDV) CALL CUNMQR('R','C', N, N, NR, U(1,NR+1), LDU, $ CWORK(N+1),V,LDV,CWORK(N+NR+1),LCWORK-N-NR,IERR) CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1),LDU) END IF @@ -1265,7 +1292,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [V] and overwrite V with the right singular vectors CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), LDV ) + $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), + $ LDV ) * .. the right singular vectors of R overwrite [V], the NR left * singular vectors of R stored in [U](1:NR,1:NR) CALL CGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, @@ -1275,9 +1303,11 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1296,10 +1326,12 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( OPTRATIO * NR .GT. N ) THEN CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL CLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1),LDV) + $ CALL CLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1), + $ LDV) * .. the right singular vectors of R overwrite [V], the NR left * singular vectors of R stored in [U](1:NR,1:NR) - CALL CLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1),LDV) + CALL CLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1), + $ LDV) CALL CGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1311,7 +1343,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL CLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1), + $ LDU) CALL CLASET( 'A',M-N,N1-N,CZERO,CONE, $ U(N+1,N+1), LDU ) END IF @@ -1319,7 +1352,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, ELSE CALL CLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) IF ( NR .GT. 1 ) - $ CALL CLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1),LDU) + $ CALL CLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1), + $ LDU) CALL CGELQF( NR, N, U(NR+1,1), LDU, CWORK(N+1), $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) CALL CLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) @@ -1329,16 +1363,20 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V, LDV, CWORK(N+NR+1), LCWORK-N-NR, RWORK, INFO ) 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) - CALL CUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU,CWORK(N+1), + CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1), + $ LDV) + CALL CUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU, + $ CWORK(N+1), $ V, LDV, CWORK(N+NR+1),LCWORK-N-NR,IERR) CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1371,7 +1409,8 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * * .. if numerical rank deficiency is detected, the truncated * singular values are set to zero. - IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) + IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), + $ N ) * .. undo scaling; this may cause overflow in the largest singular * values. IF ( ASCALED ) diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index caabe90657..362e1ded1c 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -306,7 +306,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBRD, CGELQF, CGEQRF, CLASCL, CLASET, + EXTERNAL CGEBRD, CGELQF, CGEQRF, CLASCL, + $ CLASET, $ CUNMBR, CUNMQR, CUNMLQ, CLACPY, $ SBDSVDX, SLASCL, XERBLA * .. @@ -396,7 +397,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MAXWRK = 1 IF( MINMN.GT.0 ) THEN IF( M.GE.N ) THEN - MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( M.GE.MNTHR ) THEN * * Path 1 (M much larger than N) @@ -404,24 +406,28 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, 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)) + $ 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)) + $ 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) * MINWRK = 3*N + M - MAXWRK = 2*N + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + 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 ) + MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( N.GE.MNTHR ) THEN * * Path 1t (N much larger than M) @@ -429,10 +435,12 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, 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)) + $ 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)) + $ M*M+2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M, + $ -1)) END IF ELSE * @@ -440,7 +448,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * * MINWRK = 3*M + N - MAXWRK = 2*M + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + 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)) @@ -561,7 +570,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, END DO K = K + N END DO - CALL CLASET( 'A', M-N, NS, 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) @@ -637,7 +647,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, END DO K = K + N END DO - CALL CLASET( 'A', M-N, NS, 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) diff --git a/SRC/cgesvj.f b/SRC/cgesvj.f index 1bd37ccca6..98fac0c288 100644 --- a/SRC/cgesvj.f +++ b/SRC/cgesvj.f @@ -414,7 +414,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * from BLAS EXTERNAL CCOPY, CROT, CSSCAL, CSWAP, CAXPY * from LAPACK - EXTERNAL CLASCL, CLASET, CLASSQ, SLASCL, XERBLA + EXTERNAL CLASCL, CLASET, CLASSQ, SLASCL, + $ XERBLA EXTERNAL CGSVJ0, CGSVJ1 * .. * .. Executable Statements .. @@ -440,9 +441,13 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN + ELSE IF( .NOT.( LSVEC .OR. + $ UCTOL .OR. + $ LSAME( JOBU, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( RSVEC .OR. + $ APPLV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -785,7 +790,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ V( N4*q+1, N4+1 ), LDV, EPSLN, SFMIN, TOL, 1, $ CWORK( N+1 ), LWORK-N, IERR ) * - CALL CGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL CGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * @@ -797,16 +803,19 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( UPPER ) THEN * * - CALL CGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL CGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 2, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL CGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, CWORK( N4+1 ), + CALL CGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, + $ CWORK( N4+1 ), $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL CGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, V, + CALL CGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, + $ V, $ LDV, EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), $ LWORK-N, IERR ) * @@ -959,7 +968,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, T = HALF / THETA CS = ONE - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF ( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -988,7 +998,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF ( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -1001,14 +1012,17 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * .. have to use modified Gram-Schmidt like transformation CALL CCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL CLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, CWORK(N+1), LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) CALL CAXPY( M, -AAPQ, CWORK(N+1), 1, $ A( 1, q ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL CLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ1*AAPQ1 ) ) @@ -1023,7 +1037,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SCNRM2( M, A( 1, q ), 1 ) + SVA( q ) = SCNRM2( M, A( 1, q ), + $ 1 ) ELSE T = ZERO AAQQ = ONE @@ -1175,7 +1190,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -1202,7 +1218,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -1216,15 +1233,18 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAPP.GT.AAQQ ) THEN CALL CCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL CAXPY( M, -AAPQ, CWORK(N+1), $ 1, A( 1, q ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAQQ, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -1233,15 +1253,18 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE CALL CCOPY( M, A( 1, q ), 1, $ CWORK(N+1), 1 ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL CAXPY( M, -CONJG(AAPQ), $ CWORK(N+1), 1, A( 1, p ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAPP, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -1257,7 +1280,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SCNRM2( M, A( 1, q ), 1) + SVA( q ) = SCNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE @@ -1399,7 +1423,8 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( LSVEC .OR. UCTOL ) THEN DO 1998 p = 1, N4 * CALL CSSCAL( M, ONE / SVA( p ), A( 1, p ), 1 ) - CALL CLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, IERR ) + CALL CLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, + $ IERR ) 1998 CONTINUE END IF * diff --git a/SRC/cgesvx.f b/SRC/cgesvx.f index c8ac7e9547..f6303603dc 100644 --- a/SRC/cgesvx.f +++ b/SRC/cgesvx.f @@ -345,7 +345,8 @@ *> \ingroup gesvx * * ===================================================================== - SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -385,7 +386,8 @@ SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EXTERNAL LSAME, CLANGE, CLANTR, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CGECON, CGEEQU, CGERFS, CGETRF, CGETRS, CLACPY, + EXTERNAL CGECON, CGEEQU, CGERFS, CGETRF, CGETRS, + $ CLACPY, $ CLAQGE, XERBLA * .. * .. Intrinsic Functions .. @@ -410,7 +412,9 @@ SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -476,7 +480,8 @@ SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL CGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) + CALL CGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -552,7 +557,8 @@ SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute the reciprocal of the condition number of A. * - CALL CGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL CGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/cgesvxx.f b/SRC/cgesvxx.f index 26155d268c..c6cf636fea 100644 --- a/SRC/cgesvxx.f +++ b/SRC/cgesvxx.f @@ -536,7 +536,8 @@ *> \ingroup gesvxx * * ===================================================================== - SUBROUTINE CGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, @@ -587,7 +588,8 @@ SUBROUTINE CGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, REAL SLAMCH, CLA_GERPVGRW * .. * .. External Subroutines .. - EXTERNAL CGEEQUB, CGETRF, CGETRS, CLACPY, CLAQGE, + EXTERNAL CGEEQUB, CGETRF, CGETRS, CLACPY, + $ CLAQGE, $ XERBLA, CLASCL2, CGERFSX * .. * .. Intrinsic Functions .. diff --git a/SRC/cgetrf.f b/SRC/cgetrf.f index f783cc30b7..b503826959 100644 --- a/SRC/cgetrf.f +++ b/SRC/cgetrf.f @@ -129,7 +129,8 @@ SUBROUTINE CGETRF( M, N, A, LDA, IPIV, INFO ) INTEGER I, IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL CGEMM, CGETRF2, CLASWP, CTRSM, XERBLA + EXTERNAL CGEMM, CGETRF2, CLASWP, CTRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -178,7 +179,8 @@ SUBROUTINE CGETRF( M, N, A, LDA, IPIV, INFO ) * Factor diagonal and subdiagonal blocks and test for exact * singularity. * - CALL CGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) + CALL CGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), + $ IINFO ) * * Adjust INFO and the pivot indices. * @@ -201,14 +203,16 @@ SUBROUTINE CGETRF( M, N, A, LDA, IPIV, INFO ) * * Compute block row of U. * - CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL CGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL CGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/cgetri.f b/SRC/cgetri.f index c968759a09..6cc7357037 100644 --- a/SRC/cgetri.f +++ b/SRC/cgetri.f @@ -143,7 +143,8 @@ SUBROUTINE CGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CGEMM, CGEMV, CSWAP, CTRSM, CTRTRI, XERBLA + EXTERNAL CGEMM, CGEMV, CSWAP, CTRSM, CTRTRI, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -189,7 +190,8 @@ SUBROUTINE CGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = MAX( LDWORK*NB, 1 ) IF( LWORK.LT.IWS ) THEN NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CGETRI', ' ', N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CGETRI', ' ', N, -1, -1, + $ -1 ) ) END IF ELSE IWS = N @@ -240,7 +242,8 @@ SUBROUTINE CGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL CGEMM( 'No transpose', 'No transpose', N, JB, $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) - CALL CTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB, + CALL CTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ JB, $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 50 CONTINUE END IF diff --git a/SRC/cgetrs.f b/SRC/cgetrs.f index 81bfb1cd93..978ea4b129 100644 --- a/SRC/cgetrs.f +++ b/SRC/cgetrs.f @@ -190,7 +190,8 @@ SUBROUTINE CGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, + CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -203,7 +204,8 @@ SUBROUTINE CGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve U**T *X = B or U**H *X = B, overwriting B with X. * - CALL CTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE, + CALL CTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, + $ ONE, $ A, LDA, B, LDB ) * * Solve L**T *X = B, or L**H *X = B overwriting B with X. diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 573bea95da..1e854d76d5 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -177,7 +177,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, + SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, + $ WORK, $ LWORK, INFO ) IMPLICIT NONE * @@ -208,7 +209,8 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, CUNHR_COL, + EXTERNAL CCOPY, CLATSQR, CUNGTSQR_ROW, + $ CUNHR_COL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -345,7 +347,8 @@ SUBROUTINE CGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, A( I, J ) = -CONE * WORK( LWT+N*(J-1)+I ) END DO ELSE - CALL CCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), LDA ) + CALL CCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), + $ LDA ) END IF END DO * diff --git a/SRC/cggbak.f b/SRC/cggbak.f index 473495b502..e4463f53a6 100644 --- a/SRC/cggbak.f +++ b/SRC/cggbak.f @@ -144,7 +144,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, + SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, + $ V, $ LDV, INFO ) * * -- LAPACK computational routine -- @@ -184,8 +185,10 @@ SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/cggbal.f b/SRC/cggbal.f index 1f366ac25d..765180a4b4 100644 --- a/SRC/cggbal.f +++ b/SRC/cggbal.f @@ -231,8 +231,10 @@ SUBROUTINE CGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -515,8 +517,10 @@ SUBROUTINE CGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, IF( CMAX.LT.HALF ) $ GO TO 350 * - CALL SAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 ) - CALL SAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 ) + CALL SAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), + $ 1 ) + CALL SAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), + $ 1 ) * PGAMMA = GAMMA IT = IT + 1 diff --git a/SRC/cgges.f b/SRC/cgges.f index 94ff8cb524..b466d92e5b 100644 --- a/SRC/cgges.f +++ b/SRC/cgges.f @@ -265,7 +265,8 @@ *> \ingroup gges * * ===================================================================== - SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, + SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, + $ LDB, $ SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, $ LWORK, RWORK, BWORK, INFO ) * @@ -312,7 +313,8 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, + $ CLACPY, $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. @@ -360,7 +362,8 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -383,7 +386,8 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * IF( INFO.EQ.0 ) THEN LWKMIN = MAX( 1, 2*N ) - LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) ) + LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, + $ 0 ) ) LWKOPT = MAX( LWKOPT, N + $ N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, -1 ) ) IF( ILVSL ) THEN @@ -527,9 +531,11 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * Undo scaling on eigenvalues before selecting * IF( ILASCL ) - $ CALL CLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL CLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * @@ -537,7 +543,8 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) ) 10 CONTINUE * - CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA, + CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHA, $ BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR, $ DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR ) IF( IERR.EQ.1 ) diff --git a/SRC/cgges3.f b/SRC/cgges3.f index a73f0dd345..15955929fa 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -312,7 +312,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, + $ CLACPY, $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. @@ -361,7 +362,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -534,9 +536,11 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * Undo scaling on eigenvalues before selecting * IF( ILASCL ) - $ CALL CLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL CLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * @@ -544,7 +548,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) ) 10 CONTINUE * - CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA, + CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHA, $ BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR, $ DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR ) IF( IERR.EQ.1 ) diff --git a/SRC/cggesx.f b/SRC/cggesx.f index bb544aa6d7..47bc54a79d 100644 --- a/SRC/cggesx.f +++ b/SRC/cggesx.f @@ -324,7 +324,8 @@ *> \ingroup ggesx * * ===================================================================== - SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, + SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, + $ LDA, $ B, LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, $ LDVSR, RCONDE, RCONDV, WORK, LWORK, RWORK, $ IWORK, LIWORK, BWORK, INFO ) @@ -373,7 +374,8 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, + $ CLACPY, $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. @@ -434,7 +436,8 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -466,7 +469,8 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, $ ILAENV( 1, 'CUNMQR', ' ', N, 1, N, -1 ) ) ) IF( ILVSL ) THEN MAXWRK = MAX( MAXWRK, N*( 1 + - $ ILAENV( 1, 'CUNGQR', ' ', N, 1, N, -1 ) ) ) + $ ILAENV( 1, 'CUNGQR', ' ', N, 1, N, + $ -1 ) ) ) END IF LWRK = MAXWRK IF( IJOB.GE.1 ) @@ -620,9 +624,11 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, * Undo scaling on eigenvalues before SELCTGing * IF( ILASCL ) - $ CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL CLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * diff --git a/SRC/cggev.f b/SRC/cggev.f index a976d88251..7d5af2949a 100644 --- a/SRC/cggev.f +++ b/SRC/cggev.f @@ -254,7 +254,8 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, + $ CLACPY, $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. @@ -329,7 +330,8 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * IF( INFO.EQ.0 ) THEN LWKMIN = MAX( 1, 2*N ) - LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) ) + LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, + $ 0 ) ) LWKOPT = MAX( LWKOPT, N + $ N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, 0 ) ) IF( ILVL ) THEN @@ -491,7 +493,8 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHTEMP = 'R' END IF * - CALL CTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL CTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ), $ IERR ) IF( IERR.NE.0 ) THEN diff --git a/SRC/cggev3.f b/SRC/cggev3.f index 85ff635cf1..403d9074dd 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -213,7 +213,8 @@ *> \ingroup ggev3 * * ===================================================================== - SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, + SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, + $ BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -254,7 +255,8 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, + $ CLACPY, $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. @@ -500,7 +502,8 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHTEMP = 'R' END IF * - CALL CTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL CTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ), $ IERR ) IF( IERR.NE.0 ) THEN diff --git a/SRC/cggevx.f b/SRC/cggevx.f index 3d5933046d..9009f201bb 100644 --- a/SRC/cggevx.f +++ b/SRC/cggevx.f @@ -368,7 +368,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, + SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, VL, LDVL, VR, LDVR, ILO, IHI, $ LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, $ WORK, LWORK, RWORK, IWORK, BWORK, INFO ) @@ -415,7 +416,8 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, + EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, + $ CLACPY, $ CLASCL, CLASET, CTGEVC, CTGSNA, CUNGQR, CUNMQR, $ SLASCL, XERBLA * .. @@ -514,12 +516,15 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF MAXWRK = MINWRK MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, + $ 0 ) ) MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, + $ 0 ) ) IF( ILVL ) THEN MAXWRK = MAX( MAXWRK, N + - $ N*ILAENV( 1, 'CUNGQR', ' ', N, 1, N, 0 ) ) + $ N*ILAENV( 1, 'CUNGQR', ' ', N, 1, N, + $ 0 ) ) END IF END IF WORK( 1 ) = SROUNDUP_LWORK(MAXWRK) @@ -580,7 +585,8 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * Permute and/or balance the matrix pair (A,B) * (Real Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) * - CALL CGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, + CALL CGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, + $ RSCALE, $ RWORK, IERR ) * * Compute ABNRM and BBNRM @@ -749,7 +755,8 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * (Workspace: none needed) * IF( ILVL ) THEN - CALL CGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL, + CALL CGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, + $ VL, $ LDVL, IERR ) * DO 50 JC = 1, N @@ -767,7 +774,8 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF * IF( ILVR ) THEN - CALL CGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR, + CALL CGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, + $ VR, $ LDVR, IERR ) DO 80 JC = 1, N TEMP = ZERO diff --git a/SRC/cggglm.f b/SRC/cggglm.f index a9f2910dac..1ccf20ff45 100644 --- a/SRC/cggglm.f +++ b/SRC/cggglm.f @@ -181,7 +181,8 @@ *> \ingroup ggglm * * ===================================================================== - SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, + SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -209,7 +210,8 @@ SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, $ NB4, NP * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMV, CGGQRF, CTRTRS, CUNMQR, CUNMRQ, + EXTERNAL CCOPY, CGEMV, CGGQRF, CTRTRS, CUNMQR, + $ CUNMRQ, $ XERBLA * .. * .. External Functions .. @@ -296,7 +298,8 @@ SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * Update left-hand-side vector d = Q**H*d = ( d1 ) M * ( d2 ) N-M * - CALL CUNMQR( 'Left', 'Conjugate transpose', N, 1, M, A, LDA, WORK, + CALL CUNMQR( 'Left', 'Conjugate transpose', N, 1, M, A, LDA, + $ WORK, $ D, MAX( 1, N ), WORK( M+NP+1 ), LWORK-M-NP, INFO ) LOPT = MAX( LOPT, INT( WORK( M+NP+1 ) ) ) * @@ -322,13 +325,15 @@ SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * * Update d1 = d1 - T12*y2 * - CALL CGEMV( 'No transpose', M, N-M, -CONE, B( 1, M+P-N+1 ), LDB, + CALL CGEMV( 'No transpose', M, N-M, -CONE, B( 1, M+P-N+1 ), + $ LDB, $ Y( M+P-N+1 ), 1, CONE, D, 1 ) * * Solve triangular system: R11*x = d1 * IF( M.GT.0 ) THEN - CALL CTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA, + CALL CTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, + $ LDA, $ D, M, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index df983b4546..7174eab955 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -227,7 +227,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -270,7 +271,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, CGEMM, + EXTERNAL CGGHRD, CLARTG, CLASET, CUNM22, CROT, + $ CGEMM, $ CGEMV, CTRMV, CLACPY, XERBLA * .. * .. Intrinsic Functions .. @@ -394,7 +396,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * N2NB = ( IHI-JCOL-1 ) / NNB - 1 NBLST = IHI - JCOL - N2NB*NNB - CALL CLASET( 'All', NBLST, NBLST, CZERO, CONE, WORK, NBLST ) + CALL CLASET( 'All', NBLST, NBLST, CZERO, CONE, WORK, + $ NBLST ) PW = NBLST * NBLST + 1 DO I = 1, N2NB CALL CLASET( 'All', 2*NNB, 2*NNB, CZERO, CONE, @@ -587,10 +590,12 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, WORK( PPW ) = A( I, J+1 ) PPW = PPW + 1 END DO - CALL CTRMV( 'Upper', 'Conjugate', 'Non-unit', LEN, + CALL CTRMV( 'Upper', 'Conjugate', 'Non-unit', + $ LEN, $ WORK( PPWO + NNB ), 2*NNB, WORK( PW ), $ 1 ) - CALL CTRMV( 'Lower', 'Conjugate', 'Non-unit', NNB, + CALL CTRMV( 'Lower', 'Conjugate', 'Non-unit', + $ NNB, $ WORK( PPWO + 2*LEN*NNB ), $ 2*NNB, WORK( PW + LEN ), 1 ) CALL CGEMV( 'Conjugate', NNB, LEN, CONE, @@ -759,9 +764,11 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END DO ELSE * - CALL CLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, CZERO, + CALL CLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, + $ CZERO, $ A( JCOL + 2, JCOL ), LDA ) - CALL CLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, CZERO, + CALL CLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, + $ CZERO, $ B( JCOL + 2, JCOL ), LDB ) END IF * @@ -781,7 +788,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL CUNM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL CUNM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ A( 1, J ), LDA, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -812,7 +820,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL CUNM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL CUNM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ B( 1, J ), LDB, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -892,7 +901,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END IF * IF ( JCOL.LT.IHI ) - $ CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, + $ CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, IERR ) * WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) diff --git a/SRC/cgghrd.f b/SRC/cgghrd.f index 9d328fbf96..4a6115226c 100644 --- a/SRC/cgghrd.f +++ b/SRC/cgghrd.f @@ -200,7 +200,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE CGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, INFO ) * * -- LAPACK computational routine -- @@ -344,11 +345,13 @@ SUBROUTINE CGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL CLARTG( CTEMP, B( JROW, JROW-1 ), C, S, $ B( JROW, JROW ) ) B( JROW, JROW-1 ) = CZERO - CALL CROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S ) + CALL CROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, + $ S ) CALL CROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C, $ S ) IF( ILZ ) - $ CALL CROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S ) + $ CALL CROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, + $ S ) 30 CONTINUE 40 CONTINUE * diff --git a/SRC/cgglse.f b/SRC/cgglse.f index 466d92dcef..0c83b88bf6 100644 --- a/SRC/cgglse.f +++ b/SRC/cgglse.f @@ -176,7 +176,8 @@ *> \ingroup gglse * * ===================================================================== - SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, + SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -203,7 +204,8 @@ SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, $ NB4, NR * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGEMV, CGGRQF, CTRMV, CTRTRS, + EXTERNAL CAXPY, CCOPY, CGEMV, CGGRQF, CTRMV, + $ CTRTRS, $ CUNMQR, CUNMRQ, XERBLA * .. * .. External Functions .. @@ -305,7 +307,8 @@ SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Update c1 * - CALL CGEMV( 'No transpose', N-P, P, -CONE, A( 1, N-P+1 ), LDA, + CALL CGEMV( 'No transpose', N-P, P, -CONE, A( 1, N-P+1 ), + $ LDA, $ D, 1, CONE, C, 1 ) END IF * @@ -330,7 +333,8 @@ SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, IF( M.LT.N ) THEN NR = M + P - N IF( NR.GT.0 ) - $ CALL CGEMV( 'No transpose', NR, N-M, -CONE, A( N-P+1, M+1 ), + $ CALL CGEMV( 'No transpose', NR, N-M, -CONE, A( N-P+1, + $ M+1 ), $ LDA, D( NR+1 ), 1, CONE, C( N-P+1 ), 1 ) ELSE NR = P diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f index ef5463cb7d..6b9de0278e 100644 --- a/SRC/cggqrf.f +++ b/SRC/cggqrf.f @@ -282,7 +282,8 @@ SUBROUTINE CGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * * Update B := Q**H*B. * - CALL CUNMQR( 'Left', 'Conjugate Transpose', N, P, MIN( N, M ), A, + CALL CUNMQR( 'Left', 'Conjugate Transpose', N, P, MIN( N, M ), + $ A, $ LDA, TAUA, B, LDB, WORK, LWORK, INFO ) LOPT = MAX( LOPT, INT( WORK( 1 ) ) ) * diff --git a/SRC/cggsvd3.f b/SRC/cggsvd3.f index 7443fbea9d..2cc3850666 100644 --- a/SRC/cggsvd3.f +++ b/SRC/cggsvd3.f @@ -429,7 +429,8 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, $ WORK, WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/SRC/cggsvp3.f b/SRC/cggsvp3.f index 249048ad84..ba22e45d54 100644 --- a/SRC/cggsvp3.f +++ b/SRC/cggsvp3.f @@ -312,7 +312,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEQP3, CGEQR2, CGERQ2, CLACPY, CLAPMT, + EXTERNAL CGEQP3, CGEQR2, CGERQ2, CLACPY, + $ CLAPMT, $ CLASET, CUNG2R, CUNM2R, CUNMR2, XERBLA * .. * .. Intrinsic Functions .. @@ -361,7 +362,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL CGEQP3( P, N, B, LDB, IWORK, TAU, WORK, -1, RWORK, INFO ) + CALL CGEQP3( P, N, B, LDB, IWORK, TAU, WORK, -1, RWORK, + $ INFO ) LWKOPT = INT( WORK ( 1 ) ) IF( WANTV ) THEN LWKOPT = MAX( LWKOPT, P ) @@ -371,7 +373,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, IF( WANTQ ) THEN LWKOPT = MAX( LWKOPT, N ) END IF - CALL CGEQP3( M, N, A, LDA, IWORK, TAU, WORK, -1, RWORK, INFO ) + CALL CGEQP3( M, N, A, LDA, IWORK, TAU, WORK, -1, RWORK, + $ INFO ) LWKOPT = MAX( LWKOPT, INT( WORK ( 1 ) ) ) LWKOPT = MAX( 1, LWKOPT ) WORK( 1 ) = CMPLX( LWKOPT ) @@ -391,7 +394,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, DO 10 I = 1, N IWORK( I ) = 0 10 CONTINUE - CALL CGEQP3( P, N, B, LDB, IWORK, TAU, WORK, LWORK, RWORK, INFO ) + CALL CGEQP3( P, N, B, LDB, IWORK, TAU, WORK, LWORK, RWORK, + $ INFO ) * * Update A := A*P * @@ -424,7 +428,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -442,7 +447,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, + CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, $ TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * @@ -487,7 +493,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), + CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, + $ N-L ), $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) * IF( WANTU ) THEN @@ -496,7 +503,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL CLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), + $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, + $ 1 ), $ LDU ) CALL CUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF @@ -517,7 +525,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -529,7 +538,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, + CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, $ LDA, TAU, Q, LDQ, WORK, INFO ) END IF * @@ -554,7 +564,8 @@ SUBROUTINE CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL CUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), + CALL CUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, + $ L ), $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, $ WORK, INFO ) END IF diff --git a/SRC/cgsvj0.f b/SRC/cgsvj0.f index 76acddbe5a..3c29318727 100644 --- a/SRC/cgsvj0.f +++ b/SRC/cgsvj0.f @@ -500,7 +500,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, T = HALF / THETA CS = ONE - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF ( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -529,7 +530,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF ( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -542,14 +544,17 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * .. have to use modified Gram-Schmidt like transformation CALL CCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL CLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK, LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) CALL CAXPY( M, -AAPQ, WORK, 1, $ A( 1, q ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL CLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ1*AAPQ1 ) ) @@ -564,7 +569,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SCNRM2( M, A( 1, q ), 1 ) + SVA( q ) = SCNRM2( M, A( 1, q ), + $ 1 ) ELSE T = ZERO AAQQ = ONE @@ -716,7 +722,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -743,7 +750,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -757,15 +765,18 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( AAPP.GT.AAQQ ) THEN CALL CCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL CAXPY( M, -AAPQ, WORK, $ 1, A( 1, q ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAQQ, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -774,15 +785,18 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ELSE CALL CCOPY( M, A( 1, q ), 1, $ WORK, 1 ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL CAXPY( M, -CONJG(AAPQ), $ WORK, 1, A( 1, p ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAPP, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -798,7 +812,8 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SCNRM2( M, A( 1, q ), 1) + SVA( q ) = SCNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE diff --git a/SRC/cgsvj1.f b/SRC/cgsvj1.f index b917ee37a1..9d0580fb20 100644 --- a/SRC/cgsvj1.f +++ b/SRC/cgsvj1.f @@ -485,7 +485,8 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -512,7 +513,8 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL CROT( M, A(1,p), 1, A(1,q), 1, + CALL CROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL CROT( MVL, V(1,p), 1, @@ -526,15 +528,18 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, IF( AAPP.GT.AAQQ ) THEN CALL CCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL CAXPY( M, -AAPQ, WORK, $ 1, A( 1, q ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAQQ, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -543,15 +548,18 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ELSE CALL CCOPY( M, A( 1, q ), 1, $ WORK, 1 ) - CALL CLASCL( 'G', 0, 0, AAQQ, ONE, + CALL CLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL CLASCL( 'G', 0, 0, AAPP, ONE, + CALL CLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL CAXPY( M, -CONJG(AAPQ), $ WORK, 1, A( 1, p ), 1 ) - CALL CLASCL( 'G', 0, 0, ONE, AAPP, + CALL CLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -567,7 +575,8 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SCNRM2( M, A( 1, q ), 1) + SVA( q ) = SCNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE diff --git a/SRC/cgtrfs.f b/SRC/cgtrfs.f index 630b8d3836..b21ef758cd 100644 --- a/SRC/cgtrfs.f +++ b/SRC/cgtrfs.f @@ -205,7 +205,8 @@ *> \ingroup gtrfs * * ===================================================================== - SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + $ DU2, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, $ INFO ) * @@ -248,7 +249,8 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGTTRS, CLACN2, CLAGTM, XERBLA + EXTERNAL CAXPY, CCOPY, CGTTRS, CLACN2, CLAGTM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, MAX, REAL @@ -327,7 +329,8 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE, + CALL CLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, + $ ONE, $ WORK, N ) * * Compute abs(op(A))*abs(x) + abs(b) for use in the backward @@ -402,7 +405,8 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * * Update solution and try again. * - CALL CGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, N, + CALL CGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + $ N, $ INFO ) CALL CAXPY( N, CMPLX( ONE ), WORK, 1, X( 1, J ), 1 ) LSTRES = BERR( J ) @@ -449,7 +453,8 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * * Multiply by diag(W)*inv(op(A)**H). * - CALL CGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + CALL CGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV, + $ WORK, $ N, INFO ) DO 80 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) @@ -461,7 +466,8 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, DO 90 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 90 CONTINUE - CALL CGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + CALL CGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV, + $ WORK, $ N, INFO ) END IF GO TO 70 diff --git a/SRC/cgtsvx.f b/SRC/cgtsvx.f index b25dee0480..6e186e36a6 100644 --- a/SRC/cgtsvx.f +++ b/SRC/cgtsvx.f @@ -289,7 +289,8 @@ *> \ingroup gtsvx * * ===================================================================== - SUBROUTINE CGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + SUBROUTINE CGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, + $ DUF, $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -327,7 +328,8 @@ SUBROUTINE CGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, EXTERNAL LSAME, CLANGT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGTCON, CGTRFS, CGTTRF, CGTTRS, CLACPY, + EXTERNAL CCOPY, CGTCON, CGTRFS, CGTTRF, CGTTRS, + $ CLACPY, $ XERBLA * .. * .. Intrinsic Functions .. @@ -387,7 +389,8 @@ SUBROUTINE CGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * * Compute the reciprocal of the condition number of A. * - CALL CGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK, + CALL CGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * Compute the solution vectors X. @@ -399,7 +402,8 @@ SUBROUTINE CGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, + CALL CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/cgttrs.f b/SRC/cgttrs.f index 2edabac33c..f79eda21f6 100644 --- a/SRC/cgttrs.f +++ b/SRC/cgttrs.f @@ -134,7 +134,8 @@ *> \ingroup gttrs * * ===================================================================== - SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, + SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -213,7 +214,8 @@ SUBROUTINE CGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, ELSE DO 10 J = 1, NRHS, NB JB = MIN( NRHS-J+1, NB ) - CALL CGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), + CALL CGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, + $ J ), $ LDB ) 10 CONTINUE END IF diff --git a/SRC/cgtts2.f b/SRC/cgtts2.f index 7e846825ef..cfd164bcd8 100644 --- a/SRC/cgtts2.f +++ b/SRC/cgtts2.f @@ -125,7 +125,8 @@ *> \ingroup gtts2 * * ===================================================================== - SUBROUTINE CGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) + SUBROUTINE CGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f index 9cdae58e93..2573273999 100644 --- a/SRC/chb2st_kernels.f +++ b/SRC/chb2st_kernels.f @@ -288,7 +288,8 @@ SUBROUTINE CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = CONJG( A( DPOS-NB, J1 ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP * CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), diff --git a/SRC/chbev.f b/SRC/chbev.f index 17ab41130b..dc4f4de8ef 100644 --- a/SRC/chbev.f +++ b/SRC/chbev.f @@ -182,7 +182,8 @@ SUBROUTINE CHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, CLANHB, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CHBTRD, CLASCL, CSTEQR, SSCAL, SSTERF, XERBLA + EXTERNAL CHBTRD, CLASCL, CSTEQR, SSCAL, SSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -252,9 +253,11 @@ SUBROUTINE CHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * diff --git a/SRC/chbev_2stage.f b/SRC/chbev_2stage.f index c4521f5aeb..81e59003bd 100644 --- a/SRC/chbev_2stage.f +++ b/SRC/chbev_2stage.f @@ -207,7 +207,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, RWORK, INFO ) * IMPLICIT NONE @@ -246,7 +247,8 @@ SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR, + EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, + $ CSTEQR, $ CHETRD_2STAGE, CHETRD_HB2ST * .. * .. Intrinsic Functions .. @@ -339,9 +341,11 @@ SUBROUTINE CHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * diff --git a/SRC/chbevd.f b/SRC/chbevd.f index 7c9968669f..e23d0038c7 100644 --- a/SRC/chbevd.f +++ b/SRC/chbevd.f @@ -205,7 +205,8 @@ *> \ingroup hbevd * * ===================================================================== - SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, + SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -244,7 +245,8 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, CLANHB, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CGEMM, CHBTRD, CLACPY, CLASCL, CSTEDC, SSCAL, + EXTERNAL CGEMM, CHBTRD, CLACPY, CLASCL, CSTEDC, + $ SSCAL, $ SSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -343,9 +345,11 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -364,7 +368,8 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL CGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/chbevd_2stage.f b/SRC/chbevd_2stage.f index 2dbe33d7ef..9e1be2e6b6 100644 --- a/SRC/chbevd_2stage.f +++ b/SRC/chbevd_2stage.f @@ -249,7 +249,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * @@ -293,7 +294,8 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, SLAMCH, CLANHB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL SSCAL, SSTERF, XERBLA, CGEMM, CLACPY, + EXTERNAL SSCAL, SSTERF, XERBLA, CGEMM, + $ CLACPY, $ CLASCL, CSTEDC, CHETRD_HB2ST * .. * .. Intrinsic Functions .. @@ -313,9 +315,12 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LRWMIN = 1 LIWMIN = 1 ELSE - IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'CHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'CHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'CHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) IF( WANTZ ) THEN LWMIN = 2*N**2 LRWMIN = 1 + 5*N + 2*N**2 @@ -395,9 +400,11 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -421,7 +428,8 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL CGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/chbevx.f b/SRC/chbevx.f index db8d57c26e..821beccb00 100644 --- a/SRC/chbevx.f +++ b/SRC/chbevx.f @@ -262,7 +262,8 @@ *> \ingroup hbevx * * ===================================================================== - SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, + SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, + $ VL, $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * @@ -307,7 +308,8 @@ SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, EXTERNAL LSAME, CLANHB, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMV, CHBTRD, CLACPY, CLASCL, CSTEIN, + EXTERNAL CCOPY, CGEMV, CHBTRD, CLACPY, CLASCL, + $ CSTEIN, $ CSTEQR, CSWAP, SCOPY, SSCAL, SSTEBZ, SSTERF, $ XERBLA * .. @@ -417,9 +419,11 @@ SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/chbevx_2stage.f b/SRC/chbevx_2stage.f index 07431b0560..88ced7b1ca 100644 --- a/SRC/chbevx_2stage.f +++ b/SRC/chbevx_2stage.f @@ -373,7 +373,8 @@ SUBROUTINE CHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CCOPY, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, + $ CCOPY, $ CGEMV, CLACPY, CLASCL, CSTEIN, CSTEQR, $ CSWAP, CHETRD_HB2ST * .. @@ -505,9 +506,11 @@ SUBROUTINE CHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/chbgst.f b/SRC/chbgst.f index 8aec38f36c..6fde73e0b7 100644 --- a/SRC/chbgst.f +++ b/SRC/chbgst.f @@ -161,7 +161,8 @@ *> \ingroup hbgst * * ===================================================================== - SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, + SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ X, $ LDX, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -198,7 +199,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGERC, CGERU, CLACGV, CLAR2V, CLARGV, CLARTG, + EXTERNAL CGERC, CGERU, CLACGV, CLAR2V, CLARGV, + $ CLARTG, $ CLARTV, CLASET, CROT, CSSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -442,7 +444,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL CLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1, + $ CALL CLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), + $ KA1, $ RWORK( J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -671,7 +674,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * * generate rotation to annihilate a(i-k+ka+1,i) * - CALL CLARTG( AB( KA1-K, I ), RA1, RWORK( I-K+KA-M ), + CALL CLARTG( AB( KA1-K, I ), RA1, + $ RWORK( I-K+KA-M ), $ WORK( I-K+KA-M ), RA ) * * create nonzero element a(i-k+ka+1,i-k) outside the @@ -707,7 +711,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL CLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ), + $ CALL CLARGV( NRT, AB( KA1, J2T-KA ), INCA, + $ WORK( J2T-M ), $ KA1, RWORK( J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -722,7 +727,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 1st set from both sides to diagonal * blocks * - CALL CLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL CLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, RWORK( J2-M ), WORK( J2-M ), KA1 ) * CALL CLACGV( NR, WORK( J2-M ), KA1 ) @@ -804,7 +810,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL CLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1, + CALL CLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), + $ KA1, $ RWORK( J2 ), KA1 ) * * apply rotations in 2nd set from the left @@ -818,7 +825,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from both sides to diagonal * blocks * - CALL CLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL CLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, RWORK( J2 ), WORK( J2 ), KA1 ) * CALL CLACGV( NR, WORK( J2 ), KA1 ) @@ -1022,7 +1030,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL CLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1, + $ CALL CLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), + $ KA1, $ RWORK( J1 ), KA1 ) IF( NR.GT.0 ) THEN * @@ -1123,7 +1132,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL CLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ), + CALL CLARGV( NR, AB( 1, J1+KA ), INCA, + $ WORK( M-KB+J1 ), $ KA1, RWORK( M-KB+J1 ), KA1 ) * * apply rotations in 2nd set from the left @@ -1233,7 +1243,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL CSSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL CGERC( NX, KBT, -CONE, X( 1, I ), 1, BB( 2, I ), + $ CALL CGERC( NX, KBT, -CONE, X( 1, I ), 1, BB( 2, + $ I ), $ 1, X( 1, I+1 ), LDX ) END IF * @@ -1292,14 +1303,16 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL CLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1, + $ CALL CLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), + $ KA1, $ RWORK( J1 ), KA1 ) IF( NR.GT.0 ) THEN * * apply rotations in 1st set from the right * DO 810 L = 1, KA - 1 - CALL CLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL CLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, RWORK( J1 ), WORK( J1 ), KA1 ) 810 CONTINUE * @@ -1398,7 +1411,8 @@ SUBROUTINE CHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from the right * DO 890 L = 1, KA - 1 - CALL CLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL CLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, RWORK( M-KB+J1 ), WORK( M-KB+J1 ), $ KA1 ) 890 CONTINUE diff --git a/SRC/chbgv.f b/SRC/chbgv.f index dd7e62cbe2..99ff043131 100644 --- a/SRC/chbgv.f +++ b/SRC/chbgv.f @@ -179,7 +179,8 @@ *> \ingroup hbgv * * ===================================================================== - SUBROUTINE CHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, + SUBROUTINE CHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + $ Z, $ LDZ, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -208,7 +209,8 @@ SUBROUTINE CHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CHBGST, CHBTRD, CPBSTF, CSTEQR, SSTERF, XERBLA + EXTERNAL CHBGST, CHBTRD, CPBSTF, CSTEQR, SSTERF, + $ XERBLA * .. * .. Executable Statements .. * diff --git a/SRC/chbgvd.f b/SRC/chbgvd.f index 0ccb7ffaa7..064227b840 100644 --- a/SRC/chbgvd.f +++ b/SRC/chbgvd.f @@ -241,7 +241,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ W, $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * @@ -280,7 +281,8 @@ SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SSTERF, XERBLA, CGEMM, CHBGST, CHBTRD, CLACPY, + EXTERNAL SSTERF, XERBLA, CGEMM, CHBGST, CHBTRD, + $ CLACPY, $ CPBSTF, CSTEDC * .. * .. Executable Statements .. @@ -382,7 +384,8 @@ SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL CSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL CGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/chbgvx.f b/SRC/chbgvx.f index 36d77437ae..b2566040fa 100644 --- a/SRC/chbgvx.f +++ b/SRC/chbgvx.f @@ -337,7 +337,8 @@ SUBROUTINE CHBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMV, CHBGST, CHBTRD, CLACPY, CPBSTF, + EXTERNAL CCOPY, CGEMV, CHBGST, CHBTRD, CLACPY, + $ CPBSTF, $ CSTEIN, CSTEQR, CSWAP, SCOPY, SSTEBZ, SSTERF, $ XERBLA * .. diff --git a/SRC/chbtrd.f b/SRC/chbtrd.f index d77a4e31f6..b834843ebc 100644 --- a/SRC/chbtrd.f +++ b/SRC/chbtrd.f @@ -193,7 +193,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, COMPLEX T, TEMP * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLAR2V, CLARGV, CLARTG, CLARTV, CLASET, + EXTERNAL CLACGV, CLAR2V, CLARGV, CLARTG, CLARTV, + $ CLASET, $ CROT, CSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -277,7 +278,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * generate plane rotations to annihilate nonzero * elements which have been created outside the band * - CALL CLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ), + CALL CLARGV( NR, AB( 1, J1-1 ), INCA, + $ WORK( J1 ), $ KD1, D( J1 ), KD1 ) * * apply rotations from the right @@ -349,7 +351,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL CLARTV( NRT, AB( KD-L, J1+L ), INCA, + $ CALL CLARTV( NRT, AB( KD-L, J1+L ), + $ INCA, $ AB( KD-L+1, J1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 30 CONTINUE @@ -357,7 +360,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, J1END = J1 + KD1*( NR-2 ) IF( J1END.GE.J1 ) THEN DO 40 JIN = J1, J1END, KD1 - CALL CROT( KD-1, AB( KD-1, JIN+1 ), INCX, + CALL CROT( KD-1, AB( KD-1, JIN+1 ), + $ INCX, $ AB( KD, JIN+1 ), INCX, $ D( JIN ), WORK( JIN ) ) 40 CONTINUE @@ -392,13 +396,15 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL CROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL CROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), CONJG( WORK( J ) ) ) 50 CONTINUE ELSE * DO 60 J = J1, J2, KD1 - CALL CROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL CROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), CONJG( WORK( J ) ) ) 60 CONTINUE END IF @@ -496,7 +502,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * IF( NR.GT.2*KD-1 ) THEN DO 130 L = 1, KD - 1 - CALL CLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA, + CALL CLARTV( NR, AB( KD1-L, J1-KD1+L ), + $ INCA, $ AB( KD1-L+1, J1-KD1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 130 CONTINUE @@ -555,7 +562,8 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL CLARTV( NRT, AB( L+2, J1-1 ), INCA, + $ CALL CLARTV( NRT, AB( L+2, J1-1 ), + $ INCA, $ AB( L+1, J1 ), INCA, D( J1 ), $ WORK( J1 ), KD1 ) 150 CONTINUE @@ -600,13 +608,15 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL CROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL CROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 170 CONTINUE ELSE * DO 180 J = J1, J2, KD1 - CALL CROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL CROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 180 CONTINUE END IF diff --git a/SRC/checon_rook.f b/SRC/checon_rook.f index f7164ea746..31a141f049 100644 --- a/SRC/checon_rook.f +++ b/SRC/checon_rook.f @@ -135,7 +135,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE CHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/cheequb.f b/SRC/cheequb.f index 608eb938a5..34b04f1500 100644 --- a/SRC/cheequb.f +++ b/SRC/cheequb.f @@ -129,7 +129,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -182,7 +183,8 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/cheev.f b/SRC/cheev.f index fda28e6dd3..6ddee5e16d 100644 --- a/SRC/cheev.f +++ b/SRC/cheev.f @@ -174,7 +174,8 @@ SUBROUTINE CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHETRD, CLASCL, CSTEQR, CUNGTR, SSCAL, SSTERF, + EXTERNAL CHETRD, CLASCL, CSTEQR, CUNGTR, SSCAL, + $ SSTERF, $ XERBLA * .. * .. Intrinsic Functions .. @@ -267,7 +268,8 @@ SUBROUTINE CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) INDWRK = INDE + N CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA, diff --git a/SRC/cheev_2stage.f b/SRC/cheev_2stage.f index 6df9e5053d..db522ba7db 100644 --- a/SRC/cheev_2stage.f +++ b/SRC/cheev_2stage.f @@ -226,7 +226,8 @@ SUBROUTINE CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, CSTEQR, + EXTERNAL SSCAL, SSTERF, XERBLA, CLASCL, + $ CSTEQR, $ CUNGTR, CHETRD_2STAGE * .. * .. Intrinsic Functions .. @@ -252,10 +253,14 @@ SUBROUTINE CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = N + LHTRD + LWTRD WORK( 1 ) = SROUNDUP_LWORK(LWMIN) * @@ -325,7 +330,8 @@ SUBROUTINE CHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL CUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) INDWRK = INDE + N CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA, diff --git a/SRC/cheevd.f b/SRC/cheevd.f index cdd5ca1c77..d2e2cad248 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -194,7 +194,8 @@ *> at Berkeley, USA *> * ===================================================================== - SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ RWORK, $ LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -234,7 +235,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHETRD, CLACPY, CLASCL, CSTEDC, CUNMTR, SSCAL, + EXTERNAL CHETRD, CLACPY, CLASCL, CSTEDC, CUNMTR, + $ SSCAL, $ SSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -278,7 +280,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LIWMIN = 1 END IF LOPT = MAX( LWMIN, N + - $ N*ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) ) + $ N*ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, + $ -1 ) ) LROPT = LRWMIN LIOPT = LIWMIN END IF diff --git a/SRC/cheevd_2stage.f b/SRC/cheevd_2stage.f index 198164ebb6..30b46b1f8d 100644 --- a/SRC/cheevd_2stage.f +++ b/SRC/cheevd_2stage.f @@ -243,7 +243,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, + $ LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -288,7 +289,8 @@ SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, SLAMCH, CLANHE, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL SSCAL, SSTERF, XERBLA, CLACPY, CLASCL, + EXTERNAL SSCAL, SSTERF, XERBLA, CLACPY, + $ CLASCL, $ CSTEDC, CUNMTR, CHETRD_2STAGE * .. * .. Intrinsic Functions .. diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 5e75891f40..e2e9a5cda5 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -355,7 +355,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * @@ -400,7 +401,8 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, CLANSY, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHETRD, CSSCAL, CSTEMR, CSTEIN, CSWAP, CUNMTR, + EXTERNAL CHETRD, CSSCAL, CSTEMR, CSTEIN, CSWAP, + $ CUNMTR, $ SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -677,7 +679,8 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index 2894392ce8..2bca767dc7 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -452,7 +452,8 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, + $ CSSCAL, $ CHETRD_2STAGE, CSTEMR, CSTEIN, CSWAP, CUNMTR * .. * .. Intrinsic Functions .. @@ -734,7 +735,8 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/cheevx.f b/SRC/cheevx.f index 8ace8a1f95..bb8bb4a206 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -254,7 +254,8 @@ *> \ingroup heevx * * ===================================================================== - SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * @@ -299,7 +300,8 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, SLAMCH, CLANHE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, + $ CSSCAL, $ CHETRD, CLACPY, CSTEIN, CSTEQR, CSWAP, CUNGTR, $ CUNMTR * .. @@ -505,7 +507,8 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * Apply unitary matrix used in reduction to tridiagonal * form to eigenvectors returned by CSTEIN. * - CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWRK ), LLWORK, IINFO ) END IF * diff --git a/SRC/cheevx_2stage.f b/SRC/cheevx_2stage.f index b387bcd76e..3793e37445 100644 --- a/SRC/cheevx_2stage.f +++ b/SRC/cheevx_2stage.f @@ -349,7 +349,8 @@ SUBROUTINE CHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, CSSCAL, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, + $ CSSCAL, $ CLACPY, CSTEIN, CSTEQR, CSWAP, CUNGTR, CUNMTR, $ CHETRD_2STAGE * .. @@ -564,7 +565,8 @@ SUBROUTINE CHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * Apply unitary matrix used in reduction to tridiagonal * form to eigenvectors returned by CSTEIN. * - CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL CUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWRK ), LLWORK, IINFO ) END IF * diff --git a/SRC/chegs2.f b/SRC/chegs2.f index abfa9bd716..eca69665d3 100644 --- a/SRC/chegs2.f +++ b/SRC/chegs2.f @@ -154,7 +154,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) COMPLEX CT * .. * .. External Subroutines .. - EXTERNAL CAXPY, CHER2, CLACGV, CSSCAL, CTRMV, CTRSV, + EXTERNAL CAXPY, CHER2, CLACGV, CSSCAL, CTRMV, + $ CTRSV, $ XERBLA * .. * .. Intrinsic Functions .. @@ -211,7 +212,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL CAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ), $ LDA ) CALL CLACGV( N-K, B( K, K+1 ), LDB ) - CALL CTRSV( UPLO, 'Conjugate transpose', 'Non-unit', + CALL CTRSV( UPLO, 'Conjugate transpose', + $ 'Non-unit', $ N-K, B( K+1, K+1 ), LDB, A( K, K+1 ), $ LDA ) CALL CLACGV( N-K, A( K, K+1 ), LDA ) @@ -232,10 +234,12 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) IF( K.LT.N ) THEN CALL CSSCAL( N-K, ONE / BKK, A( K+1, K ), 1 ) CT = -HALF*AKK - CALL CAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL CAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL CHER2( UPLO, N-K, -CONE, A( K+1, K ), 1, $ B( K+1, K ), 1, A( K+1, K+1 ), LDA ) - CALL CAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL CAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL CTRSV( UPLO, 'No transpose', 'Non-unit', N-K, $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 ) END IF @@ -256,7 +260,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDB, A( 1, K ), 1 ) CT = HALF*AKK CALL CAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) - CALL CHER2( UPLO, K-1, CONE, A( 1, K ), 1, B( 1, K ), 1, + CALL CHER2( UPLO, K-1, CONE, A( 1, K ), 1, B( 1, K ), + $ 1, $ A, LDA ) CALL CAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) CALL CSSCAL( K-1, BKK, A( 1, K ), 1 ) @@ -273,12 +278,14 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) AKK = REAL( A( K, K ) ) BKK = REAL( B( K, K ) ) CALL CLACGV( K-1, A( K, 1 ), LDA ) - CALL CTRMV( UPLO, 'Conjugate transpose', 'Non-unit', K-1, + CALL CTRMV( UPLO, 'Conjugate transpose', 'Non-unit', + $ K-1, $ B, LDB, A( K, 1 ), LDA ) CT = HALF*AKK CALL CLACGV( K-1, B( K, 1 ), LDB ) CALL CAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) - CALL CHER2( UPLO, K-1, CONE, A( K, 1 ), LDA, B( K, 1 ), + CALL CHER2( UPLO, K-1, CONE, A( K, 1 ), LDA, B( K, + $ 1 ), $ LDB, A, LDA ) CALL CAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) CALL CLACGV( K-1, B( K, 1 ), LDB ) diff --git a/SRC/chegst.f b/SRC/chegst.f index 4083dc2f19..d5790df95a 100644 --- a/SRC/chegst.f +++ b/SRC/chegst.f @@ -153,7 +153,8 @@ SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) INTEGER K, KB, NB * .. * .. External Subroutines .. - EXTERNAL CHEGS2, CHEMM, CHER2K, CTRMM, CTRSM, XERBLA + EXTERNAL CHEGS2, CHEMM, CHER2K, CTRMM, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -222,7 +223,8 @@ SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL CHEMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, $ A( K, K ), LDA, B( K, K+KB ), LDB, $ CONE, A( K, K+KB ), LDA ) - CALL CHER2K( UPLO, 'Conjugate transpose', N-K-KB+1, + CALL CHER2K( UPLO, 'Conjugate transpose', + $ N-K-KB+1, $ KB, -CONE, A( K, K+KB ), LDA, $ B( K, K+KB ), LDB, ONE, $ A( K+KB, K+KB ), LDA ) @@ -247,7 +249,8 @@ SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL CHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL CTRSM( 'Right', UPLO, 'Conjugate transpose', + CALL CTRSM( 'Right', UPLO, + $ 'Conjugate transpose', $ 'Non-unit', N-K-KB+1, KB, CONE, $ B( K, K ), LDB, A( K+KB, K ), LDA ) CALL CHEMM( 'Right', UPLO, N-K-KB+1, KB, -HALF, @@ -277,15 +280,18 @@ SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the upper triangle of A(1:k+kb-1,1:k+kb-1) * - CALL CTRMM( 'Left', UPLO, 'No transpose', 'Non-unit', + CALL CTRMM( 'Left', UPLO, 'No transpose', + $ 'Non-unit', $ K-1, KB, CONE, B, LDB, A( 1, K ), LDA ) - CALL CHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL CHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, CONE, A( 1, K ), $ LDA ) CALL CHER2K( UPLO, 'No transpose', K-1, KB, CONE, $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A, $ LDA ) - CALL CHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL CHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, CONE, A( 1, K ), $ LDA ) CALL CTRMM( 'Right', UPLO, 'Conjugate transpose', @@ -303,7 +309,8 @@ SUBROUTINE CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the lower triangle of A(1:k+kb-1,1:k+kb-1) * - CALL CTRMM( 'Right', UPLO, 'No transpose', 'Non-unit', + CALL CTRMM( 'Right', UPLO, 'No transpose', + $ 'Non-unit', $ KB, K-1, CONE, B, LDB, A( K, 1 ), LDA ) CALL CHEMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, CONE, A( K, 1 ), diff --git a/SRC/chegv.f b/SRC/chegv.f index 9c318e214d..8c5804e7ed 100644 --- a/SRC/chegv.f +++ b/SRC/chegv.f @@ -177,7 +177,8 @@ *> \ingroup hegv * * ===================================================================== - SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -211,7 +212,8 @@ SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHEEV, CHEGST, CPOTRF, CTRMM, CTRSM, XERBLA + EXTERNAL CHEEV, CHEGST, CPOTRF, CTRMM, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -272,7 +274,8 @@ SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, INFO ) + CALL CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ INFO ) * IF( WANTZ ) THEN * @@ -292,7 +295,8 @@ SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'C' END IF * - CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -306,7 +310,8 @@ SUBROUTINE CHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'N' END IF * - CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/chegv_2stage.f b/SRC/chegv_2stage.f index 8ad59a0b25..d7afd1548a 100644 --- a/SRC/chegv_2stage.f +++ b/SRC/chegv_2stage.f @@ -228,7 +228,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, + $ W, $ WORK, LWORK, RWORK, INFO ) * IMPLICIT NONE @@ -264,7 +265,8 @@ SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, EXTERNAL LSAME, ILAENV2STAGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL XERBLA, CHEGST, CPOTRF, CTRMM, CTRSM, + EXTERNAL XERBLA, CHEGST, CPOTRF, CTRMM, + $ CTRSM, $ CHEEV_2STAGE * .. * .. Intrinsic Functions .. @@ -294,10 +296,14 @@ SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = N + LHTRD + LWTRD WORK( 1 ) = SROUNDUP_LWORK(LWMIN) * @@ -350,7 +356,8 @@ SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'C' END IF * - CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -364,7 +371,8 @@ SUBROUTINE CHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'N' END IF * - CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/chegvd.f b/SRC/chegvd.f index d9d16b8c7f..6c412b4742 100644 --- a/SRC/chegvd.f +++ b/SRC/chegvd.f @@ -239,7 +239,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA *> * ===================================================================== - SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -273,7 +274,8 @@ SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHEEVD, CHEGST, CPOTRF, CTRMM, CTRSM, XERBLA + EXTERNAL CHEEVD, CHEGST, CPOTRF, CTRMM, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL @@ -354,7 +356,8 @@ SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, + CALL CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ LRWORK, $ IWORK, LIWORK, INFO ) LOPT = INT( MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) ) LROPT = INT( MAX( REAL( LROPT ), REAL( RWORK( 1 ) ) ) ) diff --git a/SRC/chegvx.f b/SRC/chegvx.f index ecee050c91..3f548649ac 100644 --- a/SRC/chegvx.f +++ b/SRC/chegvx.f @@ -340,7 +340,8 @@ SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHEEVX, CHEGST, CPOTRF, CTRMM, CTRSM, XERBLA + EXTERNAL CHEEVX, CHEGST, CPOTRF, CTRMM, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -424,7 +425,8 @@ SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, * Transform problem to standard eigenvalue problem and solve. * CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, + CALL CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, $ INFO ) * @@ -445,7 +447,8 @@ SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'C' END IF * - CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B, + CALL CTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, + $ B, $ LDB, Z, LDZ ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -459,7 +462,8 @@ SUBROUTINE CHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'N' END IF * - CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B, + CALL CTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, + $ B, $ LDB, Z, LDZ ) END IF END IF diff --git a/SRC/cherfs.f b/SRC/cherfs.f index 52c8a37b58..382a531ea1 100644 --- a/SRC/cherfs.f +++ b/SRC/cherfs.f @@ -188,7 +188,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHEMV, CHETRS, CLACN2, XERBLA + EXTERNAL CAXPY, CCOPY, CHEMV, CHETRS, CLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -303,7 +305,8 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * Compute residual R = B - A * X * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL CHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * @@ -410,7 +413,8 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * * Multiply by diag(W)*inv(A**H). * - CALL CHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL CHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -421,7 +425,8 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL CHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL CHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/cherfsx.f b/SRC/cherfsx.f index ed7343f5d7..71a1073b60 100644 --- a/SRC/cherfsx.f +++ b/SRC/cherfsx.f @@ -395,7 +395,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE CHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -460,7 +461,8 @@ SUBROUTINE CHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL SLAMCH, CLANHE, CLA_HERCOND_X, CLA_HERCOND_C + EXTERNAL SLAMCH, CLANHE, CLA_HERCOND_X, + $ CLA_HERCOND_C REAL SLAMCH, CLANHE, CLA_HERCOND_X, CLA_HERCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -517,7 +519,8 @@ SUBROUTINE CHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF (.NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF (.NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -609,10 +612,12 @@ SUBROUTINE CHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute scaled normwise condition number cond(A*C). * IF ( RCEQU ) THEN - RCOND_TMP = CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/chesv.f b/SRC/chesv.f index 3b9ad1d9ae..4c11b53c5d 100644 --- a/SRC/chesv.f +++ b/SRC/chesv.f @@ -207,7 +207,8 @@ SUBROUTINE CHESV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f index 82c429b1c5..a3daf79050 100644 --- a/SRC/chesv_aa.f +++ b/SRC/chesv_aa.f @@ -199,7 +199,8 @@ SUBROUTINE CHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = 0 LQUERY = ( LWORK.EQ.-1 ) LWKMIN = MAX( 1, 2*N, 3*N-2 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/chesv_rk.f b/SRC/chesv_rk.f index 19e74f901e..4cb3989c09 100644 --- a/SRC/chesv_rk.f +++ b/SRC/chesv_rk.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, + SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -263,7 +264,8 @@ SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -281,7 +283,8 @@ SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -302,7 +305,8 @@ SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/chesv_rook.f b/SRC/chesv_rook.f index da84af8b49..88859b0b18 100644 --- a/SRC/chesv_rook.f +++ b/SRC/chesv_rook.f @@ -201,7 +201,8 @@ * * * ===================================================================== - SUBROUTINE CHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE CHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -241,7 +242,8 @@ SUBROUTINE CHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -281,7 +283,8 @@ SUBROUTINE CHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS ( Use Level BLAS 2) * - CALL CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/chesvx.f b/SRC/chesvx.f index 8587531ef0..43b4953f30 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -280,7 +280,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ RWORK, INFO ) * @@ -318,7 +319,8 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHECON, CHERFS, CHETRF, CHETRS, CLACPY, XERBLA + EXTERNAL CHECON, CHERFS, CHETRF, CHETRS, CLACPY, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -333,7 +335,8 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LWKMIN = MAX( 1, 2*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -389,7 +392,8 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL CHECON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, INFO ) + CALL CHECON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * Compute the solution vectors X. * diff --git a/SRC/chesvxx.f b/SRC/chesvxx.f index 7d78d5c0e8..4318bc5d9b 100644 --- a/SRC/chesvxx.f +++ b/SRC/chesvxx.f @@ -503,7 +503,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) @@ -631,7 +632,8 @@ SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -650,7 +652,8 @@ SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^H or UDU^H factorization of A. * CALL CLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CHETRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL CHETRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * @@ -661,7 +664,8 @@ SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * leading rank-deficient INFO columns of A. * IF( N.GT.0 ) - $ RPVGRW = CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ RPVGRW = CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, + $ LDAF, $ IPIV, RWORK ) RETURN END IF @@ -670,7 +674,8 @@ SUBROUTINE CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the reciprocal pivot growth factor RPVGRW. * IF( N.GT.0 ) - $ RPVGRW = CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, + $ RPVGRW = CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ IPIV, $ RWORK ) * * Compute the solution matrix X. diff --git a/SRC/chetd2.f b/SRC/chetd2.f index d70ca18cd4..a7e33fbbf8 100644 --- a/SRC/chetd2.f +++ b/SRC/chetd2.f @@ -256,7 +256,8 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute x := tau * A * v storing x in TAU(1:i) * - CALL CHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, + CALL CHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, + $ ZERO, $ TAU, 1 ) * * Compute w := x - 1/2 * tau * (x**H * v) * v @@ -305,14 +306,16 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute w := x - 1/2 * tau * (x**H * v) * v * - ALPHA = -HALF*TAUI*CDOTC( N-I, TAU( I ), 1, A( I+1, I ), + ALPHA = -HALF*TAUI*CDOTC( N-I, TAU( I ), 1, A( I+1, + $ I ), $ 1 ) CALL CAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**H - w * v**H * - CALL CHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, + CALL CHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), + $ 1, $ A( I+1, I+1 ), LDA ) * ELSE diff --git a/SRC/chetf2.f b/SRC/chetf2.f index 6a8dfdb0e5..7f25b3dd76 100644 --- a/SRC/chetf2.f +++ b/SRC/chetf2.f @@ -285,7 +285,8 @@ SUBROUTINE CHETF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ SISNAN(ABSAKK) ) THEN * * Column K is or underflow, or contains a NaN: * set INFO and continue @@ -469,7 +470,8 @@ SUBROUTINE CHETF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ SISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, contains a NaN: * set INFO and continue @@ -492,7 +494,8 @@ SUBROUTINE CHETF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) ) END IF * @@ -525,7 +528,8 @@ SUBROUTINE CHETF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) DO 60 J = KK + 1, KP - 1 T = CONJG( A( J, KK ) ) A( J, KK ) = CONJG( A( KP, J ) ) diff --git a/SRC/chetf2_rk.f b/SRC/chetf2_rk.f index 657f1ce162..66c7d3e6e7 100644 --- a/SRC/chetf2_rk.f +++ b/SRC/chetf2_rk.f @@ -492,7 +492,8 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -561,7 +562,8 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / REAL( A( K, K ) ) - CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -580,7 +582,8 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -753,14 +756,16 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = CABS1( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -856,7 +861,8 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.NE.KK ) THEN * (1) Swap columnar parts IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * (2) Swap and conjugate middle parts DO 45 J = KK + 1, KP - 1 T = CONJG( A( J, KK ) ) diff --git a/SRC/chetf2_rook.f b/SRC/chetf2_rook.f index 775899410e..a810700d32 100644 --- a/SRC/chetf2_rook.f +++ b/SRC/chetf2_rook.f @@ -486,7 +486,8 @@ SUBROUTINE CHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / REAL( A( K, K ) ) - CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -505,7 +506,8 @@ SUBROUTINE CHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -652,14 +654,16 @@ SUBROUTINE CHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = CABS1( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -748,7 +752,8 @@ SUBROUTINE CHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.NE.KK ) THEN * (1) Swap columnar parts IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * (2) Swap and conjugate middle parts DO 45 J = KK + 1, KP - 1 T = CONJG( A( J, KK ) ) diff --git a/SRC/chetrd.f b/SRC/chetrd.f index 40ada21230..f225a5134a 100644 --- a/SRC/chetrd.f +++ b/SRC/chetrd.f @@ -189,7 +189,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) + SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f index 97fbfea8ad..d3cb67b001 100644 --- a/SRC/chetrd_2stage.f +++ b/SRC/chetrd_2stage.f @@ -270,14 +270,18 @@ SUBROUTINE CHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * * Determine the block size, the workspace size and the hous size. * - KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, -1 ) + KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', VECT, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', VECT, N, KD, -1, + $ -1 ) IF( N.EQ.0 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'CHETRD_2STAGE', VECT, N, KD, + $ IB, -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_2STAGE', VECT, N, KD, + $ IB, -1 ) END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 15d53b71ae..33360ce332 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -277,7 +277,8 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, $ TPOS, WPOS, S2POS, S1POS * .. * .. External Subroutines .. - EXTERNAL XERBLA, CHER2K, CHEMM, CGEMM, CCOPY, + EXTERNAL XERBLA, CHER2K, CHEMM, CGEMM, + $ CCOPY, $ CLARFT, CGELQF, CGEQRF, CLASET * .. * .. Intrinsic Functions .. @@ -386,7 +387,8 @@ SUBROUTINE CHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, * DO 20 J = I, I+PK-1 LK = MIN( KD, N-J ) + 1 - CALL CCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 ) + CALL CCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), + $ LDAB-1 ) 20 CONTINUE * CALL CLASET( 'Lower', PK, PK, ZERO, ONE, diff --git a/SRC/chetrf.f b/SRC/chetrf.f index 136408d9ec..8504495c07 100644 --- a/SRC/chetrf.f +++ b/SRC/chetrf.f @@ -246,7 +246,8 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'CHETRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CHETRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -275,7 +276,8 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k-kb+1:k of A and use blocked code to * update columns 1:k-kb * - CALL CLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO ) + CALL CLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, + $ IINFO ) ELSE * * Use unblocked code to factorize columns 1:k of A @@ -315,13 +317,15 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL CLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL CLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, N, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL CHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL CHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index 8a1faabf7a..aa0243f576 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -166,7 +166,8 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLAHEF_AA, CGEMM, CCOPY, CSWAP, CSCAL, XERBLA + EXTERNAL CLAHEF_AA, CGEMM, CCOPY, CSWAP, CSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC REAL, CONJG, MAX @@ -440,7 +441,8 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * J3 = J2 DO MJ = NJ-1, 1, -1 - CALL CGEMM( 'No transpose', 'Conjugate transpose', + CALL CGEMM( 'No transpose', + $ 'Conjugate transpose', $ MJ, 1, JB+1, $ -ONE, WORK( (J3-J1+1)+K1*N ), N, $ A( J3, J1-K2 ), LDA, diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index 130111f66e..352879b82c 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -562,13 +562,15 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * Compute H(J,J) * IF( J.EQ.1 ) THEN - CALL CGEMM( 'NoTranspose', 'Conjugate transpose', + CALL CGEMM( 'NoTranspose', + $ 'Conjugate transpose', $ KB, KB, KB, $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1, $ A( J*NB+1, (J-1)*NB+1 ), LDA, $ ZERO, WORK( J*NB+1 ), N ) ELSE - CALL CGEMM( 'NoTranspose', 'Conjugate transpose', + CALL CGEMM( 'NoTranspose', + $ 'Conjugate transpose', $ KB, KB, NB+KB, $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ), $ LDTB-1, diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f index d1811e3fe1..2174afe2f1 100644 --- a/SRC/chetrf_rk.f +++ b/SRC/chetrf_rk.f @@ -427,7 +427,8 @@ SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL CLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL CLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/chetrf_rook.f b/SRC/chetrf_rook.f index 0055d0a6a1..0f076e647a 100644 --- a/SRC/chetrf_rook.f +++ b/SRC/chetrf_rook.f @@ -209,7 +209,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/chetri.f b/SRC/chetri.f index 8874941205..3ff1e8656f 100644 --- a/SRC/chetri.f +++ b/SRC/chetri.f @@ -224,7 +224,8 @@ SUBROUTINE CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) END IF KSTEP = 1 @@ -249,15 +250,18 @@ SUBROUTINE CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) A( K, K+1 ) = A( K, K+1 ) - - $ CDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ CDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL CCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) A( K+1, K+1 ) = A( K+1, K+1 ) - - $ REAL( CDOTC( K-1, WORK, 1, A( 1, K+1 ), + $ REAL( CDOTC( K-1, WORK, 1, A( 1, + $ K+1 ), $ 1 ) ) END IF KSTEP = 2 @@ -317,7 +321,8 @@ SUBROUTINE CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - REAL( CDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) @@ -342,18 +347,22 @@ SUBROUTINE CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - REAL( CDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) A( K, K-1 ) = A( K, K-1 ) - - $ CDOTC( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ CDOTC( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL CCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ REAL( CDOTC( N-K, WORK, 1, A( K+1, K-1 ), + $ REAL( CDOTC( N-K, WORK, 1, A( K+1, + $ K-1 ), $ 1 ) ) END IF KSTEP = 2 diff --git a/SRC/chetri2x.f b/SRC/chetri2x.f index eb5008c19c..d0e393a857 100644 --- a/SRC/chetri2x.f +++ b/SRC/chetri2x.f @@ -385,8 +385,10 @@ SUBROUTINE CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -568,12 +570,16 @@ SUBROUTINE CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF ( I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP , + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/chetri_3x.f b/SRC/chetri_3x.f index 70d77d3a67..57c1b9b77a 100644 --- a/SRC/chetri_3x.f +++ b/SRC/chetri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -192,7 +193,8 @@ SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMM, CHESWAPR, CTRTRI, CTRMM, XERBLA + EXTERNAL CGEMM, CHESWAPR, CTRTRI, CTRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, MAX, REAL @@ -437,8 +439,10 @@ SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -633,8 +637,10 @@ SUBROUTINE CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CHESWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/chetri_rook.f b/SRC/chetri_rook.f index 49ea89d332..989cbba3bc 100644 --- a/SRC/chetri_rook.f +++ b/SRC/chetri_rook.f @@ -238,7 +238,8 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) END IF KSTEP = 1 @@ -263,15 +264,18 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - REAL( CDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) A( K, K+1 ) = A( K, K+1 ) - - $ CDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ CDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL CCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL CHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K+1 ), 1 ) A( K+1, K+1 ) = A( K+1, K+1 ) - - $ REAL( CDOTC( K-1, WORK, 1, A( 1, K+1 ), + $ REAL( CDOTC( K-1, WORK, 1, A( 1, + $ K+1 ), $ 1 ) ) END IF KSTEP = 2 @@ -384,7 +388,8 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - REAL( CDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) @@ -409,18 +414,22 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - REAL( CDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) A( K, K-1 ) = A( K, K-1 ) - - $ CDOTC( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ CDOTC( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL CCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL CHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ REAL( CDOTC( N-K, WORK, 1, A( K+1, K-1 ), + $ REAL( CDOTC( N-K, WORK, 1, A( K+1, + $ K-1 ), $ 1 ) ) END IF KSTEP = 2 @@ -435,7 +444,8 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 90 J = K + 1, KP - 1 TEMP = CONJG( A( J, K ) ) @@ -460,7 +470,8 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 100 J = K + 1, KP - 1 TEMP = CONJG( A( J, K ) ) @@ -486,7 +497,8 @@ SUBROUTINE CHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 110 J = K + 1, KP - 1 TEMP = CONJG( A( J, K ) ) diff --git a/SRC/chetrs.f b/SRC/chetrs.f index 8ee65a42ec..f71a4e83fe 100644 --- a/SRC/chetrs.f +++ b/SRC/chetrs.f @@ -149,7 +149,8 @@ SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, XERBLA + EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, REAL @@ -209,7 +210,8 @@ SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -230,7 +232,8 @@ SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL CGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -347,7 +350,8 @@ SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in column K of A. * IF( K.LT.N ) - $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -369,7 +373,8 @@ SUBROUTINE CHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/chetrs2.f b/SRC/chetrs2.f index 9d421c5f4c..7197c6b23d 100644 --- a/SRC/chetrs2.f +++ b/SRC/chetrs2.f @@ -156,7 +156,8 @@ SUBROUTINE CHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CSSCAL, CSYCONV, CSWAP, CTRSM, XERBLA + EXTERNAL CSSCAL, CSYCONV, CSWAP, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, REAL diff --git a/SRC/chetrs_3.f b/SRC/chetrs_3.f index 11c5e36ad3..583f86f5f8 100644 --- a/SRC/chetrs_3.f +++ b/SRC/chetrs_3.f @@ -248,7 +248,8 @@ SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -275,7 +276,8 @@ SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**H \ B) -> B [ U**H \ (D \ (U \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**H \ (D \ (U \P**T * B) )) ] * @@ -316,7 +318,8 @@ SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -343,7 +346,8 @@ SUBROUTINE CHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**H \ B) -> B [ L**H \ (D \ (L \P**T * B) ) ] * - CALL CTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**H \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f index 0662e53a39..e2a9c54232 100644 --- a/SRC/chetrs_aa.f +++ b/SRC/chetrs_aa.f @@ -166,7 +166,8 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, XERBLA + EXTERNAL CLACPY, CLACGV, CGTSV, CSWAP, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX @@ -228,7 +229,8 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U**H \ B -> B [ (U**H \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL CTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -238,8 +240,10 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1) - CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1) + CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), + $ 1) + CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), + $ 1) CALL CLACGV( N-1, WORK( 1 ), 1 ) END IF CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, @@ -251,7 +255,8 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**H \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B(2, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**H \P**T * B) )) ] @@ -295,8 +300,10 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 ) - CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1) + CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), + $ 1) CALL CLACGV( N-1, WORK( 2*N ), 1 ) END IF CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, @@ -308,7 +315,8 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ] * - CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB ) * * Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ] diff --git a/SRC/chetrs_aa_2stage.f b/SRC/chetrs_aa_2stage.f index 7f1ba8edd5..468285ef08 100644 --- a/SRC/chetrs_aa_2stage.f +++ b/SRC/chetrs_aa_2stage.f @@ -218,7 +218,8 @@ SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL CTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -231,7 +232,8 @@ SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -252,7 +254,8 @@ SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -265,7 +268,8 @@ SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL CTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL CTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/chetrs_rook.f b/SRC/chetrs_rook.f index d69840a6bf..e65e881a53 100644 --- a/SRC/chetrs_rook.f +++ b/SRC/chetrs_rook.f @@ -165,7 +165,8 @@ SUBROUTINE CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, XERBLA + EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, REAL @@ -225,7 +226,8 @@ SUBROUTINE CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -250,7 +252,8 @@ SUBROUTINE CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL CGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -372,7 +375,8 @@ SUBROUTINE CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -398,7 +402,8 @@ SUBROUTINE CHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/chfrk.f b/SRC/chfrk.f index 34bdec5869..9c5df53638 100644 --- a/SRC/chfrk.f +++ b/SRC/chfrk.f @@ -164,7 +164,8 @@ *> \ingroup hfrk * * ===================================================================== - SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, + $ BETA, $ C ) * * -- LAPACK computational routine -- @@ -292,9 +293,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ), + CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N ) * ELSE @@ -303,9 +306,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ), + CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N ) * END IF @@ -320,7 +325,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA, + CALL CHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N ) @@ -331,7 +337,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA, + CALL CHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N ) @@ -354,7 +361,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL CGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( N1+1, 1 ), LDA, CBETA, @@ -366,7 +374,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL CGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, N1+1 ), LDA, CBETA, @@ -384,9 +393,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL CHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ), + CALL CGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 ) * ELSE @@ -395,9 +406,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL CHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ), + CALL CGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 ) * END IF @@ -424,9 +437,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ), + CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ), $ N+1 ) * @@ -436,9 +451,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ), + CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ), $ N+1 ) * @@ -454,7 +471,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL CHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ), @@ -466,7 +484,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ), @@ -490,7 +509,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, CBETA, @@ -502,7 +522,8 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, CBETA, @@ -520,9 +541,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL CHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ), + CALL CGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK ) * ELSE @@ -531,9 +554,11 @@ SUBROUTINE CHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL CHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL CHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ), + CALL CGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK ) * END IF diff --git a/SRC/chgeqz.f b/SRC/chgeqz.f index 7ff8c0a77a..37235435a8 100644 --- a/SRC/chgeqz.f +++ b/SRC/chgeqz.f @@ -279,7 +279,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, + SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, + $ LDT, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * @@ -579,7 +580,8 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL CROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT, $ T( JCH+1, JCH+1 ), LDT, C, S ) IF( ILQ ) - $ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, CONJG( S ) ) IF( ILAZR2 ) $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C @@ -606,12 +608,14 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( JCH, JCH+1 ) ) T( JCH+1, JCH+1 ) = CZERO IF( JCH.LT.ILASTM-1 ) - $ CALL CROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT, + $ CALL CROT( ILASTM-JCH-1, T( JCH, JCH+2 ), + $ LDT, $ T( JCH+1, JCH+2 ), LDT, C, S ) CALL CROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH, $ H( JCH+1, JCH-1 ), LDH, C, S ) IF( ILQ ) - $ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL CROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, CONJG( S ) ) CTEMP = H( JCH+1, JCH ) CALL CLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S, @@ -622,7 +626,8 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL CROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1, $ T( IFRSTM, JCH-1 ), 1, C, S ) IF( ILZ ) - $ CALL CROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1, + $ CALL CROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), + $ 1, $ C, S ) 30 CONTINUE GO TO 50 @@ -657,7 +662,8 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL CROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1, $ T( IFRSTM, ILAST-1 ), 1, C, S ) IF( ILZ ) - $ CALL CROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S ) + $ CALL CROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, + $ S ) * * H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA * @@ -667,8 +673,10 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, SIGNBC = CONJG( T( ILAST, ILAST ) / ABSB ) T( ILAST, ILAST ) = ABSB IF( ILSCHR ) THEN - CALL CSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 ) - CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ), + CALL CSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), + $ 1 ) + CALL CSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, + $ ILAST ), $ 1 ) ELSE CALL CSCAL( 1, SIGNBC, H( ILAST, ILAST ), 1 ) diff --git a/SRC/chpcon.f b/SRC/chpcon.f index 5de7499e19..13f7c64097 100644 --- a/SRC/chpcon.f +++ b/SRC/chpcon.f @@ -115,7 +115,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE CHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO ) + SUBROUTINE CHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/chpev.f b/SRC/chpev.f index f060c3b5ea..8919baf877 100644 --- a/SRC/chpev.f +++ b/SRC/chpev.f @@ -169,7 +169,8 @@ SUBROUTINE CHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, EXTERNAL LSAME, CLANHP, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CHPTRD, CSSCAL, CSTEQR, CUPGTR, SSCAL, SSTERF, + EXTERNAL CHPTRD, CSSCAL, CSTEQR, CUPGTR, SSCAL, + $ SSTERF, $ XERBLA * .. * .. Intrinsic Functions .. @@ -184,7 +185,8 @@ SUBROUTINE CHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN diff --git a/SRC/chpevd.f b/SRC/chpevd.f index 27849ba860..70614f659e 100644 --- a/SRC/chpevd.f +++ b/SRC/chpevd.f @@ -228,7 +228,8 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, EXTERNAL LSAME, CLANHP, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHPTRD, CSSCAL, CSTEDC, CUPMTR, SSCAL, SSTERF, + EXTERNAL CHPTRD, CSSCAL, CSTEDC, CUPMTR, SSCAL, + $ SSTERF, $ XERBLA * .. * .. Intrinsic Functions .. @@ -244,7 +245,8 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -342,10 +344,12 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL CSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL CSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ LLWRK, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) - CALL CUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ, + CALL CUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/chpevx.f b/SRC/chpevx.f index 51ae863846..1123595fb3 100644 --- a/SRC/chpevx.f +++ b/SRC/chpevx.f @@ -277,7 +277,8 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, EXTERNAL LSAME, CLANHP, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CHPTRD, CSSCAL, CSTEIN, CSTEQR, CSWAP, CUPGTR, + EXTERNAL CHPTRD, CSSCAL, CSTEIN, CSTEQR, CSWAP, + $ CUPGTR, $ CUPMTR, SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -297,7 +298,8 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, INFO = -1 ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN INFO = -2 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -451,7 +453,8 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, * form to eigenvectors returned by CSTEIN. * INDWRK = INDTAU + N - CALL CUPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ, + CALL CUPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/chpgst.f b/SRC/chpgst.f index ba56396beb..6b56a97148 100644 --- a/SRC/chpgst.f +++ b/SRC/chpgst.f @@ -139,7 +139,8 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO ) COMPLEX CT * .. * .. External Subroutines .. - EXTERNAL CAXPY, CHPMV, CHPR2, CSSCAL, CTPMV, CTPSV, + EXTERNAL CAXPY, CHPMV, CHPR2, CSSCAL, CTPMV, + $ CTPSV, $ XERBLA * .. * .. Intrinsic Functions .. @@ -184,12 +185,14 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO ) * AP( JJ ) = REAL( AP( JJ ) ) BJJ = REAL( BP( JJ ) ) - CALL CTPSV( UPLO, 'Conjugate transpose', 'Non-unit', J, + CALL CTPSV( UPLO, 'Conjugate transpose', 'Non-unit', + $ J, $ BP, AP( J1 ), 1 ) CALL CHPMV( UPLO, J-1, -CONE, AP, BP( J1 ), 1, CONE, $ AP( J1 ), 1 ) CALL CSSCAL( J-1, ONE / BJJ, AP( J1 ), 1 ) - AP( JJ ) = ( AP( JJ )-CDOTC( J-1, AP( J1 ), 1, BP( J1 ), + AP( JJ ) = ( AP( JJ )-CDOTC( J-1, AP( J1 ), 1, + $ BP( J1 ), $ 1 ) ) / BJJ 10 CONTINUE ELSE @@ -264,7 +267,8 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO ) AP( JJ ) = AJJ*BJJ + CDOTC( N-J, AP( JJ+1 ), 1, $ BP( JJ+1 ), 1 ) CALL CSSCAL( N-J, BJJ, AP( JJ+1 ), 1 ) - CALL CHPMV( UPLO, N-J, CONE, AP( J1J1 ), BP( JJ+1 ), 1, + CALL CHPMV( UPLO, N-J, CONE, AP( J1J1 ), BP( JJ+1 ), + $ 1, $ CONE, AP( JJ+1 ), 1 ) CALL CTPMV( UPLO, 'Conjugate transpose', 'Non-unit', $ N-J+1, BP( JJ ), AP( JJ ), 1 ) diff --git a/SRC/chpgv.f b/SRC/chpgv.f index 2570c59dbb..1cd4bb3ba1 100644 --- a/SRC/chpgv.f +++ b/SRC/chpgv.f @@ -161,7 +161,8 @@ *> \ingroup hpgv * * ===================================================================== - SUBROUTINE CHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE CHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ RWORK, INFO ) * * -- LAPACK driver routine -- @@ -189,7 +190,8 @@ SUBROUTINE CHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CHPEV, CHPGST, CPPTRF, CTPMV, CTPSV, XERBLA + EXTERNAL CHPEV, CHPGST, CPPTRF, CTPMV, CTPSV, + $ XERBLA * .. * .. Executable Statements .. * diff --git a/SRC/chpgvd.f b/SRC/chpgvd.f index 81ac4f7ed8..23f2de5c47 100644 --- a/SRC/chpgvd.f +++ b/SRC/chpgvd.f @@ -221,7 +221,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE CHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE CHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -251,7 +252,8 @@ SUBROUTINE CHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CHPEVD, CHPGST, CPPTRF, CTPMV, CTPSV, XERBLA + EXTERNAL CHPEVD, CHPGST, CPPTRF, CTPMV, CTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL diff --git a/SRC/chpgvx.f b/SRC/chpgvx.f index 8c7248c46e..8b5bafdf70 100644 --- a/SRC/chpgvx.f +++ b/SRC/chpgvx.f @@ -303,7 +303,8 @@ SUBROUTINE CHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CHPEVX, CHPGST, CPPTRF, CTPMV, CTPSV, XERBLA + EXTERNAL CHPEVX, CHPGST, CPPTRF, CTPMV, CTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -369,7 +370,8 @@ SUBROUTINE CHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * Transform problem to standard eigenvalue problem and solve. * CALL CHPGST( ITYPE, UPLO, N, AP, BP, INFO ) - CALL CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, + CALL CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, + $ M, $ W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN diff --git a/SRC/chprfs.f b/SRC/chprfs.f index 7d56f1d5a6..30549b26bd 100644 --- a/SRC/chprfs.f +++ b/SRC/chprfs.f @@ -176,7 +176,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -218,7 +219,8 @@ SUBROUTINE CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHPMV, CHPTRS, CLACN2, XERBLA + EXTERNAL CAXPY, CCOPY, CHPMV, CHPTRS, CLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL diff --git a/SRC/chpsv.f b/SRC/chpsv.f index eed77b9aab..eb1cc706fb 100644 --- a/SRC/chpsv.f +++ b/SRC/chpsv.f @@ -191,7 +191,8 @@ SUBROUTINE CHPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/chpsvx.f b/SRC/chpsvx.f index 67db548f48..496e0e3db7 100644 --- a/SRC/chpsvx.f +++ b/SRC/chpsvx.f @@ -273,7 +273,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE CHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -308,7 +309,8 @@ SUBROUTINE CHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, CLANHP, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CHPCON, CHPRFS, CHPTRF, CHPTRS, CLACPY, + EXTERNAL CCOPY, CHPCON, CHPRFS, CHPTRF, CHPTRS, + $ CLACPY, $ XERBLA * .. * .. Intrinsic Functions .. @@ -322,7 +324,8 @@ SUBROUTINE CHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -370,7 +373,8 @@ SUBROUTINE CHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/chptrd.f b/SRC/chptrd.f index b324a1e65b..4cfcc48d7d 100644 --- a/SRC/chptrd.f +++ b/SRC/chptrd.f @@ -277,19 +277,22 @@ SUBROUTINE CHPTRD( UPLO, N, AP, D, E, TAU, INFO ) * * Compute y := tau * A * v storing y in TAU(i:n-1) * - CALL CHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, + CALL CHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), + $ 1, $ ZERO, TAU( I ), 1 ) * * Compute w := y - 1/2 * tau * (y**H *v) * v * - ALPHA = -HALF*TAUI*CDOTC( N-I, TAU( I ), 1, AP( II+1 ), + ALPHA = -HALF*TAUI*CDOTC( N-I, TAU( I ), 1, + $ AP( II+1 ), $ 1 ) CALL CAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**H - w * v**H * - CALL CHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, + CALL CHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), + $ 1, $ AP( I1I1 ) ) * END IF diff --git a/SRC/chptrf.f b/SRC/chptrf.f index 470e8c85b7..37e0ff5272 100644 --- a/SRC/chptrf.f +++ b/SRC/chptrf.f @@ -525,7 +525,8 @@ SUBROUTINE CHPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL CSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/chptri.f b/SRC/chptri.f index 8aa40985a6..8bf10ccd67 100644 --- a/SRC/chptri.f +++ b/SRC/chptri.f @@ -224,7 +224,8 @@ SUBROUTINE CHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL CHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KC ), 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - - $ REAL( CDOTC( K-1, WORK, 1, AP( KC ), 1 ) ) + $ REAL( CDOTC( K-1, WORK, 1, AP( KC ), + $ 1 ) ) END IF KSTEP = 1 ELSE @@ -249,15 +250,18 @@ SUBROUTINE CHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL CHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KC ), 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - - $ REAL( CDOTC( K-1, WORK, 1, AP( KC ), 1 ) ) + $ REAL( CDOTC( K-1, WORK, 1, AP( KC ), + $ 1 ) ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ CDOTC( K-1, AP( KC ), 1, AP( KCNEXT ), + $ CDOTC( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL CCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL CHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KCNEXT ), 1 ) AP( KCNEXT+K ) = AP( KCNEXT+K ) - - $ REAL( CDOTC( K-1, WORK, 1, AP( KCNEXT ), + $ REAL( CDOTC( K-1, WORK, 1, + $ AP( KCNEXT ), $ 1 ) ) END IF KSTEP = 2 @@ -350,7 +354,8 @@ SUBROUTINE CHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL CHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK, + CALL CHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), + $ WORK, $ 1, ZERO, AP( KC+1 ), 1 ) AP( KC ) = AP( KC ) - REAL( CDOTC( N-K, WORK, 1, $ AP( KC+1 ), 1 ) ) @@ -358,10 +363,12 @@ SUBROUTINE CHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) $ CDOTC( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL CCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL CHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK, + CALL CHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), + $ WORK, $ 1, ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - - $ REAL( CDOTC( N-K, WORK, 1, AP( KCNEXT+2 ), + $ REAL( CDOTC( N-K, WORK, 1, + $ AP( KCNEXT+2 ), $ 1 ) ) END IF KSTEP = 2 diff --git a/SRC/chptrs.f b/SRC/chptrs.f index 3c421923fd..51359ad129 100644 --- a/SRC/chptrs.f +++ b/SRC/chptrs.f @@ -144,7 +144,8 @@ SUBROUTINE CHPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, XERBLA + EXTERNAL CGEMV, CGERU, CLACGV, CSSCAL, CSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, REAL @@ -370,7 +371,8 @@ SUBROUTINE CHPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/chsein.f b/SRC/chsein.f index 0b7ddc6b33..73b477fd58 100644 --- a/SRC/chsein.f +++ b/SRC/chsein.f @@ -240,7 +240,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, + SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, + $ VL, $ LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, $ IFAILR, INFO ) * @@ -397,7 +398,8 @@ SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * Compute infinity-norm of submatrix H(KL:KR,KL:KR) if it * has not ben computed before. * - HNORM = CLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, RWORK ) + HNORM = CLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, + $ RWORK ) IF( SISNAN( HNORM ) ) THEN INFO = -6 RETURN @@ -426,7 +428,8 @@ SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * * Compute left eigenvector. * - CALL CLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH, + CALL CLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), + $ LDH, $ WK, VL( KL, KS ), WORK, LDWORK, RWORK, EPS3, $ SMLNUM, IINFO ) IF( IINFO.GT.0 ) THEN @@ -443,7 +446,8 @@ SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * * Compute right eigenvector. * - CALL CLAEIN( .TRUE., NOINIT, KR, H, LDH, WK, VR( 1, KS ), + CALL CLAEIN( .TRUE., NOINIT, KR, H, LDH, WK, VR( 1, + $ KS ), $ WORK, LDWORK, RWORK, EPS3, SMLNUM, IINFO ) IF( IINFO.GT.0 ) THEN INFO = INFO + 1 diff --git a/SRC/chseqr.f b/SRC/chseqr.f index 3e8a1ac0e8..1f14ab2994 100644 --- a/SRC/chseqr.f +++ b/SRC/chseqr.f @@ -348,7 +348,8 @@ SUBROUTINE CHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CLAHQR, CLAQR0, CLASET, XERBLA + EXTERNAL CCOPY, CLACPY, CLAHQR, CLAQR0, CLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, MAX, MIN, REAL @@ -399,7 +400,8 @@ SUBROUTINE CHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * * ==== Quick return in case of a workspace query ==== * - CALL CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z, + CALL CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + $ Z, $ LDZ, WORK, LWORK, INFO ) * ==== Ensure reported workspace size is backward-compatible with * . previous LAPACK versions. ==== @@ -414,7 +416,8 @@ SUBROUTINE CHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, IF( ILO.GT.1 ) $ CALL CCOPY( ILO-1, H, LDH+1, W, 1 ) IF( IHI.LT.N ) - $ CALL CCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), 1 ) + $ CALL CCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), + $ 1 ) * * ==== Initialize Z, if requested ==== * @@ -437,13 +440,15 @@ SUBROUTINE CHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * ==== CLAQR0 for big matrices; CLAHQR for small ones ==== * IF( N.GT.NMIN ) THEN - CALL CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + CALL CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, + $ IHI, $ Z, LDZ, WORK, LWORK, INFO ) ELSE * * ==== Small matrix ==== * - CALL CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + CALL CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, + $ IHI, $ Z, LDZ, INFO ) * IF( INFO.GT.0 ) THEN @@ -470,9 +475,11 @@ SUBROUTINE CHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * CALL CLACPY( 'A', N, N, H, LDH, HL, NL ) HL( N+1, N ) = ZERO - CALL CLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ), + CALL CLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, + $ N+1 ), $ NL ) - CALL CLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, W, + CALL CLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, + $ W, $ ILO, IHI, Z, LDZ, WORKL, NL, INFO ) IF( WANTT .OR. INFO.NE.0 ) $ CALL CLACPY( 'A', N, N, HL, NL, H, LDH ) diff --git a/SRC/cla_gbrfsx_extended.f b/SRC/cla_gbrfsx_extended.f index 2a50974e1f..788b4a9d63 100644 --- a/SRC/cla_gbrfsx_extended.f +++ b/SRC/cla_gbrfsx_extended.f @@ -401,7 +401,8 @@ *> \ingroup la_gbrfsx_extended * * ===================================================================== - SUBROUTINE CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + SUBROUTINE CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, $ COLEQU, C, B, LDB, Y, LDY, $ BERR_OUT, N_NORMS, ERR_BNDS_NORM, @@ -467,7 +468,8 @@ SUBROUTINE CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGBTRS, CGBMV, BLAS_CGBMV_X, + EXTERNAL CAXPY, CCOPY, CGBTRS, CGBMV, + $ BLAS_CGBMV_X, $ BLAS_CGBMV2_X, CLA_GBAMV, CLA_WWADDW, SLAMCH, $ CHLA_TRANSTYPE, CLA_LIN_BERR REAL SLAMCH @@ -538,7 +540,8 @@ SUBROUTINE CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, ! XXX: RES is no longer needed. CALL CCOPY( N, RES, 1, DY, 1 ) - CALL CGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, N, + CALL CGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, + $ N, $ INFO ) * * Calculate relative changes DX_X, DZ_Z and ratios DXRAT, DZRAT. diff --git a/SRC/cla_geamv.f b/SRC/cla_geamv.f index f99e297026..7c03b0e6f4 100644 --- a/SRC/cla_geamv.f +++ b/SRC/cla_geamv.f @@ -173,7 +173,8 @@ *> \ingroup la_geamv * * ===================================================================== - SUBROUTINE CLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, + SUBROUTINE CLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, + $ BETA, $ Y, INCY ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_gercond_c.f b/SRC/cla_gercond_c.f index 211e7a9944..8845a901fc 100644 --- a/SRC/cla_gercond_c.f +++ b/SRC/cla_gercond_c.f @@ -138,7 +138,8 @@ *> \ingroup la_gercond * * ===================================================================== - REAL FUNCTION CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, C, + REAL FUNCTION CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + $ C, $ CAPPLY, INFO, WORK, RWORK ) * * -- LAPACK computational routine -- @@ -267,7 +268,8 @@ REAL FUNCTION CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, C, CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, $ WORK, N, INFO ) ELSE - CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ENDIF * @@ -289,7 +291,8 @@ REAL FUNCTION CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, C, END IF * IF ( NOTRANS ) THEN - CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ELSE CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, diff --git a/SRC/cla_gercond_x.f b/SRC/cla_gercond_x.f index c2bc4b2192..2aad9e3b53 100644 --- a/SRC/cla_gercond_x.f +++ b/SRC/cla_gercond_x.f @@ -131,7 +131,8 @@ *> \ingroup la_gercond * * ===================================================================== - REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, X, + REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, + $ X, $ INFO, WORK, RWORK ) * * -- LAPACK computational routine -- @@ -247,7 +248,8 @@ REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, X, CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, $ WORK, N, INFO ) ELSE - CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ENDIF * @@ -265,7 +267,8 @@ REAL FUNCTION CLA_GERCOND_X( TRANS, N, A, LDA, AF, LDAF, IPIV, X, END DO * IF ( NOTRANS ) THEN - CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL CGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ELSE CALL CGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, diff --git a/SRC/cla_gerfsx_extended.f b/SRC/cla_gerfsx_extended.f index 28efc4d1cb..3c1d7b8c1b 100644 --- a/SRC/cla_gerfsx_extended.f +++ b/SRC/cla_gerfsx_extended.f @@ -389,7 +389,8 @@ *> \ingroup la_gerfsx_extended * * ===================================================================== - SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, + SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, + $ A, $ LDA, AF, LDAF, IPIV, COLEQU, C, B, $ LDB, Y, LDY, BERR_OUT, N_NORMS, $ ERRS_N, ERRS_C, RES, AYB, DY, @@ -455,7 +456,8 @@ SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGETRS, CGEMV, BLAS_CGEMV_X, + EXTERNAL CAXPY, CCOPY, CGETRS, CGEMV, + $ BLAS_CGEMV_X, $ BLAS_CGEMV2_X, CLA_GEAMV, CLA_WWADDW, SLAMCH, $ CHLA_TRANSTYPE, CLA_LIN_BERR REAL SLAMCH @@ -514,7 +516,8 @@ SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, CALL CGEMV( TRANS, N, N, (-1.0E+0,0.0E+0), A, LDA, $ Y( 1, J ), 1, (1.0E+0,0.0E+0), RES, 1) ELSE IF (Y_PREC_STATE .EQ. EXTRA_RESIDUAL) THEN - CALL BLAS_CGEMV_X( TRANS_TYPE, N, N, (-1.0E+0,0.0E+0), A, + CALL BLAS_CGEMV_X( TRANS_TYPE, N, N, (-1.0E+0,0.0E+0), + $ A, $ LDA, Y( 1, J ), 1, (1.0E+0,0.0E+0), $ RES, 1, PREC_TYPE ) ELSE @@ -674,7 +677,8 @@ SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, * op(A) = A, A**T, or A**H depending on TRANS (and type). * CALL CCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL CGEMV( TRANS, N, N, (-1.0E+0,0.0E+0), A, LDA, Y(1,J), 1, + CALL CGEMV( TRANS, N, N, (-1.0E+0,0.0E+0), A, LDA, Y(1,J), + $ 1, $ (1.0E+0,0.0E+0), RES, 1 ) DO I = 1, N diff --git a/SRC/cla_hercond_c.f b/SRC/cla_hercond_c.f index cf8fe8d601..22aac12b7b 100644 --- a/SRC/cla_hercond_c.f +++ b/SRC/cla_hercond_c.f @@ -134,7 +134,8 @@ *> \ingroup la_hercond * * ===================================================================== - REAL FUNCTION CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, C, + REAL FUNCTION CLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + $ C, $ CAPPLY, INFO, WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_hercond_x.f b/SRC/cla_hercond_x.f index b4ebdeb82a..c53f40fe6d 100644 --- a/SRC/cla_hercond_x.f +++ b/SRC/cla_hercond_x.f @@ -127,7 +127,8 @@ *> \ingroup la_hercond * * ===================================================================== - REAL FUNCTION CLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, X, + REAL FUNCTION CLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, + $ X, $ INFO, WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_herfsx_extended.f b/SRC/cla_herfsx_extended.f index ce174ea1fe..78540b5596 100644 --- a/SRC/cla_herfsx_extended.f +++ b/SRC/cla_herfsx_extended.f @@ -386,7 +386,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE CLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE CLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -458,7 +459,8 @@ SUBROUTINE CLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHETRS, CHEMV, BLAS_CHEMV_X, + EXTERNAL CAXPY, CCOPY, CHETRS, CHEMV, + $ BLAS_CHEMV_X, $ BLAS_CHEMV2_X, CLA_HEAMV, CLA_WWADDW, $ CLA_LIN_BERR REAL SLAMCH @@ -538,7 +540,8 @@ SUBROUTINE CLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * CALL CCOPY( N, B( 1, J ), 1, RES, 1 ) IF ( Y_PREC_STATE .EQ. BASE_RESIDUAL ) THEN - CALL CHEMV( UPLO, N, CMPLX(-1.0), A, LDA, Y( 1, J ), 1, + CALL CHEMV( UPLO, N, CMPLX(-1.0), A, LDA, Y( 1, J ), + $ 1, $ CMPLX(1.0), RES, 1 ) ELSE IF ( Y_PREC_STATE .EQ. EXTRA_RESIDUAL ) THEN CALL BLAS_CHEMV_X( UPLO2, N, CMPLX(-1.0), A, LDA, diff --git a/SRC/cla_herpvgrw.f b/SRC/cla_herpvgrw.f index de27096286..40f69dc5d5 100644 --- a/SRC/cla_herpvgrw.f +++ b/SRC/cla_herpvgrw.f @@ -119,7 +119,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - REAL FUNCTION CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, + REAL FUNCTION CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ IPIV, $ WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_porcond_c.f b/SRC/cla_porcond_c.f index 7cefbbeb13..6a7a4fe7e1 100644 --- a/SRC/cla_porcond_c.f +++ b/SRC/cla_porcond_c.f @@ -126,7 +126,8 @@ *> \ingroup la_porcond * * ===================================================================== - REAL FUNCTION CLA_PORCOND_C( UPLO, N, A, LDA, AF, LDAF, C, CAPPLY, + REAL FUNCTION CLA_PORCOND_C( UPLO, N, A, LDA, AF, LDAF, C, + $ CAPPLY, $ INFO, WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_porcond_x.f b/SRC/cla_porcond_x.f index 198beb576b..3a9a36b446 100644 --- a/SRC/cla_porcond_x.f +++ b/SRC/cla_porcond_x.f @@ -119,7 +119,8 @@ *> \ingroup la_porcond * * ===================================================================== - REAL FUNCTION CLA_PORCOND_X( UPLO, N, A, LDA, AF, LDAF, X, INFO, + REAL FUNCTION CLA_PORCOND_X( UPLO, N, A, LDA, AF, LDAF, X, + $ INFO, $ WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_porfsx_extended.f b/SRC/cla_porfsx_extended.f index 093636f612..67bd93e587 100644 --- a/SRC/cla_porfsx_extended.f +++ b/SRC/cla_porfsx_extended.f @@ -378,7 +378,8 @@ *> \ingroup la_porfsx_extended * * ===================================================================== - SUBROUTINE CLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE CLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, COLEQU, C, B, LDB, Y, $ LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -449,7 +450,8 @@ SUBROUTINE CLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CPOTRS, CHEMV, BLAS_CHEMV_X, + EXTERNAL CAXPY, CCOPY, CPOTRS, CHEMV, + $ BLAS_CHEMV_X, $ BLAS_CHEMV2_X, CLA_HEAMV, CLA_WWADDW, $ CLA_LIN_BERR, SLAMCH REAL SLAMCH @@ -663,7 +665,8 @@ SUBROUTINE CLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * op(A) = A, A**T, or A**H depending on TRANS (and type). * CALL CCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL CHEMV(UPLO, N, CMPLX(-1.0), A, LDA, Y(1,J), 1, CMPLX(1.0), + CALL CHEMV(UPLO, N, CMPLX(-1.0), A, LDA, Y(1,J), 1, + $ CMPLX(1.0), $ RES, 1) DO I = 1, N diff --git a/SRC/cla_porpvgrw.f b/SRC/cla_porpvgrw.f index 5476e3b846..c5e0e73528 100644 --- a/SRC/cla_porpvgrw.f +++ b/SRC/cla_porpvgrw.f @@ -102,7 +102,8 @@ *> \ingroup la_porpvgrw * * ===================================================================== - REAL FUNCTION CLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK ) + REAL FUNCTION CLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/cla_syrcond_c.f b/SRC/cla_syrcond_c.f index 9d6ee36800..98729f0792 100644 --- a/SRC/cla_syrcond_c.f +++ b/SRC/cla_syrcond_c.f @@ -134,7 +134,8 @@ *> \ingroup la_hercond * * ===================================================================== - REAL FUNCTION CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, C, + REAL FUNCTION CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + $ C, $ CAPPLY, INFO, WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_syrcond_x.f b/SRC/cla_syrcond_x.f index be284a6184..831f6db320 100644 --- a/SRC/cla_syrcond_x.f +++ b/SRC/cla_syrcond_x.f @@ -127,7 +127,8 @@ *> \ingroup la_hercond * * ===================================================================== - REAL FUNCTION CLA_SYRCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, X, + REAL FUNCTION CLA_SYRCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, + $ X, $ INFO, WORK, RWORK ) * * -- LAPACK computational routine -- diff --git a/SRC/cla_syrfsx_extended.f b/SRC/cla_syrfsx_extended.f index 724d756672..2567675a27 100644 --- a/SRC/cla_syrfsx_extended.f +++ b/SRC/cla_syrfsx_extended.f @@ -386,7 +386,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE CLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE CLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -458,7 +459,8 @@ SUBROUTINE CLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CSYTRS, CSYMV, BLAS_CSYMV_X, + EXTERNAL CAXPY, CCOPY, CSYTRS, CSYMV, + $ BLAS_CSYMV_X, $ BLAS_CSYMV2_X, CLA_SYAMV, CLA_WWADDW, $ CLA_LIN_BERR REAL SLAMCH diff --git a/SRC/cla_syrpvgrw.f b/SRC/cla_syrpvgrw.f index 238c27ad87..9434437401 100644 --- a/SRC/cla_syrpvgrw.f +++ b/SRC/cla_syrpvgrw.f @@ -119,7 +119,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - REAL FUNCTION CLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, + REAL FUNCTION CLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ IPIV, $ WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/clabrd.f b/SRC/clabrd.f index a04ee5f24d..e9ca7e4baa 100644 --- a/SRC/clabrd.f +++ b/SRC/clabrd.f @@ -208,7 +208,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, + SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, + $ Y, $ LDY ) * * -- LAPACK auxiliary routine -- @@ -280,7 +281,8 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, CALL CGEMV( 'Conjugate transpose', M-I+1, I-1, ONE, $ A( I, 1 ), LDA, A( I, I ), 1, ZERO, $ Y( 1, I ), 1 ) - CALL CGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL CGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', M-I+1, I-1, ONE, $ X( I, 1 ), LDX, A( I, I ), 1, ZERO, @@ -313,16 +315,19 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL CGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ), + CALL CGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', N-I, I, ONE, $ Y( I+1, 1 ), LDY, A( I, I+1 ), LDA, ZERO, $ X( 1, I ), 1 ) CALL CGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL CGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL CGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) - CALL CGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL CGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL CSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) @@ -358,16 +363,20 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL CGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ), + CALL CGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', N-I+1, I-1, ONE, $ Y( I, 1 ), LDY, A( I, I ), LDA, ZERO, $ X( 1, I ), 1 ) - CALL CGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL CGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL CGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ), + CALL CGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL CGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL CGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL CSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) CALL CLACGV( N-I+1, A( I, I ), LDA ) @@ -375,7 +384,8 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * Update A(i+1:m,i) * CALL CLACGV( I-1, Y( I, 1 ), LDY ) - CALL CGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL CGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 ) CALL CLACGV( I-1, Y( I, 1 ), LDY ) CALL CGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ), @@ -397,7 +407,8 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, CALL CGEMV( 'Conjugate transpose', M-I, I-1, ONE, $ A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO, $ Y( 1, I ), 1 ) - CALL CGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL CGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', M-I, I, ONE, $ X( I+1, 1 ), LDX, A( I+1, I ), 1, ZERO, diff --git a/SRC/claed0.f b/SRC/claed0.f index 6ad7493833..b44fefc5db 100644 --- a/SRC/claed0.f +++ b/SRC/claed0.f @@ -173,7 +173,8 @@ SUBROUTINE CLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, REAL TEMP * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACRM, CLAED7, SCOPY, SSTEQR, XERBLA + EXTERNAL CCOPY, CLACRM, CLAED7, SCOPY, SSTEQR, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV diff --git a/SRC/claed7.f b/SRC/claed7.f index 996c05700b..635857df13 100644 --- a/SRC/claed7.f +++ b/SRC/claed7.f @@ -243,7 +243,8 @@ *> \ingroup laed7 * * ===================================================================== - SUBROUTINE CLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + SUBROUTINE CLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, + $ Q, $ LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) @@ -271,7 +272,8 @@ SUBROUTINE CLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, $ INDXC, INDXP, IQ, IW, IZ, K, N1, N2, PTR * .. * .. External Subroutines .. - EXTERNAL CLACRM, CLAED8, SLAED9, SLAEDA, SLAMRG, XERBLA + EXTERNAL CLACRM, CLAED8, SLAED9, SLAEDA, SLAMRG, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -357,7 +359,8 @@ SUBROUTINE CLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, CALL SLAED9( K, 1, K, N, D, RWORK( IQ ), K, RHO, $ RWORK( IDLMDA ), RWORK( IW ), $ QSTORE( QPTR( CURR ) ), K, INFO ) - CALL CLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, Q, + CALL CLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, + $ Q, $ LDQ, RWORK( IQ ) ) QPTR( CURR+1 ) = QPTR( CURR ) + K**2 IF( INFO.NE.0 ) THEN diff --git a/SRC/claed8.f b/SRC/claed8.f index 2786104b74..3466a49c4f 100644 --- a/SRC/claed8.f +++ b/SRC/claed8.f @@ -223,7 +223,8 @@ *> \ingroup laed8 * * ===================================================================== - SUBROUTINE CLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, + SUBROUTINE CLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, + $ DLAMBDA, $ Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, $ GIVCOL, GIVNUM, INFO ) * @@ -260,7 +261,8 @@ SUBROUTINE CLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, EXTERNAL ISAMAX, SLAMCH, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CSROT, SCOPY, SLAMRG, SSCAL, + EXTERNAL CCOPY, CLACPY, CSROT, SCOPY, SLAMRG, + $ SSCAL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -351,7 +353,8 @@ SUBROUTINE CLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, PERM( J ) = INDXQ( INDX( J ) ) CALL CCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) 50 CONTINUE - CALL CLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), LDQ ) + CALL CLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), + $ LDQ ) RETURN END IF * @@ -473,7 +476,8 @@ SUBROUTINE CLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, * IF( K.LT.N ) THEN CALL SCOPY( N-K, DLAMBDA( K+1 ), 1, D( K+1 ), 1 ) - CALL CLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, K+1 ), + CALL CLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, + $ K+1 ), $ LDQ ) END IF * diff --git a/SRC/claein.f b/SRC/claein.f index 4e242d4bd6..7d4272566d 100644 --- a/SRC/claein.f +++ b/SRC/claein.f @@ -145,7 +145,8 @@ *> \ingroup laein * * ===================================================================== - SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, + SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, + $ RWORK, $ EPS3, SMLNUM, INFO ) * * -- LAPACK auxiliary routine -- @@ -228,7 +229,8 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, * Scale supplied initial vector. * VNORM = SCNRM2( N, V, 1 ) - CALL CSSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, 1 ) + CALL CSSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, + $ 1 ) END IF * IF( RIGHTV ) THEN @@ -314,7 +316,8 @@ SUBROUTINE CLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, * or U**H *x = scale*v for a left eigenvector, * overwriting x on v. * - CALL CLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, V, + CALL CLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, + $ V, $ SCALE, RWORK, IERR ) NORMIN = 'Y' * diff --git a/SRC/clags2.f b/SRC/clags2.f index 7d4af38ade..13a6a043f6 100644 --- a/SRC/clags2.f +++ b/SRC/clags2.f @@ -154,7 +154,8 @@ *> \ingroup lags2 * * ===================================================================== - SUBROUTINE CLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, + SUBROUTINE CLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, + $ CSV, $ SNV, CSQ, SNQ ) * * -- LAPACK auxiliary routine -- @@ -274,14 +275,18 @@ SUBROUTINE CLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, * zero (2,2) elements of U**H *A and V**H *B, and then swap. * IF( ( ABS1( UA21 )+ABS1( UA22 ) ).EQ.ZERO ) THEN - CALL CLARTG( -CONJG( VB21 ), CONJG( VB22 ), CSQ, SNQ, R ) + CALL CLARTG( -CONJG( VB21 ), CONJG( VB22 ), CSQ, SNQ, + $ R ) ELSE IF( ( ABS1( VB21 )+ABS( VB22 ) ).EQ.ZERO ) THEN - CALL CLARTG( -CONJG( UA21 ), CONJG( UA22 ), CSQ, SNQ, R ) + CALL CLARTG( -CONJG( UA21 ), CONJG( UA22 ), CSQ, SNQ, + $ R ) ELSE IF( AUA22 / ( ABS1( UA21 )+ABS1( UA22 ) ).LE.AVB22 / $ ( ABS1( VB21 )+ABS1( VB22 ) ) ) THEN - CALL CLARTG( -CONJG( UA21 ), CONJG( UA22 ), CSQ, SNQ, R ) + CALL CLARTG( -CONJG( UA21 ), CONJG( UA22 ), CSQ, SNQ, + $ R ) ELSE - CALL CLARTG( -CONJG( VB21 ), CONJG( VB22 ), CSQ, SNQ, R ) + CALL CLARTG( -CONJG( VB21 ), CONJG( VB22 ), CSQ, SNQ, + $ R ) END IF * CSU = SNL diff --git a/SRC/clagtm.f b/SRC/clagtm.f index 0f7680a46f..8ef5d5bcca 100644 --- a/SRC/clagtm.f +++ b/SRC/clagtm.f @@ -141,7 +141,8 @@ *> \ingroup lagtm * * ===================================================================== - SUBROUTINE CLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, + SUBROUTINE CLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, + $ BETA, $ B, LDB ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/clahef.f b/SRC/clahef.f index 1f30100985..bd961dd7b0 100644 --- a/SRC/clahef.f +++ b/SRC/clahef.f @@ -174,7 +174,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) EXTERNAL LSAME, ICAMAX * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMM, CGEMV, CLACGV, CSSCAL, CSWAP + EXTERNAL CCOPY, CGEMM, CGEMV, CLACGV, CSSCAL, + $ CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, MIN, REAL, SQRT @@ -257,7 +259,8 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = REAL( A( K, K ) ) IF( K.LT.N ) THEN - CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = REAL( W( K, KW ) ) END IF @@ -625,7 +628,8 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) W( K, K ) = REAL( A( K, K ) ) IF( K.LT.N ) $ CALL CCOPY( N-K, A( K+1, K ), 1, W( K+1, K ), 1 ) - CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA, + CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, CONE, W( K, K ), 1 ) W( K, K ) = REAL( W( K, K ) ) * @@ -672,13 +676,15 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1 ) CALL CLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = REAL( A( IMAX, IMAX ) ) IF( IMAX.LT.N ) $ CALL CCOPY( N-IMAX, A( IMAX+1, IMAX ), 1, $ W( IMAX+1, K+1 ), 1 ) - CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ), $ 1 ) W( IMAX, K+1 ) = REAL( W( IMAX, K+1 ) ) @@ -752,7 +758,8 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) $ LDA ) CALL CLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/clahef_aa.f b/SRC/clahef_aa.f index 91f6ed4513..dd490c50d0 100644 --- a/SRC/clahef_aa.f +++ b/SRC/clahef_aa.f @@ -173,8 +173,8 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, ICAMAX * .. * .. External Subroutines .. - EXTERNAL CLACGV, CGEMV, CSCAL, CAXPY, CCOPY, CSWAP, CLASET, - $ XERBLA + EXTERNAL CLACGV, CGEMV, CSCAL, CAXPY, CCOPY, CSWAP, + $ CLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC REAL, CONJG, MAX diff --git a/SRC/clahef_rk.f b/SRC/clahef_rk.f index e01e66d5f5..0dfa86e845 100644 --- a/SRC/clahef_rk.f +++ b/SRC/clahef_rk.f @@ -300,7 +300,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CSSCAL, CGEMM, CGEMV, CLACGV, CSWAP + EXTERNAL CCOPY, CSSCAL, CGEMM, CGEMV, CLACGV, + $ CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, AIMAG, MAX, MIN, REAL, SQRT @@ -357,7 +358,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, $ CALL CCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = REAL( A( K, K ) ) IF( K.LT.N ) THEN - CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = REAL( W( K, KW ) ) END IF @@ -423,7 +425,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy column IMAX to column KW-1 of W and update it * IF( IMAX.GT.1 ) - $ CALL CCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ CALL CCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, + $ KW-1 ), $ 1 ) W( IMAX, KW-1 ) = REAL( A( IMAX, IMAX ) ) * @@ -876,7 +879,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column k+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL CLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = REAL( A( IMAX, IMAX ) ) * @@ -903,7 +907,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = CABS1( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -926,7 +931,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -955,7 +961,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -1015,7 +1022,8 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, $ LDA ) CALL CLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (column K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/clahef_rook.f b/SRC/clahef_rook.f index c824d16dd6..22efb1ff2b 100644 --- a/SRC/clahef_rook.f +++ b/SRC/clahef_rook.f @@ -221,7 +221,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CSSCAL, CGEMM, CGEMV, CLACGV, CSWAP + EXTERNAL CCOPY, CSSCAL, CGEMM, CGEMV, CLACGV, + $ CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, AIMAG, MAX, MIN, REAL, SQRT @@ -273,7 +274,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, $ CALL CCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = REAL( A( K, K ) ) IF( K.LT.N ) THEN - CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = REAL( W( K, KW ) ) END IF @@ -333,7 +335,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy column IMAX to column KW-1 of W and update it * IF( IMAX.GT.1 ) - $ CALL CCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ CALL CCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, + $ KW-1 ), $ 1 ) W( IMAX, KW-1 ) = REAL( A( IMAX, IMAX ) ) * @@ -797,7 +800,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column k+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL CLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = REAL( A( IMAX, IMAX ) ) * @@ -824,7 +828,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = CABS1( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -847,7 +852,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -876,7 +882,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -936,7 +943,8 @@ SUBROUTINE CLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, $ LDA ) CALL CLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (column K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/clahqr.f b/SRC/clahqr.f index 68e4538bc0..00b8a1196d 100644 --- a/SRC/clahqr.f +++ b/SRC/clahqr.f @@ -285,10 +285,12 @@ SUBROUTINE CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, SC = CONJG( SC ) / ABS( SC ) H( I, I-1 ) = ABS( H( I, I-1 ) ) CALL CSCAL( JHI-I+1, SC, H( I, I ), LDH ) - CALL CSCAL( MIN( JHI, I+1 )-JLO+1, CONJG( SC ), H( JLO, I ), + CALL CSCAL( MIN( JHI, I+1 )-JLO+1, CONJG( SC ), H( JLO, + $ I ), $ 1 ) IF( WANTZ ) - $ CALL CSCAL( IHIZ-ILOZ+1, CONJG( SC ), Z( ILOZ, I ), 1 ) + $ CALL CSCAL( IHIZ-ILOZ+1, CONJG( SC ), Z( ILOZ, I ), + $ 1 ) END IF 20 CONTINUE * @@ -527,7 +529,8 @@ SUBROUTINE CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, $ CALL CSCAL( I2-J, TEMP, H( J, J+1 ), LDH ) CALL CSCAL( J-I1, CONJG( TEMP ), H( I1, J ), 1 ) IF( WANTZ ) THEN - CALL CSCAL( NZ, CONJG( TEMP ), Z( ILOZ, J ), 1 ) + CALL CSCAL( NZ, CONJG( TEMP ), Z( ILOZ, J ), + $ 1 ) END IF END IF 110 CONTINUE diff --git a/SRC/clahr2.f b/SRC/clahr2.f index f8a019ae46..d123ae1948 100644 --- a/SRC/clahr2.f +++ b/SRC/clahr2.f @@ -225,7 +225,8 @@ SUBROUTINE CLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Update I-th column of A - Y * V**H * CALL CLACGV( I-1, A( K+I-1, 1 ), LDA ) - CALL CGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY, + CALL CGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), + $ LDY, $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 ) CALL CLACGV( I-1, A( K+I-1, 1 ), LDA ) * @@ -275,7 +276,8 @@ SUBROUTINE CLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(I) to annihilate * A(K+I+1:N,I) * - CALL CLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, + CALL CLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, $ TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE diff --git a/SRC/clals0.f b/SRC/clals0.f index 57f72a88a6..36b6db1315 100644 --- a/SRC/clals0.f +++ b/SRC/clals0.f @@ -265,7 +265,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, + SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, + $ LDBX, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO ) * @@ -297,7 +298,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CLASCL, CSROT, CSSCAL, SGEMV, + EXTERNAL CCOPY, CLACPY, CLASCL, CSROT, CSSCAL, + $ SGEMV, $ XERBLA * .. * .. External Functions .. @@ -361,7 +363,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * CALL CCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX ) DO 20 I = 2, N - CALL CCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX ) + CALL CCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), + $ LDBX ) 20 CONTINUE * * Step (3L): apply the inverse of the left singular vector @@ -481,7 +484,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * parentheses (x+y)+z. The goal is to prevent optimizing * compilers from doing x+(y+z). * - RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I+1, + RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, + $ -POLES( I+1, $ 2 ) )-DIFR( I, 1 ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -490,7 +494,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, IF( Z( J ).EQ.ZERO ) THEN RWORK( I ) = ZERO ELSE - RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I, + RWORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, + $ -POLES( I, $ 2 ) )-DIFL( I ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -532,7 +537,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * IF( SQRE.EQ.1 ) THEN CALL CCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX ) - CALL CSROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S ) + CALL CSROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, + $ S ) END IF IF( K.LT.MAX( M, N ) ) $ CALL CLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, @@ -545,7 +551,8 @@ SUBROUTINE CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, CALL CCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB ) END IF DO 190 I = 2, N - CALL CCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB ) + CALL CCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), + $ LDB ) 190 CONTINUE * * Step (4R): apply back the Givens rotations performed. diff --git a/SRC/clalsa.f b/SRC/clalsa.f index 5cf5066eb9..68df81d60a 100644 --- a/SRC/clalsa.f +++ b/SRC/clalsa.f @@ -261,7 +261,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, + SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, + $ U, $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK, $ IWORK, INFO ) @@ -295,7 +296,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, $ NDIMR, NL, NLF, NLP1, NLVL, NR, NRF, NRP1, SQRE * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLALS0, SGEMM, SLASDT, XERBLA + EXTERNAL CCOPY, CLALS0, SGEMM, SLASDT, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC AIMAG, CMPLX, REAL @@ -474,7 +476,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, NLF = IC - NL NRF = IC + 1 J = J - 1 - CALL CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX, + CALL CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), + $ LDBX, $ B( NLF, 1 ), LDB, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -519,7 +522,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, SQRE = 1 END IF J = J + 1 - CALL CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB, + CALL CLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), + $ LDB, $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -561,7 +565,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = REAL( B( JROW, JCOL ) ) 200 CONTINUE 210 CONTINUE - CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO, RWORK( 1 ), $ NLP1 ) J = NLP1*NRHS*2 @@ -571,7 +576,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = AIMAG( B( JROW, JCOL ) ) 220 CONTINUE 230 CONTINUE - CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO, $ RWORK( 1+NLP1*NRHS ), NLP1 ) JREAL = 0 @@ -598,7 +604,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = REAL( B( JROW, JCOL ) ) 260 CONTINUE 270 CONTINUE - CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO, RWORK( 1 ), $ NRP1 ) J = NRP1*NRHS*2 @@ -608,7 +615,8 @@ SUBROUTINE CLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = AIMAG( B( JROW, JCOL ) ) 280 CONTINUE 290 CONTINUE - CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO, $ RWORK( 1+NRP1*NRHS ), NRP1 ) JREAL = 0 diff --git a/SRC/clalsd.f b/SRC/clalsd.f index de51725b86..be0972f3bd 100644 --- a/SRC/clalsd.f +++ b/SRC/clalsd.f @@ -217,7 +217,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, EXTERNAL ISAMAX, SLAMCH, SLANST * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CLALSA, CLASCL, CLASET, CSROT, + EXTERNAL CCOPY, CLACPY, CLALSA, CLASCL, CLASET, + $ CSROT, $ SGEMM, SLARTG, SLASCL, SLASDA, SLASDQ, SLASET, $ SLASRT, XERBLA * .. @@ -263,7 +264,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, CALL CLASET( 'A', 1, NRHS, CZERO, CZERO, B, LDB ) ELSE RANK = 1 - CALL CLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, + $ INFO ) D( 1 ) = ABS( D( 1 ) ) END IF RETURN @@ -289,7 +291,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, DO 20 J = 1, N - 1 CS = RWORK( J*2-1 ) SN = RWORK( J*2 ) - CALL CSROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN ) + CALL CSROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, + $ SN ) 20 CONTINUE 30 CONTINUE END IF @@ -361,9 +364,11 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, TOL = RCND*ABS( D( ISAMAX( N, D, 1 ) ) ) DO 100 I = 1, N IF( D( I ).LE.TOL ) THEN - CALL CLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL CLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) ELSE - CALL CLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ), + CALL CLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, + $ 1 ), $ LDB, INFO ) RANK = RANK + 1 END IF @@ -591,7 +596,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * subproblems were not solved explicitly. * IF( ABS( D( I ) ).LE.TOL ) THEN - CALL CLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ), N ) + CALL CLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ), + $ N ) ELSE RANK = RANK + 1 CALL CLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, @@ -654,7 +660,8 @@ SUBROUTINE CLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, 300 CONTINUE 310 CONTINUE ELSE - CALL CLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N, + CALL CLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), + $ N, $ B( ST, 1 ), LDB, RWORK( U+ST1 ), N, $ RWORK( VT+ST1 ), IWORK( K+ST1 ), $ RWORK( DIFL+ST1 ), RWORK( DIFR+ST1 ), diff --git a/SRC/clangb.f b/SRC/clangb.f index 5b9c5dee90..5232c2efb8 100644 --- a/SRC/clangb.f +++ b/SRC/clangb.f @@ -202,7 +202,8 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB, TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -211,7 +212,8 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB, DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, + $ SUM ) 90 CONTINUE VALUE = SCALE*SQRT( SUM ) END IF diff --git a/SRC/clange.f b/SRC/clange.f index 5aca9e872f..bca5b3ed59 100644 --- a/SRC/clange.f +++ b/SRC/clange.f @@ -191,7 +191,8 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK ) TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clangt.f b/SRC/clangt.f index 765f938506..d567570fe5 100644 --- a/SRC/clangt.f +++ b/SRC/clangt.f @@ -147,11 +147,13 @@ REAL FUNCTION CLANGT( NORM, N, DL, D, DU ) * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. + $ SISNAN( ABS( DL( I ) ) ) ) $ ANORM = ABS(DL(I)) IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) ) $ ANORM = ABS(D(I)) - IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) ) + IF( ANORM.LT.ABS( DU( I ) ) .OR. + $ SISNAN (ABS( DU( I ) ) ) ) $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN @@ -184,7 +186,8 @@ REAL FUNCTION CLANGT( NORM, N, DL, D, DU ) IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clanhb.f b/SRC/clanhb.f index 43c98e201a..73d5fb0a14 100644 --- a/SRC/clanhb.f +++ b/SRC/clanhb.f @@ -192,7 +192,8 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -228,7 +229,8 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -237,7 +239,8 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/clanhe.f b/SRC/clanhe.f index 0f8f80a7ae..f0d4be6ab9 100644 --- a/SRC/clanhe.f +++ b/SRC/clanhe.f @@ -184,7 +184,8 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -218,7 +219,8 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clanhf.f b/SRC/clanhf.f index f82f170ba2..90557e5334 100644 --- a/SRC/clanhf.f +++ b/SRC/clanhf.f @@ -678,7 +678,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is Hermitian). @@ -1130,7 +1131,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -1144,7 +1146,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 3 - CALL CLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(k,0) END DO DO J = 0, K - 1 @@ -1191,11 +1194,13 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL CLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * trap L at A(0,0) END DO DO J = 1, K - 2 - CALL CLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S ) + CALL CLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO S = S + S @@ -1241,7 +1246,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**H is upper DO J = 1, K - 2 - CALL CLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) + CALL CLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k) END DO DO J = 0, K - 2 @@ -1303,7 +1309,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k-1 rect. at A(0,k) END DO DO J = 0, K - 3 - CALL CLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(1,0) END DO S = S + S @@ -1353,7 +1360,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 2 - CALL CLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(k+1,0) END DO DO J = 0, K - 1 @@ -1390,7 +1398,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL CLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, + $ S ) * trap L at A(1,0) END DO DO J = 1, K - 1 @@ -1430,7 +1439,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**H is upper DO J = 1, K - 1 - CALL CLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) + CALL CLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k+1) END DO DO J = 0, K - 1 @@ -1438,7 +1448,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,0) END DO DO J = 0, K - 2 - CALL CLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, + CALL CLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, + $ SCALE, $ S ) * L at A(0,k) END DO @@ -1496,7 +1507,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * A**H is lower DO J = 1, K - 1 - CALL CLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) + CALL CLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO DO J = K + 1, N @@ -1504,7 +1516,8 @@ REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,k+1) END DO DO J = 0, K - 2 - CALL CLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL CLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(0,0) END DO S = S + S diff --git a/SRC/clanhp.f b/SRC/clanhp.f index 1be8e0e9e7..ceade7760b 100644 --- a/SRC/clanhp.f +++ b/SRC/clanhp.f @@ -181,7 +181,8 @@ REAL FUNCTION CLANHP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -220,7 +221,8 @@ REAL FUNCTION CLANHP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clanhs.f b/SRC/clanhs.f index 2a76ddcd03..40166f3b95 100644 --- a/SRC/clanhs.f +++ b/SRC/clanhs.f @@ -185,7 +185,8 @@ REAL FUNCTION CLANHS( NORM, N, A, LDA, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clanht.f b/SRC/clanht.f index a12d4a7fb2..cc67b27d78 100644 --- a/SRC/clanht.f +++ b/SRC/clanht.f @@ -164,7 +164,8 @@ REAL FUNCTION CLANHT( NORM, N, D, E ) IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clansb.f b/SRC/clansb.f index 52c37047c1..d692b8c5d8 100644 --- a/SRC/clansb.f +++ b/SRC/clansb.f @@ -186,7 +186,8 @@ REAL FUNCTION CLANSB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -222,7 +223,8 @@ REAL FUNCTION CLANSB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -231,7 +233,8 @@ REAL FUNCTION CLANSB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/clansp.f b/SRC/clansp.f index a491d0c5c8..f18fa18dd9 100644 --- a/SRC/clansp.f +++ b/SRC/clansp.f @@ -175,7 +175,8 @@ REAL FUNCTION CLANSP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -214,7 +215,8 @@ REAL FUNCTION CLANSP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clansy.f b/SRC/clansy.f index 930f065590..d7714868f3 100644 --- a/SRC/clansy.f +++ b/SRC/clansy.f @@ -179,7 +179,8 @@ REAL FUNCTION CLANSY( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -213,7 +214,8 @@ REAL FUNCTION CLANSY( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clantb.f b/SRC/clantb.f index 7fa1a35643..6d312ab225 100644 --- a/SRC/clantb.f +++ b/SRC/clantb.f @@ -188,14 +188,16 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,14 +207,16 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -308,7 +312,8 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -327,7 +332,8 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 290 J = 1, N - CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), + CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 290 CONTINUE END IF @@ -337,7 +343,8 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, + CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ SCALE, $ SUM ) 300 CONTINUE END IF @@ -345,7 +352,8 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 310 J = 1, N - CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, + CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ SCALE, $ SUM ) 310 CONTINUE END IF diff --git a/SRC/clantp.f b/SRC/clantp.f index ae34d19e2e..49de4d85ce 100644 --- a/SRC/clantp.f +++ b/SRC/clantp.f @@ -122,7 +122,8 @@ *> \ingroup lantp * * ===================================================================== - REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) + REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, + $ WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -173,7 +174,8 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 20 J = 1, N DO 10 I = K, K + J - 2 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -181,7 +183,8 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 40 J = 1, N DO 30 I = K + 1, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -192,7 +195,8 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 60 J = 1, N DO 50 I = K, K + J - 1 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE @@ -200,7 +204,8 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 80 J = 1, N DO 70 I = K, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -303,7 +308,8 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/clantr.f b/SRC/clantr.f index 7906da231f..a98e7e60d1 100644 --- a/SRC/clantr.f +++ b/SRC/clantr.f @@ -138,7 +138,8 @@ *> \ingroup lantr * * ===================================================================== - REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) * * -- LAPACK auxiliary routine -- @@ -189,14 +190,16 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -206,14 +209,16 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -308,7 +313,8 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -317,13 +323,15 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE diff --git a/SRC/claqgb.f b/SRC/claqgb.f index ee6979fc53..020b5a67a9 100644 --- a/SRC/claqgb.f +++ b/SRC/claqgb.f @@ -156,7 +156,8 @@ *> \ingroup laqgb * * ===================================================================== - SUBROUTINE CLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE CLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/claqhb.f b/SRC/claqhb.f index 6e0983368c..fe2d590878 100644 --- a/SRC/claqhb.f +++ b/SRC/claqhb.f @@ -138,7 +138,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE CLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE CLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/claqp2.f b/SRC/claqp2.f index 910ddd857b..c555de0c4f 100644 --- a/SRC/claqp2.f +++ b/SRC/claqp2.f @@ -212,7 +212,8 @@ SUBROUTINE CLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * Generate elementary reflector H(i). * IF( OFFPI.LT.M ) THEN - CALL CLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1, + CALL CLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), + $ 1, $ TAU( I ) ) ELSE CALL CLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) ) diff --git a/SRC/claqps.f b/SRC/claqps.f index cdee732d1d..edbb2937b2 100644 --- a/SRC/claqps.f +++ b/SRC/claqps.f @@ -174,7 +174,8 @@ *> \endhtmlonly * * ===================================================================== - SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, + SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, + $ VN1, $ VN2, AUXV, F, LDF ) * * -- LAPACK auxiliary routine -- @@ -249,7 +250,8 @@ SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, DO 20 J = 1, K - 1 F( K, J ) = CONJG( F( K, J ) ) 20 CONTINUE - CALL CGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, 1 ), + CALL CGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, + $ 1 ), $ LDA, F( K, 1 ), LDF, CONE, A( RK, K ), 1 ) DO 30 J = 1, K - 1 F( K, J ) = CONJG( F( K, J ) ) @@ -259,7 +261,8 @@ SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * Generate elementary reflector H(k). * IF( RK.LT.M ) THEN - CALL CLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) ) + CALL CLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, + $ TAU( K ) ) ELSE CALL CLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) ) END IF @@ -288,7 +291,8 @@ SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * *A(RK:M,K). * IF( K.GT.1 ) THEN - CALL CGEMV( 'Conjugate transpose', M-RK+1, K-1, -TAU( K ), + CALL CGEMV( 'Conjugate transpose', M-RK+1, K-1, + $ -TAU( K ), $ A( RK, 1 ), LDA, A( RK, K ), 1, CZERO, $ AUXV( 1 ), 1 ) * @@ -300,7 +304,8 @@ SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**H. * IF( K.LT.N ) THEN - CALL CGEMM( 'No transpose', 'Conjugate transpose', 1, N-K, + CALL CGEMM( 'No transpose', 'Conjugate transpose', 1, + $ N-K, $ K, -CONE, A( RK, 1 ), LDA, F( K+1, 1 ), LDF, $ CONE, A( RK, K+1 ), LDA ) END IF @@ -341,7 +346,8 @@ SUBROUTINE CLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**H. * IF( KB.LT.MIN( N, M-OFFSET ) ) THEN - CALL CGEMM( 'No transpose', 'Conjugate transpose', M-RK, N-KB, + CALL CGEMM( 'No transpose', 'Conjugate transpose', M-RK, + $ N-KB, $ KB, -CONE, A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, $ CONE, A( RK+1, KB+1 ), LDA ) END IF diff --git a/SRC/claqr0.f b/SRC/claqr0.f index e520aad3fb..2042a6852b 100644 --- a/SRC/claqr0.f +++ b/SRC/claqr0.f @@ -300,7 +300,8 @@ SUBROUTINE CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, COMPLEX ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL CLACPY, CLAHQR, CLAQR3, CLAQR4, CLAQR5 + EXTERNAL CLACPY, CLAHQR, CLAQR3, CLAQR4, + $ CLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, INT, MAX, MIN, MOD, REAL, @@ -510,7 +511,8 @@ SUBROUTINE CLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * * ==== Aggressive early deflation ==== * - CALL CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO, $ H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK, $ LWORK ) diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 2bb79b0852..7d56de0396 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -264,7 +264,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * @@ -302,7 +303,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLARF, + EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, + $ CLARF, $ CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. @@ -330,7 +332,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to CUNMHR ==== * - CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * @@ -399,7 +402,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL CLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL CLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) CALL CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, @@ -451,7 +455,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 20 CONTINUE ILST = I IF( IFST.NE.ILST ) - $ CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) + $ CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ INFO ) 30 CONTINUE END IF * @@ -475,7 +480,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, $ WORK( JW+1 ) ) @@ -500,7 +506,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -514,7 +521,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 60 CONTINUE * * ==== Update horizontal slab in H ==== @@ -534,7 +542,8 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 80 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL CLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/claqr3.f b/SRC/claqr3.f index b72293da03..763c10eb73 100644 --- a/SRC/claqr3.f +++ b/SRC/claqr3.f @@ -261,7 +261,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * @@ -301,7 +302,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLAQR4, + EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, + $ CLAQR4, $ CLARF, CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. @@ -329,13 +331,15 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to CUNMHR ==== * - CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Workspace query call to CLAQR4 ==== * - CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V, + CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, + $ V, $ LDV, WORK, -1, INFQR ) LWK3 = INT( WORK( 1 ) ) * @@ -404,15 +408,18 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL CLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL CLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) NMIN = ILAENV( 12, 'CLAQR3', 'SV', JW, 1, JW, LWORK ) IF( JW.GT.NMIN ) THEN - CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, + CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), + $ 1, $ JW, V, LDV, WORK, LWORK, INFQR ) ELSE - CALL CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, + CALL CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), + $ 1, $ JW, V, LDV, INFQR ) END IF * @@ -462,7 +469,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 20 CONTINUE ILST = I IF( IFST.NE.ILST ) - $ CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) + $ CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ INFO ) 30 CONTINUE END IF * @@ -486,7 +494,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, $ WORK( JW+1 ) ) @@ -511,7 +520,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -525,7 +535,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 60 CONTINUE * * ==== Update horizontal slab in H ==== @@ -545,7 +556,8 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 80 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL CLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/claqr4.f b/SRC/claqr4.f index f14c837afc..a8f43a3247 100644 --- a/SRC/claqr4.f +++ b/SRC/claqr4.f @@ -520,7 +520,8 @@ SUBROUTINE CLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * * ==== Aggressive early deflation ==== * - CALL CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO, $ H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK, $ LWORK ) diff --git a/SRC/claqr5.f b/SRC/claqr5.f index 8ca152adb4..820d723174 100644 --- a/SRC/claqr5.f +++ b/SRC/claqr5.f @@ -252,7 +252,8 @@ *> ACM Trans. Math. Softw. 40, 2, Article 12 (February 2014). *> * ===================================================================== - SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, + SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, + $ S, $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) IMPLICIT NONE @@ -301,7 +302,8 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, COMPLEX VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLAQR1, CLARFG, CLASET, CTRMM + EXTERNAL CGEMM, CLACPY, CLAQR1, CLARFG, CLASET, + $ CTRMM * .. * .. Statement Functions .. REAL CABS1 diff --git a/SRC/claqsb.f b/SRC/claqsb.f index c782efc327..4589fce84f 100644 --- a/SRC/claqsb.f +++ b/SRC/claqsb.f @@ -138,7 +138,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE CLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE CLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/claqz0.f b/SRC/claqz0.f index 4085834052..276f6c364d 100644 --- a/SRC/claqz0.f +++ b/SRC/claqz0.f @@ -278,7 +278,8 @@ *> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHA, BETA, Q, LDQ, Z, $ LDZ, WORK, LWORK, RWORK, REC, $ INFO ) @@ -418,7 +419,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL CHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, $ INFO ) RETURN @@ -430,7 +432,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to CLAQZ2 NW = MAX( NWR, NMIN ) - CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHA, $ BETA, WORK, NW, WORK, NW, WORK, -1, RWORK, REC, $ AED_INFO ) @@ -537,17 +540,20 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL CLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = CZERO CALL CROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL CROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL CROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -557,9 +563,11 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = CZERO - CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL CROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL CROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL CROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -621,7 +629,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL CLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHA, BETA, WORK, NW, WORK( NW**2+1 ), NW, $ WORK( 2*NW**2+1 ), LWORK-2*NW**2, RWORK, REC, @@ -664,7 +673,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL CLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHA( SHIFTPOS ), BETA( SHIFTPOS ), A, LDA, B, $ LDB, Q, LDQ, Z, LDZ, WORK, NBLOCK, WORK( NBLOCK** $ 2+1 ), NBLOCK, WORK( 2*NBLOCK**2+1 ), diff --git a/SRC/claqz1.f b/SRC/claqz1.f index a91c7f96a9..e99040995d 100644 --- a/SRC/claqz1.f +++ b/SRC/claqz1.f @@ -169,7 +169,8 @@ *> \ingroup laqz1 *> * ===================================================================== - SUBROUTINE CLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, + SUBROUTINE CLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, + $ B, $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ ) IMPLICIT NONE * @@ -204,7 +205,8 @@ SUBROUTINE CLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL CROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C, S ) IF ( ILZ ) THEN - CALL CROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL CROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C, S ) END IF * @@ -220,10 +222,12 @@ SUBROUTINE CLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, B( K+1, K ) = CZERO CALL CROT( K+2-ISTARTM+1, A( ISTARTM, K+1 ), 1, A( ISTARTM, $ K ), 1, C, S ) - CALL CROT( K-ISTARTM+1, B( ISTARTM, K+1 ), 1, B( ISTARTM, K ), + CALL CROT( K-ISTARTM+1, B( ISTARTM, K+1 ), 1, B( ISTARTM, + $ K ), $ 1, C, S ) IF ( ILZ ) THEN - CALL CROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, K-ZSTART+1 ), + CALL CROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, + $ K-ZSTART+1 ), $ 1, C, S ) END IF * @@ -232,9 +236,11 @@ SUBROUTINE CLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL CLARTG( A( K+1, K ), A( K+2, K ), C, S, TEMP ) A( K+1, K ) = TEMP A( K+2, K ) = CZERO - CALL CROT( ISTOPM-K, A( K+1, K+1 ), LDA, A( K+2, K+1 ), LDA, C, + CALL CROT( ISTOPM-K, A( K+1, K+1 ), LDA, A( K+2, K+1 ), LDA, + $ C, $ S ) - CALL CROT( ISTOPM-K, B( K+1, K+1 ), LDB, B( K+2, K+1 ), LDB, C, + CALL CROT( ISTOPM-K, B( K+1, K+1 ), LDB, B( K+2, K+1 ), LDB, + $ C, $ S ) IF ( ILQ ) THEN CALL CROT( NQ, Q( 1, K+1-QSTART+1 ), 1, Q( 1, K+2-QSTART+ diff --git a/SRC/claqz2.f b/SRC/claqz2.f index a5a3e0f9ae..b1c9fc8260 100644 --- a/SRC/claqz2.f +++ b/SRC/claqz2.f @@ -229,7 +229,8 @@ *> \ingroup laqz2 *> * ===================================================================== - RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHA, BETA, QC, LDQC, ZC, LDZC, $ WORK, LWORK, RWORK, REC, INFO ) @@ -320,7 +321,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL CLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL CLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -335,7 +337,8 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL CLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL CLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -392,11 +395,14 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = CZERO K2 = MAX( KWTOP, K-1 ) - CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL CROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL CROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL CROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, CONJG( S1 ) ) END DO @@ -438,25 +444,29 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, QC, + CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, A( ISTARTM, + CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, B( ISTARTM, + CALL CGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL CLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, ZC, + CALL CGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/SRC/claqz3.f b/SRC/claqz3.f index caaebcbc44..e7229bc481 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -305,7 +305,8 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, $ S ) CALL CROT( NS, B( ILO, ILO ), LDB, B( ILO+1, ILO ), LDB, C, $ S ) - CALL CROT( NS+1, QC( 1, 1 ), 1, QC( 1, 2 ), 1, C, CONJG( S ) ) + CALL CROT( NS+1, QC( 1, 1 ), 1, QC( 1, 2 ), 1, C, + $ CONJG( S ) ) * Chase the shift down DO J = 1, NS-I @@ -325,11 +326,13 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS+1 SWIDTH = ISTOPM-( ILO+NS )+1 IF ( SWIDTH > 0 ) THEN - CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ A( ILO, ILO+NS ), LDA, CZERO, WORK, SHEIGHT ) CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ILO, $ ILO+NS ), LDA ) - CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ B( ILO, ILO+NS ), LDB, CZERO, WORK, SHEIGHT ) CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ILO, $ ILO+NS ), LDB ) @@ -348,12 +351,14 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL CGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ A( ISTARTM, ILO ), LDA, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ ILO ), LDA ) CALL CGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ B( ISTARTM, ILO ), LDB, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ ILO ), LDB ) END IF IF ( ILZ ) THEN @@ -385,7 +390,8 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, * Move down the block with index k+i+j, updating * the (ns+np x ns+np) block: * (k:k+ns+np,k:k+ns+np-1) - CALL CLAQZ1( .TRUE., .TRUE., K+I+J, ISTARTB, ISTOPB, IHI, + CALL CLAQZ1( .TRUE., .TRUE., K+I+J, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NBLOCK, K+1, QC, LDQC, $ NBLOCK, K, ZC, LDZC ) END DO @@ -402,18 +408,22 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, $ LDQC, A( K+1, K+NS+NP ), LDA, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( K+1, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( K+1, $ K+NS+NP ), LDA ) CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, $ LDQC, B( K+1, K+NS+NP ), LDB, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( K+1, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( K+1, $ K+NS+NP ), LDB ) END IF IF ( ILQ ) THEN - CALL CGEMM( 'N', 'N', N, NBLOCK, NBLOCK, CONE, Q( 1, K+1 ), + CALL CGEMM( 'N', 'N', N, NBLOCK, NBLOCK, CONE, Q( 1, + $ K+1 ), $ LDQ, QC, LDQC, CZERO, WORK, N ) - CALL CLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), LDQ ) + CALL CLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), + $ LDQ ) END IF * Update A(istartm:k,k:k+ns+npos-1) and B(istartm:k,k:k+ns+npos-1) @@ -456,7 +466,8 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS * Chase the shift down to the bottom right corner DO ISHIFT = IHI-I, IHI-1 - CALL CLAQZ1( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, IHI, + CALL CLAQZ1( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NS, IHI-NS+1, QC, LDQC, NS+1, $ IHI-NS, ZC, LDZC ) END DO @@ -470,17 +481,20 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS SWIDTH = ISTOPM-( IHI+1 )+1 IF ( SWIDTH > 0 ) THEN - CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ A( IHI-NS+1, IHI+1 ), LDA, CZERO, WORK, SHEIGHT ) CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ A( IHI-NS+1, IHI+1 ), LDA ) - CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL CGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ B( IHI-NS+1, IHI+1 ), LDB, CZERO, WORK, SHEIGHT ) CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ B( IHI-NS+1, IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL CGEMM( 'N', 'N', N, NS, NS, CONE, Q( 1, IHI-NS+1 ), LDQ, + CALL CGEMM( 'N', 'N', N, NS, NS, CONE, Q( 1, IHI-NS+1 ), + $ LDQ, $ QC, LDQC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, NS, WORK, N, Q( 1, IHI-NS+1 ), LDQ ) END IF @@ -493,16 +507,19 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL CGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ A( ISTARTM, IHI-NS ), LDA, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ IHI-NS ), LDA ) CALL CGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ B( ISTARTM, IHI-NS ), LDB, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL CLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ IHI-NS ), LDB ) END IF IF ( ILZ ) THEN - CALL CGEMM( 'N', 'N', N, NS+1, NS+1, CONE, Z( 1, IHI-NS ), LDZ, + CALL CGEMM( 'N', 'N', N, NS+1, NS+1, CONE, Z( 1, IHI-NS ), + $ LDZ, $ ZC, LDZC, CZERO, WORK, N ) CALL CLACPY( 'ALL', N, NS+1, WORK, N, Z( 1, IHI-NS ), LDZ ) END IF diff --git a/SRC/clarf.f b/SRC/clarf.f index ef7458c348..9cb07198fa 100644 --- a/SRC/clarf.f +++ b/SRC/clarf.f @@ -205,7 +205,8 @@ SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H * - CALL CGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) + CALL CGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, + $ LDC ) END IF ELSE * @@ -220,7 +221,8 @@ SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H * - CALL CGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) + CALL CGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, + $ LDC ) END IF END IF RETURN diff --git a/SRC/clarfb.f b/SRC/clarfb.f index 17692a7952..fc8052d79a 100644 --- a/SRC/clarfb.f +++ b/SRC/clarfb.f @@ -193,7 +193,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, + SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, + $ LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * * -- LAPACK auxiliary routine -- @@ -266,20 +267,23 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C2**H *V2 * - CALL CGEMM( 'Conjugate transpose', 'No transpose', N, + CALL CGEMM( 'Conjugate transpose', 'No transpose', + $ N, $ K, M-K, ONE, C( K+1, 1 ), LDC, $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**H or W * T * - CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**H @@ -320,13 +324,15 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C2 * V2 * - CALL CGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL CGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, $ ONE, WORK, LDWORK ) END IF @@ -342,7 +348,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2**H * - CALL CGEMM( 'No transpose', 'Conjugate transpose', M, + CALL CGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ N-K, K, -ONE, WORK, LDWORK, V( K+1, 1 ), $ LDV, ONE, C( 1, K+1 ), LDC ) END IF @@ -377,26 +384,30 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**H * DO 70 J = 1, K - CALL CCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL CCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) CALL CLACGV( N, WORK( 1, J ), 1 ) 70 CONTINUE * * W := W * V2 * - CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C1**H * V1 * - CALL CGEMM( 'Conjugate transpose', 'No transpose', N, + CALL CGEMM( 'Conjugate transpose', 'No transpose', + $ N, $ K, M-K, ONE, C, LDC, V, LDV, ONE, WORK, $ LDWORK ) END IF * * W := W * T**H or W * T * - CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**H @@ -439,13 +450,15 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1 * - CALL CGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL CGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * @@ -460,7 +473,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1**H * - CALL CGEMM( 'No transpose', 'Conjugate transpose', M, + CALL CGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ N-K, K, -ONE, WORK, LDWORK, V, LDV, ONE, $ C, LDC ) END IF @@ -518,7 +532,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**H or W * T * - CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**H * W**H @@ -535,7 +550,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**H @@ -566,7 +582,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W + C2 * V2**H * - CALL CGEMM( 'No transpose', 'Conjugate transpose', M, + CALL CGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ K, N-K, ONE, C( 1, K+1 ), LDC, $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK ) END IF @@ -582,14 +599,16 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2 * - CALL CGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL CGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, $ C( 1, K+1 ), LDC ) END IF * * W := W * V1 * - CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -617,7 +636,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**H * DO 190 J = 1, K - CALL CCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL CCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) CALL CLACGV( N, WORK( 1, J ), 1 ) 190 CONTINUE * @@ -637,7 +657,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**H or W * T * - CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**H * W**H @@ -653,7 +674,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**H @@ -686,7 +708,8 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W + C1 * V1**H * - CALL CGEMM( 'No transpose', 'Conjugate transpose', M, + CALL CGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ K, N-K, ONE, C, LDC, V, LDV, ONE, WORK, $ LDWORK ) END IF @@ -702,13 +725,15 @@ SUBROUTINE CLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1 * - CALL CGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL CGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2 * - CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) * * C1 := C1 - W diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f index 2fa96196ec..4f08a65e72 100644 --- a/SRC/clarfgp.f +++ b/SRC/clarfgp.f @@ -129,7 +129,8 @@ SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU ) * .. External Functions .. REAL SCNRM2, SLAMCH, SLAPY3, SLAPY2 COMPLEX CLADIV - EXTERNAL SCNRM2, SLAMCH, SLAPY3, SLAPY2, CLADIV + EXTERNAL SCNRM2, SLAMCH, SLAPY3, SLAPY2, + $ CLADIV * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, REAL, SIGN diff --git a/SRC/clarft.f b/SRC/clarft.f index 8e33d80388..2740658511 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -248,7 +248,8 @@ SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) * - CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) IF( I.GT.1 ) THEN @@ -300,14 +301,16 @@ SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H * - CALL CGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ), + CALL CGEMM( '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 ) END IF * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) * - CALL CTRMV( 'Lower', 'No transpose', 'Non-unit', K-I, + CALL CTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) IF( I.GT.1 ) THEN PREVLASTV = MIN( PREVLASTV, LASTV ) diff --git a/SRC/clarrv.f b/SRC/clarrv.f index 02985ebf5f..5ac74a3d46 100644 --- a/SRC/clarrv.f +++ b/SRC/clarrv.f @@ -335,7 +335,8 @@ SUBROUTINE CLARRV( N, VL, VU, D, L, PIVMIN, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CLAR1V, CLASET, CSSCAL, SCOPY, SLARRB, + EXTERNAL CLAR1V, CLASET, CSSCAL, SCOPY, + $ SLARRB, $ SLARRF * .. * .. Intrinsic Functions .. diff --git a/SRC/clarz.f b/SRC/clarz.f index 56a6f38290..9ecb540e58 100644 --- a/SRC/clarz.f +++ b/SRC/clarz.f @@ -167,7 +167,8 @@ SUBROUTINE CLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) $ ZERO = ( 0.0E+0, 0.0E+0 ) ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGEMV, CGERC, CGERU, CLACGV + EXTERNAL CAXPY, CCOPY, CGEMV, CGERC, CGERU, + $ CLACGV * .. * .. External Functions .. LOGICAL LSAME @@ -188,7 +189,8 @@ SUBROUTINE CLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )**H * v( 1:l ) ) * - CALL CGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ), + CALL CGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, + $ 1 ), $ LDC, V, INCV, ONE, WORK, 1 ) CALL CLACGV( N, WORK, 1 ) * @@ -215,7 +217,8 @@ SUBROUTINE CLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) * - CALL CGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, + CALL CGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), + $ LDC, $ V, INCV, ONE, WORK, 1 ) * * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) diff --git a/SRC/clarzb.f b/SRC/clarzb.f index c0cc3fd577..6f6ff22adf 100644 --- a/SRC/clarzb.f +++ b/SRC/clarzb.f @@ -258,7 +258,8 @@ SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T * - CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T, + CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**H @@ -273,7 +274,8 @@ SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * V( 1:k, 1:l )**H * W( 1:n, 1:k )**H * IF( L.GT.0 ) - $ CALL CGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV, + $ CALL CGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, + $ LDV, $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC ) * ELSE IF( LSAME( SIDE, 'R' ) ) THEN @@ -299,7 +301,8 @@ SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, DO 50 J = 1, K CALL CLACGV( K-J+1, T( J, J ), 1 ) 50 CONTINUE - CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T, + CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, + $ T, $ LDT, WORK, LDWORK ) DO 60 J = 1, K CALL CLACGV( K-J+1, T( J, J ), 1 ) @@ -320,7 +323,8 @@ SUBROUTINE CLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, CALL CLACGV( K, V( 1, J ), 1 ) 90 CONTINUE IF( L.GT.0 ) - $ CALL CGEMM( 'No transpose', 'No transpose', M, L, K, -ONE, + $ CALL CGEMM( 'No transpose', 'No transpose', M, L, K, + $ -ONE, $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC ) DO 100 J = 1, L CALL CLACGV( K, V( 1, J ), 1 ) diff --git a/SRC/clascl.f b/SRC/clascl.f index 2ebdfbe0f5..c8061e0908 100644 --- a/SRC/clascl.f +++ b/SRC/clascl.f @@ -140,7 +140,8 @@ *> \ingroup lascl * * ===================================================================== - SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/clasr.f b/SRC/clasr.f index 1ee283a33b..5dfce6084c 100644 --- a/SRC/clasr.f +++ b/SRC/clasr.f @@ -238,12 +238,14 @@ SUBROUTINE CLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * Test the input parameters * INFO = 0 - IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN + IF( .NOT.( LSAME( SIDE, 'L' ) .OR. + $ LSAME( SIDE, 'R' ) ) ) THEN INFO = 1 ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN INFO = 2 - ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) + ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. + $ LSAME( DIRECT, 'B' ) ) ) $ THEN INFO = 3 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/clasyf.f b/SRC/clasyf.f index b2037c646a..abacbc5c43 100644 --- a/SRC/clasyf.f +++ b/SRC/clasyf.f @@ -174,7 +174,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -253,7 +254,8 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * CALL CCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 ) IF( K.LT.N ) - $ CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + $ CALL CGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) * KSTEP = 1 @@ -549,7 +551,8 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * Copy column K of A to column K of W and update it * CALL CCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 ) - CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA, + CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, CONE, W( K, K ), 1 ) * KSTEP = 1 @@ -587,10 +590,13 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) - CALL CCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ), + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), $ 1 ) - CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + CALL CCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, + $ K+1 ), + $ 1 ) + CALL CGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ), $ 1 ) * @@ -649,7 +655,8 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL CCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) IF( KP.LT.N ) - $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/clasyf_aa.f b/SRC/clasyf_aa.f index 53fe486523..f5d1e4d3be 100644 --- a/SRC/clasyf_aa.f +++ b/SRC/clasyf_aa.f @@ -173,7 +173,8 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, ICAMAX * .. * .. External Subroutines .. - EXTERNAL CAXPY, CGEMV, CSCAL, CCOPY, CSWAP, CLASET, + EXTERNAL CAXPY, CGEMV, CSCAL, CCOPY, CSWAP, + $ CLASET, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/clasyf_rk.f b/SRC/clasyf_rk.f index 7cadb06238..9f059b7126 100644 --- a/SRC/clasyf_rk.f +++ b/SRC/clasyf_rk.f @@ -415,7 +415,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL CCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL CCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL CCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -514,7 +515,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * and last N-K+2 columns of W * CALL CSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -531,7 +533,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL CSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL CSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL CSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -738,7 +741,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL CCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -758,7 +762,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = CABS1( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -780,7 +785,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -806,7 +812,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -841,7 +848,8 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL CCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL CCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL CCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/clasyf_rook.f b/SRC/clasyf_rook.f index 49f566211c..3c9ea16616 100644 --- a/SRC/clasyf_rook.f +++ b/SRC/clasyf_rook.f @@ -326,7 +326,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL CCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL CCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL CCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -425,7 +426,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * and last N-K+2 columns of W * CALL CSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL CSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -442,7 +444,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL CSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL CSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL CSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -652,7 +655,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL CCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL CCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -672,7 +676,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ICAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = CABS1( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -694,7 +699,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -720,7 +726,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL CCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -755,7 +762,8 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL CCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL CCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL CCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/clatbs.f b/SRC/clatbs.f index 94e8435303..efe553ff87 100644 --- a/SRC/clatbs.f +++ b/SRC/clatbs.f @@ -239,7 +239,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, + SUBROUTINE CLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, + $ X, $ SCALE, CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -275,7 +276,8 @@ SUBROUTINE CLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, INTEGER ICAMAX, ISAMAX REAL SCASUM, SLAMCH COMPLEX CDOTC, CDOTU, CLADIV - EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, CDOTC, + EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, + $ CDOTC, $ CDOTU, CLADIV * .. * .. External Subroutines .. diff --git a/SRC/clatdf.f b/SRC/clatdf.f index d05ce9be7a..9afc8c7250 100644 --- a/SRC/clatdf.f +++ b/SRC/clatdf.f @@ -201,7 +201,8 @@ SUBROUTINE CLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, COMPLEX WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CGECON, CGESC2, CLASSQ, CLASWP, + EXTERNAL CAXPY, CCOPY, CGECON, CGESC2, CLASSQ, + $ CLASWP, $ CSCAL * .. * .. External Functions .. @@ -233,7 +234,8 @@ SUBROUTINE CLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, * SPLUS = SPLUS + REAL( CDOTC( N-J, Z( J+1, J ), 1, Z( J+1, $ J ), 1 ) ) - SMINU = REAL( CDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) ) + SMINU = REAL( CDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), + $ 1 ) ) SPLUS = SPLUS*REAL( RHS( J ) ) IF( SPLUS.GT.SMINU ) THEN RHS( J ) = BP diff --git a/SRC/clatps.f b/SRC/clatps.f index 1c9910b706..662b5dc761 100644 --- a/SRC/clatps.f +++ b/SRC/clatps.f @@ -263,7 +263,8 @@ SUBROUTINE CLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, INTEGER ICAMAX, ISAMAX REAL SCASUM, SLAMCH COMPLEX CDOTC, CDOTU, CLADIV - EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, CDOTC, + EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, + $ CDOTC, $ CDOTU, CLADIV * .. * .. External Subroutines .. @@ -660,7 +661,8 @@ SUBROUTINE CLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * Compute the update * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) * - CALL CAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X, + CALL CAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, + $ X, $ 1 ) I = ICAMAX( J-1, X, 1 ) XMAX = CABS1( X( I ) ) diff --git a/SRC/clatrd.f b/SRC/clatrd.f index dd210a893b..7efc611945 100644 --- a/SRC/clatrd.f +++ b/SRC/clatrd.f @@ -224,7 +224,8 @@ SUBROUTINE CLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CAXPY, CGEMV, CHEMV, CLACGV, CLARFG, CSCAL + EXTERNAL CAXPY, CGEMV, CHEMV, CLACGV, CLARFG, + $ CSCAL * .. * .. External Functions .. LOGICAL LSAME @@ -257,7 +258,8 @@ SUBROUTINE CLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 ) CALL CLACGV( N-I, W( I, IW+1 ), LDW ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) - CALL CGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ), + CALL CGEMV( 'No transpose', I, N-I, -ONE, W( 1, + $ IW+1 ), $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) A( I, I ) = REAL( A( I, I ) ) @@ -333,17 +335,20 @@ SUBROUTINE CLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) CALL CGEMV( 'Conjugate transpose', N-I, I-1, ONE, $ W( I+1, 1 ), LDW, A( I+1, I ), 1, ZERO, $ W( 1, I ), 1 ) - CALL CGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ), + CALL CGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', N-I, I-1, ONE, $ A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO, $ W( 1, I ), 1 ) - CALL CGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ), + CALL CGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, + $ 1 ), $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL CSCAL( N-I, TAU( I ), W( I+1, I ), 1 ) ALPHA = -HALF*TAU( I )*CDOTC( N-I, W( I+1, I ), 1, $ A( I+1, I ), 1 ) - CALL CAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 ) + CALL CAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), + $ 1 ) END IF * 20 CONTINUE diff --git a/SRC/clatrs.f b/SRC/clatrs.f index 6e02f6f35c..373d1990d4 100644 --- a/SRC/clatrs.f +++ b/SRC/clatrs.f @@ -235,7 +235,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, + SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, + $ SCALE, $ CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -271,7 +272,8 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, INTEGER ICAMAX, ISAMAX REAL SCASUM, SLAMCH COMPLEX CDOTC, CDOTU, CLADIV - EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, CDOTC, + EXTERNAL LSAME, ICAMAX, ISAMAX, SCASUM, SLAMCH, + $ CDOTC, $ CDOTU, CLADIV * .. * .. External Subroutines .. @@ -787,7 +789,8 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, IF( UPPER ) THEN CSUMJ = CDOTU( J-1, A( 1, J ), 1, X, 1 ) ELSE IF( J.LT.N ) THEN - CSUMJ = CDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) + CSUMJ = CDOTU( N-J, A( J+1, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * @@ -921,7 +924,8 @@ SUBROUTINE CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, IF( UPPER ) THEN CSUMJ = CDOTC( J-1, A( 1, J ), 1, X, 1 ) ELSE IF( J.LT.N ) THEN - CSUMJ = CDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) + CSUMJ = CDOTC( N-J, A( J+1, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index 89fab12551..357dfae198 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -371,10 +371,12 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Use unblocked code for small problems * IF( NRHS.LT.NRHSMIN ) THEN - CALL CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X( 1, 1 ), + CALL CLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X( 1, + $ 1 ), $ SCALE( 1 ), CNORM, INFO ) DO K = 2, NRHS - CALL CLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, K ), + CALL CLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -401,10 +403,12 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute upper bound of A( I1:I2-1, J1:J2-1 ). * IF( NOTRAN ) THEN - ANRM = CLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = CLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + I+(J-1)*NBA ) = ANRM ELSE - ANRM = CLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = CLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + J+(I-1)*NBA ) = ANRM END IF TMAX = MAX( TMAX, ANRM ) @@ -421,7 +425,8 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * in the computation of the column norms CNORM. * DO K = 1, NRHS - CALL CLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, K ), + CALL CLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -604,7 +609,8 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute scaling factor to survive the linear update * simulating consistent scaling. * - BNRM = CLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, W ) + BNRM = CLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, + $ W ) BNRM = BNRM*( SCAMIN / WORK( I+KK*LDS ) ) XNRM( KK ) = XNRM( KK )*( SCAMIN / WORK( J+KK*LDS) ) ANRM = WORK( AWRK + I+(J-1)*NBA ) diff --git a/SRC/claunhr_col_getrfnp.f b/SRC/claunhr_col_getrfnp.f index 4cb370b229..5296645a08 100644 --- a/SRC/claunhr_col_getrfnp.f +++ b/SRC/claunhr_col_getrfnp.f @@ -167,7 +167,8 @@ SUBROUTINE CLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) INTEGER IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL CGEMM, CLAUNHR_COL_GETRFNP2, CTRSM, XERBLA + EXTERNAL CGEMM, CLAUNHR_COL_GETRFNP2, CTRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -224,14 +225,16 @@ SUBROUTINE CLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) * * Compute block row of U. * - CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, CONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL CGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL CGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -CONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, CONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/claunhr_col_getrfnp2.f b/SRC/claunhr_col_getrfnp2.f index f438f54de9..90cdba4f6e 100644 --- a/SRC/claunhr_col_getrfnp2.f +++ b/SRC/claunhr_col_getrfnp2.f @@ -164,7 +164,8 @@ *> \endverbatim * * ===================================================================== - RECURSIVE SUBROUTINE CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + RECURSIVE SUBROUTINE CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, + $ INFO ) IMPLICIT NONE * * -- LAPACK computational routine -- @@ -296,7 +297,8 @@ RECURSIVE SUBROUTINE CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) * Update B22, i.e. compute the Schur complement * B22 := B22 - B21*B12 * - CALL CGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), LDA, + CALL CGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), + $ LDA, $ A( 1, N1+1 ), LDA, CONE, A( N1+1, N1+1 ), LDA ) * * Factor B22, recursive call diff --git a/SRC/clauu2.f b/SRC/clauu2.f index 62ca5af595..ef54512bb7 100644 --- a/SRC/clauu2.f +++ b/SRC/clauu2.f @@ -165,10 +165,12 @@ SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO ) DO 10 I = 1, N AII = REAL( A( I, I ) ) IF( I.LT.N ) THEN - A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I, I+1 ), LDA, + A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I, I+1 ), + $ LDA, $ A( I, I+1 ), LDA ) ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) - CALL CGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL CGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, CMPLX( AII ), $ A( 1, I ), 1 ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) @@ -184,7 +186,8 @@ SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO ) DO 20 I = 1, N AII = REAL( A( I, I ) ) IF( I.LT.N ) THEN - A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I+1, I ), 1, + A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I+1, I ), + $ 1, $ A( I+1, I ), 1 ) ) CALL CLACGV( I-1, A( I, 1 ), LDA ) CALL CGEMV( 'Conjugate transpose', N-I, I-1, ONE, diff --git a/SRC/clauum.f b/SRC/clauum.f index aa1a4da232..50634d5551 100644 --- a/SRC/clauum.f +++ b/SRC/clauum.f @@ -203,7 +203,8 @@ SUBROUTINE CLAUUM( UPLO, N, A, LDA, INFO ) $ A( I, 1 ), LDA ) CALL CLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) IF( I+IB.LE.N ) THEN - CALL CGEMM( 'Conjugate transpose', 'No transpose', IB, + CALL CGEMM( 'Conjugate transpose', 'No transpose', + $ IB, $ I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA, $ A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA ) CALL CHERK( 'Lower', 'Conjugate transpose', IB, diff --git a/SRC/cpbcon.f b/SRC/cpbcon.f index e3bfff6985..04e595500e 100644 --- a/SRC/cpbcon.f +++ b/SRC/cpbcon.f @@ -232,13 +232,15 @@ SUBROUTINE CPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * * Multiply by inv(U). * - CALL CLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL CLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/cpbequ.f b/SRC/cpbequ.f index 30e38b7a64..2e04954bc0 100644 --- a/SRC/cpbequ.f +++ b/SRC/cpbequ.f @@ -127,7 +127,8 @@ *> \ingroup pbequ * * ===================================================================== - SUBROUTINE CPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) + SUBROUTINE CPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/cpbrfs.f b/SRC/cpbrfs.f index 44c1693008..8f0ce4700e 100644 --- a/SRC/cpbrfs.f +++ b/SRC/cpbrfs.f @@ -226,7 +226,8 @@ SUBROUTINE CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHBMV, CLACN2, CPBTRS, XERBLA + EXTERNAL CAXPY, CCOPY, CHBMV, CLACN2, CPBTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, MIN, REAL @@ -412,7 +413,8 @@ SUBROUTINE CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * * Multiply by diag(W)*inv(A**H). * - CALL CPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, INFO ) + CALL CPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -423,7 +425,8 @@ SUBROUTINE CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL CPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, INFO ) + CALL CPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/cpbsv.f b/SRC/cpbsv.f index 2682459ae5..37ae4ce37e 100644 --- a/SRC/cpbsv.f +++ b/SRC/cpbsv.f @@ -192,7 +192,8 @@ SUBROUTINE CPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/cpbsvx.f b/SRC/cpbsvx.f index 09293f2b1a..1829fde26e 100644 --- a/SRC/cpbsvx.f +++ b/SRC/cpbsvx.f @@ -337,7 +337,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, + $ LDAFB, $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -373,7 +374,8 @@ SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EXTERNAL LSAME, CLANHB, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CLAQHB, CPBCON, CPBEQU, CPBRFS, + EXTERNAL CCOPY, CLACPY, CLAQHB, CPBCON, CPBEQU, + $ CPBRFS, $ CPBTRF, CPBTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -396,7 +398,9 @@ SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN @@ -453,7 +457,8 @@ SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Equilibrate the matrix. * - CALL CLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + CALL CLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) RCEQU = LSAME( EQUED, 'Y' ) END IF END IF @@ -501,7 +506,8 @@ SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Compute the reciprocal of the condition number of A. * - CALL CPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, RWORK, + CALL CPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, + $ RWORK, $ INFO ) * * Compute the solution matrix X. @@ -512,7 +518,8 @@ SUBROUTINE CPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, + CALL CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/cpbtrf.f b/SRC/cpbtrf.f index f2db4dfac5..f2bfa98f36 100644 --- a/SRC/cpbtrf.f +++ b/SRC/cpbtrf.f @@ -175,7 +175,8 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL CGEMM, CHERK, CPBTF2, CPOTF2, CTRSM, XERBLA + EXTERNAL CGEMM, CHERK, CPBTF2, CPOTF2, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -272,14 +273,16 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A12 * - CALL CTRSM( 'Left', 'Upper', 'Conjugate transpose', + CALL CTRSM( 'Left', 'Upper', + $ 'Conjugate transpose', $ 'Non-unit', IB, I2, CONE, $ AB( KD+1, I ), LDAB-1, $ AB( KD+1-IB, I+IB ), LDAB-1 ) * * Update A22 * - CALL CHERK( 'Upper', 'Conjugate transpose', I2, IB, + CALL CHERK( 'Upper', 'Conjugate transpose', I2, + $ IB, $ -ONE, AB( KD+1-IB, I+IB ), LDAB-1, ONE, $ AB( KD+1, I+IB ), LDAB-1 ) END IF @@ -296,7 +299,8 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A13 (in the work array). * - CALL CTRSM( 'Left', 'Upper', 'Conjugate transpose', + CALL CTRSM( 'Left', 'Upper', + $ 'Conjugate transpose', $ 'Non-unit', IB, I3, CONE, $ AB( KD+1, I ), LDAB-1, WORK, LDWORK ) * @@ -311,7 +315,8 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A33 * - CALL CHERK( 'Upper', 'Conjugate transpose', I3, IB, + CALL CHERK( 'Upper', 'Conjugate transpose', I3, + $ IB, $ -ONE, WORK, LDWORK, ONE, $ AB( KD+1, I+KD ), LDAB-1 ) * @@ -381,7 +386,8 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A22 * - CALL CHERK( 'Lower', 'No transpose', I2, IB, -ONE, + CALL CHERK( 'Lower', 'No transpose', I2, IB, + $ -ONE, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1, I+IB ), LDAB-1 ) END IF @@ -414,7 +420,8 @@ SUBROUTINE CPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A33 * - CALL CHERK( 'Lower', 'No transpose', I3, IB, -ONE, + CALL CHERK( 'Lower', 'No transpose', I3, IB, + $ -ONE, $ WORK, LDWORK, ONE, AB( 1, I+KD ), $ LDAB-1 ) * diff --git a/SRC/cpbtrs.f b/SRC/cpbtrs.f index 5b632d189c..f157c6173e 100644 --- a/SRC/cpbtrs.f +++ b/SRC/cpbtrs.f @@ -185,12 +185,14 @@ SUBROUTINE CPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL CTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL CTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ KD, AB, LDAB, B( 1, J ), 1 ) * * Solve U*X = B, overwriting B with X. * - CALL CTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB, + CALL CTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) 10 CONTINUE ELSE @@ -201,12 +203,14 @@ SUBROUTINE CPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL CTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB, + CALL CTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) * * Solve L**H *X = B, overwriting B with X. * - CALL CTBSV( 'Lower', 'Conjugate transpose', 'Non-unit', N, + CALL CTBSV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ N, $ KD, AB, LDAB, B( 1, J ), 1 ) 20 CONTINUE END IF diff --git a/SRC/cpftrf.f b/SRC/cpftrf.f index d69484ee71..bdd2c3d413 100644 --- a/SRC/cpftrf.f +++ b/SRC/cpftrf.f @@ -305,7 +305,8 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'L', N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'R', 'L', 'C', 'N', N2, N1, CONE, A( 0 ), N, + CALL CTRSM( 'R', 'L', 'C', 'N', N2, N1, CONE, A( 0 ), + $ N, $ A( N1 ), N ) CALL CHERK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE, $ A( N ), N ) @@ -322,7 +323,8 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'L', N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'L', 'L', 'N', 'N', N1, N2, CONE, A( N2 ), N, + CALL CTRSM( 'L', 'L', 'N', 'N', N1, N2, CONE, A( N2 ), + $ N, $ A( 0 ), N ) CALL CHERK( 'U', 'C', N2, N1, -ONE, A( 0 ), N, ONE, $ A( N1 ), N ) @@ -345,9 +347,11 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'U', N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'L', 'U', 'C', 'N', N1, N2, CONE, A( 0 ), N1, + CALL CTRSM( 'L', 'U', 'C', 'N', N1, N2, CONE, A( 0 ), + $ N1, $ A( N1*N1 ), N1 ) - CALL CHERK( 'L', 'C', N2, N1, -ONE, A( N1*N1 ), N1, ONE, + CALL CHERK( 'L', 'C', N2, N1, -ONE, A( N1*N1 ), N1, + $ ONE, $ A( 1 ), N1 ) CALL CPOTRF( 'L', N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -362,7 +366,8 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'U', N1, A( N2*N2 ), N2, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'R', 'U', 'N', 'N', N2, N1, CONE, A( N2*N2 ), + CALL CTRSM( 'R', 'U', 'N', 'N', N2, N1, CONE, + $ A( N2*N2 ), $ N2, A( 0 ), N2 ) CALL CHERK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE, $ A( N1*N2 ), N2 ) @@ -391,7 +396,8 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'L', K, A( 1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'R', 'L', 'C', 'N', K, K, CONE, A( 1 ), N+1, + CALL CTRSM( 'R', 'L', 'C', 'N', K, K, CONE, A( 1 ), + $ N+1, $ A( K+1 ), N+1 ) CALL CHERK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE, $ A( 0 ), N+1 ) @@ -431,9 +437,11 @@ SUBROUTINE CPFTRF( TRANSR, UPLO, N, A, INFO ) CALL CPOTRF( 'U', K, A( 0+K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRSM( 'L', 'U', 'C', 'N', K, K, CONE, A( K ), N1, + CALL CTRSM( 'L', 'U', 'C', 'N', K, K, CONE, A( K ), + $ N1, $ A( K*( K+1 ) ), K ) - CALL CHERK( 'L', 'C', K, K, -ONE, A( K*( K+1 ) ), K, ONE, + CALL CHERK( 'L', 'C', K, K, -ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( 0 ), K ) CALL CPOTRF( 'L', K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) diff --git a/SRC/cpftri.f b/SRC/cpftri.f index beba935045..9b1b4e5cdf 100644 --- a/SRC/cpftri.f +++ b/SRC/cpftri.f @@ -238,7 +238,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, CTFTRI, CLAUUM, CTRMM, CHERK + EXTERNAL XERBLA, CTFTRI, CLAUUM, CTRMM, + $ CHERK * .. * .. Intrinsic Functions .. INTRINSIC MOD @@ -313,7 +314,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'L', N1, A( 0 ), N, INFO ) CALL CHERK( 'L', 'C', N1, N2, ONE, A( N1 ), N, ONE, $ A( 0 ), N ) - CALL CTRMM( 'L', 'U', 'N', 'N', N2, N1, CONE, A( N ), N, + CALL CTRMM( 'L', 'U', 'N', 'N', N2, N1, CONE, A( N ), + $ N, $ A( N1 ), N ) CALL CLAUUM( 'U', N2, A( N ), N, INFO ) * @@ -326,7 +328,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'L', N1, A( N2 ), N, INFO ) CALL CHERK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE, $ A( N2 ), N ) - CALL CTRMM( 'R', 'U', 'C', 'N', N1, N2, CONE, A( N1 ), N, + CALL CTRMM( 'R', 'U', 'C', 'N', N1, N2, CONE, A( N1 ), + $ N, $ A( 0 ), N ) CALL CLAUUM( 'U', N2, A( N1 ), N, INFO ) * @@ -342,9 +345,11 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1) * CALL CLAUUM( 'U', N1, A( 0 ), N1, INFO ) - CALL CHERK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE, + CALL CHERK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, + $ ONE, $ A( 0 ), N1 ) - CALL CTRMM( 'R', 'L', 'N', 'N', N1, N2, CONE, A( 1 ), N1, + CALL CTRMM( 'R', 'L', 'N', 'N', N1, N2, CONE, A( 1 ), + $ N1, $ A( N1*N1 ), N1 ) CALL CLAUUM( 'L', N2, A( 1 ), N1, INFO ) * @@ -356,7 +361,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'U', N1, A( N2*N2 ), N2, INFO ) CALL CHERK( 'U', 'C', N1, N2, ONE, A( 0 ), N2, ONE, $ A( N2*N2 ), N2 ) - CALL CTRMM( 'L', 'L', 'C', 'N', N2, N1, CONE, A( N1*N2 ), + CALL CTRMM( 'L', 'L', 'C', 'N', N2, N1, CONE, + $ A( N1*N2 ), $ N2, A( 0 ), N2 ) CALL CLAUUM( 'L', N2, A( N1*N2 ), N2, INFO ) * @@ -381,7 +387,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'L', K, A( 1 ), N+1, INFO ) CALL CHERK( 'L', 'C', K, K, ONE, A( K+1 ), N+1, ONE, $ A( 1 ), N+1 ) - CALL CTRMM( 'L', 'U', 'N', 'N', K, K, CONE, A( 0 ), N+1, + CALL CTRMM( 'L', 'U', 'N', 'N', K, K, CONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) CALL CLAUUM( 'U', K, A( 0 ), N+1, INFO ) * @@ -394,7 +401,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'L', K, A( K+1 ), N+1, INFO ) CALL CHERK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE, $ A( K+1 ), N+1 ) - CALL CTRMM( 'R', 'U', 'C', 'N', K, K, CONE, A( K ), N+1, + CALL CTRMM( 'R', 'U', 'C', 'N', K, K, CONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) CALL CLAUUM( 'U', K, A( K ), N+1, INFO ) * @@ -411,7 +419,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k * CALL CLAUUM( 'U', K, A( K ), K, INFO ) - CALL CHERK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE, + CALL CHERK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( K ), K ) CALL CTRMM( 'R', 'L', 'N', 'N', K, K, CONE, A( 0 ), K, $ A( K*( K+1 ) ), K ) @@ -426,7 +435,8 @@ SUBROUTINE CPFTRI( TRANSR, UPLO, N, A, INFO ) CALL CLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO ) CALL CHERK( 'U', 'C', K, K, ONE, A( 0 ), K, ONE, $ A( K*( K+1 ) ), K ) - CALL CTRMM( 'L', 'L', 'C', 'N', K, K, CONE, A( K*K ), K, + CALL CTRMM( 'L', 'L', 'C', 'N', K, K, CONE, A( K*K ), + $ K, $ A( 0 ), K ) CALL CLAUUM( 'L', K, A( K*K ), K, INFO ) * diff --git a/SRC/cpftrs.f b/SRC/cpftrs.f index 0c9540239d..95788dd47f 100644 --- a/SRC/cpftrs.f +++ b/SRC/cpftrs.f @@ -281,14 +281,18 @@ SUBROUTINE CPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO ) * start execution: there are two triangular solves * IF( LOWER ) THEN - CALL CTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, B, + CALL CTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) - CALL CTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, B, + CALL CTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) ELSE - CALL CTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, B, + CALL CTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) - CALL CTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, B, + CALL CTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) END IF * diff --git a/SRC/cpocon.f b/SRC/cpocon.f index 16a1a8f2e7..a163add2d7 100644 --- a/SRC/cpocon.f +++ b/SRC/cpocon.f @@ -217,13 +217,15 @@ SUBROUTINE CPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(U). * - CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL CLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/cporfs.f b/SRC/cporfs.f index 7021a20831..aa93f070a8 100644 --- a/SRC/cporfs.f +++ b/SRC/cporfs.f @@ -220,7 +220,8 @@ SUBROUTINE CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHEMV, CLACN2, CPOTRS, XERBLA + EXTERNAL CAXPY, CCOPY, CHEMV, CLACN2, CPOTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -293,7 +294,8 @@ SUBROUTINE CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * Compute residual R = B - A * X * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL CHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * diff --git a/SRC/cporfsx.f b/SRC/cporfsx.f index 012d9a78d7..59dd1dba35 100644 --- a/SRC/cporfsx.f +++ b/SRC/cporfsx.f @@ -387,7 +387,8 @@ *> \ingroup porfsx * * ===================================================================== - SUBROUTINE CPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, + SUBROUTINE CPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, + $ B, $ LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -452,7 +453,8 @@ SUBROUTINE CPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL SLAMCH, CLANHE, CLA_PORCOND_X, CLA_PORCOND_C + EXTERNAL SLAMCH, CLANHE, CLA_PORCOND_X, + $ CLA_PORCOND_C REAL SLAMCH, CLANHE, CLA_PORCOND_X, CLA_PORCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -509,7 +511,8 @@ SUBROUTINE CPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, * * Test input parameters. * - IF (.NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF (.NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 diff --git a/SRC/cposv.f b/SRC/cposv.f index cb871a4325..7dca052cc2 100644 --- a/SRC/cposv.f +++ b/SRC/cposv.f @@ -158,7 +158,8 @@ SUBROUTINE CPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/cposvx.f b/SRC/cposvx.f index ddb7a901e4..5217d45779 100644 --- a/SRC/cposvx.f +++ b/SRC/cposvx.f @@ -301,7 +301,8 @@ *> \ingroup posvx * * ===================================================================== - SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, $ RWORK, INFO ) * @@ -337,7 +338,8 @@ SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, EXTERNAL LSAME, CLANHE, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CLACPY, CLAQHE, CPOCON, CPOEQU, CPORFS, CPOTRF, + EXTERNAL CLACPY, CLAQHE, CPOCON, CPOEQU, CPORFS, + $ CPOTRF, $ CPOTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -359,10 +361,13 @@ SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -451,7 +456,8 @@ SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Compute the reciprocal of the condition number of A. * - CALL CPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL CPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/cposvxx.f b/SRC/cposvxx.f index e7b2e42de5..181033ced4 100644 --- a/SRC/cposvxx.f +++ b/SRC/cposvxx.f @@ -490,7 +490,8 @@ *> \ingroup posvxx * * ===================================================================== - SUBROUTINE CPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE CPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) diff --git a/SRC/cpotf2.f b/SRC/cpotf2.f index a1b1e4deb6..a349020011 100644 --- a/SRC/cpotf2.f +++ b/SRC/cpotf2.f @@ -202,7 +202,8 @@ SUBROUTINE CPOTF2( UPLO, N, A, LDA, INFO ) * * Compute L(J,J) and test for non-positive-definiteness. * - AJJ = REAL( REAL( A( J, J ) ) - CDOTC( J-1, A( J, 1 ), LDA, + AJJ = REAL( REAL( A( J, J ) ) - CDOTC( J-1, A( J, 1 ), + $ LDA, $ A( J, 1 ), LDA ) ) IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN A( J, J ) = AJJ @@ -215,7 +216,8 @@ SUBROUTINE CPOTF2( UPLO, N, A, LDA, INFO ) * IF( J.LT.N ) THEN CALL CLACGV( J-1, A( J, 1 ), LDA ) - CALL CGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, 1 ), + CALL CGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, + $ 1 ), $ LDA, A( J, 1 ), LDA, CONE, A( J+1, J ), 1 ) CALL CLACGV( J-1, A( J, 1 ), LDA ) CALL CSSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) diff --git a/SRC/cpotrf.f b/SRC/cpotrf.f index 06ef4b76ae..c9c77d750c 100644 --- a/SRC/cpotrf.f +++ b/SRC/cpotrf.f @@ -135,7 +135,8 @@ SUBROUTINE CPOTRF( UPLO, N, A, LDA, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL CGEMM, CHERK, CPOTRF2, CTRSM, XERBLA + EXTERNAL CGEMM, CHERK, CPOTRF2, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -194,7 +195,8 @@ SUBROUTINE CPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block row. * - CALL CGEMM( 'Conjugate transpose', 'No transpose', JB, + CALL CGEMM( 'Conjugate transpose', 'No transpose', + $ JB, $ N-J-JB+1, J-1, -CONE, A( 1, J ), LDA, $ A( 1, J+JB ), LDA, CONE, A( J, J+JB ), $ LDA ) @@ -227,7 +229,8 @@ SUBROUTINE CPOTRF( UPLO, N, A, LDA, INFO ) $ N-J-JB+1, JB, J-1, -CONE, A( J+JB, 1 ), $ LDA, A( J, 1 ), LDA, CONE, A( J+JB, J ), $ LDA ) - CALL CTRSM( 'Right', 'Lower', 'Conjugate transpose', + CALL CTRSM( 'Right', 'Lower', + $ 'Conjugate transpose', $ 'Non-unit', N-J-JB+1, JB, CONE, A( J, J ), $ LDA, A( J+JB, J ), LDA ) END IF diff --git a/SRC/cpotri.f b/SRC/cpotri.f index 3f0fe8d50b..abbd7da3d5 100644 --- a/SRC/cpotri.f +++ b/SRC/cpotri.f @@ -123,7 +123,8 @@ SUBROUTINE CPOTRI( UPLO, N, A, LDA, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/cpotrs.f b/SRC/cpotrs.f index cdcd7c165c..1e8939f989 100644 --- a/SRC/cpotrs.f +++ b/SRC/cpotrs.f @@ -173,7 +173,8 @@ SUBROUTINE CPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL CTRSM( 'Left', 'Upper', 'Conjugate transpose', 'Non-unit', + CALL CTRSM( 'Left', 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ N, NRHS, ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -191,7 +192,8 @@ SUBROUTINE CPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve L**H *X = B, overwriting B with X. * - CALL CTRSM( 'Left', 'Lower', 'Conjugate transpose', 'Non-unit', + CALL CTRSM( 'Left', 'Lower', 'Conjugate transpose', + $ 'Non-unit', $ N, NRHS, ONE, A, LDA, B, LDB ) END IF * diff --git a/SRC/cppcon.f b/SRC/cppcon.f index 894a173542..837fa2f16a 100644 --- a/SRC/cppcon.f +++ b/SRC/cppcon.f @@ -115,7 +115,8 @@ *> \ingroup ppcon * * ===================================================================== - SUBROUTINE CPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO ) + SUBROUTINE CPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -212,13 +213,15 @@ SUBROUTINE CPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO ) * * Multiply by inv(U). * - CALL CLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL CLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL CLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/cpprfs.f b/SRC/cpprfs.f index 796ebada68..90805c0cb4 100644 --- a/SRC/cpprfs.f +++ b/SRC/cpprfs.f @@ -167,7 +167,8 @@ *> \ingroup pprfs * * ===================================================================== - SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -208,7 +209,8 @@ SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CHPMV, CLACN2, CPPTRS, XERBLA + EXTERNAL CAXPY, CCOPY, CHPMV, CLACN2, CPPTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -277,7 +279,8 @@ SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * Compute residual R = B - A * X * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CHPMV( UPLO, N, -CONE, AP, X( 1, J ), 1, CONE, WORK, 1 ) + CALL CHPMV( UPLO, N, -CONE, AP, X( 1, J ), 1, CONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * diff --git a/SRC/cppsv.f b/SRC/cppsv.f index 55dc6e05cc..0646a8ddf9 100644 --- a/SRC/cppsv.f +++ b/SRC/cppsv.f @@ -172,7 +172,8 @@ SUBROUTINE CPPSV( UPLO, N, NRHS, AP, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/cppsvx.f b/SRC/cppsvx.f index be2522c090..4f59fbc94f 100644 --- a/SRC/cppsvx.f +++ b/SRC/cppsvx.f @@ -307,7 +307,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, + SUBROUTINE CPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, + $ LDB, $ X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -342,7 +343,8 @@ SUBROUTINE CPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, EXTERNAL LSAME, CLANHP, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CLAQHP, CPPCON, CPPEQU, CPPRFS, + EXTERNAL CCOPY, CLACPY, CLAQHP, CPPCON, CPPEQU, + $ CPPRFS, $ CPPTRF, CPPTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -364,10 +366,13 @@ SUBROUTINE CPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -462,7 +467,8 @@ SUBROUTINE CPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, + CALL CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + $ BERR, $ WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/cpptrf.f b/SRC/cpptrf.f index b1e5cf9874..9f91fcb61b 100644 --- a/SRC/cpptrf.f +++ b/SRC/cpptrf.f @@ -185,7 +185,8 @@ SUBROUTINE CPPTRF( UPLO, N, AP, INFO ) * Compute elements 1:J-1 of column J. * IF( J.GT.1 ) - $ CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ CALL CTPSV( 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ J-1, AP, AP( JC ), 1 ) * * Compute U(J,J) and test for non-positive-definiteness. diff --git a/SRC/cpptri.f b/SRC/cpptri.f index 0000b5fdd1..8676440e92 100644 --- a/SRC/cpptri.f +++ b/SRC/cpptri.f @@ -173,9 +173,11 @@ SUBROUTINE CPPTRI( UPLO, N, AP, INFO ) JJ = 1 DO 20 J = 1, N JJN = JJ + N - J + 1 - AP( JJ ) = REAL( CDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) ) + AP( JJ ) = REAL( CDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), + $ 1 ) ) IF( J.LT.N ) - $ CALL CTPMV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ CALL CTPMV( 'Lower', 'Conjugate transpose', + $ 'Non-unit', $ N-J, AP( JJN ), AP( JJ+1 ), 1 ) JJ = JJN 20 CONTINUE diff --git a/SRC/cpptrs.f b/SRC/cpptrs.f index 148035b097..f283f69dab 100644 --- a/SRC/cpptrs.f +++ b/SRC/cpptrs.f @@ -168,7 +168,8 @@ SUBROUTINE CPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL CTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ AP, B( 1, I ), 1 ) * * Solve U*X = B, overwriting B with X. @@ -189,7 +190,8 @@ SUBROUTINE CPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO ) * * Solve L**H *X = Y, overwriting B with X. * - CALL CTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N, + CALL CTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ N, $ AP, B( 1, I ), 1 ) 20 CONTINUE END IF diff --git a/SRC/cpstf2.f b/SRC/cpstf2.f index 54c836fde9..205ef2a1b7 100644 --- a/SRC/cpstf2.f +++ b/SRC/cpstf2.f @@ -139,7 +139,8 @@ *> \ingroup pstf2 * * ===================================================================== - SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -176,7 +177,8 @@ SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL SLAMCH, LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CGEMV, CLACGV, CSSCAL, CSWAP, XERBLA + EXTERNAL CGEMV, CLACGV, CSSCAL, CSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, REAL, SQRT @@ -301,7 +303,8 @@ SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * IF( J.LT.N ) THEN CALL CLACGV( J-1, A( 1, J ), 1 ) - CALL CGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ), LDA, + CALL CGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ), + $ LDA, $ A( 1, J ), 1, CONE, A( J, J+1 ), LDA ) CALL CLACGV( J-1, A( 1, J ), 1 ) CALL CSSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA ) @@ -347,7 +350,8 @@ SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) A( PVT, PVT ) = A( J, J ) CALL CSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) IF( PVT.LT.N ) - $ CALL CSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ), + $ CALL CSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, + $ PVT ), $ 1 ) DO 170 I = J + 1, PVT - 1 CTEMP = CONJG( A( I, J ) ) diff --git a/SRC/cpstrf.f b/SRC/cpstrf.f index 7175c03668..66328d2d38 100644 --- a/SRC/cpstrf.f +++ b/SRC/cpstrf.f @@ -139,7 +139,8 @@ *> \ingroup pstrf * * ===================================================================== - SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -177,7 +178,8 @@ SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL SLAMCH, ILAENV, LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CGEMV, CHERK, CLACGV, CPSTF2, CSSCAL, CSWAP, + EXTERNAL CGEMV, CHERK, CLACGV, CPSTF2, CSSCAL, + $ CSWAP, $ XERBLA * .. * .. Intrinsic Functions .. @@ -324,7 +326,8 @@ SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * IF( J.LT.N ) THEN CALL CLACGV( J-1, A( 1, J ), 1 ) - CALL CGEMV( 'Trans', J-K, N-J, -CONE, A( K, J+1 ), + CALL CGEMV( 'Trans', J-K, N-J, -CONE, A( K, + $ J+1 ), $ LDA, A( K, J ), 1, CONE, A( J, J+1 ), $ LDA ) CALL CLACGV( J-1, A( 1, J ), 1 ) @@ -391,7 +394,8 @@ SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Pivot OK, so can now swap pivot rows and columns * A( PVT, PVT ) = A( J, J ) - CALL CSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) + CALL CSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), + $ LDA ) IF( PVT.LT.N ) $ CALL CSWAP( N-PVT, A( PVT+1, J ), 1, $ A( PVT+1, PVT ), 1 ) diff --git a/SRC/cptsvx.f b/SRC/cptsvx.f index 7d2916e8c6..e098fe1c19 100644 --- a/SRC/cptsvx.f +++ b/SRC/cptsvx.f @@ -265,7 +265,8 @@ SUBROUTINE CPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, EXTERNAL LSAME, CLANHT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CPTCON, CPTRFS, CPTTRF, CPTTRS, + EXTERNAL CCOPY, CLACPY, CPTCON, CPTRFS, CPTTRF, + $ CPTTRS, $ SCOPY, XERBLA * .. * .. Intrinsic Functions .. @@ -326,7 +327,8 @@ SUBROUTINE CPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL CPTRFS( 'Lower', N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, + CALL CPTRFS( 'Lower', N, NRHS, D, E, DF, EF, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/crscl.f b/SRC/crscl.f index 7e1f1fcaaa..5efed242a3 100644 --- a/SRC/crscl.f +++ b/SRC/crscl.f @@ -166,7 +166,8 @@ SUBROUTINE CRSCL( N, A, X, INCX ) * IF( (ABS( UR ).LT.SAFMIN).OR.(ABS( UI ).LT.SAFMIN) ) THEN * This means that both alphaR and alphaI are very small. - CALL CSCAL( N, CMPLX( SAFMIN / UR, -SAFMIN / UI ), X, INCX ) + CALL CSCAL( N, CMPLX( SAFMIN / UR, -SAFMIN / UI ), X, + $ INCX ) CALL CSSCAL( N, SAFMAX, X, INCX ) ELSE IF( (ABS( UR ).GT.SAFMAX).OR.(ABS( UI ).GT.SAFMAX) ) THEN IF( (ABSR.GT.OV).OR.(ABSI.GT.OV) ) THEN @@ -185,7 +186,8 @@ SUBROUTINE CRSCL( N, A, X, INCX ) UR = (SAFMIN * AR) + AI * ( (SAFMIN * AI) / AR ) UI = (SAFMIN * AI) + SAFMIN * (AR * ( AR / AI )) END IF - CALL CSCAL( N, CMPLX( ONE / UR, -ONE / UI ), X, INCX ) + CALL CSCAL( N, CMPLX( ONE / UR, -ONE / UI ), X, + $ INCX ) ELSE CALL CSCAL( N, CMPLX( SAFMAX / UR, -SAFMAX / UI ), $ X, INCX ) diff --git a/SRC/cspcon.f b/SRC/cspcon.f index 88443f2b16..96ee07f91b 100644 --- a/SRC/cspcon.f +++ b/SRC/cspcon.f @@ -115,7 +115,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE CSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO ) + SUBROUTINE CSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/cspmv.f b/SRC/cspmv.f index 4efc03dce4..9aaaa39679 100644 --- a/SRC/cspmv.f +++ b/SRC/cspmv.f @@ -187,7 +187,8 @@ SUBROUTINE CSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/cspr.f b/SRC/cspr.f index ce8fa5d44c..221ccb885d 100644 --- a/SRC/cspr.f +++ b/SRC/cspr.f @@ -166,7 +166,8 @@ SUBROUTINE CSPR( UPLO, N, ALPHA, X, INCX, AP ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/csprfs.f b/SRC/csprfs.f index 05914923ff..84df8de346 100644 --- a/SRC/csprfs.f +++ b/SRC/csprfs.f @@ -176,7 +176,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -218,7 +219,8 @@ SUBROUTINE CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CLACN2, CSPMV, CSPTRS, XERBLA + EXTERNAL CAXPY, CCOPY, CLACN2, CSPMV, CSPTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL diff --git a/SRC/cspsv.f b/SRC/cspsv.f index 79a77be8b7..dc6a3e5128 100644 --- a/SRC/cspsv.f +++ b/SRC/cspsv.f @@ -191,7 +191,8 @@ SUBROUTINE CSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/cspsvx.f b/SRC/cspsvx.f index 0d4e53a57e..57c66a77bc 100644 --- a/SRC/cspsvx.f +++ b/SRC/cspsvx.f @@ -273,7 +273,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE CSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -308,7 +309,8 @@ SUBROUTINE CSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, CLANSP, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLACPY, CSPCON, CSPRFS, CSPTRF, CSPTRS, + EXTERNAL CCOPY, CLACPY, CSPCON, CSPRFS, CSPTRF, + $ CSPTRS, $ XERBLA * .. * .. Intrinsic Functions .. @@ -322,7 +324,8 @@ SUBROUTINE CSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -370,7 +373,8 @@ SUBROUTINE CSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/csptrf.f b/SRC/csptrf.f index 8ea6ed10b8..235676534e 100644 --- a/SRC/csptrf.f +++ b/SRC/csptrf.f @@ -507,7 +507,8 @@ SUBROUTINE CSPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL CSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/csptri.f b/SRC/csptri.f index c299918548..61b96a3e52 100644 --- a/SRC/csptri.f +++ b/SRC/csptri.f @@ -219,7 +219,8 @@ SUBROUTINE CSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL CCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL CSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL CSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ CDOTU( K-1, WORK, 1, AP( KC ), 1 ) @@ -244,18 +245,21 @@ SUBROUTINE CSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL CCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL CSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL CSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ CDOTU( K-1, WORK, 1, AP( KC ), 1 ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ CDOTU( K-1, AP( KC ), 1, AP( KCNEXT ), + $ CDOTU( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL CCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL CSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, $ AP( KCNEXT ), 1 ) AP( KCNEXT+K ) = AP( KCNEXT+K ) - - $ CDOTU( K-1, WORK, 1, AP( KCNEXT ), 1 ) + $ CDOTU( K-1, WORK, 1, AP( KCNEXT ), + $ 1 ) END IF KSTEP = 2 KCNEXT = KCNEXT + K + 1 @@ -346,7 +350,8 @@ SUBROUTINE CSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL CSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL CSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KC+1 ), 1 ) AP( KC ) = AP( KC ) - CDOTU( N-K, WORK, 1, AP( KC+1 ), $ 1 ) @@ -354,10 +359,12 @@ SUBROUTINE CSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) $ CDOTU( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL CCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL CSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL CSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - - $ CDOTU( N-K, WORK, 1, AP( KCNEXT+2 ), 1 ) + $ CDOTU( N-K, WORK, 1, AP( KCNEXT+2 ), + $ 1 ) END IF KSTEP = 2 KCNEXT = KCNEXT - ( N-K+3 ) diff --git a/SRC/csptrs.f b/SRC/csptrs.f index 3288174400..b3e9cf9d71 100644 --- a/SRC/csptrs.f +++ b/SRC/csptrs.f @@ -268,7 +268,8 @@ SUBROUTINE CSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -285,7 +286,8 @@ SUBROUTINE CSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB ) @@ -356,7 +358,8 @@ SUBROUTINE CSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/cstedc.f b/SRC/cstedc.f index 3e6960d5fe..23448b0ea7 100644 --- a/SRC/cstedc.f +++ b/SRC/cstedc.f @@ -238,7 +238,8 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL XERBLA, CLACPY, CLACRM, CLAED0, CSTEQR, CSWAP, + EXTERNAL XERBLA, CLACPY, CLACRM, CLAED0, CSTEQR, + $ CSWAP, $ SLASCL, SLASET, SSTEDC, SSTEQR, SSTERF * .. * .. Intrinsic Functions .. @@ -409,12 +410,15 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * Scale. * ORGNRM = SLANST( 'M', M, D( START ), E( START ) ) - CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), + $ M, $ INFO ) - CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, + $ E( START ), $ M-1, INFO ) * - CALL CLAED0( N, M, D( START ), E( START ), Z( 1, START ), + CALL CLAED0( N, M, D( START ), E( START ), Z( 1, + $ START ), $ LDZ, WORK, N, RWORK, IWORK, INFO ) IF( INFO.GT.0 ) THEN INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) + @@ -424,13 +428,15 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * * Scale back. * - CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), + $ M, $ INFO ) * ELSE CALL SSTEQR( 'I', M, D( START ), E( START ), RWORK, M, $ RWORK( M*M+1 ), INFO ) - CALL CLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N, + CALL CLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, + $ N, $ RWORK( M*M+1 ) ) CALL CLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ ) IF( INFO.GT.0 ) THEN diff --git a/SRC/cstein.f b/SRC/cstein.f index f627a6f6e6..9859842bc8 100644 --- a/SRC/cstein.f +++ b/SRC/cstein.f @@ -223,7 +223,8 @@ SUBROUTINE CSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, EXTERNAL ISAMAX, SLAMCH, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAGTF, SLAGTS, SLARNV, SSCAL, XERBLA + EXTERNAL SCOPY, SLAGTF, SLAGTS, SLARNV, SSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX, REAL, SQRT @@ -366,7 +367,8 @@ SUBROUTINE CSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Compute LU factors with partial pivoting ( PT = LU ) * TOL = ZERO - CALL SLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ), + CALL SLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK, $ IINFO ) * @@ -387,7 +389,8 @@ SUBROUTINE CSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * * Solve the system LU = Pb. * - CALL SLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ), + CALL SLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK, $ WORK( INDRV1+1 ), TOL, IINFO ) * diff --git a/SRC/cstemr.f b/SRC/cstemr.f index d56f829991..b8f92e0490 100644 --- a/SRC/cstemr.f +++ b/SRC/cstemr.f @@ -381,7 +381,8 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, EXTERNAL LSAME, SLAMCH, SLANST, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLARRV, CSWAP, SCOPY, SLAE2, SLAEV2, SLARRC, + EXTERNAL CLARRV, CSWAP, SCOPY, SLAE2, SLAEV2, + $ SLARRC, $ SLARRE, SLARRJ, SLARRR, SLASRT, SSCAL, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/csteqr.f b/SRC/csteqr.f index e372678139..8731ceabc2 100644 --- a/SRC/csteqr.f +++ b/SRC/csteqr.f @@ -169,7 +169,8 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, SLAMCH, SLANST, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL CLASET, CLASR, CSWAP, SLAE2, SLAEV2, SLARTG, + EXTERNAL CLASET, CLASR, CSWAP, SLAE2, SLAEV2, + $ SLARTG, $ SLASCL, SLASRT, XERBLA * .. * .. Intrinsic Functions .. @@ -275,13 +276,15 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) $ GO TO 10 IF( ANORM.GT.SSFMAX ) THEN ISCALE = 1 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) @@ -324,7 +327,8 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L+1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S ) + CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, + $ S ) WORK( L ) = C WORK( N-1+L ) = S CALL CLASR( 'R', 'V', 'B', N, 2, WORK( L ), @@ -383,7 +387,8 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = M - L + 1 - CALL CLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ), + CALL CLASR( 'R', 'V', 'B', N, MM, WORK( L ), + $ WORK( N-1+L ), $ Z( 1, L ), LDZ ) END IF * @@ -431,7 +436,8 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L-1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S ) + CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, + $ S ) WORK( M ) = C WORK( N-1+M ) = S CALL CLASR( 'R', 'V', 'F', N, 2, WORK( M ), @@ -490,7 +496,8 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = L - M + 1 - CALL CLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ), + CALL CLASR( 'R', 'V', 'F', N, MM, WORK( M ), + $ WORK( N-1+M ), $ Z( 1, M ), LDZ ) END IF * @@ -516,12 +523,14 @@ SUBROUTINE CSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) IF( ISCALE.EQ.1 ) THEN CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) ELSE IF( ISCALE.EQ.2 ) THEN CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) END IF * diff --git a/SRC/csycon_rook.f b/SRC/csycon_rook.f index dd7802c24c..e0f295b01d 100644 --- a/SRC/csycon_rook.f +++ b/SRC/csycon_rook.f @@ -135,7 +135,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE CSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/csyequb.f b/SRC/csyequb.f index ebeec8e79d..34c11879ff 100644 --- a/SRC/csyequb.f +++ b/SRC/csyequb.f @@ -129,7 +129,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -182,7 +183,8 @@ SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/csymv.f b/SRC/csymv.f index cabf700e2f..119dcbb480 100644 --- a/SRC/csymv.f +++ b/SRC/csymv.f @@ -154,7 +154,8 @@ *> \ingroup hemv * * ===================================================================== - SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) + SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, + $ INCY ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -196,7 +197,8 @@ SUBROUTINE CSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/csyr.f b/SRC/csyr.f index ec37148050..c24da1c219 100644 --- a/SRC/csyr.f +++ b/SRC/csyr.f @@ -172,7 +172,8 @@ SUBROUTINE CSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/csyrfs.f b/SRC/csyrfs.f index 09e6d337f0..600decbfda 100644 --- a/SRC/csyrfs.f +++ b/SRC/csyrfs.f @@ -188,7 +188,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CLACN2, CSYMV, CSYTRS, XERBLA + EXTERNAL CAXPY, CCOPY, CLACN2, CSYMV, CSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -303,7 +305,8 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * Compute residual R = B - A * X * CALL CCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL CSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * @@ -410,7 +413,8 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * * Multiply by diag(W)*inv(A**T). * - CALL CSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL CSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -421,7 +425,8 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL CSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL CSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/csyrfsx.f b/SRC/csyrfsx.f index 4e65d76eb0..5f266e25eb 100644 --- a/SRC/csyrfsx.f +++ b/SRC/csyrfsx.f @@ -396,7 +396,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE CSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -462,7 +463,8 @@ SUBROUTINE CSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL SLAMCH, CLANSY, CLA_SYRCOND_X, CLA_SYRCOND_C + EXTERNAL SLAMCH, CLANSY, CLA_SYRCOND_X, + $ CLA_SYRCOND_C REAL SLAMCH, CLANSY, CLA_SYRCOND_X, CLA_SYRCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -519,7 +521,8 @@ SUBROUTINE CSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF ( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF ( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -611,10 +614,12 @@ SUBROUTINE CSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute scaled normwise condition number cond(A*C). * IF ( RCEQU ) THEN - RCOND_TMP = CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/csysv.f b/SRC/csysv.f index ffad7c9a5d..ce863376b0 100644 --- a/SRC/csysv.f +++ b/SRC/csysv.f @@ -206,7 +206,8 @@ SUBROUTINE CSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/csysv_aa.f b/SRC/csysv_aa.f index d0fadec76e..489fc47af1 100644 --- a/SRC/csysv_aa.f +++ b/SRC/csysv_aa.f @@ -198,7 +198,8 @@ SUBROUTINE CSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/csysv_rk.f b/SRC/csysv_rk.f index 965d91d153..397b4e5bf3 100644 --- a/SRC/csysv_rk.f +++ b/SRC/csysv_rk.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, + SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -263,7 +264,8 @@ SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -281,7 +283,8 @@ SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -302,7 +305,8 @@ SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/csysv_rook.f b/SRC/csysv_rook.f index f0700a12bb..5d0d333a38 100644 --- a/SRC/csysv_rook.f +++ b/SRC/csysv_rook.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE CSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -239,7 +240,8 @@ SUBROUTINE CSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -279,7 +281,8 @@ SUBROUTINE CSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS_ROOK ( Use Level 2 BLAS) * - CALL CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/csysvx.f b/SRC/csysvx.f index cd87fb58b2..65c7989d32 100644 --- a/SRC/csysvx.f +++ b/SRC/csysvx.f @@ -280,7 +280,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ RWORK, INFO ) * @@ -318,7 +319,8 @@ SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL ILAENV, LSAME, CLANSY, SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLACPY, CSYCON, CSYRFS, CSYTRF, CSYTRS, XERBLA + EXTERNAL CLACPY, CSYCON, CSYRFS, CSYTRF, CSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -332,7 +334,8 @@ SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -388,7 +391,8 @@ SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL CSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, INFO ) + CALL CSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * Compute the solution vectors X. * diff --git a/SRC/csysvxx.f b/SRC/csysvxx.f index 401893b0c3..c9c8564778 100644 --- a/SRC/csysvxx.f +++ b/SRC/csysvxx.f @@ -503,7 +503,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) @@ -631,7 +632,8 @@ SUBROUTINE CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -651,7 +653,8 @@ SUBROUTINE CSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^T or UDU^T factorization of A. * CALL CLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL CSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL CSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * diff --git a/SRC/csytf2.f b/SRC/csytf2.f index 4391f3a9c6..6d2830b673 100644 --- a/SRC/csytf2.f +++ b/SRC/csytf2.f @@ -482,7 +482,8 @@ SUBROUTINE CSYTF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) ) END IF * @@ -514,7 +515,8 @@ SUBROUTINE CSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) T = A( KK, KK ) diff --git a/SRC/csytf2_rk.f b/SRC/csytf2_rk.f index 18896c59c7..933e45fa63 100644 --- a/SRC/csytf2_rk.f +++ b/SRC/csytf2_rk.f @@ -470,7 +470,8 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL CSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -485,7 +486,8 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.GT.1 ) $ CALL CSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL CSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL CSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -527,7 +529,8 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = CONE / A( K, K ) - CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -546,7 +549,8 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -704,14 +708,16 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = CABS1( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -770,7 +776,8 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( P.LT.N ) $ CALL CSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL CSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL CSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -792,9 +799,11 @@ SUBROUTINE CSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/csytf2_rook.f b/SRC/csytf2_rook.f index 64b691274b..17166c06e0 100644 --- a/SRC/csytf2_rook.f +++ b/SRC/csytf2_rook.f @@ -419,7 +419,8 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.GT.1 ) $ CALL CSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL CSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL CSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -453,7 +454,8 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = CONE / A( K, K ) - CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -472,7 +474,8 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL CSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -602,14 +605,16 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ICAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ICAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = CABS1( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -668,7 +673,8 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( P.LT.N ) $ CALL CSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL CSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL CSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -683,9 +689,11 @@ SUBROUTINE CSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL CSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL CSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/csytrf.f b/SRC/csytrf.f index 53bbccefd9..64148914b2 100644 --- a/SRC/csytrf.f +++ b/SRC/csytrf.f @@ -251,7 +251,8 @@ SUBROUTINE CSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'CSYTRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CSYTRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -280,7 +281,8 @@ SUBROUTINE CSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k-kb+1:k of A and use blocked code to * update columns 1:k-kb * - CALL CLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO ) + CALL CLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, + $ IINFO ) ELSE * * Use unblocked code to factorize columns 1:k of A @@ -320,13 +322,15 @@ SUBROUTINE CSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL CLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL CLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, N, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL CSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL CSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f index f04da09bbc..a1e0833c23 100644 --- a/SRC/csytrf_aa.f +++ b/SRC/csytrf_aa.f @@ -164,7 +164,8 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLASYF_AA, CGEMM, CGEMV, CSCAL, CSWAP, CCOPY, + EXTERNAL CLASYF_AA, CGEMM, CGEMV, CSCAL, CSWAP, + $ CCOPY, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/csytrf_aa_2stage.f b/SRC/csytrf_aa_2stage.f index 5975ad5737..e352bb1cc2 100644 --- a/SRC/csytrf_aa_2stage.f +++ b/SRC/csytrf_aa_2stage.f @@ -193,7 +193,8 @@ SUBROUTINE CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGBTRF, CGEMM, CGETRF, CLACPY, + EXTERNAL CCOPY, CGBTRF, CGEMM, CGETRF, + $ CLACPY, $ CLASET, CTRSM, CSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/csytrf_rk.f b/SRC/csytrf_rk.f index 8e58541cb5..a5929ae8f7 100644 --- a/SRC/csytrf_rk.f +++ b/SRC/csytrf_rk.f @@ -427,7 +427,8 @@ SUBROUTINE CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL CLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL CLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/csytrf_rook.f b/SRC/csytrf_rook.f index fc9382fe1e..23b807df71 100644 --- a/SRC/csytrf_rook.f +++ b/SRC/csytrf_rook.f @@ -205,7 +205,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/csytri.f b/SRC/csytri.f index ead4c9e0f3..1cc9b3a016 100644 --- a/SRC/csytri.f +++ b/SRC/csytri.f @@ -222,7 +222,8 @@ SUBROUTINE CSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -247,10 +248,12 @@ SUBROUTINE CSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ CDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ CDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL CCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -309,9 +312,11 @@ SUBROUTINE CSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -334,18 +339,23 @@ SUBROUTINE CSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ CDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ CDOTU( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL CCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ CDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 ) + $ CDOTU( N-K, WORK, 1, A( K+1, K-1 ), + $ 1 ) END IF KSTEP = 2 END IF diff --git a/SRC/csytri2x.f b/SRC/csytri2x.f index 481029abbb..9b96e0b256 100644 --- a/SRC/csytri2x.f +++ b/SRC/csytri2x.f @@ -383,8 +383,10 @@ SUBROUTINE CSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -566,12 +568,16 @@ SUBROUTINE CSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF ( I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/csytri_3x.f b/SRC/csytri_3x.f index a3ae6a34df..00a928cd6a 100644 --- a/SRC/csytri_3x.f +++ b/SRC/csytri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -189,7 +190,8 @@ SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CGEMM, CSYSWAPR, CTRTRI, CTRMM, XERBLA + EXTERNAL CGEMM, CSYSWAPR, CTRTRI, CTRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MOD @@ -434,8 +436,10 @@ SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -630,8 +634,10 @@ SUBROUTINE CSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL CSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/csytri_rook.f b/SRC/csytri_rook.f index 9aea579d6d..6371c2b8c2 100644 --- a/SRC/csytri_rook.f +++ b/SRC/csytri_rook.f @@ -237,7 +237,8 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -262,10 +263,12 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL CCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - CDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ CDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ CDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL CCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL CSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K+1 ), 1 ) @@ -284,7 +287,8 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL CSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -298,7 +302,8 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL CSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -313,7 +318,8 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL CSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL CSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -351,9 +357,11 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -376,18 +384,23 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL CCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - CDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ CDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ CDOTU( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL CCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL CSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ CDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 ) + $ CDOTU( N-K, WORK, 1, A( K+1, K-1 ), + $ 1 ) END IF KSTEP = 2 END IF @@ -400,8 +413,10 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -414,8 +429,10 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -429,8 +446,10 @@ SUBROUTINE CSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL CSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL CSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP diff --git a/SRC/csytrs.f b/SRC/csytrs.f index e84a7e4680..78b886813a 100644 --- a/SRC/csytrs.f +++ b/SRC/csytrs.f @@ -208,7 +208,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -228,7 +229,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL CGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -271,7 +273,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -287,7 +290,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) CALL CGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB ) @@ -334,7 +338,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in column K of A. * IF( K.LT.N ) - $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL CGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -355,7 +360,8 @@ SUBROUTINE CSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/csytrs2.f b/SRC/csytrs2.f index d4f0f0fcfc..dc147c77e1 100644 --- a/SRC/csytrs2.f +++ b/SRC/csytrs2.f @@ -160,7 +160,8 @@ SUBROUTINE CSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CSCAL, CSYCONV, CSWAP, CTRSM, XERBLA + EXTERNAL CSCAL, CSYCONV, CSWAP, CTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX diff --git a/SRC/csytrs_3.f b/SRC/csytrs_3.f index 1857589283..94bf6ec904 100644 --- a/SRC/csytrs_3.f +++ b/SRC/csytrs_3.f @@ -247,7 +247,8 @@ SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -273,7 +274,8 @@ SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**T \ (D \ (U \P**T * B) )) ] * @@ -314,7 +316,8 @@ SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -340,7 +343,8 @@ SUBROUTINE CSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ] * - CALL CTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL CTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**T \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/csytrs_aa.f b/SRC/csytrs_aa.f index 638df1c5d3..80861535e9 100644 --- a/SRC/csytrs_aa.f +++ b/SRC/csytrs_aa.f @@ -215,7 +215,8 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U**T \ B -> B [ (U**T \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL CTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -225,10 +226,13 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL CLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN - CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 ) - CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 ) + CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL CLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL CGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, + CALL CGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, + $ LDB, $ INFO ) * * 3) Backward substitution with U @@ -237,7 +241,8 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (U**T \ (T \ (U \P**T * B) )) ] @@ -267,7 +272,8 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L \ B -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -278,10 +284,13 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 ) - CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 ) + CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL CGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, + CALL CGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, + $ LDB, $ INFO) * * 3) Backward substitution with L**T @@ -290,7 +299,8 @@ SUBROUTINE CSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL CTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL CTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/csytrs_aa_2stage.f b/SRC/csytrs_aa_2stage.f index ec98a7c774..ee86c6d14f 100644 --- a/SRC/csytrs_aa_2stage.f +++ b/SRC/csytrs_aa_2stage.f @@ -216,7 +216,8 @@ SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * - CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -229,7 +230,8 @@ SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -250,7 +252,8 @@ SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \ B) -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -263,7 +266,8 @@ SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/csytrs_rook.f b/SRC/csytrs_rook.f index 55eccaa49d..07ba193ee0 100644 --- a/SRC/csytrs_rook.f +++ b/SRC/csytrs_rook.f @@ -224,7 +224,8 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL CGERU( K-1, NRHS, -CONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL CGERU( K-1, NRHS, -CONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -251,7 +252,8 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, IF( K.GT.2 ) THEN CALL CGERU( K-2, NRHS,-CONE, A( 1, K ), 1, B( K, 1 ), $ LDB, B( 1, 1 ), LDB ) - CALL CGERU( K-2, NRHS,-CONE, A( 1, K-1 ), 1, B( K-1, 1 ), + CALL CGERU( K-2, NRHS,-CONE, A( 1, K-1 ), 1, B( K-1, + $ 1 ), $ LDB, B( 1, 1 ), LDB ) END IF * @@ -364,7 +366,8 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL CGERU( N-K, NRHS, -CONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL CGERU( N-K, NRHS, -CONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -389,7 +392,8 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL CGERU( N-K-1, NRHS,-CONE, A( K+2, K ), 1, B( K, 1 ), + CALL CGERU( N-K-1, NRHS,-CONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL CGERU( N-K-1, NRHS,-CONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) @@ -434,7 +438,8 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + $ CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K ), 1, CONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -451,9 +456,11 @@ SUBROUTINE CSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K-1 and K of A. * IF( K.LT.N ) THEN - CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K ), 1, CONE, B( K, 1 ), LDB ) - CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + CALL CGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K-1 ), 1, CONE, B( K-1, 1 ), $ LDB ) END IF diff --git a/SRC/ctbcon.f b/SRC/ctbcon.f index d64625c833..ac71328717 100644 --- a/SRC/ctbcon.f +++ b/SRC/ctbcon.f @@ -139,7 +139,8 @@ *> \ingroup tbcon * * ===================================================================== - SUBROUTINE CTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, + SUBROUTINE CTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, + $ WORK, $ RWORK, INFO ) * * -- LAPACK computational routine -- @@ -252,13 +253,15 @@ SUBROUTINE CTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, * * Multiply by inv(A). * - CALL CLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD, + CALL CLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ KD, $ AB, LDAB, WORK, SCALE, RWORK, INFO ) ELSE * * Multiply by inv(A**H). * - CALL CLATBS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL CLATBS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, KD, AB, LDAB, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ctbrfs.f b/SRC/ctbrfs.f index d4423bea6e..af37f84f65 100644 --- a/SRC/ctbrfs.f +++ b/SRC/ctbrfs.f @@ -220,7 +220,8 @@ SUBROUTINE CTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CLACN2, CTBMV, CTBSV, XERBLA + EXTERNAL CAXPY, CCOPY, CLACN2, CTBMV, CTBSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, MIN, REAL diff --git a/SRC/ctbtrs.f b/SRC/ctbtrs.f index 354e2aab2a..c8e04bc3bc 100644 --- a/SRC/ctbtrs.f +++ b/SRC/ctbtrs.f @@ -187,7 +187,8 @@ SUBROUTINE CTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 @@ -232,7 +233,8 @@ SUBROUTINE CTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * Solve A * X = B, A**T * X = B, or A**H * X = B. * DO 30 J = 1, NRHS - CALL CTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) + CALL CTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), + $ 1 ) 30 CONTINUE * RETURN diff --git a/SRC/ctfsm.f b/SRC/ctfsm.f index 237400e2b7..70a6b30029 100644 --- a/SRC/ctfsm.f +++ b/SRC/ctfsm.f @@ -294,7 +294,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, + SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, + $ A, $ B, LDB ) * * -- LAPACK computational routine -- @@ -349,7 +350,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, INFO = -3 ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -4 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -5 ELSE IF( M.LT.0 ) THEN @@ -420,12 +422,15 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A, M, B, LDB ) ELSE - CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) - CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), + CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, + $ A( M1 ), $ M, B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, $ A( M ), M, B( M1, 0 ), LDB ) @@ -437,12 +442,15 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'C' * IF( M.EQ.1 ) THEN - CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) ELSE - CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, + $ ALPHA, $ A( M ), M, B( M1, 0 ), LDB ) - CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), + CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, + $ A( M1 ), $ M, B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, $ A( 0 ), M, B, LDB ) @@ -461,7 +469,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, $ A( M2 ), M, B, LDB ) - CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), M, + CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), + $ M, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, $ A( M1 ), M, B( M1, 0 ), LDB ) @@ -473,7 +482,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, $ A( M1 ), M, B( M1, 0 ), LDB ) - CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), M, + CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), + $ M, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, $ A( M2 ), M, B, LDB ) @@ -496,10 +506,12 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, $ A( M1*M1 ), M1, B, LDB, ALPHA, @@ -514,10 +526,12 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'C' * IF( M.EQ.1 ) THEN - CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, + CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, + $ ALPHA, $ A( 1 ), M1, B( M1, 0 ), LDB ) CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, $ A( M1*M1 ), M1, B( M1, 0 ), LDB, @@ -539,7 +553,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, $ A( M2*M2 ), M2, B, LDB ) - CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), M2, + CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), + $ M2, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL CTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) @@ -551,7 +566,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) - CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), M2, + CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), + $ M2, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, $ A( M2*M2 ), M2, B, LDB ) @@ -611,7 +627,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, $ A( K+1 ), M+1, B, LDB ) - CALL CGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), M+1, + CALL CGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), + $ M+1, $ B, LDB, ALPHA, B( K, 0 ), LDB ) CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, CONE, $ A( K ), M+1, B( K, 0 ), LDB ) @@ -622,7 +639,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * and TRANS = 'C' CALL CTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, $ A( K ), M+1, B( K, 0 ), LDB ) - CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), M+1, + CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), + $ M+1, $ B( K, 0 ), LDB, ALPHA, B, LDB ) CALL CTRSM( 'L', 'L', 'C', DIAG, K, N, CONE, $ A( K+1 ), M+1, B, LDB ) @@ -678,7 +696,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA, $ A( K*( K+1 ) ), K, B, LDB ) - CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, B, + CALL CGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, + $ B, $ LDB, ALPHA, B( K, 0 ), LDB ) CALL CTRSM( 'L', 'L', 'N', DIAG, K, N, CONE, $ A( K*K ), K, B( K, 0 ), LDB ) @@ -744,7 +763,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, $ A( N ), N, B( 0, N1 ), LDB ) - CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), + CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ), $ LDB ) CALL CTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, @@ -757,7 +777,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, $ A( 0 ), N, B( 0, 0 ), LDB ) - CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), + CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL CTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, @@ -776,7 +797,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, $ A( N2 ), N, B( 0, 0 ), LDB ) - CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), + CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL CTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, @@ -789,7 +811,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, $ A( N1 ), N, B( 0, N1 ), LDB ) - CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), + CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB ) CALL CTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, $ A( N2 ), N, B( 0, 0 ), LDB ) @@ -813,7 +836,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( 1 ), N1, B( 0, N1 ), LDB ) - CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), + CALL CGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ), $ LDB ) CALL CTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, @@ -826,7 +850,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( 0 ), N1, B( 0, 0 ), LDB ) - CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), + CALL CGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ), $ LDB ) CALL CTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, @@ -845,7 +870,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) - CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), + CALL CGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ), $ LDB ) CALL CTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, @@ -858,7 +884,8 @@ SUBROUTINE CTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL CTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) - CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), + CALL CGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ), $ LDB ) CALL CTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, diff --git a/SRC/ctftri.f b/SRC/ctftri.f index b5c437654a..be9d9a24a8 100644 --- a/SRC/ctftri.f +++ b/SRC/ctftri.f @@ -263,7 +263,8 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) INFO = -1 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -319,14 +320,16 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL CTRTRI( 'L', DIAG, N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'R', 'L', 'N', DIAG, N2, N1, -CONE, A( 0 ), + CALL CTRMM( 'R', 'L', 'N', DIAG, N2, N1, -CONE, + $ A( 0 ), $ N, A( N1 ), N ) CALL CTRTRI( 'U', DIAG, N2, A( N ), N, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'U', 'C', DIAG, N2, N1, CONE, A( N ), N, + CALL CTRMM( 'L', 'U', 'C', DIAG, N2, N1, CONE, A( N ), + $ N, $ A( N1 ), N ) * ELSE @@ -338,14 +341,16 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL CTRTRI( 'L', DIAG, N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'L', 'C', DIAG, N1, N2, -CONE, A( N2 ), + CALL CTRMM( 'L', 'L', 'C', DIAG, N1, N2, -CONE, + $ A( N2 ), $ N, A( 0 ), N ) CALL CTRTRI( 'U', DIAG, N2, A( N1 ), N, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'R', 'U', 'N', DIAG, N1, N2, CONE, A( N1 ), + CALL CTRMM( 'R', 'U', 'N', DIAG, N1, N2, CONE, + $ A( N1 ), $ N, A( 0 ), N ) * END IF @@ -362,7 +367,8 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL CTRTRI( 'U', DIAG, N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'U', 'N', DIAG, N1, N2, -CONE, A( 0 ), + CALL CTRMM( 'L', 'U', 'N', DIAG, N1, N2, -CONE, + $ A( 0 ), $ N1, A( N1*N1 ), N1 ) CALL CTRTRI( 'L', DIAG, N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -417,7 +423,8 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'U', 'C', DIAG, K, K, CONE, A( 0 ), N+1, + CALL CTRMM( 'L', 'U', 'C', DIAG, K, K, CONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) * ELSE @@ -429,14 +436,16 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL CTRTRI( 'L', DIAG, K, A( K+1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'L', 'C', DIAG, K, K, -CONE, A( K+1 ), + CALL CTRMM( 'L', 'L', 'C', DIAG, K, K, -CONE, + $ A( K+1 ), $ N+1, A( 0 ), N+1 ) CALL CTRTRI( 'U', DIAG, K, A( K ), N+1, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'R', 'U', 'N', DIAG, K, K, CONE, A( K ), N+1, + CALL CTRMM( 'R', 'U', 'N', DIAG, K, K, CONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) END IF ELSE @@ -452,14 +461,16 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL CTRTRI( 'U', DIAG, K, A( K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'U', 'N', DIAG, K, K, -CONE, A( K ), K, + CALL CTRMM( 'L', 'U', 'N', DIAG, K, K, -CONE, A( K ), + $ K, $ A( K*( K+1 ) ), K ) CALL CTRTRI( 'L', DIAG, K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'R', 'L', 'C', DIAG, K, K, CONE, A( 0 ), K, + CALL CTRMM( 'R', 'L', 'C', DIAG, K, K, CONE, A( 0 ), + $ K, $ A( K*( K+1 ) ), K ) ELSE * @@ -477,7 +488,8 @@ SUBROUTINE CTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL CTRMM( 'L', 'L', 'N', DIAG, K, K, CONE, A( K*K ), K, + CALL CTRMM( 'L', 'L', 'N', DIAG, K, K, CONE, A( K*K ), + $ K, $ A( 0 ), K ) END IF END IF diff --git a/SRC/ctgevc.f b/SRC/ctgevc.f index 9aac91aebf..fd26ec07e5 100644 --- a/SRC/ctgevc.f +++ b/SRC/ctgevc.f @@ -528,7 +528,8 @@ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * Back transform eigenvector if HOWMNY='B'. * IF( ILBACK ) THEN - CALL CGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), LDVL, + CALL CGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), + $ LDVL, $ WORK( JE ), 1, CZERO, WORK( N+1 ), 1 ) ISRC = 2 IBEG = 1 diff --git a/SRC/ctgex2.f b/SRC/ctgex2.f index 1e8d2b1134..c080f4b8f9 100644 --- a/SRC/ctgex2.f +++ b/SRC/ctgex2.f @@ -339,10 +339,14 @@ SUBROUTINE CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * If the swap is accepted ("weakly" and "strongly"), apply the * equivalence transformations to the original matrix pair (A,B) * - CALL CROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, CZ, CONJG( SZ ) ) - CALL CROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, CZ, CONJG( SZ ) ) - CALL CROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, SQ ) - CALL CROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, SQ ) + CALL CROT( J1+1, A( 1, J1 ), 1, A( 1, J1+1 ), 1, CZ, + $ CONJG( SZ ) ) + CALL CROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, CZ, + $ CONJG( SZ ) ) + CALL CROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, + $ SQ ) + CALL CROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, + $ SQ ) * * Set N1 by N2 (2,1) blocks to 0 * @@ -352,9 +356,11 @@ SUBROUTINE CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * Accumulate transformations into Q and Z if requested. * IF( WANTZ ) - $ CALL CROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, CZ, CONJG( SZ ) ) + $ CALL CROT( N, Z( 1, J1 ), 1, Z( 1, J1+1 ), 1, CZ, + $ CONJG( SZ ) ) IF( WANTQ ) - $ CALL CROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, CQ, CONJG( SQ ) ) + $ CALL CROT( N, Q( 1, J1 ), 1, Q( 1, J1+1 ), 1, CQ, + $ CONJG( SQ ) ) * * Exit with INFO = 0 if swap was successfully performed. * diff --git a/SRC/ctgexc.f b/SRC/ctgexc.f index 4da8bb5869..a2c7417ad9 100644 --- a/SRC/ctgexc.f +++ b/SRC/ctgexc.f @@ -262,7 +262,8 @@ SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap with next one below * - CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, + CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ LDZ, $ HERE, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -279,7 +280,8 @@ SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap with next one above * - CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, + CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ LDZ, $ HERE, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE diff --git a/SRC/ctgsen.f b/SRC/ctgsen.f index 87dcf9f5c7..a62c3fb473 100644 --- a/SRC/ctgsen.f +++ b/SRC/ctgsen.f @@ -428,7 +428,8 @@ *> 1996. *> * ===================================================================== - SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -474,7 +475,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * .. * .. External Subroutines .. REAL SLAMCH - EXTERNAL CLACN2, CLACPY, CLASSQ, CSCAL, CTGEXC, CTGSYL, + EXTERNAL CLACN2, CLACPY, CLASSQ, CSCAL, CTGEXC, + $ CTGSYL, $ SLAMCH, XERBLA * .. * .. Intrinsic Functions .. @@ -594,7 +596,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * and Z that will swap adjacent diagonal blocks in (A, B). * IF( K.NE.KS ) - $ CALL CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ CALL CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, K, KS, IERR ) * IF( IERR.GT.0 ) THEN @@ -624,7 +627,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, N2 = N - M I = N1 + 1 CALL CLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL CLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL CLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) IJB = 0 CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, @@ -666,14 +670,16 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu estimate. * - CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl estimate. * - CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -701,7 +707,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -710,7 +717,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL CTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL CTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -730,7 +738,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -739,7 +748,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL CTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL CTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, diff --git a/SRC/ctgsja.f b/SRC/ctgsja.f index 9bb58afab5..6eadfa3bfe 100644 --- a/SRC/ctgsja.f +++ b/SRC/ctgsja.f @@ -418,7 +418,8 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLAGS2, CLAPLL, CLASET, CROT, CSSCAL, + EXTERNAL CCOPY, CLAGS2, CLAPLL, CLASET, CROT, + $ CSSCAL, $ SLARTG, XERBLA * .. * .. Intrinsic Functions .. @@ -441,9 +442,13 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, INFO = 0 IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITV .OR. + $ WANTV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITQ .OR. + $ WANTQ .OR. + $ LSAME( JOBQ, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -513,7 +518,8 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, * Update (K+I)-th and (K+J)-th rows of matrix A: U**H *A * IF( K+J.LE.M ) - $ CALL CROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ), + $ CALL CROT( L, A( K+J, N-L+1 ), LDA, A( K+I, + $ N-L+1 ), $ LDA, CSU, CONJG( SNU ) ) * * Update I-th and J-th rows of matrix B: V**H *B @@ -556,10 +562,12 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ SNU ) * IF( WANTV ) - $ CALL CROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV ) + $ CALL CROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, + $ SNV ) * IF( WANTQ ) - $ CALL CROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ, + $ CALL CROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, + $ CSQ, $ SNQ ) * 10 CONTINUE @@ -576,7 +584,8 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, ERROR = ZERO DO 30 I = 1, MIN( L, M-K ) CALL CCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 ) - CALL CCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 ) + CALL CCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), + $ 1 ) CALL CLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN ) ERROR = MAX( ERROR, SSMIN ) 30 CONTINUE @@ -619,16 +628,19 @@ SUBROUTINE CTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ CALL CSSCAL( P, -ONE, V( 1, I ), 1 ) END IF * - CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ), + CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), + $ ALPHA( K+I ), $ RWK ) * IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN - CALL CSSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ), + CALL CSSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, + $ N-L+I ), $ LDA ) ELSE CALL CSSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ), $ LDB ) - CALL CCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ), + CALL CCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, + $ N-L+I ), $ LDA ) END IF * diff --git a/SRC/ctgsna.f b/SRC/ctgsna.f index f6b015748e..2543788305 100644 --- a/SRC/ctgsna.f +++ b/SRC/ctgsna.f @@ -350,7 +350,8 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, $ CDOTC * .. * .. External Subroutines .. - EXTERNAL CGEMV, CLACPY, CTGEXC, CTGSYL, XERBLA + EXTERNAL CGEMV, CLACPY, CTGEXC, CTGSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX @@ -466,7 +467,8 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * IF( WANTDF ) THEN IF( N.EQ.1 ) THEN - DIF( KS ) = SLAPY2( ABS( A( 1, 1 ) ), ABS( B( 1, 1 ) ) ) + DIF( KS ) = SLAPY2( ABS( A( 1, 1 ) ), ABS( B( 1, + $ 1 ) ) ) ELSE * * Estimate the reciprocal condition number of the k-th @@ -480,7 +482,8 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, IFST = K ILST = 1 * - CALL CTGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), + CALL CTGEXC( .FALSE., .FALSE., N, WORK, N, + $ WORK( N*N+1 ), $ N, DUMMY, 1, DUMMY1, 1, IFST, ILST, IERR ) * IF( IERR.GT.0 ) THEN @@ -499,7 +502,8 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, N1 = 1 N2 = N - N1 I = N*N + 1 - CALL CTGSYL( 'N', IDIFJB, N2, N1, WORK( N*N1+N1+1 ), + CALL CTGSYL( 'N', IDIFJB, N2, N1, + $ WORK( N*N1+N1+1 ), $ N, WORK, N, WORK( N1+1 ), N, $ WORK( N*N1+N1+I ), N, WORK( I ), N, $ WORK( N1+I ), N, SCALE, DIF( KS ), DUMMY, diff --git a/SRC/ctgsy2.f b/SRC/ctgsy2.f index aeb24f125c..09adac05bf 100644 --- a/SRC/ctgsy2.f +++ b/SRC/ctgsy2.f @@ -254,7 +254,8 @@ *> Umea University, S-901 87 Umea, Sweden. * * ===================================================================== - SUBROUTINE CTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE CTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, $ INFO ) * @@ -294,7 +295,8 @@ SUBROUTINE CTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CAXPY, CGESC2, CGETC2, CSCAL, CLATDF, XERBLA + EXTERNAL CAXPY, CGESC2, CGETC2, CSCAL, CLATDF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, CONJG, MAX @@ -370,9 +372,11 @@ SUBROUTINE CTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, CALL CGESC2( LDZ, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 10 K = 1, N - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 10 CONTINUE SCALE = SCALE*SCALOC @@ -391,8 +395,10 @@ SUBROUTINE CTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( I.GT.1 ) THEN ALPHA = -RHS( 1 ) - CALL CAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), 1 ) - CALL CAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), 1 ) + CALL CAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), + $ 1 ) + CALL CAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), + $ 1 ) END IF IF( J.LT.N ) THEN CALL CAXPY( N-J, RHS( 2 ), B( J, J+1 ), LDB, diff --git a/SRC/ctgsyl.f b/SRC/ctgsyl.f index 64b8da08c6..c0427028e1 100644 --- a/SRC/ctgsyl.f +++ b/SRC/ctgsyl.f @@ -290,7 +290,8 @@ *> July 1989, pp 745-751. *> * ===================================================================== - SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, $ IWORK, INFO ) * @@ -334,7 +335,8 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLASET, CSCAL, CTGSY2, XERBLA + EXTERNAL CGEMM, CLACPY, CLASET, CSCAL, CTGSY2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, MAX, REAL, SQRT @@ -438,7 +440,8 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, DSCALE = ZERO DSUM = ONE PQ = M*N - CALL CTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D, + CALL CTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE, $ INFO ) IF( DSCALE.NE.ZERO ) THEN @@ -526,7 +529,8 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IS = IWORK( I ) IE = IWORK( I+1 ) - 1 MB = IE - IS + 1 - CALL CTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA, + CALL CTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), + $ LDA, $ B( JS, JS ), LDB, C( IS, JS ), LDC, $ D( IS, IS ), LDD, E( JS, JS ), LDE, $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE, @@ -536,9 +540,11 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, PQ = PQ + MB*NB IF( SCALOC.NE.ONE ) THEN DO 80 K = 1, JS - 1 - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 80 CONTINUE DO 90 K = JS, JE @@ -554,9 +560,11 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ F( IE+1, K ), 1 ) 100 CONTINUE DO 110 K = JE + 1, N - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, K ), + CALL CSCAL( M, CMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 110 CONTINUE SCALE = SCALE*SCALOC @@ -639,9 +647,11 @@ SUBROUTINE CTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ 1 ) 160 CONTINUE DO 170 K = JS, JE - CALL CSCAL( IS-1, CMPLX( SCALOC, ZERO ), C( 1, K ), + CALL CSCAL( IS-1, CMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL CSCAL( IS-1, CMPLX( SCALOC, ZERO ), F( 1, K ), + CALL CSCAL( IS-1, CMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 170 CONTINUE DO 180 K = JS, JE diff --git a/SRC/ctpcon.f b/SRC/ctpcon.f index 2c2e045a70..020395c855 100644 --- a/SRC/ctpcon.f +++ b/SRC/ctpcon.f @@ -235,13 +235,15 @@ SUBROUTINE CTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, * * Multiply by inv(A). * - CALL CLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP, + CALL CLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ AP, $ WORK, SCALE, RWORK, INFO ) ELSE * * Multiply by inv(A**H). * - CALL CLATPS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL CLATPS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, AP, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f index 717e3214de..73b34b86af 100644 --- a/SRC/ctpmlqt.f +++ b/SRC/ctpmlqt.f @@ -195,7 +195,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, + SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/ctpmqrt.f b/SRC/ctpmqrt.f index 9c92acb769..2a91c3bcbf 100644 --- a/SRC/ctpmqrt.f +++ b/SRC/ctpmqrt.f @@ -212,7 +212,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, + SUBROUTINE CTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/ctprfb.f b/SRC/ctprfb.f index 45bef1b02f..b099939b33 100644 --- a/SRC/ctprfb.f +++ b/SRC/ctprfb.f @@ -433,7 +433,8 @@ SUBROUTINE CTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL CGEMM( 'N', 'C', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL CGEMM( 'N', 'C', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL CGEMM( 'N', 'C', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB ) CALL CTRMM( 'R', 'U', 'C', 'N', M, L, ONE, V( NP, 1 ), LDV, $ WORK, LDWORK ) @@ -674,7 +675,8 @@ SUBROUTINE CTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL CGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL CGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL CGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) CALL CTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV, $ WORK, LDWORK ) diff --git a/SRC/ctprfs.f b/SRC/ctprfs.f index 845d489a01..f15743b17b 100644 --- a/SRC/ctprfs.f +++ b/SRC/ctprfs.f @@ -170,7 +170,8 @@ *> \ingroup tprfs * * ===================================================================== - SUBROUTINE CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, + SUBROUTINE CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -205,7 +206,8 @@ SUBROUTINE CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CLACN2, CTPMV, CTPSV, XERBLA + EXTERNAL CAXPY, CCOPY, CLACN2, CTPMV, CTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL diff --git a/SRC/ctptrs.f b/SRC/ctptrs.f index d9a1ede55f..18364c3e60 100644 --- a/SRC/ctptrs.f +++ b/SRC/ctptrs.f @@ -127,7 +127,8 @@ *> \ingroup tptrs * * ===================================================================== - SUBROUTINE CTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) + SUBROUTINE CTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ SUBROUTINE CTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/ctrcon.f b/SRC/ctrcon.f index afea0f8d53..1167fc240a 100644 --- a/SRC/ctrcon.f +++ b/SRC/ctrcon.f @@ -250,7 +250,8 @@ SUBROUTINE CTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, * * Multiply by inv(A**H). * - CALL CLATRS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL CLATRS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, A, LDA, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ctrevc.f b/SRC/ctrevc.f index 220dda97fb..108aa05572 100644 --- a/SRC/ctrevc.f +++ b/SRC/ctrevc.f @@ -214,7 +214,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -254,7 +255,8 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, ICAMAX, SCASUM, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMV, CLATRS, CSSCAL, XERBLA + EXTERNAL CCOPY, CGEMV, CLATRS, CSSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, REAL @@ -388,7 +390,8 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 60 CONTINUE ELSE IF( KI.GT.1 ) - $ CALL CGEMV( 'N', N, KI-1, CMONE, VR, LDVR, WORK( 1 ), + $ CALL CGEMV( 'N', N, KI-1, CMONE, VR, LDVR, + $ WORK( 1 ), $ 1, CMPLX( SCALE ), VR( 1, KI ), 1 ) * II = ICAMAX( N, VR( 1, KI ), 1 ) @@ -437,7 +440,8 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 100 CONTINUE * IF( KI.LT.N ) THEN - CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + CALL CLATRS( 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, $ WORK( KI+1 ), SCALE, RWORK, INFO ) WORK( KI ) = SCALE @@ -457,7 +461,8 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 110 CONTINUE ELSE IF( KI.LT.N ) - $ CALL CGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), LDVL, + $ CALL CGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1 ), 1, CMPLX( SCALE ), $ VL( 1, KI ), 1 ) * diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index 7fe0f23ad2..b0a13e1df5 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -240,7 +240,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) IMPLICIT NONE * @@ -284,7 +285,8 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL XERBLA, CCOPY, CLASET, CSSCAL, CGEMM, CGEMV, + EXTERNAL XERBLA, CCOPY, CLASET, CSSCAL, CGEMM, + $ CGEMV, $ CLATRS, CLACPY * .. * .. Intrinsic Functions .. @@ -544,7 +546,8 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 100 CONTINUE * IF( KI.LT.N ) THEN - CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + 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 @@ -555,7 +558,8 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 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 ) + 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 ) ) @@ -569,7 +573,8 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * ------------------------------ * 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, + $ CALL CGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1 + IV*N ), 1, CMPLX( SCALE ), $ VL( 1, KI ), 1 ) * diff --git a/SRC/ctrexc.f b/SRC/ctrexc.f index d322e86746..7b93df76f8 100644 --- a/SRC/ctrexc.f +++ b/SRC/ctrexc.f @@ -214,9 +214,11 @@ SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO ) * Apply transformation to the matrix T. * IF( K+2.LE.N ) - $ CALL CROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS, + $ CALL CROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, + $ CS, $ SN ) - CALL CROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, CONJG( SN ) ) + CALL CROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, + $ CONJG( SN ) ) * T( K, K ) = T22 T( K+1, K+1 ) = T11 diff --git a/SRC/ctrrfs.f b/SRC/ctrrfs.f index 52dea48751..0e3b109a0c 100644 --- a/SRC/ctrrfs.f +++ b/SRC/ctrrfs.f @@ -178,7 +178,8 @@ *> \ingroup trrfs * * ===================================================================== - SUBROUTINE CTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, + SUBROUTINE CTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -214,7 +215,8 @@ SUBROUTINE CTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CLACN2, CTRMV, CTRSV, XERBLA + EXTERNAL CAXPY, CCOPY, CLACN2, CTRMV, CTRSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL diff --git a/SRC/ctrsen.f b/SRC/ctrsen.f index 524ea25613..fa18df71d2 100644 --- a/SRC/ctrsen.f +++ b/SRC/ctrsen.f @@ -260,7 +260,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, + SUBROUTINE CTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, + $ S, $ SEP, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -298,7 +299,8 @@ SUBROUTINE CTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, EXTERNAL LSAME, CLANGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL CLACN2, CLACPY, CTREXC, CTRSYL, XERBLA + EXTERNAL CLACN2, CLACPY, CTREXC, CTRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/ctrsna.f b/SRC/ctrsna.f index 759a15138d..ce5253251b 100644 --- a/SRC/ctrsna.f +++ b/SRC/ctrsna.f @@ -244,7 +244,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, $ INFO ) * @@ -286,10 +287,12 @@ SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, INTEGER ICAMAX REAL SCNRM2, SLAMCH COMPLEX CDOTC - EXTERNAL LSAME, ICAMAX, SCNRM2, SLAMCH, CDOTC + EXTERNAL LSAME, ICAMAX, SCNRM2, SLAMCH, + $ CDOTC * .. * .. External Subroutines .. - EXTERNAL CLACN2, CLACPY, CLATRS, CSRSCL, CTREXC, XERBLA + EXTERNAL CLACN2, CLACPY, CLATRS, CSRSCL, CTREXC, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -398,7 +401,8 @@ SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * diagonal element to the (1,1) position. * CALL CLACPY( 'Full', N, N, T, LDT, WORK, LDWORK ) - CALL CTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1, IERR ) + CALL CTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1, + $ IERR ) * * Form C = T22 - lambda*I in WORK(2:N,2:N). * @@ -414,7 +418,8 @@ SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, KASE = 0 NORMIN = 'N' 30 CONTINUE - CALL CLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE, ISAVE ) + CALL CLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE, + $ ISAVE ) * IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/ctrsyl.f b/SRC/ctrsyl.f index f1a221bb8b..99ac5c7da6 100644 --- a/SRC/ctrsyl.f +++ b/SRC/ctrsyl.f @@ -189,7 +189,8 @@ SUBROUTINE CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME REAL CLANGE, SLAMCH COMPLEX CDOTC, CDOTU, CLADIV - EXTERNAL LSAME, CLANGE, SLAMCH, CDOTC, CDOTU, CLADIV + EXTERNAL LSAME, CLANGE, SLAMCH, CDOTC, CDOTU, + $ CLADIV * .. * .. External Subroutines .. EXTERNAL CSSCAL, XERBLA diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index 10576d8f90..45ee5826cc 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -152,7 +152,8 @@ * Angelika Schwarz, Umea University, Sweden. * * ===================================================================== - SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, + SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, + $ C, $ LDC, SCALE, SWORK, LDSWORK, INFO ) IMPLICIT NONE * @@ -186,10 +187,12 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SLARMM - EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, SLARMM + EXTERNAL CLANGE, ILAENV, LSAME, SLAMCH, + $ SLARMM * .. * .. External Subroutines .. - EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, XERBLA + EXTERNAL CSSCAL, CGEMM, CLASCL, CTRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, EXPONENT, MAX, MIN, REAL diff --git a/SRC/ctrtri.f b/SRC/ctrtri.f index ebac52fe68..32d46466db 100644 --- a/SRC/ctrtri.f +++ b/SRC/ctrtri.f @@ -199,9 +199,11 @@ SUBROUTINE CTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * * Compute rows 1:j-1 of current block column * - CALL CTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, + CALL CTRMM( 'Left', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL CTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, + CALL CTRSM( 'Right', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) * * Compute inverse of current diagonal block diff --git a/SRC/ctrtrs.f b/SRC/ctrtrs.f index 7db08f63ce..be20233ac7 100644 --- a/SRC/ctrtrs.f +++ b/SRC/ctrtrs.f @@ -177,10 +177,12 @@ SUBROUTINE CTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * INFO = 0 NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/ctzrzf.f b/SRC/ctzrzf.f index ac85cce30a..58fdf78456 100644 --- a/SRC/ctzrzf.f +++ b/SRC/ctzrzf.f @@ -282,7 +282,8 @@ SUBROUTINE CTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL CLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ), + CALL CLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, + $ M1 ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:i-1,i:n) from the right diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index 980028bf2b..fac310500c 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -282,7 +282,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, + $ LDX12, $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1, $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, REAL Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL CAXPY, CLARF, CLARFGP, CSCAL, XERBLA + EXTERNAL CAXPY, CLARF, CLARFGP, CSCAL, + $ XERBLA EXTERNAL CLACGV * * .. @@ -419,7 +421,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ SCNRM2( P-I+1, X11(I,I), 1 ) ) * IF( P .GT. I ) THEN - CALL CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + CALL CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, + $ TAUP1(I) ) ELSE IF ( P .EQ. I ) THEN CALL CLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF @@ -452,7 +455,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL CAXPY( Q-I, CMPLX( Z2*Z3*COS(THETA(I)), 0.0E0 ), $ X21(I,I+1), LDX21, X11(I,I+1), LDX11 ) END IF - CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4*SIN(THETA(I)), 0.0E0 ), + CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4*SIN(THETA(I)), + $ 0.0E0 ), $ X12(I,I), LDX12 ) CALL CAXPY( M-Q-I+1, CMPLX( Z2*Z4*COS(THETA(I)), 0.0E0 ), $ X22(I,I), LDX22, X12(I,I), LDX12 ) @@ -485,13 +489,16 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL CLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL CLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL CLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL CLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN @@ -522,7 +529,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) @@ -581,7 +589,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL CLACGV( P-I+1, X11(I,I), LDX11 ) CALL CLACGV( M-P-I+1, X21(I,I), LDX21 ) * - CALL CLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) + CALL CLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, + $ TAUP1(I) ) X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL CLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, @@ -594,7 +603,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * CALL CLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), $ X11(I+1,I), LDX11, WORK ) - CALL CLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I), + CALL CLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), $ X12(I,I), LDX12, WORK ) CALL CLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), $ X21(I+1,I), LDX21, WORK ) @@ -610,7 +620,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL CAXPY( Q-I, CMPLX( Z2*Z3*COS(THETA(I)), 0.0E0 ), $ X21(I+1,I), 1, X11(I+1,I), 1 ) END IF - CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4*SIN(THETA(I)), 0.0E0 ), + CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4*SIN(THETA(I)), + $ 0.0E0 ), $ X12(I,I), 1 ) CALL CAXPY( M-Q-I+1, CMPLX( Z2*Z4*COS(THETA(I)), 0.0E0 ), $ X22(I,I), 1, X12(I,I), 1 ) @@ -620,10 +631,12 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ SCNRM2( M-Q-I+1, X12(I,I), 1 ) ) * IF( I .LT. Q ) THEN - CALL CLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, TAUQ1(I) ) + CALL CLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, + $ TAUQ1(I) ) X11(I+1,I) = ONE END IF - CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF( I .LT. Q ) THEN @@ -632,7 +645,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL CLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, $ CONJG(TAUQ1(I)), X21(I+1,I+1), LDX21, WORK ) END IF - CALL CLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, CONJG(TAUQ2(I)), + CALL CLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), $ X12(I,I+1), LDX12, WORK ) IF ( M-P .GT. I ) THEN @@ -645,8 +659,10 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * DO I = Q + 1, P * - CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4, 0.0E0 ), X12(I,I), 1 ) - CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL CSCAL( M-Q-I+1, CMPLX( -Z1*Z4, 0.0E0 ), X12(I,I), + $ 1 ) + CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF ( P .GT. I ) THEN diff --git a/SRC/cunbdb1.f b/SRC/cunbdb1.f index 937b3cb200..e1e32c19c3 100644 --- a/SRC/cunbdb1.f +++ b/SRC/cunbdb1.f @@ -198,7 +198,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, XERBLA + EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, + $ XERBLA EXTERNAL CLACGV * .. * .. External Functions .. @@ -297,7 +299,8 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, CALL CSROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, $ S ) CALL CLACGV( Q-I, X21(I,I+1), LDX21 ) - CALL CLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) ) + CALL CLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, + $ TAUQ1(I) ) S = REAL( X21(I,I+1) ) X21(I,I+1) = ONE CALL CLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f index 7ee8bb867a..d2159bbaac 100644 --- a/SRC/cunbdb2.f +++ b/SRC/cunbdb2.f @@ -198,7 +198,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -228,7 +229,8 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, CLACGV, + EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, + $ CLACGV, $ XERBLA * .. * .. External Functions .. @@ -310,7 +312,8 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, C = COS( PHI(I) ) S = SIN( PHI(I) ) X11(I+1,I) = ONE - CALL CLARF( 'L', P-I, Q-I, X11(I+1,I), 1, CONJG(TAUP1(I)), + CALL CLARF( 'L', P-I, Q-I, X11(I+1,I), 1, + $ CONJG(TAUP1(I)), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF X21(I,I) = ONE diff --git a/SRC/cunbdb3.f b/SRC/cunbdb3.f index e648899f09..fa62579d11 100644 --- a/SRC/cunbdb3.f +++ b/SRC/cunbdb3.f @@ -198,7 +198,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CLACGV, XERBLA + EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CLACGV, + $ XERBLA * .. * .. External Functions .. REAL SCNRM2, SROUNDUP_LWORK @@ -303,12 +305,14 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) IF( I .LT. M-P ) THEN - CALL CLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) ) + CALL CLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, + $ TAUP2(I) ) PHI(I) = ATAN2( REAL( X21(I+1,I) ), REAL( X11(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) X21(I+1,I) = ONE - CALL CLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, CONJG(TAUP2(I)), + CALL CLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, + $ CONJG(TAUP2(I)), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF X11(I,I) = ONE diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f index 0bdec660bd..572847b73f 100644 --- a/SRC/cunbdb4.f +++ b/SRC/cunbdb4.f @@ -208,7 +208,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * @@ -239,7 +240,8 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, CLACGV, + EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, + $ CLACGV, $ XERBLA * .. * .. External Functions .. @@ -303,22 +305,26 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ LORBDB5, CHILDINFO ) CALL CSCAL( P, NEGONE, PHANTOM(1), 1 ) CALL CLARFGP( P, PHANTOM(1), PHANTOM(2), 1, TAUP1(1) ) - CALL CLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, TAUP2(1) ) + CALL CLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, + $ TAUP2(1) ) THETA(I) = ATAN2( REAL( PHANTOM(1) ), REAL( PHANTOM(P+1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) PHANTOM(1) = ONE PHANTOM(P+1) = ONE - CALL CLARF( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), X11, + CALL CLARF( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), + $ X11, $ LDX11, WORK(ILARF) ) - CALL CLARF( 'L', M-P, Q, PHANTOM(P+1), 1, CONJG(TAUP2(1)), + CALL CLARF( 'L', M-P, Q, PHANTOM(P+1), 1, + $ CONJG(TAUP2(1)), $ X21, LDX21, WORK(ILARF) ) ELSE CALL CUNBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), $ LDX21, WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL CSCAL( P-I+1, NEGONE, X11(I,I-1), 1 ) - CALL CLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, TAUP1(I) ) + CALL CLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, + $ TAUP1(I) ) CALL CLARFGP( M-P-I+1, X21(I,I-1), X21(I+1,I-1), 1, $ TAUP2(I) ) THETA(I) = ATAN2( REAL( X11(I,I-1) ), REAL( X21(I,I-1) ) ) @@ -367,10 +373,12 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, * DO I = P + 1, Q CALL CLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) - CALL CLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), LDX21, + CALL CLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), + $ LDX21, $ TAUQ1(I) ) X21(M-Q+I-P,I) = ONE - CALL CLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, TAUQ1(I), + CALL CLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) END DO diff --git a/SRC/cunbdb5.f b/SRC/cunbdb5.f index 4d611928bc..a4b3a12c28 100644 --- a/SRC/cunbdb5.f +++ b/SRC/cunbdb5.f @@ -152,7 +152,8 @@ *> \ingroup unbdb5 * * ===================================================================== - SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/cunbdb6.f b/SRC/cunbdb6.f index 9575d5f441..50da70cf5f 100644 --- a/SRC/cunbdb6.f +++ b/SRC/cunbdb6.f @@ -155,7 +155,8 @@ *> \ingroup unbdb6 * * ===================================================================== - SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -239,11 +240,13 @@ SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL CGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL CGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL CGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL CGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL CGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) @@ -285,11 +288,13 @@ SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL CGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL CGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL CGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL CGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL CGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) diff --git a/SRC/cuncsd.f b/SRC/cuncsd.f index 5d6531050b..db35565df9 100644 --- a/SRC/cuncsd.f +++ b/SRC/cuncsd.f @@ -312,7 +312,8 @@ *> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, @@ -361,7 +362,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, LOGICAL LRQUERY * .. * .. External Subroutines .. - EXTERNAL XERBLA, CBBCSD, CLACPY, CLAPMR, CLAPMT, + EXTERNAL XERBLA, CBBCSD, CLACPY, CLAPMR, + $ CLAPMT, $ CUNBDB, CUNGLQ, CUNGQR * .. * .. External Functions .. @@ -430,7 +432,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL CUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL CUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, RWORK, LRWORK, IWORK, @@ -534,7 +537,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, RWORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -544,7 +548,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -560,7 +565,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -577,7 +583,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL CUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL CUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -593,7 +600,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL CUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL CUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -611,7 +619,8 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), diff --git a/SRC/cuncsd2by1.f b/SRC/cuncsd2by1.f index 80b3635230..231efed63a 100644 --- a/SRC/cuncsd2by1.f +++ b/SRC/cuncsd2by1.f @@ -251,7 +251,8 @@ *> \ingroup uncsd2by1 * * ===================================================================== - SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, + SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, + $ LDX11, $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) @@ -294,7 +295,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, COMPLEX CDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL CBBCSD, CCOPY, CLACPY, CLAPMR, CLAPMT, CUNBDB1, + EXTERNAL CBBCSD, CCOPY, CLACPY, CLAPMR, CLAPMT, + $ CUNBDB1, $ CUNBDB2, CUNBDB3, CUNBDB4, CUNGLQ, CUNGQR, $ XERBLA * .. @@ -413,17 +415,20 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, + CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, + $ THETA, $ 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, DUM, + CALL CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), + CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, + $ WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) @@ -440,13 +445,15 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, + CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, + $ THETA, $ 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, DUM, + CALL CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN @@ -473,7 +480,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO $ ) LORBDB = M + INT( WORK(1) ) @@ -484,7 +492,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, 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, + 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) ) ) @@ -544,7 +553,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -560,7 +570,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END DO CALL CLACPY( 'U', Q-1, Q-1, X21(1,2), LDX21, V1T(2,2), $ LDV1T ) - CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL CUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF * @@ -603,7 +614,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, U1(1,J) = ZERO U1(J,1) = ZERO END DO - CALL CLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), LDU1 ) + CALL CLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), + $ LDU1 ) CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, WORK(ITAUP1), $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF @@ -653,7 +665,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL CLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL CUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -737,7 +750,8 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL CLACPY( 'U', M-Q, Q, X21, LDX21, V1T, LDV1T ) - CALL CLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), LDX11, + CALL CLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), + $ LDX11, $ V1T(M-Q+1,M-Q+1), LDV1T ) CALL CLACPY( 'U', -P+Q, Q-P, X21(M-Q+1,P+1), LDX21, $ V1T(P+1,P+1), LDV1T ) diff --git a/SRC/cung2l.f b/SRC/cung2l.f index fb263f20f5..22658eb600 100644 --- a/SRC/cung2l.f +++ b/SRC/cung2l.f @@ -179,7 +179,8 @@ SUBROUTINE CUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL CLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, + CALL CLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, $ LDA, WORK ) CALL CSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) diff --git a/SRC/cungbr.f b/SRC/cungbr.f index f4b2b3be8c..1f90d107bb 100644 --- a/SRC/cungbr.f +++ b/SRC/cungbr.f @@ -154,7 +154,8 @@ *> \ingroup ungbr * * ===================================================================== - SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/cunghr.f b/SRC/cunghr.f index b6df366dba..c69d72e5d6 100644 --- a/SRC/cunghr.f +++ b/SRC/cunghr.f @@ -123,7 +123,8 @@ *> \ingroup unghr * * ===================================================================== - SUBROUTINE CUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE CUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/cunglq.f b/SRC/cunglq.f index df9a62a883..39a0d9de42 100644 --- a/SRC/cunglq.f +++ b/SRC/cunglq.f @@ -213,7 +213,8 @@ SUBROUTINE CUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNGLQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CUNGLQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -254,12 +255,14 @@ SUBROUTINE CUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL CLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL CLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**H to A(i+ib:m,i:n) from the right * - CALL CLARFB( 'Right', 'Conjugate transpose', 'Forward', + CALL CLARFB( 'Right', 'Conjugate transpose', + $ 'Forward', $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ), $ LDA, WORK, LDWORK, A( I+IB, I ), LDA, $ WORK( IB+1 ), LDWORK ) @@ -267,7 +270,8 @@ SUBROUTINE CUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to columns i:n of current block * - CALL CUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL CUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set columns 1:i-1 of current block to zero diff --git a/SRC/cungql.f b/SRC/cungql.f index 9e87a28662..21a7616876 100644 --- a/SRC/cungql.f +++ b/SRC/cungql.f @@ -223,7 +223,8 @@ SUBROUTINE CUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNGQL', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CUNGQL', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF diff --git a/SRC/cungqr.f b/SRC/cungqr.f index 55dc3d334f..1ede1bed5c 100644 --- a/SRC/cungqr.f +++ b/SRC/cungqr.f @@ -214,7 +214,8 @@ SUBROUTINE CUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNGQR', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CUNGQR', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -268,7 +269,8 @@ SUBROUTINE CUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H to rows i:m of current block * - CALL CUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL CUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set rows 1:i-1 of current block to zero diff --git a/SRC/cungrq.f b/SRC/cungrq.f index bbebe2dfbf..ce88afba95 100644 --- a/SRC/cungrq.f +++ b/SRC/cungrq.f @@ -223,7 +223,8 @@ SUBROUTINE CUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNGRQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'CUNGRQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -267,7 +268,8 @@ SUBROUTINE CUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * - CALL CLARFB( 'Right', 'Conjugate transpose', 'Backward', + CALL CLARFB( 'Right', 'Conjugate transpose', + $ 'Backward', $ 'Rowwise', II-1, N-K+I+IB-1, IB, A( II, 1 ), $ LDA, WORK, LDWORK, A, LDA, WORK( IB+1 ), $ LDWORK ) @@ -275,7 +277,8 @@ SUBROUTINE CUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to columns 1:n-k+i+ib-1 of current block * - CALL CUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ), + CALL CUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) * * Set columns n-k+i+ib:n of current block to zero diff --git a/SRC/cungtr.f b/SRC/cungtr.f index 94ec42ce34..40cfa649ed 100644 --- a/SRC/cungtr.f +++ b/SRC/cungtr.f @@ -219,7 +219,8 @@ SUBROUTINE CUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Generate Q(1:n-1,1:n-1) * - CALL CUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO ) + CALL CUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, + $ IINFO ) * ELSE * diff --git a/SRC/cunhr_col.f b/SRC/cunhr_col.f index 42b86ca448..4cece20cf4 100644 --- a/SRC/cunhr_col.f +++ b/SRC/cunhr_col.f @@ -282,7 +282,8 @@ SUBROUTINE CUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) $ NPLUSONE * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLAUNHR_COL_GETRFNP, CSCAL, CTRSM, + EXTERNAL CCOPY, CLAUNHR_COL_GETRFNP, CSCAL, + $ CTRSM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/cunm22.f b/SRC/cunm22.f index bb29b199d1..4028cae90b 100644 --- a/SRC/cunm22.f +++ b/SRC/cunm22.f @@ -216,7 +216,8 @@ SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, IF( N1.EQ.0 .OR. N2.EQ.0 ) NW = 1 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN @@ -282,13 +283,15 @@ SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL CLACPY( 'All', N1, LEN, C( N2+1, I ), LDC, WORK, $ LDWORK ) - CALL CTRMM( 'Left', 'Lower', 'No Transpose', 'Non-Unit', + CALL CTRMM( 'Left', 'Lower', 'No Transpose', + $ 'Non-Unit', $ N1, LEN, ONE, Q( 1, N2+1 ), LDQ, WORK, $ LDWORK ) * * Multiply top part of C by Q11. * - CALL CGEMM( 'No Transpose', 'No Transpose', N1, LEN, N2, + CALL CGEMM( 'No Transpose', 'No Transpose', N1, LEN, + $ N2, $ ONE, Q, LDQ, C( 1, I ), LDC, ONE, WORK, $ LDWORK ) * @@ -296,13 +299,15 @@ SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL CLACPY( 'All', N2, LEN, C( 1, I ), LDC, $ WORK( N1+1 ), LDWORK ) - CALL CTRMM( 'Left', 'Upper', 'No Transpose', 'Non-Unit', + CALL CTRMM( 'Left', 'Upper', 'No Transpose', + $ 'Non-Unit', $ N2, LEN, ONE, Q( N1+1, 1 ), LDQ, $ WORK( N1+1 ), LDWORK ) * * Multiply bottom part of C by Q22. * - CALL CGEMM( 'No Transpose', 'No Transpose', N2, LEN, N1, + CALL CGEMM( 'No Transpose', 'No Transpose', N2, LEN, + $ N1, $ ONE, Q( N1+1, N2+1 ), LDQ, C( N2+1, I ), LDC, $ ONE, WORK( N1+1 ), LDWORK ) * @@ -360,13 +365,15 @@ SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL CLACPY( 'All', LEN, N2, C( I, N1+1 ), LDC, WORK, $ LDWORK ) - CALL CTRMM( 'Right', 'Upper', 'No Transpose', 'Non-Unit', + CALL CTRMM( 'Right', 'Upper', 'No Transpose', + $ 'Non-Unit', $ LEN, N2, ONE, Q( N1+1, 1 ), LDQ, WORK, $ LDWORK ) * * Multiply left part of C by Q11. * - CALL CGEMM( 'No Transpose', 'No Transpose', LEN, N2, N1, + CALL CGEMM( 'No Transpose', 'No Transpose', LEN, N2, + $ N1, $ ONE, C( I, 1 ), LDC, Q, LDQ, ONE, WORK, $ LDWORK ) * @@ -374,13 +381,15 @@ SUBROUTINE CUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL CLACPY( 'All', LEN, N1, C( I, 1 ), LDC, $ WORK( 1 + N2*LDWORK ), LDWORK ) - CALL CTRMM( 'Right', 'Lower', 'No Transpose', 'Non-Unit', + CALL CTRMM( 'Right', 'Lower', 'No Transpose', + $ 'Non-Unit', $ LEN, N1, ONE, Q( 1, N2+1 ), LDQ, $ WORK( 1 + N2*LDWORK ), LDWORK ) * * Multiply right part of C by Q22. * - CALL CGEMM( 'No Transpose', 'No Transpose', LEN, N1, N2, + CALL CGEMM( 'No Transpose', 'No Transpose', LEN, N1, + $ N2, $ ONE, C( I, N1+1 ), LDC, Q( N1+1, N2+1 ), LDQ, $ ONE, WORK( 1 + N2*LDWORK ), LDWORK ) * diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index fecebcea0d..12664df14b 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -273,7 +273,8 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF AII = A( I, I ) A( I, I ) = ONE - CALL CLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC, + CALL CLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), + $ LDC, $ WORK ) A( I, I ) = AII 10 CONTINUE diff --git a/SRC/cunmbr.f b/SRC/cunmbr.f index fed5d75db3..802a7799be 100644 --- a/SRC/cunmbr.f +++ b/SRC/cunmbr.f @@ -273,18 +273,22 @@ SUBROUTINE CUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, IF( M.GT.0 .AND. N.GT.0 ) THEN IF( APPLYQ ) THEN IF( LEFT ) THEN - NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M-1, N, M-1, + NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M-1, N, + $ M-1, $ -1 ) ELSE - NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M, N-1, N-1, + NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M, N-1, + $ N-1, $ -1 ) END IF ELSE IF( LEFT ) THEN - NB = ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M-1, N, M-1, + NB = ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M-1, N, + $ M-1, $ -1 ) ELSE - NB = ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M, N-1, N-1, + NB = ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M, N-1, + $ N-1, $ -1 ) END IF END IF @@ -332,7 +336,8 @@ SUBROUTINE CUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, I1 = 1 I2 = 2 END IF - CALL CUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + CALL CUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, + $ TAU, $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) END IF ELSE diff --git a/SRC/cunmhr.f b/SRC/cunmhr.f index 5948567fef..850575f57e 100644 --- a/SRC/cunmhr.f +++ b/SRC/cunmhr.f @@ -229,7 +229,8 @@ SUBROUTINE CUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/cunmlq.f b/SRC/cunmlq.f index f61c8d5bb7..d6ba1443fc 100644 --- a/SRC/cunmlq.f +++ b/SRC/cunmlq.f @@ -248,7 +248,8 @@ SUBROUTINE CUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'CUNMLQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -275,7 +276,8 @@ SUBROUTINE CUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNMLQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'CUNMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -284,7 +286,8 @@ SUBROUTINE CUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -340,7 +343,8 @@ SUBROUTINE CUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL CLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB, + CALL CLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, + $ IB, $ A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/cunmql.f b/SRC/cunmql.f index 60fc5b0de8..a6d53081ae 100644 --- a/SRC/cunmql.f +++ b/SRC/cunmql.f @@ -247,7 +247,8 @@ SUBROUTINE CUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'CUNMQL', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'CUNMQL', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -274,7 +275,8 @@ SUBROUTINE CUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNMQL', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'CUNMQL', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -283,7 +285,8 @@ SUBROUTINE CUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL CUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL CUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -329,7 +332,8 @@ SUBROUTINE CUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL CLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + CALL CLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, + $ NI, $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, $ WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/cunmqr.f b/SRC/cunmqr.f index a8c5e7708a..9981217c62 100644 --- a/SRC/cunmqr.f +++ b/SRC/cunmqr.f @@ -244,7 +244,8 @@ SUBROUTINE CUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'CUNMQR', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'CUNMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -269,7 +270,8 @@ SUBROUTINE CUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNMQR', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'CUNMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -278,7 +280,8 @@ SUBROUTINE CUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -310,7 +313,8 @@ SUBROUTINE CUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL CLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + CALL CLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * @@ -328,7 +332,8 @@ SUBROUTINE CUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL CLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + CALL CLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, + $ NI, $ IB, A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/cunmr2.f b/SRC/cunmr2.f index 64caed8778..48a704fe21 100644 --- a/SRC/cunmr2.f +++ b/SRC/cunmr2.f @@ -270,7 +270,8 @@ SUBROUTINE CUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, CALL CLACGV( NQ-K+I-1, A( I, 1 ), LDA ) AII = A( I, NQ-K+I ) A( I, NQ-K+I ) = ONE - CALL CLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, WORK ) + CALL CLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, + $ WORK ) A( I, NQ-K+I ) = AII CALL CLACGV( NQ-K+I-1, A( I, 1 ), LDA ) 10 CONTINUE diff --git a/SRC/cunmr3.f b/SRC/cunmr3.f index 9cb111f8be..7c0749dc6a 100644 --- a/SRC/cunmr3.f +++ b/SRC/cunmr3.f @@ -174,7 +174,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE CUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/cunmrq.f b/SRC/cunmrq.f index df600c90dd..f5be5e8b41 100644 --- a/SRC/cunmrq.f +++ b/SRC/cunmrq.f @@ -248,7 +248,8 @@ SUBROUTINE CUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'CUNMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'CUNMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -273,7 +274,8 @@ SUBROUTINE CUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'CUNMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -282,7 +284,8 @@ SUBROUTINE CUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL CUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL CUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * diff --git a/SRC/cunmrz.f b/SRC/cunmrz.f index 60f1d5e507..75787ebc01 100644 --- a/SRC/cunmrz.f +++ b/SRC/cunmrz.f @@ -183,7 +183,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE CUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -269,7 +270,8 @@ SUBROUTINE CUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'CUNMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'CUNMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -298,7 +300,8 @@ SUBROUTINE CUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'CUNMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'CUNMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -347,7 +350,8 @@ SUBROUTINE CUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL CLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA, + CALL CLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), + $ LDA, $ TAU( I ), WORK( IWT ), LDT ) * IF( LEFT ) THEN diff --git a/SRC/cunmtr.f b/SRC/cunmtr.f index f508e1ab2a..f3dc88a420 100644 --- a/SRC/cunmtr.f +++ b/SRC/cunmtr.f @@ -168,7 +168,8 @@ *> \ingroup unmtr * * ===================================================================== - SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -224,7 +225,8 @@ SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -3 ELSE IF( M.LT.0 ) THEN @@ -287,7 +289,8 @@ SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, * * Q was determined by a call to CHETRD with UPLO = 'U' * - CALL CUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + CALL CUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, + $ C, $ LDC, WORK, LWORK, IINFO ) ELSE * diff --git a/SRC/cupmtr.f b/SRC/cupmtr.f index f383c0401c..904c88bdd2 100644 --- a/SRC/cupmtr.f +++ b/SRC/cupmtr.f @@ -146,7 +146,8 @@ *> \ingroup upmtr * * ===================================================================== - SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, + SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dbbcsd.f b/SRC/dbbcsd.f index c0bbf21db5..302b1856cb 100644 --- a/SRC/dbbcsd.f +++ b/SRC/dbbcsd.f @@ -326,7 +326,8 @@ *> \ingroup bbcsd * * ===================================================================== - SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, + $ Q, $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T, $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) @@ -373,7 +374,8 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ UNFL, X1, X2, Y1, Y2 * * .. External Subroutines .. - EXTERNAL DLASR, DSCAL, DSWAP, DLARTGP, DLARTGS, DLAS2, + EXTERNAL DLASR, DSCAL, DSWAP, DLARTGP, DLARTGS, + $ DLAS2, $ XERBLA * .. * .. External Functions .. @@ -560,9 +562,11 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * * Compute shifts for B11 and B21 and use the lesser * - CALL DLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11, + CALL DLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), + $ SIGMA11, $ DUMMY ) - CALL DLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21, + CALL DLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), + $ SIGMA21, $ DUMMY ) * IF( SIGMA11 .LE. SIGMA21 ) THEN @@ -698,7 +702,8 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART21 ) THEN - CALL DLARTGP( X2, X1, WORK(IV1TSN+I-1), WORK(IV1TCS+I-1), + CALL DLARTGP( X2, X1, WORK(IV1TSN+I-1), + $ WORK(IV1TCS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART21 ) THEN CALL DLARTGP( B11BULGE, B11E(I-1), WORK(IV1TSN+I-1), @@ -725,10 +730,12 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL DLARTGP( B22BULGE, B22D(I-1), WORK(IV2TSN+I-1-1), $ WORK(IV2TCS+I-1-1), R ) ELSE IF( NU .LT. MU ) THEN - CALL DLARTGS( B12E(I-1), B12D(I), NU, WORK(IV2TCS+I-1-1), + CALL DLARTGS( B12E(I-1), B12D(I), NU, + $ WORK(IV2TCS+I-1-1), $ WORK(IV2TSN+I-1-1) ) ELSE - CALL DLARTGS( B22E(I-1), B22D(I), MU, WORK(IV2TCS+I-1-1), + CALL DLARTGS( B22E(I-1), B22D(I), MU, + $ WORK(IV2TCS+I-1-1), $ WORK(IV2TSN+I-1-1) ) END IF * @@ -781,7 +788,8 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN - CALL DLARTGP( X2, X1, WORK(IU1SN+I-1), WORK(IU1CS+I-1), + CALL DLARTGP( X2, X1, WORK(IU1SN+I-1), + $ WORK(IU1CS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN CALL DLARTGP( B11BULGE, B11D(I), WORK(IU1SN+I-1), @@ -797,7 +805,8 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ WORK(IU1SN+I-1) ) END IF IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN - CALL DLARTGP( Y2, Y1, WORK(IU2SN+I-1), WORK(IU2CS+I-1), + CALL DLARTGP( Y2, Y1, WORK(IU2SN+I-1), + $ WORK(IU2CS+I-1), $ R ) ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN CALL DLARTGP( B21BULGE, B21D(I), WORK(IU2SN+I-1), @@ -863,10 +872,12 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL DLARTGP( Y2, Y1, WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN - CALL DLARTGP( B12BULGE, B12D(IMAX-1), WORK(IV2TSN+IMAX-1-1), + CALL DLARTGP( B12BULGE, B12D(IMAX-1), + $ WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN - CALL DLARTGP( B22BULGE, B22D(IMAX-1), WORK(IV2TSN+IMAX-1-1), + CALL DLARTGP( B22BULGE, B22D(IMAX-1), + $ WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( NU .LT. MU ) THEN CALL DLARTGS( B12E(IMAX-1), B12D(IMAX), NU, @@ -1053,7 +1064,8 @@ SUBROUTINE DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( WANTU2 ) $ CALL DSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 ) IF( WANTV1T ) - $ CALL DSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T ) + $ CALL DSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), + $ LDV1T ) IF( WANTV2T ) $ CALL DSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1), $ LDV2T ) diff --git a/SRC/dbdsdc.f b/SRC/dbdsdc.f index 613c610a2d..ea9380a6de 100644 --- a/SRC/dbdsdc.f +++ b/SRC/dbdsdc.f @@ -194,7 +194,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, + SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, + $ IQ, $ WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -234,7 +235,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, EXTERNAL LSAME, ILAENV, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, DLASDQ, + EXTERNAL DCOPY, DLARTG, DLASCL, DLASD0, DLASDA, + $ DLASDQ, $ DLASET, DLASR, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -341,14 +343,17 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, IF( ICOMPQ.EQ.2 ) THEN CALL DLASET( 'A', N, N, ZERO, ONE, U, LDU ) CALL DLASET( 'A', N, N, ZERO, ONE, VT, LDVT ) - CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U, + CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, + $ U, $ LDU, WORK( WSTART ), INFO ) ELSE IF( ICOMPQ.EQ.1 ) THEN IU = 1 IVT = IU + N - CALL DLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ), + CALL DLASET( 'A', N, N, ZERO, ONE, + $ Q( IU+( QSTART-1 )*N ), $ N ) - CALL DLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ), + CALL DLASET( 'A', N, N, ZERO, ONE, + $ Q( IVT+( QSTART-1 )*N ), $ N ) CALL DLASDQ( 'U', 0, N, N, N, 0, D, E, $ Q( IVT+( QSTART-1 )*N ), N, @@ -506,7 +511,8 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, * which rotated B to be upper bidiagonal * IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) ) - $ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU ) + $ CALL DLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, + $ LDU ) * RETURN * diff --git a/SRC/dbdsqr.f b/SRC/dbdsqr.f index 68f1235745..d72f4706be 100644 --- a/SRC/dbdsqr.f +++ b/SRC/dbdsqr.f @@ -288,7 +288,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, EXTERNAL LSAME, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, DROT, + EXTERNAL DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, + $ DROT, $ DSCAL, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -369,10 +370,12 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NRU.GT.0 ) - $ CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U, + $ CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), + $ U, $ LDU ) IF( NCC.GT.0 ) - $ CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C, + $ CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), + $ C, $ LDC ) END IF * @@ -494,10 +497,12 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Compute singular vectors, if desired * IF( NCVT.GT.0 ) - $ CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR, + $ CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, + $ COSR, $ SINR ) IF( NRU.GT.0 ) - $ CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL ) + $ CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, + $ SINL ) IF( NCC.GT.0 ) $ CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL, $ SINL ) @@ -630,7 +635,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL DLARTG( D( I )*CS, E( I ), CS, SN, R ) IF( I.GT.LL ) $ E( I-1 ) = OLDSN*R - CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, + $ D( I ) ) WORK( I-LL+1 ) = CS WORK( I-LL+1+NM1 ) = SN WORK( I-LL+1+NM12 ) = OLDCS @@ -646,10 +652,12 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ), $ WORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ), + $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ), + $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -668,7 +676,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R ) IF( I.LT.M ) $ E( I ) = OLDSN*R - CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, + $ D( I ) ) WORK( I-LL ) = CS WORK( I-LL+NM1 ) = -SN WORK( I-LL+NM12 ) = OLDCS @@ -681,7 +690,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors * IF( NCVT.GT.0 ) - $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ), + $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ), @@ -736,10 +746,12 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ), $ WORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ), + $ CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ), + $ CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -786,7 +798,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NCVT.GT.0 ) - $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ), + $ CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ), @@ -842,7 +855,8 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, IF( NRU.GT.0 ) $ CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 ) IF( NCC.GT.0 ) - $ CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC ) + $ CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), + $ LDC ) END IF 190 CONTINUE GO TO 220 diff --git a/SRC/dbdsvdx.f b/SRC/dbdsvdx.f index be20285fdf..c025399e29 100644 --- a/SRC/dbdsvdx.f +++ b/SRC/dbdsvdx.f @@ -264,10 +264,12 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, LOGICAL LSAME INTEGER IDAMAX DOUBLE PRECISION DDOT, DLAMCH, DNRM2 - EXTERNAL IDAMAX, LSAME, DAXPY, DDOT, DLAMCH, DNRM2 + EXTERNAL IDAMAX, LSAME, DAXPY, DDOT, DLAMCH, + $ DNRM2 * .. * .. External Subroutines .. - EXTERNAL DSTEVX, DCOPY, DLASET, DSCAL, DSWAP, XERBLA + EXTERNAL DSTEVX, DCOPY, DLASET, DSCAL, DSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, SIGN, SQRT @@ -424,7 +426,8 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( NS.EQ.0 ) THEN RETURN ELSE - IF( WANTZ ) 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 * @@ -461,7 +464,8 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - IF( WANTZ ) 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. @@ -588,7 +592,8 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * WORK( ITEMP: ): 2*5*NTGK * IWORK( 1: ): 2*6*NTGK * - CALL DSTEVX( JOBZ, RNGVX, NTGK, WORK( IDTGK+ISPLT-1 ), + CALL DSTEVX( JOBZ, RNGVX, NTGK, + $ WORK( IDTGK+ISPLT-1 ), $ WORK( IETGK+ISPLT-1 ), VLTGK, VUTGK, $ ILTGK, IUTGK, ABSTOL, NSL, S( ISBEG ), $ Z( IROWZ,ICOLZ ), LDZ, WORK( ITEMP ), @@ -643,13 +648,15 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ ABS( NRMU-ORTOL )*SQRT2.GT.ONE ) $ THEN DO J = 0, I-1 - ZJTJI = -DDOT( NRU, Z( IROWU, ICOLZ+J ), + ZJTJI = -DDOT( NRU, Z( IROWU, + $ ICOLZ+J ), $ 2, Z( IROWU, ICOLZ+I ), 2 ) CALL DAXPY( NRU, ZJTJI, $ Z( IROWU, ICOLZ+J ), 2, $ Z( IROWU, ICOLZ+I ), 2 ) END DO - NRMU = DNRM2( NRU, Z( IROWU, ICOLZ+I ), 2 ) + NRMU = DNRM2( NRU, Z( IROWU, ICOLZ+I ), + $ 2 ) CALL DSCAL( NRU, ONE/NRMU, $ Z( IROWU,ICOLZ+I ), 2 ) END IF @@ -666,13 +673,15 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ ABS( NRMV-ORTOL )*SQRT2.GT.ONE ) $ THEN DO J = 0, I-1 - ZJTJI = -DDOT( NRV, Z( IROWV, ICOLZ+J ), + ZJTJI = -DDOT( NRV, Z( IROWV, + $ ICOLZ+J ), $ 2, Z( IROWV, ICOLZ+I ), 2 ) CALL DAXPY( NRU, ZJTJI, $ Z( IROWV, ICOLZ+J ), 2, $ Z( IROWV, ICOLZ+I ), 2 ) END DO - NRMV = DNRM2( NRV, Z( IROWV, ICOLZ+I ), 2 ) + NRMV = DNRM2( NRV, Z( IROWV, ICOLZ+I ), + $ 2 ) CALL DSCAL( NRV, ONE/NRMV, $ Z( IROWV,ICOLZ+I ), 2 ) END IF @@ -752,7 +761,8 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - IF( WANTZ ) 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 * diff --git a/SRC/dgbbrd.f b/SRC/dgbbrd.f index 3f04cd9016..534b4e31e4 100644 --- a/SRC/dgbbrd.f +++ b/SRC/dgbbrd.f @@ -212,7 +212,8 @@ SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, DOUBLE PRECISION RA, RB, RC, RS * .. * .. External Subroutines .. - EXTERNAL DLARGV, DLARTG, DLARTV, DLASET, DROT, XERBLA + EXTERNAL DLARGV, DLARTG, DLARTV, DLASET, DROT, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -231,7 +232,9 @@ SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, WANTC = NCC.GT.0 KLU1 = KL + KU + 1 INFO = 0 - IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) ) + IF( .NOT.WANTQ .AND. + $ .NOT.WANTPT .AND. + $ .NOT.LSAME( VECT, 'N' ) ) $ THEN INFO = -1 ELSE IF( M.LT.0 ) THEN @@ -328,7 +331,8 @@ SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL DLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA, + $ CALL DLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), + $ INCA, $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA, $ WORK( MN+J1 ), WORK( J1 ), KB1 ) 10 CONTINUE @@ -368,7 +372,8 @@ SUBROUTINE DGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, * apply plane rotations to C * DO 30 J = J1, J2, KB1 - CALL DROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC, + CALL DROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), + $ LDC, $ WORK( MN+J ), WORK( J ) ) 30 CONTINUE END IF diff --git a/SRC/dgbcon.f b/SRC/dgbcon.f index 4471ca7ce4..ce374fbc0a 100644 --- a/SRC/dgbcon.f +++ b/SRC/dgbcon.f @@ -142,7 +142,8 @@ *> \ingroup gbcon * * ===================================================================== - SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, + SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, + $ RCOND, $ WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -181,7 +182,8 @@ SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DLACN2, DLATBS, DRSCL, XERBLA + EXTERNAL DAXPY, DLACN2, DLATBS, DRSCL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN @@ -250,13 +252,15 @@ SUBROUTINE DGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK( JP ) = WORK( J ) WORK( J ) = T END IF - CALL DAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 ) + CALL DAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), + $ 1 ) 20 CONTINUE END IF * * Multiply by inv(U). * - CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), $ INFO ) ELSE diff --git a/SRC/dgbequ.f b/SRC/dgbequ.f index 091942c7a0..0718077756 100644 --- a/SRC/dgbequ.f +++ b/SRC/dgbequ.f @@ -149,7 +149,8 @@ *> \ingroup gbequ * * ===================================================================== - SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE DGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dgbequb.f b/SRC/dgbequb.f index 8c69bc57cd..88c357e8cc 100644 --- a/SRC/dgbequb.f +++ b/SRC/dgbequb.f @@ -156,7 +156,8 @@ *> \ingroup gbequb * * ===================================================================== - SUBROUTINE DGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE DGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dgbrfs.f b/SRC/dgbrfs.f index 6fca00075f..fe529c0b57 100644 --- a/SRC/dgbrfs.f +++ b/SRC/dgbrfs.f @@ -200,7 +200,8 @@ *> \ingroup gbrfs * * ===================================================================== - SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, $ INFO ) * @@ -242,7 +243,8 @@ SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGBMV, DGBTRS, DLACN2, XERBLA + EXTERNAL DAXPY, DCOPY, DGBMV, DGBTRS, DLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -321,7 +323,8 @@ SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL DGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), 1, + CALL DGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), + $ 1, $ ONE, WORK( N+1 ), 1 ) * * Compute componentwise relative backward error from formula @@ -419,7 +422,8 @@ SUBROUTINE DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/dgbrfsx.f b/SRC/dgbrfsx.f index 9085b12c76..b16162be43 100644 --- a/SRC/dgbrfsx.f +++ b/SRC/dgbrfsx.f @@ -433,7 +433,8 @@ *> \ingroup gbrfsx * * ===================================================================== - SUBROUTINE DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, @@ -648,14 +649,16 @@ SUBROUTINE DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, PREC_TYPE = ILAPREC( 'E' ) IF ( NOTRAN ) THEN - CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK( N+1 ), WORK( 1 ), WORK( 2*N+1 ), $ WORK( 1 ), RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, $ IGNORE_CWISE, INFO ) ELSE - CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK( N+1 ), WORK( 1 ), WORK( 2*N+1 ), @@ -664,7 +667,8 @@ SUBROUTINE DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, END IF END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). @@ -722,7 +726,8 @@ SUBROUTINE DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, DO J = 1, NRHS IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG ) $ THEN - RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, 1, X( 1, J ), INFO, WORK, IWORK ) ELSE RCOND_TMP = 0.0D+0 diff --git a/SRC/dgbsv.f b/SRC/dgbsv.f index 8639ada7d2..939b61f0ac 100644 --- a/SRC/dgbsv.f +++ b/SRC/dgbsv.f @@ -159,7 +159,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) + SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE DGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) * * Solve the system A*X = B, overwriting B with X. * - CALL DGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV, + CALL DGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, + $ IPIV, $ B, LDB, INFO ) END IF RETURN diff --git a/SRC/dgbsvx.f b/SRC/dgbsvx.f index 5f2ea6bb13..25aa917793 100644 --- a/SRC/dgbsvx.f +++ b/SRC/dgbsvx.f @@ -403,7 +403,8 @@ SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, EXTERNAL LSAME, DLAMCH, DLANGB, DLANTB * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGBCON, DGBEQU, DGBRFS, DGBTRF, DGBTRS, + EXTERNAL DCOPY, DGBCON, DGBEQU, DGBRFS, DGBTRF, + $ DGBTRS, $ DLACPY, DLAQGB, XERBLA * .. * .. Intrinsic Functions .. @@ -428,7 +429,9 @@ SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -504,7 +507,8 @@ SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -555,7 +559,8 @@ SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) 80 CONTINUE 90 CONTINUE - RPVGRW = DLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), + RPVGRW = DLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, + $ KL+KU ), $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, $ WORK ) IF( RPVGRW.EQ.ZERO ) THEN @@ -599,7 +604,8 @@ SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, + CALL DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/dgbsvxx.f b/SRC/dgbsvxx.f index 725fb8f7a5..6231620781 100644 --- a/SRC/dgbsvxx.f +++ b/SRC/dgbsvxx.f @@ -553,7 +553,8 @@ *> \ingroup gbsvxx * * ===================================================================== - SUBROUTINE DGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE DGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, $ RCOND, RPVGRW, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, @@ -604,7 +605,8 @@ SUBROUTINE DGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, DOUBLE PRECISION DLAMCH, DLA_GBRPVGRW * .. * .. External Subroutines .. - EXTERNAL DGBEQUB, DGBTRF, DGBTRS, DLACPY, DLAQGB, + EXTERNAL DGBEQUB, DGBTRF, DGBTRS, DLACPY, + $ DLAQGB, $ XERBLA, DLASCL2, DGBRFSX * .. * .. Intrinsic Functions .. @@ -711,7 +713,8 @@ SUBROUTINE DGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -777,7 +780,8 @@ SUBROUTINE DGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + CALL DGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) diff --git a/SRC/dgbtf2.f b/SRC/dgbtf2.f index 26597c540e..1b1e013517 100644 --- a/SRC/dgbtf2.f +++ b/SRC/dgbtf2.f @@ -250,7 +250,8 @@ SUBROUTINE DGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers. * - CALL DSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 ) + CALL DSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), + $ 1 ) * * Update trailing submatrix within the band. * diff --git a/SRC/dgbtrf.f b/SRC/dgbtrf.f index 523879717a..ab635a5f70 100644 --- a/SRC/dgbtrf.f +++ b/SRC/dgbtrf.f @@ -177,7 +177,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) EXTERNAL IDAMAX, ILAENV * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGBTF2, DGEMM, DGER, DLASWP, DSCAL, + EXTERNAL DCOPY, DGBTF2, DGEMM, DGER, DLASWP, + $ DSCAL, $ DSWAP, DTRSM, XERBLA * .. * .. Intrinsic Functions .. @@ -325,7 +326,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers * - CALL DSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ), + CALL DSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, + $ JJ ), $ 1 ) * * Update trailing submatrix within the band and within @@ -394,7 +396,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A12 * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL DTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J2, ONE, AB( KV+1, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1 ) * @@ -402,7 +405,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A22 * - CALL DGEMM( 'No transpose', 'No transpose', I2, J2, + CALL DGEMM( 'No transpose', 'No transpose', I2, + $ J2, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+1, J+JB ), LDAB-1 ) @@ -412,7 +416,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A32 * - CALL DGEMM( 'No transpose', 'No transpose', I3, J2, + CALL DGEMM( 'No transpose', 'No transpose', I3, + $ J2, $ JB, -ONE, WORK31, LDWORK, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+KL+1-JB, J+JB ), LDAB-1 ) @@ -432,7 +437,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A13 in the work array * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL DTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J3, ONE, AB( KV+1, J ), LDAB-1, $ WORK13, LDWORK ) * @@ -440,7 +446,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A23 * - CALL DGEMM( 'No transpose', 'No transpose', I2, J3, + CALL DGEMM( 'No transpose', 'No transpose', I2, + $ J3, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ), $ LDAB-1 ) @@ -450,7 +457,8 @@ SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A33 * - CALL DGEMM( 'No transpose', 'No transpose', I3, J3, + CALL DGEMM( 'No transpose', 'No transpose', I3, + $ J3, $ JB, -ONE, WORK31, LDWORK, WORK13, $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 ) END IF diff --git a/SRC/dgbtrs.f b/SRC/dgbtrs.f index beabcf4cdc..0a520a3b72 100644 --- a/SRC/dgbtrs.f +++ b/SRC/dgbtrs.f @@ -134,7 +134,8 @@ *> \ingroup gbtrs * * ===================================================================== - SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -222,7 +223,8 @@ SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, L = IPIV( J ) IF( L.NE.J ) $ CALL DSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) - CALL DGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ), + CALL DGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, + $ 1 ), $ LDB, B( J+1, 1 ), LDB ) 10 CONTINUE END IF @@ -231,7 +233,8 @@ SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U*X = B, overwriting B with X. * - CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU, + CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, + $ KL+KU, $ AB, LDAB, B( 1, I ), 1 ) 20 CONTINUE * @@ -243,7 +246,8 @@ SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**T*X = B, overwriting B with X. * - CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB, + CALL DTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, + $ AB, $ LDAB, B( 1, I ), 1 ) 30 CONTINUE * diff --git a/SRC/dgebak.f b/SRC/dgebak.f index 4d85c529a0..5b6401a5c8 100644 --- a/SRC/dgebak.f +++ b/SRC/dgebak.f @@ -170,8 +170,10 @@ SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/dgebal.f b/SRC/dgebal.f index f7d70468a5..1be3a072d5 100644 --- a/SRC/dgebal.f +++ b/SRC/dgebal.f @@ -194,7 +194,8 @@ SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) LOGICAL DISNAN, LSAME INTEGER IDAMAX DOUBLE PRECISION DLAMCH, DNRM2 - EXTERNAL DISNAN, LSAME, IDAMAX, DLAMCH, DNRM2 + EXTERNAL DISNAN, LSAME, IDAMAX, DLAMCH, + $ DNRM2 * .. * .. External Subroutines .. EXTERNAL DSCAL, DSWAP, XERBLA @@ -205,8 +206,10 @@ SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -263,7 +266,8 @@ SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( L ) = I IF( I.NE.L ) THEN CALL DSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) - CALL DSWAP( N-K+1, A( I, K ), LDA, A( L, K ), LDA ) + CALL DSWAP( N-K+1, A( I, K ), LDA, A( L, K ), + $ LDA ) END IF NOCONV = .TRUE. * @@ -298,7 +302,8 @@ SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( K ) = J IF( J.NE.K ) THEN CALL DSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) - CALL DSWAP( N-K+1, A( J, K ), LDA, A( K, K ), LDA ) + CALL DSWAP( N-K+1, A( J, K ), LDA, A( K, K ), + $ LDA ) END IF NOCONV = .TRUE. * diff --git a/SRC/dgebd2.f b/SRC/dgebd2.f index 0f3ff21041..e05517ab81 100644 --- a/SRC/dgebd2.f +++ b/SRC/dgebd2.f @@ -248,7 +248,8 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * Apply H(i) to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ), + $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, + $ TAUQ( I ), $ A( I, I+1 ), LDA, WORK ) A( I, I ) = D( I ) * @@ -279,7 +280,8 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * * Generate elementary reflector G(i) to annihilate A(i,i+1:n) * - CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, + CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), + $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) A( I, I ) = ONE @@ -296,14 +298,16 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * Generate elementary reflector H(i) to annihilate * A(i+2:m,i) * - CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1, + CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), + $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE * * Apply H(i) to A(i+1:m,i+1:n) from the left * - CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ), + CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, + $ TAUQ( I ), $ A( I+1, I+1 ), LDA, WORK ) A( I+1, I ) = E( I ) ELSE diff --git a/SRC/dgebrd.f b/SRC/dgebrd.f index d82d34b810..7458c162a5 100644 --- a/SRC/dgebrd.f +++ b/SRC/dgebrd.f @@ -316,7 +316,8 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * the matrices X and Y which are needed to update the unreduced * part of the matrix * - CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ), + CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), + $ E( I ), $ TAUQ( I ), TAUP( I ), WORK, LDWRKX, $ WORK( LDWRKX*NB+1 ), LDWRKY ) * @@ -327,7 +328,8 @@ SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ NB, -ONE, A( I+NB, I ), LDA, $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE, $ A( I+NB, I+NB ), LDA ) - CALL DGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1, + CALL DGEMM( 'No transpose', 'No transpose', M-I-NB+1, + $ N-I-NB+1, $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA, $ ONE, A( I+NB, I+NB ), LDA ) * diff --git a/SRC/dgecon.f b/SRC/dgecon.f index 96eecec248..71b3593227 100644 --- a/SRC/dgecon.f +++ b/SRC/dgecon.f @@ -230,18 +230,21 @@ SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, * * Multiply by inv(L). * - CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A, + CALL DLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, + $ A, $ LDA, WORK, SL, WORK( 2*N+1 ), INFO ) * * Multiply by inv(U). * - CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO ) ELSE * * Multiply by inv(U**T). * - CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SU, WORK( 3*N+1 ), INFO ) * * Multiply by inv(L**T). diff --git a/SRC/dgees.f b/SRC/dgees.f index a87151075b..f2d205cfba 100644 --- a/SRC/dgees.f +++ b/SRC/dgees.f @@ -251,7 +251,8 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, + EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, + $ DLACPY, $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA * .. * .. External Functions .. @@ -273,7 +274,8 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, WANTST = LSAME( SORT, 'S' ) IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -4 @@ -301,7 +303,8 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 ) MINWRK = 3*N * - CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, + CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, + $ LDVS, $ WORK, -1, IEVAL ) HSWORK = INT( WORK( 1 ) ) * @@ -379,7 +382,8 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, * Generate orthogonal matrix in VS * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -420,7 +424,8 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, * Undo balancing * (Workspace: need N) * - CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS, + CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -463,12 +468,14 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, WI( I ) = ZERO WI( I+1 ) = ZERO IF( I.GT.1 ) - $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 ) + $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), + $ 1 ) IF( N.GT.I+1 ) $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) IF( WANTVS ) THEN - CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), + $ 1 ) END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO diff --git a/SRC/dgeesx.f b/SRC/dgeesx.f index 3ebd66e743..2f30ab74d5 100644 --- a/SRC/dgeesx.f +++ b/SRC/dgeesx.f @@ -318,7 +318,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, + EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, + $ DLACPY, $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA * .. * .. External Functions .. @@ -345,7 +346,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -381,7 +383,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, MAXWRK = 2*N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 ) MINWRK = 3*N * - CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, + CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, + $ LDVS, $ WORK, -1, IEVAL ) HSWORK = INT( WORK( 1 ) ) * @@ -467,7 +470,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * Generate orthogonal matrix in VS * (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -500,7 +504,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM) * otherwise, need 0 ) * - CALL DTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI, + CALL DTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, + $ WI, $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1, $ IWORK, LIWORK, ICOND ) IF( .NOT.WANTSN ) @@ -528,7 +533,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * Undo balancing * (RWorkspace: need N) * - CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS, + CALL DGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -540,7 +546,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, CALL DCOPY( N, A, LDA+1, WR, 1 ) IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN DUM( 1 ) = RCONDV - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR ) + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, + $ IERR ) RCONDV = DUM( 1 ) END IF IF( CSCALE.EQ.SMLNUM ) THEN @@ -576,12 +583,14 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WI( I ) = ZERO WI( I+1 ) = ZERO IF( I.GT.1 ) - $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 ) + $ CALL DSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), + $ 1 ) IF( N.GT.I+1 ) $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) IF( WANTVS ) THEN - CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), + $ 1 ) END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO diff --git a/SRC/dgeev.f b/SRC/dgeev.f index c6fad12bd4..4ec789f749 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -188,7 +188,8 @@ *> \ingroup geev * * ===================================================================== - SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, + SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, + $ VR, $ LDVR, WORK, LWORK, INFO ) implicit none * @@ -224,14 +225,16 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG, + EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, + $ DLARTG, $ DLASCL, DORGHR, DROT, DSCAL, DTREVC3, XERBLA * .. * .. External Functions .. LOGICAL LSAME INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2 - EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2, + EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, + $ DLAPY2, $ DNRM2 * .. * .. Intrinsic Functions .. @@ -247,7 +250,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, WANTVR = LSAME( JOBVR, 'V' ) IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 @@ -279,7 +283,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, 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, VL, LDVL, + CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, + $ LDVL, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -293,7 +298,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, 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, + CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -305,7 +311,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N - CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, + CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -378,14 +385,16 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Generate orthogonal matrix in VL * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL, + CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, + $ LDVL, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * IF( WANTVR ) THEN @@ -408,14 +417,16 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Generate orthogonal matrix in VR * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * ELSE @@ -424,7 +435,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL DHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * @@ -438,7 +450,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Compute left and/or right eigenvectors * (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * @@ -447,7 +460,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Undo balancing of left eigenvectors * (Workspace: need N) * - CALL DGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL, + CALL DGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, + $ LDVL, $ IERR ) * * Normalize left eigenvectors and make largest component real @@ -477,7 +491,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Undo balancing of right eigenvectors * (Workspace: need N) * - CALL DGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR, + CALL DGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, + $ LDVR, $ IERR ) * * Normalize right eigenvectors and make largest component real @@ -506,9 +521,11 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * 50 CONTINUE IF( SCALEA ) THEN - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ), + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WR( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ), + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WI( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.GT.0 ) THEN CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N, diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index 240144c096..ed4f827e1d 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -301,7 +301,8 @@ *> \ingroup geevx * * ===================================================================== - SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, + 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 @@ -342,7 +343,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG, + EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, + $ DLARTG, $ DLASCL, DORGHR, DROT, DSCAL, DTREVC3, DTRSNA, $ XERBLA * .. @@ -350,7 +352,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, LOGICAL LSAME INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2 - EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, DLAPY2, + EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, + $ DLAPY2, $ DNRM2 * .. * .. Intrinsic Functions .. @@ -369,12 +372,16 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, 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' ) ) ) + $ .OR. + $ LSAME( BALANC, 'P' ) .OR. + $ LSAME( BALANC, 'B' ) ) ) $ THEN INFO = -1 - ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVL ) .AND. + $ ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR. $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND. @@ -413,7 +420,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ 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, + 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, @@ -421,7 +429,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ 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, + CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) ELSE IF( WNTSNN ) THEN @@ -446,7 +455,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) ) $ MINWRK = MAX( MINWRK, N*N + 6*N ) MAXWRK = MAX( MAXWRK, HSWORK ) - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'DORGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'DORGHR', $ ' ', N, 1, N, -1 ) ) IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) ) $ MAXWRK = MAX( MAXWRK, N*N + 6*N ) @@ -525,14 +535,16 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Generate orthogonal matrix in VL * (Workspace: need 2*N-1, prefer N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL, + CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, + $ LDVL, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * IF( WANTVR ) THEN @@ -555,14 +567,16 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Generate orthogonal matrix in VR * (Workspace: need 2*N-1, prefer N+(N-1)*NB) * - CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL DORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL DHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * ELSE @@ -579,7 +593,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL DHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL DHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * @@ -593,7 +608,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Compute left and/or right eigenvectors * (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * @@ -601,7 +617,8 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * (Workspace: need N*N+6*N unless SENSE = 'E') * IF( .NOT.WNTSNN ) THEN - CALL DTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL DTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, IWORK, $ ICOND ) END IF @@ -668,9 +685,11 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * 50 CONTINUE IF( SCALEA ) THEN - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ), + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WR( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ), + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WI( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.EQ.0 ) THEN IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 ) diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index 23c2ebbdf1..75fcb74e44 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -164,7 +164,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -194,7 +195,8 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) DOUBLE PRECISION EI * .. * .. External Subroutines .. - EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, DTRMM, + EXTERNAL DAXPY, DGEHD2, DGEMM, DLAHR2, DLARFB, + $ DTRMM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f index d6162aaab6..caca9a6b9e 100644 --- a/SRC/dgejsv.f +++ b/SRC/dgejsv.f @@ -515,7 +515,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, EXTERNAL IDAMAX, LSAME, DLAMCH, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGELQF, DGEQP3, DGEQRF, DLACPY, DLASCL, + EXTERNAL DCOPY, DGELQF, DGEQP3, DGEQRF, DLACPY, + $ DLASCL, $ DLASET, DLASSQ, DLASWP, DORGQR, DORMLQ, $ DORMQR, DPOCON, DSCAL, DSWAP, DTRSM, XERBLA * @@ -693,8 +694,10 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL DLACPY( 'A', M, 1, A, LDA, U, LDU ) * computing all M left singular vectors of the M x 1 matrix IF ( N1 .NE. N ) THEN - CALL DGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N,IERR ) - CALL DORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N,IERR ) + CALL DGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N, + $ IERR ) + CALL DORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N, + $ IERR ) CALL DCOPY( M, A(1,1), 1, U(1,1), 1 ) END IF END IF @@ -1116,7 +1119,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 1949 CONTINUE 1947 CONTINUE ELSE - CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), LDA ) + CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), + $ LDA ) END IF * * .. and one-sided Jacobi rotations are started on a lower @@ -1140,7 +1144,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, DO 1998 p = 1, NR CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) 1998 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) * CALL DGESVJ( 'L','U','N', N, NR, V,LDV, SVA, NR, A,LDA, $ WORK, LWORK, INFO ) @@ -1152,25 +1157,32 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * .. two more QR factorizations ( one QRF is not enough, two require * accumulated product of Jacobi rotations, three are perfect ) * - CALL DLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), LDA ) - CALL DGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, IERR) + CALL DLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), + $ LDA ) + CALL DGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, + $ IERR) CALL DLACPY( 'Lower', NR, NR, A, LDA, V, LDV ) - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) CALL DGEQRF( NR, NR, V, LDV, WORK(N+1), WORK(2*N+1), $ LWORK-2*N, IERR ) DO 8998 p = 1, NR CALL DCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) 8998 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) * CALL DGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, WORK(N+1), LWORK, INFO ) SCALEM = WORK(N+1) NUMRANK = IDNINT(WORK(N+2)) IF ( NR .LT. N ) THEN - CALL DLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), LDV ) - CALL DLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), LDV ) + CALL DLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), + $ LDV ) + CALL DLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), + $ LDV ) + CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), + $ LDV ) END IF * CALL DORMLQ( 'Left', 'Transpose', N, N, NR, A, LDA, WORK, @@ -1214,8 +1226,10 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. M ) THEN CALL DLASET( 'A', M-NR, NR,ZERO, ZERO, U(NR+1,1), LDU ) IF ( NR .LT. N1 ) THEN - CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), LDU ) - CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), LDU ) + CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), + $ LDU ) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1277,7 +1291,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 2968 CONTINUE 2969 CONTINUE ELSE - CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) END IF * * Estimate the row scaled condition number of R1 @@ -1433,7 +1448,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * equation is Q2*V2 = the product of the Jacobi rotations * used in DGESVJ, premultiplied with the orthogonal matrix * from the second QR factorization. - CALL DTRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V,LDV ) + CALL DTRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V, + $ LDV ) ELSE * .. R1 is well conditioned, but non-square. Transpose(R2) * is inverted to get the product of the Jacobi rotations @@ -1444,7 +1460,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) END IF CALL DORMQR('L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1458,7 +1475,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * is Q3^T*V3 = the product of the Jacobi rotations (applied to * the lower triangular L3 from the LQ factorization of * R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL DGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, + CALL DGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) SCALEM = WORK(2*N+N*NR+NR+1) NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2)) @@ -1466,7 +1484,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL DCOPY( NR, V(1,p), 1, U(1,p), 1 ) CALL DSCAL( NR, SVA(p), U(1,p), 1 ) 3870 CONTINUE - CALL DTRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U,LDU) + CALL DTRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U, + $ LDU) * .. apply the permutation from the second QR factorization DO 873 q = 1, NR DO 872 p = 1, NR @@ -1479,7 +1498,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV ) END IF CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) @@ -1495,14 +1515,16 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * defense ensures that DGEJSV completes the task. * Compute the full SVD of L3 using DGESVJ with explicit * accumulation of Jacobi rotations. - CALL DGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, + CALL DGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) SCALEM = WORK(2*N+N*NR+NR+1) NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2)) IF ( NR .LT. N ) THEN CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV ) END IF CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) @@ -1540,10 +1562,12 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * At this moment, V contains the right singular vectors of A. * Next, assemble the left singular vector matrix U (M x N). IF ( NR .LT. M ) THEN - CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) + CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) - CALL DLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1),LDU) + CALL DLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), + $ LDU) END IF END IF * @@ -1612,8 +1636,10 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( N .LT. M ) THEN CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU ) IF ( N .LT. N1 ) THEN - CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) - CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU ) + CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1), + $ LDU ) + CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1), + $ LDU ) END IF END IF CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, @@ -1720,8 +1746,10 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. M ) THEN CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) IF ( NR .LT. N1 ) THEN - CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU ) - CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU ) + CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), + $ LDU ) + CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1746,7 +1774,8 @@ SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL DLASCL( '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/SRC/dgelq2.f b/SRC/dgelq2.f index ef8d5d59d4..085288fe95 100644 --- a/SRC/dgelq2.f +++ b/SRC/dgelq2.f @@ -186,7 +186,8 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ), + CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), $ A( I+1, I ), LDA, WORK ) A( I, I ) = AII END IF diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 54b9b84c78..4f0544ba0c 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -252,7 +252,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/dgels.f b/SRC/dgels.f index 164e2a7185..7c71f9d144 100644 --- a/SRC/dgels.f +++ b/SRC/dgels.f @@ -179,7 +179,8 @@ *> \ingroup gels * * ===================================================================== - SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -215,7 +216,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DGELQF, DGEQRF, DLASCL, DLASET, DORMLQ, DORMQR, + EXTERNAL DGELQF, DGEQRF, DLASCL, DLASET, DORMLQ, + $ DORMQR, $ DTRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -228,7 +230,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'T' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -346,7 +349,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * compute QR factorization of A * - CALL DGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL DGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least N, optimally N*NB @@ -365,7 +369,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -411,7 +416,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Compute LQ factorization of A * - CALL DGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL DGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least M, optimally M*NB. @@ -422,7 +428,8 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/dgelsd.f b/SRC/dgelsd.f index 6f256ca956..1de3d83626 100644 --- a/SRC/dgelsd.f +++ b/SRC/dgelsd.f @@ -229,7 +229,8 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, DLALSD, + EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, + $ DLALSD, $ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA * .. * .. External Functions .. @@ -311,13 +312,16 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Path 2a - underdetermined, with many more columns * than rows. * - MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) + MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, + $ -1 ) MAXWRK = MAX( MAXWRK, M*M+4*M+2*M* $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) MAXWRK = MAX( MAXWRK, M*M+4*M+NRHS* - $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, M, -1 ) ) + $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, M, + $ -1 ) ) MAXWRK = MAX( MAXWRK, M*M+4*M+( M-1 )* - $ ILAENV( 1, 'DORMBR', 'PLN', M, NRHS, M, -1 ) ) + $ ILAENV( 1, 'DORMBR', 'PLN', M, NRHS, M, + $ -1 ) ) IF( NRHS.GT.1 ) THEN MAXWRK = MAX( MAXWRK, M*M+M+M*NRHS ) ELSE @@ -337,9 +341,11 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, MAXWRK = 3*M + ( N+M )*ILAENV( 1, 'DGEBRD', ' ', M, N, $ -1, -1 ) MAXWRK = MAX( MAXWRK, 3*M+NRHS* - $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, N, -1 ) ) + $ ILAENV( 1, 'DORMBR', 'QLT', M, NRHS, N, + $ -1 ) ) MAXWRK = MAX( MAXWRK, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, M, -1 ) ) + $ ILAENV( 1, 'DORMBR', 'PLN', N, NRHS, M, + $ -1 ) ) MAXWRK = MAX( MAXWRK, 3*M+WLALSD ) END IF MINWRK = MAX( 3*M+NRHS, 3*M+M, 3*M+WLALSD ) @@ -408,13 +414,15 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM. * - CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM. * - CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -447,13 +455,15 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose(Q). * (Workspace: need N+NRHS, prefer N+NRHS*NB) * - CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Zero out below R. * IF( N.GT.1 ) THEN - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) END IF END IF * @@ -472,7 +482,8 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors of R. * (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB) * - CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -485,7 +496,8 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of R. * - CALL DORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ), + CALL DORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+ @@ -575,7 +587,8 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors. * (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB) * - CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -588,7 +601,8 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of A. * - CALL DORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ), + CALL DORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * END IF @@ -596,18 +610,22 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling. * IF( IASCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 10 CONTINUE diff --git a/SRC/dgelss.f b/SRC/dgelss.f index af5976793d..c5d1768465 100644 --- a/SRC/dgelss.f +++ b/SRC/dgelss.f @@ -203,7 +203,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV, + EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, + $ DGEMV, $ DGEQRF, DLACPY, DLASCL, DLASET, DORGBR, $ DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA * .. @@ -276,7 +277,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ DUM(1), DUM(1), -1, INFO ) LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORMBR - CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1), + CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ DUM(1), $ B, LDB, DUM(1), -1, INFO ) LWORK_DORMBR = INT( DUM(1) ) * Compute space needed for DORGBR @@ -421,13 +423,15 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -455,13 +459,15 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose(Q) * (Workspace: need N+NRHS, prefer N+NRHS*NB) * - CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Zero out below R * IF( N.GT.1 ) - $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + $ CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) END IF * IE = 1 @@ -479,7 +485,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors of R * (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB) * - CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors of R in A @@ -510,7 +517,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 10 CONTINUE * @@ -518,14 +526,16 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need N, prefer N*NRHS) * IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN - CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, ZERO, + CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, + $ ZERO, $ WORK, LDB ) CALL DLACPY( 'G', N, NRHS, WORK, LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = LWORK / N DO 20 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ), + CALL DGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, + $ I ), $ LDB, ZERO, WORK, N ) CALL DLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB ) 20 CONTINUE @@ -580,7 +590,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Generate right bidiagonalizing vectors of R in WORK(IL) * (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB) * - CALL DORGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ), + CALL DORGBR( 'P', M, M, M, WORK( IL ), LDWORK, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, INFO ) IWORK = IE + M * @@ -605,7 +616,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 30 CONTINUE IWORK = IE @@ -614,21 +626,23 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS) * IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN - CALL DGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), LDWORK, + CALL DGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), + $ LDWORK, $ B, LDB, ZERO, WORK( IWORK ), LDB ) CALL DLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = ( LWORK-IWORK+1 ) / M DO 40 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK, + CALL DGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), + $ LDWORK, $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M ) CALL DLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ), $ LDB ) 40 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ), - $ 1, ZERO, WORK( IWORK ), 1 ) + CALL DGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, + $ 1 ),1, ZERO, WORK( IWORK ), 1 ) CALL DCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 ) END IF * @@ -662,7 +676,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors * (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB) * - CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors in A @@ -693,7 +708,8 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL DRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL DLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 50 CONTINUE * @@ -701,14 +717,16 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need N, prefer N*NRHS) * IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN - CALL DGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, ZERO, + CALL DGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, + $ ZERO, $ WORK, LDB ) CALL DLACPY( 'F', N, NRHS, WORK, LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = LWORK / N DO 60 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL DGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, I ), + CALL DGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, + $ I ), $ LDB, ZERO, WORK, N ) CALL DLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB ) 60 CONTINUE @@ -721,18 +739,22 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/dgelst.f b/SRC/dgelst.f index ed561e5454..08b3f99e62 100644 --- a/SRC/dgelst.f +++ b/SRC/dgelst.f @@ -190,7 +190,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -227,7 +228,8 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DGELQT, DGEQRT, DGEMLQT, DGEMQRT, DLASCL, + EXTERNAL DGELQT, DGEQRT, DGEMLQT, DGEMQRT, + $ DLASCL, $ DLASET, DTRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -240,7 +242,8 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'T' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -377,13 +380,15 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL DGEMQRT( 'Left', 'Transpose', M, NRHS, N, NB, A, LDA, + CALL DGEMQRT( 'Left', 'Transpose', M, NRHS, N, NB, A, + $ LDA, $ WORK( 1 ), NB, B, LDB, WORK( MN*NB+1 ), $ INFO ) * * Compute B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -450,7 +455,8 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Block 1: B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL DTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -470,7 +476,8 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL DGEMLQT( 'Left', 'Transpose', N, NRHS, M, NB, A, LDA, + CALL DGEMLQT( 'Left', 'Transpose', N, NRHS, M, NB, A, + $ LDA, $ WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * diff --git a/SRC/dgelsy.f b/SRC/dgelsy.f index 9bf35ad1fa..f9ac62afc9 100644 --- a/SRC/dgelsy.f +++ b/SRC/dgelsy.f @@ -202,7 +202,8 @@ *> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n *> * ===================================================================== - SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, + SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, $ WORK, LWORK, INFO ) * * -- LAPACK driver routine -- @@ -239,7 +240,8 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, EXTERNAL ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEQP3, DLAIC1, DLASCL, DLASET, + EXTERNAL DCOPY, DGEQP3, DLAIC1, DLASCL, + $ DLASET, $ DORMQR, DORMRZ, DTRSM, DTZRZF, XERBLA * .. * .. Intrinsic Functions .. @@ -340,13 +342,15 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -413,7 +417,8 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), + CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), $ B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) ) * @@ -454,18 +459,22 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/dgeql2.f b/SRC/dgeql2.f index ef196de9ad..c1659f26e1 100644 --- a/SRC/dgeql2.f +++ b/SRC/dgeql2.f @@ -180,7 +180,8 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * AII = A( M-K+I, N-K+I ) A( M-K+I, N-K+I ) = ONE - CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ), + CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + $ TAU( I ), $ A, LDA, WORK ) A( M-K+I, N-K+I ) = AII 10 CONTINUE diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index 0373d9cbfe..ed60071881 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -249,7 +249,8 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the QL factorization of the current block * A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1) * - CALL DGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ), + CALL DGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( N-K+I.GT.1 ) THEN * diff --git a/SRC/dgeqp3.f b/SRC/dgeqp3.f index 9e2a089426..a2d611af8f 100644 --- a/SRC/dgeqp3.f +++ b/SRC/dgeqp3.f @@ -174,7 +174,8 @@ SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DLAQP2, DLAQPS, DORMQR, DSWAP, XERBLA + EXTERNAL DGEQRF, DLAQP2, DLAQPS, DORMQR, DSWAP, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -256,7 +257,8 @@ SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) IF( NA.LT.N ) THEN *CC CALL DORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA, *CC $ TAU, A( 1, NA+1 ), LDA, WORK, INFO ) - CALL DORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU, + CALL DORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, + $ TAU, $ A( 1, NA+1 ), LDA, WORK, LWORK, INFO ) IWS = MAX( IWS, INT( WORK( 1 ) ) ) END IF @@ -297,7 +299,8 @@ SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = ( LWORK-2*SN ) / ( SN+1 ) - NBMIN = MAX( 2, ILAENV( INBMIN, 'DGEQRF', ' ', SM, SN, + NBMIN = MAX( 2, ILAENV( INBMIN, 'DGEQRF', ' ', SM, + $ SN, $ -1, -1 ) ) * * diff --git a/SRC/dgeqrt.f b/SRC/dgeqrt.f index 690a443562..a6b9d27863 100644 --- a/SRC/dgeqrt.f +++ b/SRC/dgeqrt.f @@ -196,9 +196,11 @@ SUBROUTINE DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) * Compute the QR factorization of the current block A(I:M,I:I+IB-1) * IF( USE_RECURSIVE_QR ) THEN - CALL DGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL DGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) ELSE - CALL DGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL DGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) END IF IF( I+IB.LE.N ) THEN * diff --git a/SRC/dgerfs.f b/SRC/dgerfs.f index 57f82f5b5f..dd384e1817 100644 --- a/SRC/dgerfs.f +++ b/SRC/dgerfs.f @@ -181,7 +181,8 @@ *> \ingroup gerfs * * ===================================================================== - SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -222,7 +223,8 @@ SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGEMV, DGETRS, DLACN2, XERBLA + EXTERNAL DAXPY, DCOPY, DGEMV, DGETRS, DLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -393,14 +395,16 @@ SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL DGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + CALL DGETRS( TRANST, N, 1, AF, LDAF, IPIV, + $ WORK( N+1 ), $ N, INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) @@ -412,7 +416,8 @@ SUBROUTINE DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL DGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/dgerfsx.f b/SRC/dgerfsx.f index 47d3dfb153..0b8eb98013 100644 --- a/SRC/dgerfsx.f +++ b/SRC/dgerfsx.f @@ -408,7 +408,8 @@ *> \ingroup gerfsx * * ===================================================================== - SUBROUTINE DGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE DGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) @@ -607,7 +608,8 @@ SUBROUTINE DGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, NORM = '1' END IF ANORM = DLANGE( NORM, N, N, A, LDA, WORK ) - CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Perform refinement on each right-hand side * @@ -632,19 +634,23 @@ SUBROUTINE DGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, END IF END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ -1, C, INFO, WORK, IWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ -1, R, INFO, WORK, IWORK ) ELSE - RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = DLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ 0, R, INFO, WORK, IWORK ) END IF DO J = 1, NRHS diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index ca65a32655..40037934f3 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -249,7 +249,8 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the RQ factorization of the current block * A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1) * - CALL DGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ), + CALL DGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( M-K+I.GT.1 ) THEN * diff --git a/SRC/dgesdd.f b/SRC/dgesdd.f index b39e6e6f53..1fe0c49d41 100644 --- a/SRC/dgesdd.f +++ b/SRC/dgesdd.f @@ -255,7 +255,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DBDSDC, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY, + EXTERNAL DBDSDC, DGEBRD, DGELQF, DGEMM, DGEQRF, + $ DLACPY, $ DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR, $ XERBLA * .. @@ -338,10 +339,12 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ IERR ) LWORK_DORGBR_Q_NN = INT( DUM(1) ) * - CALL DORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + 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 ) + 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, @@ -460,13 +463,15 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, 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 ) + 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 ) + 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, @@ -626,12 +631,14 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Workspace: need N [tau] + N [work] * Workspace: prefer N [tau] + N*NB [work] * - CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Zero out below R * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N @@ -641,7 +648,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NWORK = IE + N @@ -649,7 +657,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, computing singular values only * Workspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, + $ 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN @@ -674,13 +683,15 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ 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 @@ -712,7 +723,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of bidiagonal matrix in VT * 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, + CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), + $ N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, $ INFO ) * @@ -721,10 +733,12 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, + CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -760,13 +774,15 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ 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 @@ -802,11 +818,13 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * - CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, + CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -815,7 +833,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA, + $ WORK( IR ), $ LDWRKR, ZERO, U, LDU ) * ELSE IF( WNTQA ) THEN @@ -836,7 +855,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * @@ -848,7 +868,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Produce R in A, zeroing out other entries * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N @@ -858,7 +879,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -867,7 +889,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of bidiagonal matrix in VT * Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * - CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, + CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), + $ N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, $ INFO ) * @@ -887,7 +910,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * WORK(IU), storing result in A * Workspace: need N*N [U] * - CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), + CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU, + $ WORK( IU ), $ LDWRKU, ZERO, A, LDA ) * * Copy left singular vectors of A from A to U @@ -921,7 +945,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, only computing singular values * Workspace: need 3*N [e, tauq, taup] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, + 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') @@ -980,7 +1005,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy left singular vectors of A from WORK(IU) to A * - CALL DLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) + CALL DLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, + $ LDA ) ELSE * * Path 5o-slow @@ -999,7 +1025,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 20 I = 1, M, LDWRKR CHUNK = MIN( M - I + 1, LDWRKR ) - CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) CALL DLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR, @@ -1047,7 +1074,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 * @@ -1086,12 +1114,14 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Workspace: need M [tau] + M [work] * Workspace: prefer M [tau] + M*NB [work] * - CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL DGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Zero out above L * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = 1 ITAUQ = IE + M ITAUP = ITAUQ + M @@ -1101,7 +1131,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NWORK = IE + M @@ -1109,7 +1140,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, computing singular values only * Workspace: need M [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, + $ 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN @@ -1138,7 +1170,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it @@ -1180,10 +1213,12 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, + CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * @@ -1195,7 +1230,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 30 I = 1, N, CHUNK BLK = MIN( N - I + 1, CHUNK ) - CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, + 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, $ A( 1, I ), LDA ) @@ -1219,7 +1255,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it @@ -1261,10 +1298,12 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, + CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -1273,7 +1312,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), + $ LDWRKL, $ A, LDA, ZERO, VT, LDVT ) * ELSE IF( WNTQA ) THEN @@ -1294,7 +1334,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * @@ -1307,7 +1348,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Produce L in A, zeroing out other entries * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M @@ -1317,7 +1359,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -1346,7 +1389,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Q in VT, storing result in A * Workspace: need M*M [VT] * - CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, + CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), + $ LDWKVT, $ VT, LDVT, ZERO, A, LDA ) * * Copy right singular vectors of A from A to VT @@ -1380,7 +1424,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, only computing singular values * Workspace: need 3*M [e, tauq, taup] + BDSPAC * - CALL DBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, + 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') @@ -1437,7 +1482,8 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy right singular vectors of A from WORK(IVT) to A * - CALL DLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) + CALL DLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, + $ LDA ) ELSE * * Path 5to-slow @@ -1456,10 +1502,12 @@ SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N - I + 1, CHUNK ) - CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), + CALL DGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) - CALL DLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, I ), + CALL DLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, + $ I ), $ LDA ) 40 CONTINUE END IF diff --git a/SRC/dgesvd.f b/SRC/dgesvd.f index 4d0049e47f..addc0f37d0 100644 --- a/SRC/dgesvd.f +++ b/SRC/dgesvd.f @@ -245,7 +245,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY, + EXTERNAL DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, + $ DLACPY, $ DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR, $ XERBLA * .. @@ -475,7 +476,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) LWORK_DGELQF = INT( DUM(1) ) * Compute space needed for DORGLQ - CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) LWORK_DORGLQ_N = INT( DUM(1) ) CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) LWORK_DORGLQ_M = INT( DUM(1) ) @@ -685,7 +687,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Compute A=Q*R * (Workspace: need 2*N, prefer N + N*NB) * - CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R @@ -702,7 +705,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N + 2*N*NB) * - CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), + CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) NCVT = 0 @@ -721,7 +725,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in A if desired * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA, + CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, + $ LDA, $ DUM, 1, DUM, 1, WORK( IWORK ), INFO ) * * If right singular vectors desired in VT, copy them there @@ -770,8 +775,10 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Copy R to WORK(IR) and zero 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 DLACPY( 'U', N, N, A, LDA, WORK( IR ), + $ LDWRKR ) + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -787,7 +794,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Bidiagonalize R in WORK(IR) * (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * - CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), + CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -803,7 +811,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of R in WORK(IR) * (Workspace: need N*N + BDSPAC) * - CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1, + CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + $ 1, $ WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) IU = IE + N @@ -814,7 +823,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, ZERO, $ WORK( IU ), LDWRKU ) CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -848,7 +858,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1, + CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + $ 1, $ A, LDA, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -915,7 +926,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) + 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) @@ -936,7 +948,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of R in VT * (Workspace: need N*N + BDSPAC) * - CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT, + CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, + $ LDVT, $ WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) IU = IE + N @@ -947,7 +960,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, ZERO, $ WORK( IU ), LDWRKU ) CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -1010,7 +1024,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in VT * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT, + CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, + $ LDVT, $ A, LDA, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -1085,7 +1100,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of R in WORK(IR) * (Workspace: need N*N + BDSPAC) * - CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), + $ DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) * @@ -1146,7 +1162,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in U * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), + $ DUM, $ 1, U, LDU, DUM, 1, WORK( IWORK ), $ INFO ) * @@ -1309,7 +1326,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate right vectors bidiagonalizing R in A * (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * - CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL DORGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1394,7 +1412,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (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 ), + CALL DORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1463,7 +1482,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate right bidiagonalizing vectors in VT * (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * - CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL DORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1551,7 +1571,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of R in WORK(IR) * (Workspace: need N*N + BDSPAC) * - CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), + $ DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) * @@ -1617,7 +1638,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in U * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), + $ DUM, $ 1, U, LDU, DUM, 1, WORK( IWORK ), $ INFO ) * @@ -1785,7 +1807,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate right bidiagonalizing vectors in A * (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * - CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL DORGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1871,7 +1894,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (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 ), + CALL DORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1944,7 +1968,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate right bidiagonalizing vectors in VT * (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * - CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL DORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -2048,7 +2073,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * vectors in A * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA, + CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) ELSE * @@ -2082,12 +2108,14 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Compute A=L*Q * (Workspace: need 2*M, prefer M + M*NB) * - CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL DGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out above L * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = 1 ITAUQ = IE + M ITAUP = ITAUQ + M @@ -2096,7 +2124,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Bidiagonalize L in A * (Workspace: need 4*M, prefer 3*M + 2*M*NB) * - CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), + CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) IF( WNTUO .OR. WNTUAS ) THEN @@ -2116,7 +2145,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * vectors of A in A if desired * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A, + CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, + $ A, $ LDA, DUM, 1, WORK( IWORK ), INFO ) * * If left singular vectors desired in U, copy them there @@ -2168,7 +2198,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Copy L to WORK(IR) and zero out above it * - CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR ) + CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), + $ LDWRKR ) CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, $ WORK( IR+LDWRKR ), LDWRKR ) * @@ -2185,7 +2216,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Bidiagonalize L in WORK(IR) * (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * - CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ), + CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -2212,7 +2244,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ), + CALL DGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, ZERO, $ WORK( IU ), LDWRKU ) CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2246,7 +2279,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA, + CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, + $ LDA, $ DUM, 1, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -2315,7 +2349,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) + 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) @@ -2347,7 +2382,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ), + CALL DGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, ZERO, $ WORK( IU ), LDWRKU ) CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2409,7 +2445,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA, + CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -2525,7 +2562,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Zero out above L in A * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -2688,7 +2726,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Zero out above L in A * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -2708,7 +2747,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors of L in A * (Workspace: need 4*M, prefer 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2793,7 +2833,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors in U * (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2836,7 +2877,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Copy L to U, zeroing out above it * CALL DLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, + $ 2 ), $ LDU ) IE = ITAU ITAUQ = IE + M @@ -2861,7 +2903,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors in U * (Workspace: need 4*M, prefer 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2991,7 +3034,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Zero out above L in A * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -3159,7 +3203,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Zero out above L in A * - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -3180,7 +3225,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors in A * (Workspace: need 4*M, prefer 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3265,7 +3311,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors in U * (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3312,7 +3359,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Copy L to U, zeroing out above it * CALL DLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, + $ 2 ), $ LDU ) IE = ITAU ITAUQ = IE + M @@ -3337,7 +3385,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Generate left bidiagonalizing vectors in U * (Workspace: need 4*M, prefer 3*M + M*NB) * - CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL DORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3441,7 +3490,8 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * vectors in A * (Workspace: need BDSPAC) * - CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA, + CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) ELSE * @@ -3481,13 +3531,15 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ IERR ) IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM ) - $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ), + $ CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, + $ WORK( 2 ), $ MINMN, IERR ) IF( ANRM.LT.SMLNUM ) $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ IERR ) IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM ) - $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ), + $ CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, + $ WORK( 2 ), $ MINMN, IERR ) END IF * diff --git a/SRC/dgesvdq.f b/SRC/dgesvdq.f index 586c3e4a21..76be486e46 100644 --- a/SRC/dgesvdq.f +++ b/SRC/dgesvdq.f @@ -444,7 +444,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, DOUBLE PRECISION RDUMMY(1) * .. * .. External Subroutines (BLAS, LAPACK) - EXTERNAL DGELQF, DGEQP3, DGEQRF, DGESVD, DLACPY, DLAPMT, + EXTERNAL DGELQF, DGEQP3, DGEQRF, DGESVD, DLACPY, + $ DLAPMT, $ DLASCL, DLASET, DLASWP, DSCAL, DPOCON, DORMLQ, $ DORMQR, XERBLA * .. @@ -676,10 +677,12 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL DGEQRF(N,N/2,U,LDU,RDUMMY,RDUMMY,-1,IERR) LWRK_DGEQRF = INT( RDUMMY(1) ) - CALL DGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + CALL DGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U, + $ LDU, $ V, LDV, RDUMMY, -1, IERR ) LWRK_DGESVD2 = INT( RDUMMY(1) ) - CALL DORMQR( 'R', 'C', N, N, N/2, U, LDU, RDUMMY, + CALL DORMQR( 'R', 'C', N, N, N/2, U, LDU, + $ RDUMMY, $ V, LDV, RDUMMY, -1, IERR ) LWRK_DORMQR2 = INT( RDUMMY(1) ) OPTWRK2 = MAX( LWRK_DGEQP3, N/2+LWRK_DGEQRF, @@ -698,10 +701,12 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL DGELQF(N/2,N,U,LDU,RDUMMY,RDUMMY,-1,IERR) LWRK_DGELQF = INT( RDUMMY(1) ) - CALL DGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + CALL DGESVD( 'S','O', N/2,N/2, V, LDV, S, U, + $ LDU, $ V, LDV, RDUMMY, -1, IERR ) LWRK_DGESVD2 = INT( RDUMMY(1) ) - CALL DORMLQ( 'R', 'N', N, N, N/2, U, LDU, RDUMMY, + CALL DORMLQ( 'R', 'N', N, N, N/2, U, LDU, + $ RDUMMY, $ V, LDV, RDUMMY,-1,IERR ) LWRK_DORMLQ = INT( RDUMMY(1) ) OPTWRK2 = MAX( LWRK_DGEQP3, N/2+LWRK_DGELQF, @@ -801,7 +806,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RWORK(1) .GT. BIG / SQRT(DBLE(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL DLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + CALL DLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF CALL DLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) @@ -823,7 +829,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RTMP .GT. BIG / SQRT(DBLE(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL DLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + CALL DLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF END IF @@ -991,7 +998,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [U] and overwrite [U] with the left singular vectors CALL DLACPY( 'U', NR, N, A, LDA, U, LDU ) IF ( NR .GT. 1 ) - $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), LDU ) + $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), + $ LDU ) * .. the right singular vectors not computed, the NR left singular * vectors overwrite [U](1:NR,1:NR) CALL DGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, @@ -1082,7 +1090,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into V and overwrite V with the right singular vectors CALL DLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), LDV ) + $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), + $ LDV ) * .. the right singular vectors overwrite V, the NR left singular * vectors stored in U(1:NR,1:NR) IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1154,9 +1163,11 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1117 CONTINUE * IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1207,7 +1218,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL DLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1), + $ LDU) CALL DLASET('A',M-N,N1-N,ZERO,ONE, $ U(N+1,N+1), LDU ) END IF @@ -1234,7 +1246,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V,LDV, WORK(N+NR+1),LWORK-N-NR, INFO ) CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) CALL DORMQR('R','C', N, N, NR, U(1,NR+1), LDU, $ WORK(N+1),V,LDV,WORK(N+NR+1),LWORK-N-NR,IERR) CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1243,7 +1256,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL DLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) IF ( NR .LT. N1 ) THEN - CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1),LDU) END IF @@ -1269,9 +1283,11 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1305,7 +1321,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL DLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1), + $ LDU) CALL DLASET( 'A',M-N,N1-N,ZERO,ONE, $ U(N+1,N+1), LDU ) END IF @@ -1323,7 +1340,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V, LDV, WORK(N+NR+1), LWORK-N-NR, INFO ) CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) CALL DORMLQ('R','N',N,N,NR,U(NR+1,1),LDU,WORK(N+1), $ V, LDV, WORK(N+NR+1),LWORK-N-NR,IERR) CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1332,7 +1350,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL DLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) IF ( NR .LT. N1 ) THEN - CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1365,7 +1384,8 @@ SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * * .. if numerical rank deficiency is detected, the truncated * singular values are set to zero. - IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) + IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), + $ N ) * .. undo scaling; this may cause overflow in the largest singular * values. IF ( ASCALED ) diff --git a/SRC/dgesvdx.f b/SRC/dgesvdx.f index d5caea0a4d..cb167b2be7 100644 --- a/SRC/dgesvdx.f +++ b/SRC/dgesvdx.f @@ -295,7 +295,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DBDSVDX, DGEBRD, DGELQF, DGEQRF, DLACPY, + EXTERNAL DBDSVDX, DGEBRD, DGELQF, DGEQRF, + $ DLACPY, $ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, $ DCOPY, XERBLA * .. @@ -385,7 +386,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MAXWRK = 1 IF( MINMN.GT.0 ) THEN IF( M.GE.N ) THEN - MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( M.GE.MNTHR ) THEN * * Path 1 (M much larger than N) @@ -420,7 +422,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE - MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( N.GE.MNTHR ) THEN * * Path 1t (N much larger than M) @@ -542,8 +545,10 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, ITAUP = ITAUQ + N ITEMP = ITAUP + N CALL DLACPY( 'U', N, N, A, LDA, WORK( IQRF ), N ) - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IQRF+1 ), N ) - CALL DGEBRD( N, N, WORK( IQRF ), N, WORK( ID ), WORK( IE ), + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IQRF+1 ), + $ N ) + CALL DGEBRD( N, N, WORK( IQRF ), N, WORK( ID ), + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) * @@ -552,7 +557,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + N*(N*2+1) - CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), WORK( IE ), + CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ N*2, WORK( ITEMP ), IWORK, INFO) * @@ -564,7 +570,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, NS, 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) @@ -621,7 +628,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + N*(N*2+1) - CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), WORK( IE ), + CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ N*2, WORK( ITEMP ), IWORK, INFO) * @@ -633,7 +641,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, NS, 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) @@ -690,8 +699,10 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, ITAUP = ITAUQ + M ITEMP = ITAUP + M CALL DLACPY( 'L', M, M, A, LDA, WORK( ILQF ), M ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( ILQF+M ), M ) - CALL DGEBRD( M, M, WORK( ILQF ), M, WORK( ID ), WORK( IE ), + CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( ILQF+M ), + $ M ) + CALL DGEBRD( M, M, WORK( ILQF ), M, WORK( ID ), + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) * @@ -700,7 +711,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + M*(M*2+1) - CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, WORK( ID ), WORK( IE ), + CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ M*2, WORK( ITEMP ), IWORK, INFO) * @@ -729,7 +741,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', NS, 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) @@ -769,7 +782,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + M*(M*2+1) - CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, WORK( ID ), WORK( IE ), + CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ M*2, WORK( ITEMP ), IWORK, INFO) * @@ -798,7 +812,8 @@ SUBROUTINE DGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', NS, 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/SRC/dgesvj.f b/SRC/dgesvj.f index 319bb29cf5..c550c259c3 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -424,9 +424,13 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN + ELSE IF( .NOT.( LSVEC .OR. + $ UCTOL .OR. + $ LSAME( JOBU, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( RSVEC .OR. + $ APPLV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -782,11 +786,13 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( UPPER ) THEN * * - CALL DGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, LDV, + CALL DGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 2, WORK( N+1 ), LWORK-N, $ IERR ) * - CALL DGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, WORK( N4+1 ), + CALL DGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, + $ WORK( N4+1 ), $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV, $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N, $ IERR ) @@ -889,7 +895,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAQQ.GE.ONE ) THEN ROTOK = ( SMALL*AAPP ).LE.AAQQ IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -904,7 +911,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE ROTOK = AAPP.LE.( AAQQ / SMALL ) IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -981,7 +989,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, FASTR( 4 ) = -T*AQOAP WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q )*CS - CALL DROTM( M, A( 1, p ), 1, + CALL DROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL DROTM( MVL, @@ -997,7 +1006,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q ) / CS IF( RSVEC ) THEN - CALL DAXPY( MVL, -T*AQOAP, + CALL DAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL DAXPY( MVL, @@ -1011,13 +1021,15 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL DAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL DAXPY( M, -CS*SN*AQOAP, + CALL DAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) WORK( p ) = WORK( p ) / CS WORK( q ) = WORK( q )*CS IF( RSVEC ) THEN - CALL DAXPY( MVL, T*APOAQ, + CALL DAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL DAXPY( MVL, @@ -1031,7 +1043,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL DAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL DAXPY( M, CS*SN*APOAQ, + CALL DAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) WORK( p ) = WORK( p )*CS @@ -1074,15 +1087,19 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * .. have to use modified Gram-Schmidt like transformation CALL DCOPY( M, A( 1, p ), 1, $ WORK( N+1 ), 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL DLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK( N+1 ), LDA, $ IERR ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) TEMP1 = -AAPQ*WORK( p ) / WORK( q ) - CALL DAXPY( M, TEMP1, WORK( N+1 ), 1, + CALL DAXPY( M, TEMP1, WORK( N+1 ), + $ 1, $ A( 1, q ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL DLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) @@ -1097,7 +1114,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DNRM2( M, A( 1, q ), 1 )* + SVA( q ) = DNRM2( M, A( 1, q ), + $ 1 )* $ WORK( q ) ELSE T = ZERO @@ -1196,7 +1214,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -1215,7 +1234,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -1287,7 +1307,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, FASTR( 4 ) = -T*AQOAP WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q )*CS - CALL DROTM( M, A( 1, p ), 1, + CALL DROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL DROTM( MVL, @@ -1301,7 +1322,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, -T*AQOAP, + CALL DAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL DAXPY( MVL, @@ -1317,11 +1339,13 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL DAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL DAXPY( M, -CS*SN*AQOAP, + CALL DAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, T*APOAQ, + CALL DAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL DAXPY( MVL, @@ -1337,7 +1361,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL DAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL DAXPY( M, CS*SN*APOAQ, + CALL DAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) WORK( p ) = WORK( p )*CS @@ -1380,16 +1405,20 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAPP.GT.AAQQ ) THEN CALL DCOPY( M, A( 1, p ), 1, $ WORK( N+1 ), 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK( N+1 ), LDA, $ IERR ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*WORK( p ) / WORK( q ) - CALL DAXPY( M, TEMP1, WORK( N+1 ), + CALL DAXPY( M, TEMP1, + $ WORK( N+1 ), $ 1, A( 1, q ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAQQ, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*DSQRT( MAX( ZERO, @@ -1398,16 +1427,20 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE CALL DCOPY( M, A( 1, q ), 1, $ WORK( N+1 ), 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK( N+1 ), LDA, $ IERR ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*WORK( q ) / WORK( p ) - CALL DAXPY( M, TEMP1, WORK( N+1 ), + CALL DAXPY( M, TEMP1, + $ WORK( N+1 ), $ 1, A( 1, p ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAPP, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*DSQRT( MAX( ZERO, @@ -1423,7 +1456,8 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DNRM2( M, A( 1, q ), 1 )* + SVA( q ) = DNRM2( M, A( 1, q ), + $ 1 )* $ WORK( q ) ELSE T = ZERO diff --git a/SRC/dgesvx.f b/SRC/dgesvx.f index 54f4f4e11a..e9b3fe4a94 100644 --- a/SRC/dgesvx.f +++ b/SRC/dgesvx.f @@ -344,7 +344,8 @@ *> \ingroup gesvx * * ===================================================================== - SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -383,7 +384,8 @@ SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EXTERNAL LSAME, DLAMCH, DLANGE, DLANTR * .. * .. External Subroutines .. - EXTERNAL DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, DLACPY, + EXTERNAL DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, + $ DLACPY, $ DLAQGE, XERBLA * .. * .. Intrinsic Functions .. @@ -408,7 +410,9 @@ SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -474,7 +478,8 @@ SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) + CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -549,7 +554,8 @@ SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute the reciprocal of the condition number of A. * - CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/dgesvxx.f b/SRC/dgesvxx.f index 3c3cb0c45f..b3b2b15196 100644 --- a/SRC/dgesvxx.f +++ b/SRC/dgesvxx.f @@ -533,7 +533,8 @@ *> \ingroup gesvxx * * ===================================================================== - SUBROUTINE DGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE DGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, @@ -584,7 +585,8 @@ SUBROUTINE DGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, DOUBLE PRECISION DLAMCH, DLA_GERPVGRW * .. * .. External Subroutines .. - EXTERNAL DGEEQUB, DGETRF, DGETRS, DLACPY, DLAQGE, + EXTERNAL DGEEQUB, DGETRF, DGETRS, DLACPY, + $ DLAQGE, $ XERBLA, DLASCL2, DGERFSX * .. * .. Intrinsic Functions .. diff --git a/SRC/dgetf2.f b/SRC/dgetf2.f index 121a73430b..8d7c375729 100644 --- a/SRC/dgetf2.f +++ b/SRC/dgetf2.f @@ -200,7 +200,8 @@ SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) * * Update trailing submatrix. * - CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA, + CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), + $ LDA, $ A( J+1, J+1 ), LDA ) END IF 10 CONTINUE diff --git a/SRC/dgetrf.f b/SRC/dgetrf.f index 68222fb8b9..61dfbbd24b 100644 --- a/SRC/dgetrf.f +++ b/SRC/dgetrf.f @@ -129,7 +129,8 @@ SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) INTEGER I, IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL DGEMM, DGETRF2, DLASWP, DTRSM, XERBLA + EXTERNAL DGEMM, DGETRF2, DLASWP, DTRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -178,7 +179,8 @@ SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * Factor diagonal and subdiagonal blocks and test for exact * singularity. * - CALL DGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) + CALL DGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), + $ IINFO ) * * Adjust INFO and the pivot indices. * @@ -201,14 +203,16 @@ SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * * Compute block row of U. * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL DGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/dgetri.f b/SRC/dgetri.f index 92a4247795..a46743af2b 100644 --- a/SRC/dgetri.f +++ b/SRC/dgetri.f @@ -141,7 +141,8 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL ILAENV * .. * .. External Subroutines .. - EXTERNAL DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, XERBLA + EXTERNAL DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -188,7 +189,8 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = MAX( LDWORK*NB, 1 ) IF( LWORK.LT.IWS ) THEN NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, + $ -1 ) ) END IF ELSE IWS = N @@ -239,7 +241,8 @@ SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL DGEMM( 'No transpose', 'No transpose', N, JB, $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) - CALL DTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB, + CALL DTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ JB, $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 50 CONTINUE END IF diff --git a/SRC/dgetrs.f b/SRC/dgetrs.f index c03e3bcd33..6bae94cba2 100644 --- a/SRC/dgetrs.f +++ b/SRC/dgetrs.f @@ -190,7 +190,8 @@ SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -203,12 +204,14 @@ SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve U**T *X = B, overwriting B with X. * - CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, + CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve L**T *X = B, overwriting B with X. * - CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE, + CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, + $ ONE, $ A, LDA, B, LDB ) * * Apply row interchanges to the solution vectors. diff --git a/SRC/dgetsqrhrt.f b/SRC/dgetsqrhrt.f index 53734796f5..e475174ca8 100644 --- a/SRC/dgetsqrhrt.f +++ b/SRC/dgetsqrhrt.f @@ -178,7 +178,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, + SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, + $ WORK, $ LWORK, INFO ) IMPLICIT NONE * @@ -205,7 +206,8 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, $ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLATSQR, DORGTSQR_ROW, DORHR_COL, + EXTERNAL DCOPY, DLATSQR, DORGTSQR_ROW, + $ DORHR_COL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -342,7 +344,8 @@ SUBROUTINE DGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, A( I, J ) = -ONE * WORK( LWT+N*(J-1)+I ) END DO ELSE - CALL DCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), LDA ) + CALL DCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), + $ LDA ) END IF END DO * diff --git a/SRC/dggbak.f b/SRC/dggbak.f index 1779a3537f..dcd2167ff0 100644 --- a/SRC/dggbak.f +++ b/SRC/dggbak.f @@ -143,7 +143,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, + SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, + $ V, $ LDV, INFO ) * * -- LAPACK computational routine -- @@ -182,8 +183,10 @@ SUBROUTINE DGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/dggbal.f b/SRC/dggbal.f index 8dff4d2dfa..cb01d1608f 100644 --- a/SRC/dggbal.f +++ b/SRC/dggbal.f @@ -222,8 +222,10 @@ SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -502,8 +504,10 @@ SUBROUTINE DGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, IF( CMAX.LT.HALF ) $ GO TO 350 * - CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 ) - CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 ) + CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), + $ 1 ) + CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), + $ 1 ) * PGAMMA = GAMMA IT = IT + 1 diff --git a/SRC/dgges.f b/SRC/dgges.f index fa97ec1f03..3ee4aabc98 100644 --- a/SRC/dgges.f +++ b/SRC/dgges.f @@ -279,7 +279,8 @@ *> \ingroup gges * * ===================================================================== - SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, + SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, + $ LDB, $ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, $ LDVSR, WORK, LWORK, BWORK, INFO ) * @@ -322,7 +323,8 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. @@ -370,7 +372,8 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -400,7 +403,8 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, $ N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, -1 ) ) IF( ILVSL ) THEN MAXWRK = MAX( MAXWRK, MINWRK - N + - $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) ) + $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, + $ -1 ) ) END IF ELSE MINWRK = 1 @@ -545,15 +549,18 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, $ IERR ) END IF IF( ILBSCL ) - $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * - CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR, + CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHAR, $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, $ IERR ) @@ -617,8 +624,10 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * IF( ILASCL ) THEN CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dgges3.f b/SRC/dgges3.f index b6b2c29c68..62b03d7d90 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -322,7 +322,8 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. @@ -375,7 +376,8 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -551,15 +553,18 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, $ IERR ) END IF IF( ILBSCL ) - $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * - CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR, + CALL DTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHAR, $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, $ IERR ) @@ -622,8 +627,10 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( ILASCL ) THEN CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dggesx.f b/SRC/dggesx.f index d66aa0b827..e2425412e3 100644 --- a/SRC/dggesx.f +++ b/SRC/dggesx.f @@ -359,7 +359,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, + SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, + $ LDA, $ B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, $ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK, $ LIWORK, BWORK, INFO ) @@ -406,7 +407,8 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. @@ -467,7 +469,8 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -661,12 +664,14 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, $ IERR ) END IF IF( ILBSCL ) - $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL DLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * * Reorder eigenvalues, transform Generalized Schur vectors, and @@ -754,8 +759,10 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, * IF( ILASCL ) THEN CALL DLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dggev.f b/SRC/dggev.f index 961b503a2d..92c2159c9b 100644 --- a/SRC/dggev.f +++ b/SRC/dggev.f @@ -222,7 +222,8 @@ *> \ingroup ggev * * ===================================================================== - SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, + SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) * * -- LAPACK driver routine -- @@ -258,7 +259,8 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA * .. * .. External Functions .. @@ -488,7 +490,8 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, ELSE CHTEMP = 'R' END IF - CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), IERR ) IF( IERR.NE.0 ) THEN INFO = N + 2 @@ -572,8 +575,10 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, 110 CONTINUE * IF( ILASCL ) THEN - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dggev3.f b/SRC/dggev3.f index 44e616a031..fed1c66696 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -260,7 +260,8 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA * .. * .. External Functions .. @@ -498,7 +499,8 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ELSE CHTEMP = 'R' END IF - CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL DTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), IERR ) IF( IERR.NE.0 ) THEN INFO = N + 2 @@ -581,8 +583,10 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, 110 CONTINUE * IF( ILASCL ) THEN - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dggevx.f b/SRC/dggevx.f index e41e4df599..cf11ca72d8 100644 --- a/SRC/dggevx.f +++ b/SRC/dggevx.f @@ -385,7 +385,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, + SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO, $ IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, $ RCONDV, WORK, LWORK, IWORK, BWORK, INFO ) @@ -428,7 +429,8 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, + $ DLACPY, $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, DTGSNA, $ XERBLA * .. @@ -479,7 +481,9 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, INFO = 0 LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, - $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) + $ 'S' ) .OR. + $ LSAME( BALANC, 'P' ) .OR. + $ LSAME( BALANC, 'B' ) ) ) $ THEN INFO = -1 ELSE IF( IJOBVL.LE.0 ) THEN @@ -527,12 +531,15 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF MAXWRK = MINWRK MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'DGEQRF', ' ', N, 1, N, + $ 0 ) ) MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'DORMQR', ' ', N, 1, N, + $ 0 ) ) IF( ILVL ) THEN MAXWRK = MAX( MAXWRK, N + - $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, 0 ) ) + $ N*ILAENV( 1, 'DORGQR', ' ', N, 1, N, + $ 0 ) ) END IF END IF WORK( 1 ) = MAXWRK @@ -594,7 +601,8 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * Permute and/or balance the matrix pair (A,B) * (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) * - CALL DGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, + CALL DGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, + $ RSCALE, $ WORK, IERR ) * * Compute ABNRM and BBNRM @@ -779,7 +787,8 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * (Workspace: none needed) * IF( ILVL ) THEN - CALL DGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL, + CALL DGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, + $ VL, $ LDVL, IERR ) * DO 70 JC = 1, N @@ -812,7 +821,8 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, 70 CONTINUE END IF IF( ILVR ) THEN - CALL DGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR, + CALL DGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, + $ VR, $ LDVR, IERR ) DO 120 JC = 1, N IF( ALPHAI( JC ).LT.ZERO ) @@ -849,8 +859,10 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, 130 CONTINUE * IF( ILASCL ) THEN - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL DLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/dggglm.f b/SRC/dggglm.f index 6b13fdb6bb..14ac002af5 100644 --- a/SRC/dggglm.f +++ b/SRC/dggglm.f @@ -181,7 +181,8 @@ *> \ingroup ggglm * * ===================================================================== - SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, + SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -208,7 +209,8 @@ SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, $ NB4, NP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DGGQRF, DORMQR, DORMRQ, DTRTRS, + EXTERNAL DCOPY, DGEMV, DGGQRF, DORMQR, DORMRQ, + $ DTRTRS, $ XERBLA * .. * .. External Functions .. @@ -326,7 +328,8 @@ SUBROUTINE DGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * Solve triangular system: R11*x = d1 * IF( M.GT.0 ) THEN - CALL DTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA, + CALL DTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, + $ LDA, $ D, M, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f index 345e24d263..54979efd17 100644 --- a/SRC/dgghd3.f +++ b/SRC/dgghd3.f @@ -226,7 +226,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -264,7 +265,8 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. - EXTERNAL DGGHRD, DLARTG, DLASET, DORM22, DROT, DGEMM, + EXTERNAL DGGHRD, DLARTG, DLASET, DORM22, DROT, + $ DGEMM, $ DGEMV, DTRMV, DLACPY, XERBLA * .. * .. Intrinsic Functions .. @@ -388,7 +390,8 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * N2NB = ( IHI-JCOL-1 ) / NNB - 1 NBLST = IHI - JCOL - N2NB*NNB - CALL DLASET( 'All', NBLST, NBLST, ZERO, ONE, WORK, NBLST ) + CALL DLASET( 'All', NBLST, NBLST, ZERO, ONE, WORK, + $ NBLST ) PW = NBLST * NBLST + 1 DO I = 1, N2NB CALL DLASET( 'All', 2*NNB, 2*NNB, ZERO, ONE, @@ -585,10 +588,12 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, WORK( PPW ) = A( I, J+1 ) PPW = PPW + 1 END DO - CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', LEN, + CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', + $ LEN, $ WORK( PPWO + NNB ), 2*NNB, WORK( PW ), $ 1 ) - CALL DTRMV( 'Lower', 'Transpose', 'Non-unit', NNB, + CALL DTRMV( 'Lower', 'Transpose', 'Non-unit', + $ NNB, $ WORK( PPWO + 2*LEN*NNB ), $ 2*NNB, WORK( PW + LEN ), 1 ) CALL DGEMV( 'Transpose', NNB, LEN, ONE, @@ -777,7 +782,8 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL DORM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL DORM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ A( 1, J ), LDA, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -808,7 +814,8 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL DORM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL DORM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ B( 1, J ), LDB, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -888,7 +895,8 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END IF * IF ( JCOL.LT.IHI ) - $ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, + $ CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, IERR ) * WORK( 1 ) = DBLE( LWKOPT ) diff --git a/SRC/dgghrd.f b/SRC/dgghrd.f index d4936fbefc..6013910b17 100644 --- a/SRC/dgghrd.f +++ b/SRC/dgghrd.f @@ -203,7 +203,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, INFO ) * * -- LAPACK computational routine -- @@ -336,7 +337,8 @@ SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL DROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB, $ B( JROW, JROW-1 ), LDB, C, S ) IF( ILQ ) - $ CALL DROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S ) + $ CALL DROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, + $ S ) * * Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1) * @@ -344,11 +346,13 @@ SUBROUTINE DGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL DLARTG( TEMP, B( JROW, JROW-1 ), C, S, $ B( JROW, JROW ) ) B( JROW, JROW-1 ) = ZERO - CALL DROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S ) + CALL DROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, + $ S ) CALL DROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C, $ S ) IF( ILZ ) - $ CALL DROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S ) + $ CALL DROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, + $ S ) 30 CONTINUE 40 CONTINUE * diff --git a/SRC/dgglse.f b/SRC/dgglse.f index b46eab5201..a310da7579 100644 --- a/SRC/dgglse.f +++ b/SRC/dgglse.f @@ -176,7 +176,8 @@ *> \ingroup gglse * * ===================================================================== - SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, + SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -203,7 +204,8 @@ SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, $ NB4, NR * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGEMV, DGGRQF, DORMQR, DORMRQ, + EXTERNAL DAXPY, DCOPY, DGEMV, DGGRQF, DORMQR, + $ DORMRQ, $ DTRMV, DTRTRS, XERBLA * .. * .. External Functions .. @@ -282,7 +284,8 @@ SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * Update c = Z**T *c = ( c1 ) N-P * ( c2 ) M+P-N * - CALL DORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, WORK( P+1 ), + CALL DORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, + $ WORK( P+1 ), $ C, MAX( 1, M ), WORK( P+MN+1 ), LWORK-P-MN, INFO ) LOPT = MAX( LOPT, INT( WORK( P+MN+1 ) ) ) * @@ -303,7 +306,8 @@ SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Update c1 * - CALL DGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), LDA, + CALL DGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), + $ LDA, $ D, 1, ONE, C, 1 ) END IF * @@ -328,7 +332,8 @@ SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, IF( M.LT.N ) THEN NR = M + P - N IF( NR.GT.0 ) - $ CALL DGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, M+1 ), + $ CALL DGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, + $ M+1 ), $ LDA, D( NR+1 ), 1, ONE, C( N-P+1 ), 1 ) ELSE NR = P @@ -341,7 +346,8 @@ SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Backward transformation x = Q**T*x * - CALL DORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), X, + CALL DORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), + $ X, $ N, WORK( P+MN+1 ), LWORK-P-MN, INFO ) WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) * diff --git a/SRC/dggqrf.f b/SRC/dggqrf.f index 43bf3be1d6..d866252f2b 100644 --- a/SRC/dggqrf.f +++ b/SRC/dggqrf.f @@ -281,7 +281,8 @@ SUBROUTINE DGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * * Update B := Q**T*B. * - CALL DORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, TAUA, + CALL DORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, + $ TAUA, $ B, LDB, WORK, LWORK, INFO ) LOPT = MAX( LOPT, INT( WORK( 1 ) ) ) * diff --git a/SRC/dggsvd3.f b/SRC/dggsvd3.f index 038caa51d1..e7a292886e 100644 --- a/SRC/dggsvd3.f +++ b/SRC/dggsvd3.f @@ -424,7 +424,8 @@ SUBROUTINE DGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK, $ WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/SRC/dggsvp3.f b/SRC/dggsvp3.f index 8672d694a0..b83fd761b7 100644 --- a/SRC/dggsvp3.f +++ b/SRC/dggsvp3.f @@ -304,7 +304,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DGEQP3, DGEQR2, DGERQ2, DLACPY, DLAPMT, + EXTERNAL DGEQP3, DGEQR2, DGERQ2, DLACPY, + $ DLAPMT, $ DLASET, DORG2R, DORM2R, DORMR2, XERBLA * .. * .. Intrinsic Functions .. @@ -441,7 +442,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, + CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, $ LDQ, WORK, INFO ) END IF * @@ -488,7 +490,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL DLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), + $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, + $ 1 ), $ LDU ) CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF @@ -509,7 +512,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -521,7 +525,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, + CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, $ Q, LDQ, WORK, INFO ) END IF * @@ -546,7 +551,8 @@ SUBROUTINE DGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), + CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, + $ L ), $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, $ WORK, INFO ) END IF diff --git a/SRC/dgsvj0.f b/SRC/dgsvj0.f index 5ea44afaf6..bac1e85343 100644 --- a/SRC/dgsvj0.f +++ b/SRC/dgsvj0.f @@ -260,7 +260,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, EXTERNAL IDAMAX, LSAME, DDOT, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP, + EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, + $ DSWAP, $ XERBLA * .. * .. Executable Statements .. @@ -425,12 +426,15 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( AAQQ.GE.ONE ) THEN ROTOK = ( SMALL*AAPP ).LE.AAQQ IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, D( p ), + CALL DCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -438,12 +442,15 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ELSE ROTOK = AAPP.LE.( AAQQ / SMALL ) IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL DCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -512,7 +519,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL DROTM( M, A( 1, p ), 1, + CALL DROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL DROTM( MVL, @@ -528,7 +536,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, D( p ) = D( p )*CS D( q ) = D( q ) / CS IF( RSVEC ) THEN - CALL DAXPY( MVL, -T*AQOAP, + CALL DAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL DAXPY( MVL, @@ -542,13 +551,15 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL DAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL DAXPY( M, -CS*SN*AQOAP, + CALL DAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) D( p ) = D( p ) / CS D( q ) = D( q )*CS IF( RSVEC ) THEN - CALL DAXPY( MVL, T*APOAQ, + CALL DAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL DAXPY( MVL, @@ -561,7 +572,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL DAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL DAXPY( M, CS*SN*APOAQ, + CALL DAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -602,15 +614,19 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * ELSE * .. have to use modified Gram-Schmidt like transformation - CALL DCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL DCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL DAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL DLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) @@ -624,7 +640,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DNRM2( M, A( 1, q ), 1 )* + SVA( q ) = DNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO @@ -725,12 +742,15 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, D( p ), + CALL DCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -742,12 +762,15 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL DCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -811,7 +834,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL DROTM( M, A( 1, p ), 1, + CALL DROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL DROTM( MVL, @@ -825,7 +849,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, -T*AQOAP, + CALL DAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL DAXPY( MVL, @@ -841,11 +866,13 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL DAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL DAXPY( M, -CS*SN*AQOAP, + CALL DAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, T*APOAQ, + CALL DAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL DAXPY( MVL, @@ -860,7 +887,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL DAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL DAXPY( M, CS*SN*APOAQ, + CALL DAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -901,34 +929,42 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * ELSE IF( AAPP.GT.AAQQ ) THEN - CALL DCOPY( M, A( 1, p ), 1, WORK, + CALL DCOPY( M, A( 1, p ), 1, + $ WORK, $ 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL DAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAQQ, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) MXSINJ = MAX( MXSINJ, SFMIN ) ELSE - CALL DCOPY( M, A( 1, q ), 1, WORK, + CALL DCOPY( M, A( 1, q ), 1, + $ WORK, $ 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*D( q ) / D( p ) CALL DAXPY( M, TEMP1, WORK, 1, $ A( 1, p ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAPP, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*DSQRT( MAX( ZERO, @@ -944,7 +980,8 @@ SUBROUTINE DGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DNRM2( M, A( 1, q ), 1 )* + SVA( q ) = DNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO diff --git a/SRC/dgsvj1.f b/SRC/dgsvj1.f index 8e22c53cc6..8ecbf23a09 100644 --- a/SRC/dgsvj1.f +++ b/SRC/dgsvj1.f @@ -278,7 +278,8 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, EXTERNAL IDAMAX, LSAME, DDOT, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, DSWAP, + EXTERNAL DAXPY, DCOPY, DLASCL, DLASSQ, DROTM, + $ DSWAP, $ XERBLA * .. * .. Executable Statements .. @@ -424,12 +425,15 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, D( p ), + CALL DCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -441,12 +445,15 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( DDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( DDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL DCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL DCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL DLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = DDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -510,7 +517,8 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL DROTM( M, A( 1, p ), 1, + CALL DROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL DROTM( MVL, @@ -524,7 +532,8 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, -T*AQOAP, + CALL DAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL DAXPY( MVL, @@ -540,11 +549,13 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, CALL DAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL DAXPY( M, -CS*SN*AQOAP, + CALL DAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL DAXPY( MVL, T*APOAQ, + CALL DAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL DAXPY( MVL, @@ -559,7 +570,8 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, CALL DAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL DAXPY( M, CS*SN*APOAQ, + CALL DAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -600,34 +612,42 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ELSE IF( AAPP.GT.AAQQ ) THEN - CALL DCOPY( M, A( 1, p ), 1, WORK, + CALL DCOPY( M, A( 1, p ), 1, + $ WORK, $ 1 ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL DAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAQQ, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) MXSINJ = MAX( MXSINJ, SFMIN ) ELSE - CALL DCOPY( M, A( 1, q ), 1, WORK, + CALL DCOPY( M, A( 1, q ), 1, + $ WORK, $ 1 ) - CALL DLASCL( 'G', 0, 0, AAQQ, ONE, + CALL DLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL DLASCL( 'G', 0, 0, AAPP, ONE, + CALL DLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*D( q ) / D( p ) CALL DAXPY( M, TEMP1, WORK, 1, $ A( 1, p ), 1 ) - CALL DLASCL( 'G', 0, 0, ONE, AAPP, + CALL DLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*DSQRT( MAX( ZERO, @@ -643,7 +663,8 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DNRM2( M, A( 1, q ), 1 )* + SVA( q ) = DNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO diff --git a/SRC/dgtcon.f b/SRC/dgtcon.f index ef5ad2089e..eda89a82da 100644 --- a/SRC/dgtcon.f +++ b/SRC/dgtcon.f @@ -235,7 +235,8 @@ SUBROUTINE DGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, * * Multiply by inv(L**T)*inv(U**T). * - CALL DGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK, + CALL DGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, + $ WORK, $ N, INFO ) END IF GO TO 20 diff --git a/SRC/dgtrfs.f b/SRC/dgtrfs.f index 05765004e2..36bd6af34f 100644 --- a/SRC/dgtrfs.f +++ b/SRC/dgtrfs.f @@ -204,7 +204,8 @@ *> \ingroup gtrfs * * ===================================================================== - SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + $ DU2, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, $ INFO ) * @@ -245,7 +246,8 @@ SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGTTRS, DLACN2, DLAGTM, XERBLA + EXTERNAL DAXPY, DCOPY, DGTTRS, DLACN2, DLAGTM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -318,7 +320,8 @@ SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL DLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE, + CALL DLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, + $ ONE, $ WORK( N+1 ), N ) * * Compute abs(op(A))*abs(x) + abs(b) for use in the backward @@ -429,7 +432,8 @@ SUBROUTINE DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * KASE = 0 70 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/dgtsvx.f b/SRC/dgtsvx.f index 510dc7b9ef..76882f1301 100644 --- a/SRC/dgtsvx.f +++ b/SRC/dgtsvx.f @@ -288,7 +288,8 @@ *> \ingroup gtsvx * * ===================================================================== - SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, + $ DUF, $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -325,7 +326,8 @@ SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, EXTERNAL LSAME, DLAMCH, DLANGT * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGTCON, DGTRFS, DGTTRF, DGTTRS, DLACPY, + EXTERNAL DCOPY, DGTCON, DGTRFS, DGTTRF, DGTTRS, + $ DLACPY, $ XERBLA * .. * .. Intrinsic Functions .. @@ -385,7 +387,8 @@ SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * * Compute the reciprocal of the condition number of A. * - CALL DGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK, + CALL DGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, + $ WORK, $ IWORK, INFO ) * * Compute the solution vectors X. @@ -397,7 +400,8 @@ SUBROUTINE DGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, + CALL DGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/dgttrs.f b/SRC/dgttrs.f index 1b6243e027..221d2548a0 100644 --- a/SRC/dgttrs.f +++ b/SRC/dgttrs.f @@ -134,7 +134,8 @@ *> \ingroup gttrs * * ===================================================================== - SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, + SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -211,7 +212,8 @@ SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, ELSE DO 10 J = 1, NRHS, NB JB = MIN( NRHS-J+1, NB ) - CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), + CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, + $ J ), $ LDB ) 10 CONTINUE END IF diff --git a/SRC/dgtts2.f b/SRC/dgtts2.f index d079fb270d..3ef1c50272 100644 --- a/SRC/dgtts2.f +++ b/SRC/dgtts2.f @@ -125,7 +125,8 @@ *> \ingroup gtts2 * * ===================================================================== - SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) + SUBROUTINE DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dhgeqz.f b/SRC/dhgeqz.f index 23c4fdf133..d745b06020 100644 --- a/SRC/dhgeqz.f +++ b/SRC/dhgeqz.f @@ -299,7 +299,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, + SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, + $ LDT, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * @@ -348,10 +349,12 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, * .. External Functions .. LOGICAL LSAME DOUBLE PRECISION DLAMCH, DLANHS, DLAPY2, DLAPY3 - EXTERNAL LSAME, DLAMCH, DLANHS, DLAPY2, DLAPY3 + EXTERNAL LSAME, DLAMCH, DLANHS, DLAPY2, + $ DLAPY3 * .. * .. External Subroutines .. - EXTERNAL DLAG2, DLARFG, DLARTG, DLASET, DLASV2, DROT, + EXTERNAL DLAG2, DLARFG, DLARTG, DLASET, DLASV2, + $ DROT, $ XERBLA * .. * .. Intrinsic Functions .. @@ -598,7 +601,8 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL DROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT, $ T( JCH+1, JCH+1 ), LDT, C, S ) IF( ILQ ) - $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, S ) IF( ILAZR2 ) $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C @@ -625,12 +629,14 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( JCH, JCH+1 ) ) T( JCH+1, JCH+1 ) = ZERO IF( JCH.LT.ILASTM-1 ) - $ CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT, + $ CALL DROT( ILASTM-JCH-1, T( JCH, JCH+2 ), + $ LDT, $ T( JCH+1, JCH+2 ), LDT, C, S ) CALL DROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH, $ H( JCH+1, JCH-1 ), LDH, C, S ) IF( ILQ ) - $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL DROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, S ) TEMP = H( JCH+1, JCH ) CALL DLARTG( TEMP, H( JCH+1, JCH-1 ), C, S, @@ -641,7 +647,8 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL DROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1, $ T( IFRSTM, JCH-1 ), 1, C, S ) IF( ILZ ) - $ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1, + $ CALL DROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), + $ 1, $ C, S ) 50 CONTINUE GO TO 70 @@ -676,7 +683,8 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL DROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1, $ T( IFRSTM, ILAST-1 ), 1, C, S ) IF( ILZ ) - $ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S ) + $ CALL DROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, + $ S ) * * H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI, * and BETA @@ -908,10 +916,12 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( IFRSTM, ILAST ), 1, CR, SR ) * IF( ILQ ) - $ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL, + $ CALL DROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, + $ CL, $ SL ) IF( ILZ ) - $ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR, + $ CALL DROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, + $ CR, $ SR ) * T( ILAST-1, ILAST-1 ) = B11 diff --git a/SRC/dhsein.f b/SRC/dhsein.f index e9866740a8..8d90d98e0d 100644 --- a/SRC/dhsein.f +++ b/SRC/dhsein.f @@ -258,7 +258,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, + SUBROUTINE DHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, + $ WI, $ VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, $ IFAILR, INFO ) * @@ -458,7 +459,8 @@ SUBROUTINE DHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, * * Compute left eigenvector. * - CALL DLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH, + CALL DLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), + $ LDH, $ WKR, WKI, VL( KL, KSR ), VL( KL, KSI ), $ WORK, LDWORK, WORK( N*N+N+1 ), EPS3, SMLNUM, $ BIGNUM, IINFO ) diff --git a/SRC/dhseqr.f b/SRC/dhseqr.f index 2898061c2e..4a7f8b35e6 100644 --- a/SRC/dhseqr.f +++ b/SRC/dhseqr.f @@ -362,7 +362,8 @@ SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLAHQR, DLAQR0, DLASET, XERBLA + EXTERNAL DLACPY, DLAHQR, DLAQR0, DLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN @@ -455,13 +456,15 @@ SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * ==== DLAQR0 for big matrices; DLAHQR for small ones ==== * IF( N.GT.NMIN ) THEN - CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO, + CALL DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, + $ ILO, $ IHI, Z, LDZ, WORK, LWORK, INFO ) ELSE * * ==== Small matrix ==== * - CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO, + CALL DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, + $ ILO, $ IHI, Z, LDZ, INFO ) * IF( INFO.GT.0 ) THEN @@ -476,7 +479,8 @@ SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * ==== Larger matrices have enough subdiagonal scratch * . space to call DLAQR0 directly. ==== * - CALL DLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR, + CALL DLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, + $ WR, $ WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO ) * ELSE @@ -488,9 +492,11 @@ SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * CALL DLACPY( 'A', N, N, H, LDH, HL, NL ) HL( N+1, N ) = ZERO - CALL DLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ), + CALL DLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, + $ N+1 ), $ NL ) - CALL DLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR, + CALL DLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, + $ WR, $ WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO ) IF( WANTT .OR. INFO.NE.0 ) $ CALL DLACPY( 'A', N, N, HL, NL, H, LDH ) diff --git a/SRC/dla_gbrcond.f b/SRC/dla_gbrcond.f index 921151c05d..302edd592c 100644 --- a/SRC/dla_gbrcond.f +++ b/SRC/dla_gbrcond.f @@ -165,7 +165,8 @@ *> \ingroup la_gbrcond * * ===================================================================== - DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, + DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, + $ LDAB, $ AFB, LDAFB, IPIV, CMODE, C, $ INFO, WORK, IWORK ) * @@ -295,7 +296,8 @@ DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, CALL DGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, $ IPIV, WORK, N, INFO ) ELSE - CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV, + CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, + $ IPIV, $ WORK, N, INFO ) END IF * @@ -325,7 +327,8 @@ DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, END IF IF ( NOTRANS ) THEN - CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV, + CALL DGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, + $ IPIV, $ WORK, N, INFO ) ELSE CALL DGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, diff --git a/SRC/dla_gbrfsx_extended.f b/SRC/dla_gbrfsx_extended.f index 628a7c1448..a33de3b0a6 100644 --- a/SRC/dla_gbrfsx_extended.f +++ b/SRC/dla_gbrfsx_extended.f @@ -402,7 +402,8 @@ *> \ingroup la_gbrfsx_extended * * ===================================================================== - SUBROUTINE DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + SUBROUTINE DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, $ COLEQU, C, B, LDB, Y, LDY, $ BERR_OUT, N_NORMS, ERR_BNDS_NORM, @@ -467,7 +468,8 @@ SUBROUTINE DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGBTRS, DGBMV, BLAS_DGBMV_X, + EXTERNAL DAXPY, DCOPY, DGBTRS, DGBMV, + $ BLAS_DGBMV_X, $ BLAS_DGBMV2_X, DLA_GBAMV, DLA_WWADDW, DLAMCH, $ CHLA_TRANSTYPE, DLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -532,7 +534,8 @@ SUBROUTINE DLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, ! XXX: RES is no longer needed. CALL DCOPY( N, RES, 1, DY, 1 ) - CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, N, + CALL DGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, + $ N, $ INFO ) * * Calculate relative changes DX_X, DZ_Z and ratios DXRAT, DZRAT. diff --git a/SRC/dla_gerfsx_extended.f b/SRC/dla_gerfsx_extended.f index e482f6f19f..874b908aa7 100644 --- a/SRC/dla_gerfsx_extended.f +++ b/SRC/dla_gerfsx_extended.f @@ -388,7 +388,8 @@ *> \ingroup la_gerfsx_extended * * ===================================================================== - SUBROUTINE DLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, + SUBROUTINE DLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, + $ A, $ LDA, AF, LDAF, IPIV, COLEQU, C, B, $ LDB, Y, LDY, BERR_OUT, N_NORMS, $ ERRS_N, ERRS_C, RES, AYB, DY, @@ -451,7 +452,8 @@ SUBROUTINE DLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGETRS, DGEMV, BLAS_DGEMV_X, + EXTERNAL DAXPY, DCOPY, DGETRS, DGEMV, + $ BLAS_DGEMV_X, $ BLAS_DGEMV2_X, DLA_GEAMV, DLA_WWADDW, DLAMCH, $ CHLA_TRANSTYPE, DLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -501,7 +503,8 @@ SUBROUTINE DLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, * CALL DCOPY( N, B( 1, J ), 1, RES, 1 ) IF ( Y_PREC_STATE .EQ. BASE_RESIDUAL ) THEN - CALL DGEMV( TRANS, N, N, -1.0D+0, A, LDA, Y( 1, J ), 1, + CALL DGEMV( TRANS, N, N, -1.0D+0, A, LDA, Y( 1, J ), + $ 1, $ 1.0D+0, RES, 1 ) ELSE IF ( Y_PREC_STATE .EQ. EXTRA_RESIDUAL ) THEN CALL BLAS_DGEMV_X( TRANS_TYPE, N, N, -1.0D+0, A, LDA, diff --git a/SRC/dla_porcond.f b/SRC/dla_porcond.f index 997cffe14c..0b2af24ffe 100644 --- a/SRC/dla_porcond.f +++ b/SRC/dla_porcond.f @@ -137,7 +137,8 @@ *> \ingroup la_porcond * * ===================================================================== - DOUBLE PRECISION FUNCTION DLA_PORCOND( UPLO, N, A, LDA, AF, LDAF, + DOUBLE PRECISION FUNCTION DLA_PORCOND( UPLO, N, A, LDA, AF, + $ LDAF, $ CMODE, C, INFO, WORK, $ IWORK ) * diff --git a/SRC/dla_porfsx_extended.f b/SRC/dla_porfsx_extended.f index 33e73fa43a..6c16d17562 100644 --- a/SRC/dla_porfsx_extended.f +++ b/SRC/dla_porfsx_extended.f @@ -378,7 +378,8 @@ *> \ingroup la_porfsx_extended * * ===================================================================== - SUBROUTINE DLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE DLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, COLEQU, C, B, LDB, Y, $ LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -447,7 +448,8 @@ SUBROUTINE DLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DPOTRS, DSYMV, BLAS_DSYMV_X, + EXTERNAL DAXPY, DCOPY, DPOTRS, DSYMV, + $ BLAS_DSYMV_X, $ BLAS_DSYMV2_X, DLA_SYAMV, DLA_WWADDW, $ DLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -655,7 +657,8 @@ SUBROUTINE DLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * op(A) = A, A**T, or A**H depending on TRANS (and type). * CALL DCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, RES, + CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, + $ RES, $ 1 ) DO I = 1, N diff --git a/SRC/dla_porpvgrw.f b/SRC/dla_porpvgrw.f index 46b81d1745..2f1681b143 100644 --- a/SRC/dla_porpvgrw.f +++ b/SRC/dla_porpvgrw.f @@ -102,7 +102,8 @@ *> \ingroup la_porpvgrw * * ===================================================================== - DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, + DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, + $ AF, $ LDAF, WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/dla_syrcond.f b/SRC/dla_syrcond.f index bf383056a8..9427122b30 100644 --- a/SRC/dla_syrcond.f +++ b/SRC/dla_syrcond.f @@ -143,7 +143,8 @@ *> \ingroup la_hercond * * ===================================================================== - DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, + DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, + $ LDAF, $ IPIV, CMODE, C, INFO, WORK, $ IWORK ) * @@ -283,9 +284,11 @@ DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, END DO IF ( UP ) THEN - CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ELSE - CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ENDIF * * Multiply by inv(C). @@ -314,9 +317,11 @@ DOUBLE PRECISION FUNCTION DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, END IF IF ( UP ) THEN - CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL DSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ELSE - CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL DSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ENDIF * * Multiply by R. diff --git a/SRC/dla_syrfsx_extended.f b/SRC/dla_syrfsx_extended.f index cbe24023d2..25663970df 100644 --- a/SRC/dla_syrfsx_extended.f +++ b/SRC/dla_syrfsx_extended.f @@ -387,7 +387,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE DLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE DLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -457,7 +458,8 @@ SUBROUTINE DLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DSYTRS, DSYMV, BLAS_DSYMV_X, + EXTERNAL DAXPY, DCOPY, DSYTRS, DSYMV, + $ BLAS_DSYMV_X, $ BLAS_DSYMV2_X, DLA_SYAMV, DLA_WWADDW, $ DLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -684,7 +686,8 @@ SUBROUTINE DLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * Compute residual RES = B_s - op(A_s) * Y, * op(A) = A, A**T, or A**H depending on TRANS (and type). CALL DCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, RES, + CALL DSYMV( UPLO, N, -1.0D+0, A, LDA, Y(1,J), 1, 1.0D+0, + $ RES, $ 1 ) DO I = 1, N diff --git a/SRC/dla_syrpvgrw.f b/SRC/dla_syrpvgrw.f index 64a8875a5e..9be3db416f 100644 --- a/SRC/dla_syrpvgrw.f +++ b/SRC/dla_syrpvgrw.f @@ -118,7 +118,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - DOUBLE PRECISION FUNCTION DLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, + DOUBLE PRECISION FUNCTION DLA_SYRPVGRW( UPLO, N, INFO, A, LDA, + $ AF, $ LDAF, IPIV, WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/dlabrd.f b/SRC/dlabrd.f index 578b7d74f8..5c63b0289a 100644 --- a/SRC/dlabrd.f +++ b/SRC/dlabrd.f @@ -206,7 +206,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, + SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, + $ Y, $ LDY ) * * -- LAPACK auxiliary routine -- @@ -268,11 +269,14 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL DGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ), $ LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA, + CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), + $ LDA, $ A( I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX, + CALL DGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), + $ LDX, $ A( I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL DGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ), $ LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) @@ -294,15 +298,19 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL DGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ), + CALL DGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY, + CALL DGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), + $ LDY, $ A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) CALL DGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) - CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) END IF @@ -317,12 +325,14 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL DGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ), $ LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA ) - CALL DGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA, + CALL DGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), + $ LDA, $ X( I, 1 ), LDX, ONE, A( I, I ), LDA ) * * Generate reflection P(i) to annihilate A(i,i+1:n) * - CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, + CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), + $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) IF( I.LT.M ) THEN @@ -330,28 +340,35 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL DGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ), + CALL DGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY, + CALL DGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), + $ LDY, $ A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL DGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ), + CALL DGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL DGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) * * Update A(i+1:m,i) * - CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL DGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 ) CALL DGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ), $ LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 ) * * Generate reflection Q(i) to annihilate A(i+2:m,i) * - CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1, + CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), + $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE @@ -360,13 +377,17 @@ SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL DGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ), $ LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL DGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL DGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX, + CALL DGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), + $ LDX, $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL DGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA, + CALL DGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), + $ LDA, $ Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 ) END IF diff --git a/SRC/dlaed0.f b/SRC/dlaed0.f index b1ec938a94..57f09131e2 100644 --- a/SRC/dlaed0.f +++ b/SRC/dlaed0.f @@ -198,7 +198,8 @@ SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, DOUBLE PRECISION TEMP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DLACPY, DLAED1, DLAED7, DSTEQR, + EXTERNAL DCOPY, DGEMM, DLACPY, DLAED1, DLAED7, + $ DSTEQR, $ XERBLA * .. * .. External Functions .. @@ -374,7 +375,8 @@ SUBROUTINE DLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, $ E( SUBMAT+MSD2-1 ), MSD2, WORK, $ IWORK( SUBPBS+1 ), INFO ) ELSE - CALL DLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, CURPRB, + CALL DLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, + $ CURPRB, $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS, $ IWORK( INDXQ+SUBMAT ), E( SUBMAT+MSD2-1 ), $ MSD2, WORK( IQ ), IWORK( IQPTR ), diff --git a/SRC/dlaed1.f b/SRC/dlaed1.f index 15926c53a3..8ec033db3c 100644 --- a/SRC/dlaed1.f +++ b/SRC/dlaed1.f @@ -159,7 +159,8 @@ *> Modified by Francoise Tisseur, University of Tennessee *> * ===================================================================== - SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, + SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, + $ IWORK, $ INFO ) * * -- LAPACK computational routine -- @@ -182,7 +183,8 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ IW, IZ, K, N1, N2, ZPP1 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAED2, DLAED3, DLAMRG, XERBLA + EXTERNAL DCOPY, DLAED2, DLAED3, DLAMRG, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -230,7 +232,8 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, * CALL DCOPY( CUTPNT, Q( CUTPNT, 1 ), LDQ, WORK( IZ ), 1 ) ZPP1 = CUTPNT + 1 - CALL DCOPY( N-CUTPNT, Q( ZPP1, ZPP1 ), LDQ, WORK( IZ+CUTPNT ), 1 ) + CALL DCOPY( N-CUTPNT, Q( ZPP1, ZPP1 ), LDQ, WORK( IZ+CUTPNT ), + $ 1 ) * * Deflate eigenvalues. * diff --git a/SRC/dlaed2.f b/SRC/dlaed2.f index 82994f51ab..07a81cf5d6 100644 --- a/SRC/dlaed2.f +++ b/SRC/dlaed2.f @@ -208,7 +208,8 @@ *> Modified by Francoise Tisseur, University of Tennessee *> * ===================================================================== - SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, W, + SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, + $ W, $ Q2, INDX, INDXC, INDXP, COLTYP, INFO ) * * -- LAPACK computational routine -- @@ -247,7 +248,8 @@ SUBROUTINE DLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, W, EXTERNAL IDAMAX, DLAMCH, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, XERBLA + EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT diff --git a/SRC/dlaed3.f b/SRC/dlaed3.f index 2888ff9ae3..db581bec3c 100644 --- a/SRC/dlaed3.f +++ b/SRC/dlaed3.f @@ -205,7 +205,8 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, EXTERNAL DNRM2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DLACPY, DLAED4, DLASET, XERBLA + EXTERNAL DCOPY, DGEMM, DLACPY, DLAED4, DLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, SIGN, SQRT @@ -235,7 +236,8 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, * * DO 20 J = 1, K - CALL DLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), INFO ) + CALL DLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), + $ INFO ) * * If the zero finder fails, the computation is terminated. * @@ -300,7 +302,8 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, CALL DLACPY( 'A', N23, K, Q( CTOT( 1 )+1, 1 ), LDQ, S, N23 ) IQ2 = N1*N12 + 1 IF( N23.NE.0 ) THEN - CALL DGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, N23, + CALL DGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, + $ N23, $ ZERO, Q( N1+1, 1 ), LDQ ) ELSE CALL DLASET( 'A', N2, K, ZERO, ZERO, Q( N1+1, 1 ), LDQ ) @@ -308,7 +311,8 @@ SUBROUTINE DLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, * CALL DLACPY( 'A', N12, K, Q, LDQ, S, N12 ) IF( N12.NE.0 ) THEN - CALL DGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, Q, + CALL DGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, + $ Q, $ LDQ ) ELSE CALL DLASET( 'A', N1, K, ZERO, ZERO, Q( 1, 1 ), LDQ ) diff --git a/SRC/dlaed4.f b/SRC/dlaed4.f index 84b44d22d6..b4d69b1cb5 100644 --- a/SRC/dlaed4.f +++ b/SRC/dlaed4.f @@ -833,7 +833,8 @@ SUBROUTINE DLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO ) ZZ( 3 ) = Z( IIP1 )*Z( IIP1 ) END IF END IF - CALL DLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA, + CALL DLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, + $ ETA, $ INFO ) IF( INFO.NE.0 ) $ GO TO 250 diff --git a/SRC/dlaed6.f b/SRC/dlaed6.f index d536da4022..1be6b11559 100644 --- a/SRC/dlaed6.f +++ b/SRC/dlaed6.f @@ -137,7 +137,8 @@ *> at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO ) + SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dlaed7.f b/SRC/dlaed7.f index d692c35446..2438b4b212 100644 --- a/SRC/dlaed7.f +++ b/SRC/dlaed7.f @@ -254,7 +254,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, + $ Q, $ LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR, $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) @@ -286,7 +287,8 @@ SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, $ IQ2, IS, IW, IZ, K, LDQ2, N1, N2, PTR * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLAED8, DLAED9, DLAEDA, DLAMRG, XERBLA + EXTERNAL DGEMM, DLAED8, DLAED9, DLAEDA, DLAMRG, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -375,7 +377,8 @@ SUBROUTINE DLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, * Solve Secular Equation. * IF( K.NE.0 ) THEN - CALL DLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, WORK( IDLMDA ), + CALL DLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, + $ WORK( IDLMDA ), $ WORK( IW ), QSTORE( QPTR( CURR ) ), K, INFO ) IF( INFO.NE.0 ) $ GO TO 30 diff --git a/SRC/dlaed8.f b/SRC/dlaed8.f index fd845a8778..c4eb03b8fa 100644 --- a/SRC/dlaed8.f +++ b/SRC/dlaed8.f @@ -276,7 +276,8 @@ SUBROUTINE DLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, EXTERNAL IDAMAX, DLAMCH, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, XERBLA + EXTERNAL DCOPY, DLACPY, DLAMRG, DROT, DSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -371,7 +372,8 @@ SUBROUTINE DLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, ELSE DO 60 J = 1, N PERM( J ) = INDXQ( INDX( J ) ) - CALL DCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + CALL DCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), + $ 1 ) 60 CONTINUE CALL DLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), $ LDQ ) diff --git a/SRC/dlaed9.f b/SRC/dlaed9.f index 55cbf656e7..3ce4f3ffb9 100644 --- a/SRC/dlaed9.f +++ b/SRC/dlaed9.f @@ -152,7 +152,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMBDA, + SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, + $ DLAMBDA, $ W, S, LDS, INFO ) * * -- LAPACK computational routine -- @@ -215,7 +216,8 @@ SUBROUTINE DLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMBDA, $ RETURN * DO 20 J = KSTART, KSTOP - CALL DLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), INFO ) + CALL DLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), + $ INFO ) * * If the zero finder fails, the computation is terminated. * diff --git a/SRC/dlaeda.f b/SRC/dlaeda.f index 7416bac1c7..76e01e9079 100644 --- a/SRC/dlaeda.f +++ b/SRC/dlaeda.f @@ -162,7 +162,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, + SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, + $ GIVPTR, $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO ) * * -- LAPACK computational routine -- @@ -287,7 +288,8 @@ SUBROUTINE DLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, CALL DGEMV( 'T', BSIZ1, BSIZ1, ONE, Q( QPTR( CURR ) ), $ BSIZ1, ZTEMP( 1 ), 1, ZERO, Z( ZPTR1 ), 1 ) END IF - CALL DCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, Z( ZPTR1+BSIZ1 ), + CALL DCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, + $ Z( ZPTR1+BSIZ1 ), $ 1 ) IF( BSIZ2.GT.0 ) THEN CALL DGEMV( 'T', BSIZ2, BSIZ2, ONE, Q( QPTR( CURR+1 ) ), diff --git a/SRC/dlaein.f b/SRC/dlaein.f index 919581ef37..b2e2846739 100644 --- a/SRC/dlaein.f +++ b/SRC/dlaein.f @@ -168,7 +168,8 @@ *> \ingroup laein * * ===================================================================== - SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, + SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, + $ B, $ LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO ) * * -- LAPACK auxiliary routine -- @@ -333,7 +334,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, * or U**T*x = scale*v for a left eigenvector, * overwriting x on v. * - CALL DLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, + CALL DLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, + $ LDB, $ VR, SCALE, WORK, IERR ) NORMIN = 'Y' * @@ -570,7 +572,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, * * Divide by diagonal element of B. * - CALL DLADIV( XR, XI, B( I, I ), B( I+1, I ), VR( I ), + CALL DLADIV( XR, XI, B( I, I ), B( I+1, I ), + $ VR( I ), $ VI( I ) ) VMAX = MAX( ABS( VR( I ) )+ABS( VI( I ) ), VMAX ) VCRIT = BIGNUM / VMAX diff --git a/SRC/dlaexc.f b/SRC/dlaexc.f index 04c914ede6..aeb4d7753e 100644 --- a/SRC/dlaexc.f +++ b/SRC/dlaexc.f @@ -174,7 +174,8 @@ SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, EXTERNAL DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLANV2, DLARFG, DLARFX, DLARTG, DLASY2, + EXTERNAL DLACPY, DLANV2, DLARFG, DLARFX, DLARTG, + $ DLASY2, $ DROT * .. * .. Intrinsic Functions .. @@ -209,7 +210,8 @@ SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * Apply transformation to the matrix T. * IF( J3.LE.N ) - $ CALL DROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS, + $ CALL DROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, + $ CS, $ SN ) CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN ) * @@ -277,7 +279,8 @@ SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * * Accept swap: apply transformation to the entire matrix T. * - CALL DLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK ) + CALL DLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, + $ WORK ) CALL DLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK ) * T( J3, J1 ) = ZERO @@ -371,9 +374,11 @@ SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * * Accept swap: apply transformation to the entire matrix T. * - CALL DLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK ) + CALL DLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, + $ WORK ) CALL DLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK ) - CALL DLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK ) + CALL DLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, + $ WORK ) CALL DLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK ) * T( J3, J1 ) = ZERO @@ -397,7 +402,8 @@ SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * CALL DLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ), $ T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN ) - CALL DROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT, + CALL DROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), + $ LDT, $ CS, SN ) CALL DROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN ) IF( WANTQ ) diff --git a/SRC/dlags2.f b/SRC/dlags2.f index 34d3b5f398..e00abb0b31 100644 --- a/SRC/dlags2.f +++ b/SRC/dlags2.f @@ -148,7 +148,8 @@ *> \ingroup lags2 * * ===================================================================== - SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, + SUBROUTINE DLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, + $ CSV, $ SNV, CSQ, SNQ ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/dlagtm.f b/SRC/dlagtm.f index b0e2f38638..e030635be7 100644 --- a/SRC/dlagtm.f +++ b/SRC/dlagtm.f @@ -141,7 +141,8 @@ *> \ingroup lagtm * * ===================================================================== - SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, + SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, + $ BETA, $ B, LDB ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/dlagv2.f b/SRC/dlagv2.f index 3b67ced4b0..91cbceda26 100644 --- a/SRC/dlagv2.f +++ b/SRC/dlagv2.f @@ -153,7 +153,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL, + SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, + $ SNL, $ CSR, SNR ) * * -- LAPACK auxiliary routine -- @@ -254,7 +255,8 @@ SUBROUTINE DLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL, * * B is nonsingular, first compute the eigenvalues of (A,B) * - CALL DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2, + CALL DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, + $ WR2, $ WI ) * IF( WI.EQ.ZERO ) THEN diff --git a/SRC/dlahqr.f b/SRC/dlahqr.f index 606be1af2f..5b3454740e 100644 --- a/SRC/dlahqr.f +++ b/SRC/dlahqr.f @@ -596,13 +596,15 @@ SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, IF( I2.GT.I ) $ CALL DROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH, $ CS, SN ) - CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN ) + CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, + $ SN ) END IF IF( WANTZ ) THEN * * Apply the transformation to Z. * - CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN ) + CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, + $ SN ) END IF END IF * reset deflation counter diff --git a/SRC/dlahr2.f b/SRC/dlahr2.f index 476bf8d0f9..6b3a147dfc 100644 --- a/SRC/dlahr2.f +++ b/SRC/dlahr2.f @@ -224,7 +224,8 @@ SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Update I-th column of A - Y * V**T * - CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY, + CALL DGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), + $ LDY, $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 ) * * Apply I - V * T**T * V**T to this column (call it b) from the @@ -273,7 +274,8 @@ SUBROUTINE DLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(I) to annihilate * A(K+I+1:N,I) * - CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, + CALL DLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, $ TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE diff --git a/SRC/dlals0.f b/SRC/dlals0.f index 463d2eadb2..610f7f4e5a 100644 --- a/SRC/dlals0.f +++ b/SRC/dlals0.f @@ -263,7 +263,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, + SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, + $ LDBX, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO ) * @@ -294,7 +295,8 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DROT, DSCAL, + EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DROT, + $ DSCAL, $ XERBLA * .. * .. External Functions .. @@ -358,7 +360,8 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * CALL DCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX ) DO 20 I = 2, N - CALL DCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX ) + CALL DCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), + $ LDBX ) 20 CONTINUE * * Step (3L): apply the inverse of the left singular vector @@ -412,7 +415,8 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, 40 CONTINUE WORK( 1 ) = NEGONE TEMP = DNRM2( K, WORK, 1 ) - CALL DGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO, + CALL DGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, + $ ZERO, $ B( J, 1 ), LDB ) CALL DLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ), $ LDB, INFO ) @@ -451,7 +455,8 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * parentheses (x+y)+z. The goal is to prevent * optimizing compilers from doing x+(y+z). * - WORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I+1, + WORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, + $ -POLES( I+1, $ 2 ) )-DIFR( I, 1 ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -475,10 +480,12 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * IF( SQRE.EQ.1 ) THEN CALL DCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX ) - CALL DROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S ) + CALL DROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, + $ S ) END IF IF( K.LT.MAX( M, N ) ) - $ CALL DLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ), + $ CALL DLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, + $ 1 ), $ LDBX ) * * Step (3R): permute rows of B. @@ -488,7 +495,8 @@ SUBROUTINE DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, CALL DCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB ) END IF DO 90 I = 2, N - CALL DCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB ) + CALL DCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), + $ LDB ) 90 CONTINUE * * Step (4R): apply back the Givens rotations performed. diff --git a/SRC/dlalsa.f b/SRC/dlalsa.f index 2a3ec66739..a7e1c6792a 100644 --- a/SRC/dlalsa.f +++ b/SRC/dlalsa.f @@ -261,7 +261,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, + SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, + $ U, $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, $ IWORK, INFO ) @@ -296,7 +297,8 @@ SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, $ NR, NRF, NRP1, SQRE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DLALS0, DLASDT, XERBLA + EXTERNAL DCOPY, DGEMM, DLALS0, DLASDT, + $ XERBLA * .. * .. Executable Statements .. * @@ -403,7 +405,8 @@ SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, NLF = IC - NL NRF = IC + 1 J = J - 1 - CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX, + CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), + $ LDBX, $ B( NLF, 1 ), LDB, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -448,7 +451,8 @@ SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, SQRE = 1 END IF J = J + 1 - CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB, + CALL DLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), + $ LDB, $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -476,9 +480,11 @@ SUBROUTINE DLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, END IF NLF = IC - NL NRF = IC + 1 - CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX ) - CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX ) 80 CONTINUE * diff --git a/SRC/dlalsd.f b/SRC/dlalsd.f index ff07f7d929..de82e520b4 100644 --- a/SRC/dlalsd.f +++ b/SRC/dlalsd.f @@ -205,7 +205,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, EXTERNAL IDAMAX, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DLACPY, DLALSA, DLARTG, DLASCL, + EXTERNAL DCOPY, DGEMM, DLACPY, DLALSA, DLARTG, + $ DLASCL, $ DLASDA, DLASDQ, DLASET, DLASRT, DROT, XERBLA * .. * .. Intrinsic Functions .. @@ -250,7 +251,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, B, LDB ) ELSE RANK = 1 - CALL DLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, + $ INFO ) D( 1 ) = ABS( D( 1 ) ) END IF RETURN @@ -276,7 +278,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, DO 20 J = 1, N - 1 CS = WORK( J*2-1 ) SN = WORK( J*2 ) - CALL DROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN ) + CALL DROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, + $ SN ) 20 CONTINUE 30 CONTINUE END IF @@ -300,7 +303,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, IF( N.LE.SMLSIZ ) THEN NWORK = 1 + N*N CALL DLASET( 'A', N, N, ZERO, ONE, WORK, N ) - CALL DLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, B, + CALL DLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, + $ B, $ LDB, WORK( NWORK ), INFO ) IF( INFO.NE.0 ) THEN RETURN @@ -308,14 +312,17 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, TOL = RCND*ABS( D( IDAMAX( N, D, 1 ) ) ) DO 40 I = 1, N IF( D( I ).LE.TOL ) THEN - CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) ELSE - CALL DLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ), + CALL DLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, + $ 1 ), $ LDB, INFO ) RANK = RANK + 1 END IF 40 CONTINUE - CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, ZERO, + CALL DGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, + $ ZERO, $ WORK( NWORK ), N ) CALL DLACPY( 'A', N, NRHS, WORK( NWORK ), N, B, LDB ) * @@ -463,7 +470,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * subproblems were not solved explicitly. * IF( ABS( D( I ) ).LE.TOL ) THEN - CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), N ) + CALL DLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), + $ N ) ELSE RANK = RANK + 1 CALL DLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, @@ -487,7 +495,8 @@ SUBROUTINE DLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, $ WORK( VT+ST1 ), N, WORK( BXST ), N, ZERO, $ B( ST, 1 ), LDB ) ELSE - CALL DLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N, + CALL DLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), + $ N, $ B( ST, 1 ), LDB, WORK( U+ST1 ), N, $ WORK( VT+ST1 ), IWORK( K+ST1 ), $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ), diff --git a/SRC/dlangb.f b/SRC/dlangb.f index cb172c4e92..935ae8f0bb 100644 --- a/SRC/dlangb.f +++ b/SRC/dlangb.f @@ -201,7 +201,8 @@ DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB, TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -210,7 +211,8 @@ DOUBLE PRECISION FUNCTION DLANGB( NORM, N, KL, KU, AB, LDAB, DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, + $ SUM ) 90 CONTINUE VALUE = SCALE*SQRT( SUM ) END IF diff --git a/SRC/dlange.f b/SRC/dlange.f index f9bc4430ae..3c27c5dd07 100644 --- a/SRC/dlange.f +++ b/SRC/dlange.f @@ -189,7 +189,8 @@ DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlangt.f b/SRC/dlangt.f index 1757e25795..08c4d84fb5 100644 --- a/SRC/dlangt.f +++ b/SRC/dlangt.f @@ -147,11 +147,13 @@ DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU ) * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. + $ DISNAN( ABS( DL( I ) ) ) ) $ ANORM = ABS(DL(I)) IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) ) $ ANORM = ABS(D(I)) - IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) ) + IF( ANORM.LT.ABS( DU( I ) ) .OR. + $ DISNAN (ABS( DU( I ) ) ) ) $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN @@ -184,7 +186,8 @@ DOUBLE PRECISION FUNCTION DLANGT( NORM, N, DL, D, DU ) IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlanhs.f b/SRC/dlanhs.f index 3538a8ebff..d83ed9cd4d 100644 --- a/SRC/dlanhs.f +++ b/SRC/dlanhs.f @@ -183,7 +183,8 @@ DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlansb.f b/SRC/dlansb.f index ef5fbebd59..d70328ca93 100644 --- a/SRC/dlansb.f +++ b/SRC/dlansb.f @@ -184,7 +184,8 @@ DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -220,7 +221,8 @@ DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -229,7 +231,8 @@ DOUBLE PRECISION FUNCTION DLANSB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL DLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL DLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/dlansf.f b/SRC/dlansf.f index bd386b9469..2bc790229e 100644 --- a/SRC/dlansf.f +++ b/SRC/dlansf.f @@ -206,7 +206,8 @@ *> \endverbatim * * ===================================================================== - DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) + DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -333,7 +334,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) END DO END IF END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -778,7 +780,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -792,7 +795,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 3 - CALL DLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(k,0) END DO DO J = 0, K - 1 @@ -808,11 +812,13 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL DLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * trap L at A(0,0) END DO DO J = 0, K - 2 - CALL DLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S ) + CALL DLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO S = S + S @@ -827,7 +833,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**T is upper DO J = 1, K - 2 - CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) + CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k) END DO DO J = 0, K - 2 @@ -843,7 +850,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * double s for the off diagonal elements CALL DLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S ) * tri U at A(0,k) - CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S ) + CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, + $ S ) * tri L at A(0,k-1) ELSE * A**T is lower @@ -856,7 +864,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k-1 rect. at A(0,k) END DO DO J = 0, K - 3 - CALL DLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(1,0) END DO S = S + S @@ -874,7 +883,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 2 - CALL DLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(k+1,0) END DO DO J = 0, K - 1 @@ -890,7 +900,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL DLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, + $ S ) * trap L at A(1,0) END DO DO J = 1, K - 1 @@ -909,7 +920,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**T is upper DO J = 1, K - 1 - CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) + CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k+1) END DO DO J = 0, K - 1 @@ -917,20 +929,23 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,0) END DO DO J = 0, K - 2 - CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, + CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, + $ SCALE, $ S ) * L at A(0,k) END DO S = S + S * double s for the off diagonal elements - CALL DLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S ) + CALL DLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, + $ S ) * tri U at A(0,k+1) CALL DLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S ) * tri L at A(0,k) ELSE * A**T is lower DO J = 1, K - 1 - CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) + CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO DO J = K + 1, N @@ -938,7 +953,8 @@ DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,k+1) END DO DO J = 0, K - 2 - CALL DLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL DLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(0,0) END DO S = S + S diff --git a/SRC/dlansp.f b/SRC/dlansp.f index 01afa56cfc..10a05d9edb 100644 --- a/SRC/dlansp.f +++ b/SRC/dlansp.f @@ -173,7 +173,8 @@ DOUBLE PRECISION FUNCTION DLANSP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -212,7 +213,8 @@ DOUBLE PRECISION FUNCTION DLANSP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlanst.f b/SRC/dlanst.f index e339820f1e..ed08fbd7e5 100644 --- a/SRC/dlanst.f +++ b/SRC/dlanst.f @@ -162,7 +162,8 @@ DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlansy.f b/SRC/dlansy.f index d859a1040d..18ec5986f5 100644 --- a/SRC/dlansy.f +++ b/SRC/dlansy.f @@ -177,7 +177,8 @@ DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -211,7 +212,8 @@ DOUBLE PRECISION FUNCTION DLANSY( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlantb.f b/SRC/dlantb.f index 4777411af2..aa8280bbae 100644 --- a/SRC/dlantb.f +++ b/SRC/dlantb.f @@ -186,14 +186,16 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,14 +205,16 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -306,7 +310,8 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -325,7 +330,8 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 290 J = 1, N - CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), + CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 290 CONTINUE END IF @@ -335,7 +341,8 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, + CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ SCALE, $ SUM ) 300 CONTINUE END IF @@ -343,7 +350,8 @@ DOUBLE PRECISION FUNCTION DLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 310 J = 1, N - CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, + CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ SCALE, $ SUM ) 310 CONTINUE END IF diff --git a/SRC/dlantp.f b/SRC/dlantp.f index fc5db75dd1..4db0325c95 100644 --- a/SRC/dlantp.f +++ b/SRC/dlantp.f @@ -121,7 +121,8 @@ *> \ingroup lantp * * ===================================================================== - DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) + DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, + $ WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 20 J = 1, N DO 10 I = K, K + J - 2 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -179,7 +181,8 @@ DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 40 J = 1, N DO 30 I = K + 1, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -190,7 +193,8 @@ DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 60 J = 1, N DO 50 I = K, K + J - 1 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE @@ -198,7 +202,8 @@ DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 80 J = 1, N DO 70 I = K, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -301,7 +306,8 @@ DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/dlantr.f b/SRC/dlantr.f index 99bd7c5f06..e0e1550855 100644 --- a/SRC/dlantr.f +++ b/SRC/dlantr.f @@ -137,7 +137,8 @@ *> \ingroup lantr * * ===================================================================== - DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) * * -- LAPACK auxiliary routine -- @@ -187,14 +188,16 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,14 +207,16 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -306,7 +311,8 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -315,13 +321,15 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE diff --git a/SRC/dlaorhr_col_getrfnp.f b/SRC/dlaorhr_col_getrfnp.f index 4ca91f2cbe..cdd3eb4179 100644 --- a/SRC/dlaorhr_col_getrfnp.f +++ b/SRC/dlaorhr_col_getrfnp.f @@ -167,7 +167,8 @@ SUBROUTINE DLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) INTEGER IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLAORHR_COL_GETRFNP2, DTRSM, XERBLA + EXTERNAL DGEMM, DLAORHR_COL_GETRFNP2, DTRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -224,14 +225,16 @@ SUBROUTINE DLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) * * Compute block row of U. * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL DGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/dlaorhr_col_getrfnp2.f b/SRC/dlaorhr_col_getrfnp2.f index dc206947c0..17010ffe43 100644 --- a/SRC/dlaorhr_col_getrfnp2.f +++ b/SRC/dlaorhr_col_getrfnp2.f @@ -164,7 +164,8 @@ *> \endverbatim * * ===================================================================== - RECURSIVE SUBROUTINE DLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + RECURSIVE SUBROUTINE DLAORHR_COL_GETRFNP2( M, N, A, LDA, D, + $ INFO ) IMPLICIT NONE * * -- LAPACK computational routine -- diff --git a/SRC/dlaqgb.f b/SRC/dlaqgb.f index 592d391450..05ce392e09 100644 --- a/SRC/dlaqgb.f +++ b/SRC/dlaqgb.f @@ -155,7 +155,8 @@ *> \ingroup laqgb * * ===================================================================== - SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/dlaqp2.f b/SRC/dlaqp2.f index 2d2a071e21..900071607a 100644 --- a/SRC/dlaqp2.f +++ b/SRC/dlaqp2.f @@ -209,7 +209,8 @@ SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * Generate elementary reflector H(i). * IF( OFFPI.LT.M ) THEN - CALL DLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1, + CALL DLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), + $ 1, $ TAU( I ) ) ELSE CALL DLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) ) diff --git a/SRC/dlaqps.f b/SRC/dlaqps.f index 004b6601f4..abf195c08d 100644 --- a/SRC/dlaqps.f +++ b/SRC/dlaqps.f @@ -173,7 +173,8 @@ *> \endhtmlonly * * ===================================================================== - SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, + SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, + $ VN1, $ VN2, AUXV, F, LDF ) * * -- LAPACK auxiliary routine -- @@ -241,14 +242,16 @@ SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)**T. * IF( K.GT.1 ) THEN - CALL DGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ), + CALL DGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, + $ 1 ), $ LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 ) END IF * * Generate elementary reflector H(k). * IF( RK.LT.M ) THEN - CALL DLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) ) + CALL DLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, + $ TAU( K ) ) ELSE CALL DLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) ) END IF @@ -277,7 +280,8 @@ SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * *A(RK:M,K). * IF( K.GT.1 ) THEN - CALL DGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ), + CALL DGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, + $ 1 ), $ LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 ) * CALL DGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF, @@ -288,7 +292,8 @@ SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**T. * IF( K.LT.N ) THEN - CALL DGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF, + CALL DGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), + $ LDF, $ A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA ) END IF * @@ -328,7 +333,8 @@ SUBROUTINE DLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**T. * IF( KB.LT.MIN( N, M-OFFSET ) ) THEN - CALL DGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE, + CALL DGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, + $ -ONE, $ A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE, $ A( RK+1, KB+1 ), LDA ) END IF diff --git a/SRC/dlaqr0.f b/SRC/dlaqr0.f index 9f3aec0eb4..91027b4318 100644 --- a/SRC/dlaqr0.f +++ b/SRC/dlaqr0.f @@ -314,7 +314,8 @@ SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, DOUBLE PRECISION ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR3, DLAQR4, DLAQR5 + EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR3, DLAQR4, + $ DLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD @@ -517,7 +518,8 @@ SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * * ==== Aggressive early deflation ==== * - CALL DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH, $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, $ WORK, LWORK ) @@ -561,7 +563,8 @@ SUBROUTINE DLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, BB = SS CC = WILK2*SS DD = AA - CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ), + CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), + $ WI( I-1 ), $ WR( I ), WI( I ), CS, SN ) 30 CONTINUE IF( KS.EQ.KTOP ) THEN diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index 8475b1c076..c22812b6c1 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -273,7 +273,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * @@ -310,7 +311,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, + EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, + $ DLAHQR, $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. @@ -332,7 +334,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to DORMHR ==== * - CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * @@ -402,7 +405,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) CALL DLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ), @@ -449,7 +453,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . (DTREXC can not fail in this case.) ==== * IFST = NS - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 1 END IF @@ -474,7 +479,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . ILST in case of a rare exchange failure. ==== * IFST = NS - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 2 END IF @@ -536,7 +542,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, SORTED = .false. IFST = I ILST = K - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) IF( INFO.EQ.0 ) THEN I = ILST @@ -593,7 +600,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) @@ -618,7 +626,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -632,7 +641,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 70 CONTINUE * * ==== Update horizontal slab in H ==== @@ -652,7 +662,8 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 90 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/dlaqr3.f b/SRC/dlaqr3.f index aa0255cc6a..98bc4e171e 100644 --- a/SRC/dlaqr3.f +++ b/SRC/dlaqr3.f @@ -270,7 +270,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * @@ -308,7 +309,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, DLANV2, + EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, + $ DLANV2, $ DLAQR4, DLARF, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. @@ -330,13 +332,15 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to DORMHR ==== * - CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL DORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Workspace query call to DLAQR4 ==== * - CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW, + CALL DLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, + $ JW, $ V, LDV, WORK, -1, INFQR ) LWK3 = INT( WORK( 1 ) ) * @@ -406,7 +410,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL DLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL DCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL DLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) NMIN = ILAENV( 12, 'DLAQR3', 'SV', JW, 1, JW, LWORK ) @@ -459,7 +464,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . (DTREXC can not fail in this case.) ==== * IFST = NS - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 1 END IF @@ -484,7 +490,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . ILST in case of a rare exchange failure. ==== * IFST = NS - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 2 END IF @@ -546,7 +553,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, SORTED = .false. IFST = I ILST = K - CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL DTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) IF( INFO.EQ.0 ) THEN I = ILST @@ -603,7 +611,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) @@ -628,7 +637,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL DORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -642,7 +652,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL DLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 70 CONTINUE * * ==== Update horizontal slab in H ==== @@ -662,7 +673,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 90 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL DGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL DLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/dlaqr4.f b/SRC/dlaqr4.f index e4baa39f82..c57f53da15 100644 --- a/SRC/dlaqr4.f +++ b/SRC/dlaqr4.f @@ -320,7 +320,8 @@ SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, DOUBLE PRECISION ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR2, DLAQR5 + EXTERNAL DLACPY, DLAHQR, DLANV2, DLAQR2, + $ DLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, MOD @@ -523,7 +524,8 @@ SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * * ==== Aggressive early deflation ==== * - CALL DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH, $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, $ WORK, LWORK ) @@ -567,7 +569,8 @@ SUBROUTINE DLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, BB = SS CC = WILK2*SS DD = AA - CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ), + CALL DLANV2( AA, BB, CC, DD, WR( I-1 ), + $ WI( I-1 ), $ WR( I ), WI( I ), CS, SN ) 30 CONTINUE IF( KS.EQ.KTOP ) THEN diff --git a/SRC/dlaqr5.f b/SRC/dlaqr5.f index aef7cd1cdd..e11de5b4ec 100644 --- a/SRC/dlaqr5.f +++ b/SRC/dlaqr5.f @@ -307,7 +307,8 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, DOUBLE PRECISION VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLAQR1, DLARFG, DLASET, DTRMM + EXTERNAL DGEMM, DLACPY, DLAQR1, DLARFG, DLASET, + $ DTRMM * .. * .. Executable Statements .. * diff --git a/SRC/dlaqsb.f b/SRC/dlaqsb.f index a1dd414a93..625753f566 100644 --- a/SRC/dlaqsb.f +++ b/SRC/dlaqsb.f @@ -137,7 +137,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dlaqtr.f b/SRC/dlaqtr.f index 892fc81f89..04df2030b0 100644 --- a/SRC/dlaqtr.f +++ b/SRC/dlaqtr.f @@ -161,7 +161,8 @@ *> \ingroup laqtr * * ===================================================================== - SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, + SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, + $ WORK, $ INFO ) * * -- LAPACK auxiliary routine -- @@ -315,7 +316,8 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF IF( J1.GT.1 ) THEN - CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) + CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) K = IDAMAX( J1-1, X, 1 ) XMAX = ABS( X( K ) ) END IF @@ -358,8 +360,10 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, * Update right-hand side * IF( J1.GT.1 ) THEN - CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) - CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 ) + CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) + CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, + $ 1 ) K = IDAMAX( J1-1, X, 1 ) XMAX = ABS( X( K ) ) END IF @@ -403,7 +407,8 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF * - X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, 1 ) + X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, + $ 1 ) * XJ = ABS( X( J1 ) ) TJJ = ABS( T( J1, J1 ) ) @@ -533,7 +538,8 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF * IF( J1.GT.1 ) THEN - CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) + CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) CALL DAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1, $ X( N+1 ), 1 ) * @@ -555,7 +561,8 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, D( 2, 1 ) = X( J2 ) D( 1, 2 ) = X( N+J1 ) D( 2, 2 ) = X( N+J2 ) - CALL DLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, J1 ), + CALL DLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, + $ J1 ), $ LDT, ONE, ONE, D, 2, ZERO, -W, V, 2, $ SCALOC, XNORM, IERR ) IF( IERR.NE.0 ) @@ -587,8 +594,10 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, * Update the right-hand side. * IF( J1.GT.1 ) THEN - CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) - CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 ) + CALL DAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) + CALL DAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, + $ 1 ) * CALL DAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1, $ X( N+1 ), 1 ) @@ -645,7 +654,8 @@ SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF * - X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, 1 ) + X( J1 ) = X( J1 ) - DDOT( J1-1, T( 1, J1 ), 1, X, + $ 1 ) X( N+J1 ) = X( N+J1 ) - DDOT( J1-1, T( 1, J1 ), 1, $ X( N+1 ), 1 ) IF( J1.GT.1 ) THEN diff --git a/SRC/dlaqz0.f b/SRC/dlaqz0.f index 8fb6b23cbd..facefd29f5 100644 --- a/SRC/dlaqz0.f +++ b/SRC/dlaqz0.f @@ -300,7 +300,8 @@ *> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHAR, ALPHAI, BETA, $ Q, LDQ, Z, LDZ, WORK, LWORK, REC, $ INFO ) @@ -440,7 +441,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL DHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) RETURN @@ -452,7 +454,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to dlaqz3 NW = MAX( NWR, NMIN ) - CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR, $ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC, $ AED_INFO ) @@ -477,8 +480,10 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Initialize Q and Z * - IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ ) - IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ ) + IF( IWANTQ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Q, + $ LDQ ) + IF( IWANTZ.EQ.3 ) CALL DLASET( 'FULL', N, N, ZERO, ONE, Z, + $ LDZ ) * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) @@ -571,17 +576,20 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL DLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = ZERO CALL DROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL DROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL DROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -591,9 +599,11 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = ZERO - CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL DROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL DROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL DROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -655,7 +665,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL DLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ), $ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC, @@ -725,7 +736,8 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL DLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ), $ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ, $ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK, diff --git a/SRC/dlaqz2.f b/SRC/dlaqz2.f index e89e047d9d..62e276892a 100644 --- a/SRC/dlaqz2.f +++ b/SRC/dlaqz2.f @@ -170,7 +170,8 @@ *> \ingroup laqz2 *> * ===================================================================== - SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, + SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, + $ B, $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ ) IMPLICIT NONE * @@ -206,16 +207,19 @@ SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, * CALL DROT( IHI-ISTARTM+1, B( ISTARTM, IHI ), 1, B( ISTARTM, $ IHI-1 ), 1, C1, S1 ) - CALL DROT( IHI-ISTARTM+1, B( ISTARTM, IHI-1 ), 1, B( ISTARTM, + CALL DROT( IHI-ISTARTM+1, B( ISTARTM, IHI-1 ), 1, + $ B( ISTARTM, $ IHI-2 ), 1, C2, S2 ) B( IHI-1, IHI-2 ) = ZERO B( IHI, IHI-2 ) = ZERO CALL DROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C1, S1 ) - CALL DROT( IHI-ISTARTM+1, A( ISTARTM, IHI-1 ), 1, A( ISTARTM, + CALL DROT( IHI-ISTARTM+1, A( ISTARTM, IHI-1 ), 1, + $ A( ISTARTM, $ IHI-2 ), 1, C2, S2 ) IF ( ILZ ) THEN - CALL DROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL DROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C1, S1 ) CALL DROT( NZ, Z( 1, IHI-1-ZSTART+1 ), 1, Z( 1, $ IHI-2-ZSTART+1 ), 1, C2, S2 ) @@ -230,7 +234,8 @@ SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL DROT( ISTOPM-IHI+2, B( IHI-1, IHI-1 ), LDB, B( IHI, $ IHI-1 ), LDB, C1, S1 ) IF ( ILQ ) THEN - CALL DROT( NQ, Q( 1, IHI-1-QSTART+1 ), 1, Q( 1, IHI-QSTART+ + CALL DROT( NQ, Q( 1, IHI-1-QSTART+1 ), 1, Q( 1, + $ IHI-QSTART+ $ 1 ), 1, C1, S1 ) END IF * @@ -242,7 +247,8 @@ SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL DROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL DROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL DROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C1, S1 ) END IF * @@ -278,7 +284,8 @@ SUBROUTINE DLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, IF ( ILZ ) THEN CALL DROT( NZ, Z( 1, K+2-ZSTART+1 ), 1, Z( 1, K+1-ZSTART+ $ 1 ), 1, C1, S1 ) - CALL DROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, K-ZSTART+1 ), + CALL DROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, + $ K-ZSTART+1 ), $ 1, C2, S2 ) END IF B( K+1, K ) = ZERO diff --git a/SRC/dlaqz3.f b/SRC/dlaqz3.f index a5cd1f0435..9c21b44cf0 100644 --- a/SRC/dlaqz3.f +++ b/SRC/dlaqz3.f @@ -233,7 +233,8 @@ *> \ingroup laqz3 *> * ===================================================================== - RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHAR, ALPHAI, BETA, QC, LDQC, $ ZC, LDZC, WORK, LWORK, REC, INFO ) @@ -326,7 +327,8 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL DLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL DLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL DLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -341,7 +343,8 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL DLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL DLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL DLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -448,11 +451,14 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = ZERO K2 = MAX( KWTOP, K-1 ) - CALL DROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL DROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL DROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL DROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL DROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL DROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, S1 ) END DO @@ -477,7 +483,8 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, DO K2 = K, KWBOT-2 * Move shift down - CALL DLARTG( B( K2+1, K2+1 ), B( K2+1, K2 ), C1, S1, + CALL DLARTG( B( K2+1, K2+1 ), B( K2+1, K2 ), C1, + $ S1, $ TEMP ) B( K2+1, K2+1 ) = TEMP B( K2+1, K2 ) = ZERO @@ -492,9 +499,11 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ TEMP ) A( K2+1, K2 ) = TEMP A( K2+2, K2 ) = ZERO - CALL DROT( ISTOPM-K2, A( K2+1, K2+1 ), LDA, A( K2+2, + CALL DROT( ISTOPM-K2, A( K2+1, K2+1 ), LDA, + $ A( K2+2, $ K2+1 ), LDA, C1, S1 ) - CALL DROT( ISTOPM-K2, B( K2+1, K2+1 ), LDB, B( K2+2, + CALL DROT( ISTOPM-K2, B( K2+1, K2+1 ), LDB, + $ B( K2+2, $ K2+1 ), LDB, C1, S1 ) CALL DROT( JW, QC( 1, K2+1-KWTOP+1 ), 1, QC( 1, $ K2+2-KWTOP+1 ), 1, C1, S1 ) @@ -502,7 +511,8 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, END DO * Remove the shift - CALL DLARTG( B( KWBOT, KWBOT ), B( KWBOT, KWBOT-1 ), C1, + CALL DLARTG( B( KWBOT, KWBOT ), B( KWBOT, KWBOT-1 ), + $ C1, $ S1, TEMP ) B( KWBOT, KWBOT ) = TEMP B( KWBOT, KWBOT-1 ) = ZERO @@ -539,25 +549,29 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL DGEMM( 'N', 'N', N, JW, JW, ONE, Q( 1, KWTOP ), LDQ, QC, + CALL DGEMM( 'N', 'N', N, JW, JW, ONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, ZERO, WORK, N ) CALL DLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL DGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, A( ISTARTM, + CALL DGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, ZERO, WORK, $ KWTOP-ISTARTM ) CALL DLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL DGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, B( ISTARTM, + CALL DGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, ZERO, WORK, $ KWTOP-ISTARTM ) CALL DLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL DGEMM( 'N', 'N', N, JW, JW, ONE, Z( 1, KWTOP ), LDZ, ZC, + CALL DGEMM( 'N', 'N', N, JW, JW, ONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, ZERO, WORK, N ) CALL DLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/SRC/dlaqz4.f b/SRC/dlaqz4.f index 2a70409860..0bcc7927df 100644 --- a/SRC/dlaqz4.f +++ b/SRC/dlaqz4.f @@ -316,18 +316,21 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS, 2 * Introduce the shift - CALL DLAQZ1( A( ILO, ILO ), LDA, B( ILO, ILO ), LDB, SR( I ), + CALL DLAQZ1( A( ILO, ILO ), LDA, B( ILO, ILO ), LDB, + $ SR( I ), $ SR( I+1 ), SI( I ), SS( I ), SS( I+1 ), V ) TEMP = V( 2 ) CALL DLARTG( TEMP, V( 3 ), C1, S1, V( 2 ) ) CALL DLARTG( V( 1 ), V( 2 ), C2, S2, TEMP ) - CALL DROT( NS, A( ILO+1, ILO ), LDA, A( ILO+2, ILO ), LDA, C1, + CALL DROT( NS, A( ILO+1, ILO ), LDA, A( ILO+2, ILO ), LDA, + $ C1, $ S1 ) CALL DROT( NS, A( ILO, ILO ), LDA, A( ILO+1, ILO ), LDA, C2, $ S2 ) - CALL DROT( NS, B( ILO+1, ILO ), LDB, B( ILO+2, ILO ), LDB, C1, + CALL DROT( NS, B( ILO+1, ILO ), LDB, B( ILO+2, ILO ), LDB, + $ C1, $ S1 ) CALL DROT( NS, B( ILO, ILO ), LDB, B( ILO+1, ILO ), LDB, C2, $ S2 ) @@ -352,11 +355,13 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS+1 SWIDTH = ISTOPM-( ILO+NS )+1 IF ( SWIDTH > 0 ) THEN - CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ A( ILO, ILO+NS ), LDA, ZERO, WORK, SHEIGHT ) CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ILO, $ ILO+NS ), LDA ) - CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ B( ILO, ILO+NS ), LDB, ZERO, WORK, SHEIGHT ) CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ILO, $ ILO+NS ), LDB ) @@ -372,17 +377,22 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = ILO-1-ISTARTM+1 SWIDTH = NS IF ( SHEIGHT > 0 ) THEN - CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, A( ISTARTM, + CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ A( ISTARTM, $ ILO ), LDA, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ ILO ), LDA ) - CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, B( ISTARTM, + CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ B( ISTARTM, $ ILO ), LDB, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ ILO ), LDB ) END IF IF ( ILZ ) THEN - CALL DGEMM( 'N', 'N', N, SWIDTH, SWIDTH, ONE, Z( 1, ILO ), LDZ, + CALL DGEMM( 'N', 'N', N, SWIDTH, SWIDTH, ONE, Z( 1, ILO ), + $ LDZ, $ ZC, LDZC, ZERO, WORK, N ) CALL DLACPY( 'ALL', N, SWIDTH, WORK, N, Z( 1, ILO ), LDZ ) END IF @@ -427,18 +437,22 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, $ LDQC, A( K+1, K+NS+NP ), LDA, ZERO, WORK, $ SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( K+1, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( K+1, $ K+NS+NP ), LDA ) CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, $ LDQC, B( K+1, K+NS+NP ), LDB, ZERO, WORK, $ SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( K+1, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( K+1, $ K+NS+NP ), LDB ) END IF IF ( ILQ ) THEN - CALL DGEMM( 'N', 'N', N, NBLOCK, NBLOCK, ONE, Q( 1, K+1 ), + CALL DGEMM( 'N', 'N', N, NBLOCK, NBLOCK, ONE, Q( 1, + $ K+1 ), $ LDQ, QC, LDQC, ZERO, WORK, N ) - CALL DLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), LDQ ) + CALL DLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), + $ LDQ ) END IF * Update A(istartm:k,k:k+ns+npos-1) and B(istartm:k,k:k+ns+npos-1) @@ -481,7 +495,8 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS, 2 * Chase the shift down to the bottom right corner DO ISHIFT = IHI-I-1, IHI-2 - CALL DLAQZ2( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, IHI, + CALL DLAQZ2( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NS, IHI-NS+1, QC, LDQC, NS+1, $ IHI-NS, ZC, LDZC ) END DO @@ -495,11 +510,13 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS SWIDTH = ISTOPM-( IHI+1 )+1 IF ( SWIDTH > 0 ) THEN - CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ A( IHI-NS+1, IHI+1 ), LDA, ZERO, WORK, SHEIGHT ) CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ A( IHI-NS+1, IHI+1 ), LDA ) - CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL DGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ B( IHI-NS+1, IHI+1 ), LDB, ZERO, WORK, SHEIGHT ) CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ B( IHI-NS+1, IHI+1 ), LDB ) @@ -515,17 +532,22 @@ SUBROUTINE DLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = IHI-NS-ISTARTM+1 SWIDTH = NS+1 IF ( SHEIGHT > 0 ) THEN - CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, A( ISTARTM, + CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ A( ISTARTM, $ IHI-NS ), LDA, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ IHI-NS ), LDA ) - CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, B( ISTARTM, + CALL DGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ B( ISTARTM, $ IHI-NS ), LDB, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL DLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ IHI-NS ), LDB ) END IF IF ( ILZ ) THEN - CALL DGEMM( 'N', 'N', N, NS+1, NS+1, ONE, Z( 1, IHI-NS ), LDZ, + CALL DGEMM( 'N', 'N', N, NS+1, NS+1, ONE, Z( 1, IHI-NS ), + $ LDZ, $ ZC, LDZC, ZERO, WORK, N ) CALL DLACPY( 'ALL', N, NS+1, WORK, N, Z( 1, IHI-NS ), LDZ ) END IF diff --git a/SRC/dlarf.f b/SRC/dlarf.f index bbab72ebf8..0e2e654996 100644 --- a/SRC/dlarf.f +++ b/SRC/dlarf.f @@ -195,7 +195,8 @@ SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) * - CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV, + CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, + $ INCV, $ ZERO, WORK, 1 ) * * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T diff --git a/SRC/dlarfb.f b/SRC/dlarfb.f index 92d4511397..aa51742cf3 100644 --- a/SRC/dlarfb.f +++ b/SRC/dlarfb.f @@ -193,7 +193,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, + SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, + $ LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * * -- LAPACK auxiliary routine -- @@ -262,7 +263,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * @@ -275,7 +277,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T @@ -291,7 +294,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, + $ K, $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T @@ -316,13 +320,15 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C2 * V2 * - CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL DGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, $ ONE, WORK, LDWORK ) END IF @@ -345,7 +351,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, + $ K, $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -373,12 +380,14 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**T * DO 70 J = 1, K - CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) 70 CONTINUE * * W := W * V2 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * @@ -390,7 +399,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T @@ -405,7 +415,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, + $ K, $ ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T @@ -430,13 +441,15 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1 * - CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL DGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * @@ -457,7 +470,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, + $ K, $ ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W @@ -492,20 +506,23 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, + $ K, $ ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C2**T * V2**T * - CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, + $ ONE, $ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE, $ WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T @@ -514,14 +531,16 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - V2**T * W**T * - CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, + $ -ONE, $ V( 1, K+1 ), LDV, WORK, LDWORK, ONE, $ C( K+1, 1 ), LDC ) END IF * * W := W * V1 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T @@ -546,7 +565,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, + $ K, $ ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * @@ -568,14 +588,16 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2 * - CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL DGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, $ C( 1, K+1 ), LDC ) END IF * * W := W * V1 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -603,24 +625,28 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**T * DO 190 J = 1, K - CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) 190 CONTINUE * * W := W * V2**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, + $ K, $ ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C1**T * V1**T * - CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, + $ ONE, $ C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T @@ -629,13 +655,15 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - V1**T * W**T * - CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, + $ -ONE, $ V, LDV, WORK, LDWORK, ONE, C, LDC ) END IF * * W := W * V2 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T @@ -660,7 +688,8 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, + $ K, $ ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * @@ -681,13 +710,15 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1 * - CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL DGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) * * C1 := C1 - W diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 03b23c14bf..294e6928df 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -246,7 +246,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) * - CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) IF( I.GT.1 ) THEN @@ -283,7 +284,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) * - CALL DGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ), + CALL DGEMV( 'Transpose', N-K+I-J, K-I, + $ -TAU( I ), $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, $ T( I+1, I ), 1 ) ELSE @@ -305,7 +307,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) * - CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', K-I, + CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) IF( I.GT.1 ) THEN PREVLASTV = MIN( PREVLASTV, LASTV ) diff --git a/SRC/dlarrd.f b/SRC/dlarrd.f index b67c6b9a15..a348614d26 100644 --- a/SRC/dlarrd.f +++ b/SRC/dlarrd.f @@ -677,7 +677,8 @@ SUBROUTINE DLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS, * Compute Eigenvalues ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) / $ LOG( TWO ) ) + 2 - CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, + CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, + $ PIVMIN, $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ), $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT, $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) diff --git a/SRC/dlarre.f b/SRC/dlarre.f index ba99dc0de0..66eda0c3ef 100644 --- a/SRC/dlarre.f +++ b/SRC/dlarre.f @@ -357,7 +357,8 @@ SUBROUTINE DLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLARNV, DLARRA, DLARRB, DLARRC, DLARRD, + EXTERNAL DCOPY, DLARNV, DLARRA, DLARRB, DLARRC, + $ DLARRD, $ DLASQ2, DLARRK * .. * .. Intrinsic Functions .. diff --git a/SRC/dlarrv.f b/SRC/dlarrv.f index ee1ed46a2f..c41b8d862d 100644 --- a/SRC/dlarrv.f +++ b/SRC/dlarrv.f @@ -338,7 +338,8 @@ SUBROUTINE DLARRV( N, VL, VU, D, L, PIVMIN, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAR1V, DLARRB, DLARRF, DLASET, + EXTERNAL DCOPY, DLAR1V, DLARRB, DLARRF, + $ DLASET, $ DSCAL * .. * .. Intrinsic Functions .. diff --git a/SRC/dlarz.f b/SRC/dlarz.f index 954226b190..d4e0b61e0c 100644 --- a/SRC/dlarz.f +++ b/SRC/dlarz.f @@ -184,7 +184,8 @@ SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l ) * - CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V, + CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, + $ V, $ INCV, ONE, WORK, 1 ) * * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n ) @@ -210,7 +211,8 @@ SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) * - CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, + CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), + $ LDC, $ V, INCV, ONE, WORK, 1 ) * * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) diff --git a/SRC/dlarzb.f b/SRC/dlarzb.f index 7a8803d73f..8cda5cfb86 100644 --- a/SRC/dlarzb.f +++ b/SRC/dlarzb.f @@ -257,7 +257,8 @@ SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T * - CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T, + CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T @@ -272,7 +273,8 @@ SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * V( 1:k, 1:l )**T * W( 1:n, 1:k )**T * IF( L.GT.0 ) - $ CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV, + $ CALL DGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, + $ LDV, $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC ) * ELSE IF( LSAME( SIDE, 'R' ) ) THEN @@ -294,7 +296,8 @@ SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:m, 1:k ) = W( 1:m, 1:k ) * T or W( 1:m, 1:k ) * T**T * - CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T, + CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k ) @@ -309,7 +312,8 @@ SUBROUTINE DLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * W( 1:m, 1:k ) * V( 1:k, 1:l ) * IF( L.GT.0 ) - $ CALL DGEMM( 'No transpose', 'No transpose', M, L, K, -ONE, + $ CALL DGEMM( 'No transpose', 'No transpose', M, L, K, + $ -ONE, $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC ) * END IF diff --git a/SRC/dlascl.f b/SRC/dlascl.f index b2ef681691..66780c52d5 100644 --- a/SRC/dlascl.f +++ b/SRC/dlascl.f @@ -140,7 +140,8 @@ *> \ingroup lascl * * ===================================================================== - SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dlasd0.f b/SRC/dlasd0.f index 6a1a7aa6f0..19f46db2c1 100644 --- a/SRC/dlasd0.f +++ b/SRC/dlasd0.f @@ -148,7 +148,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, + SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, + $ IWORK, $ WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -204,7 +205,8 @@ SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, * If the input matrix is too small, call DLASDQ to find the SVD. * IF( N.LE.SMLSIZ ) THEN - CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, U, + CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, + $ U, $ LDU, WORK, INFO ) RETURN END IF @@ -241,7 +243,8 @@ SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, NLF = IC - NL NRF = IC + 1 SQREI = 1 - CALL DLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), E( NLF ), + CALL DLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), + $ E( NLF ), $ VT( NLF, NLF ), LDVT, U( NLF, NLF ), LDU, $ U( NLF, NLF ), LDU, WORK, INFO ) IF( INFO.NE.0 ) THEN @@ -257,7 +260,8 @@ SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, SQREI = 1 END IF NRP1 = NR + SQREI - CALL DLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), E( NRF ), + CALL DLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), + $ E( NRF ), $ VT( NRF, NRF ), LDVT, U( NRF, NRF ), LDU, $ U( NRF, NRF ), LDU, WORK, INFO ) IF( INFO.NE.0 ) THEN diff --git a/SRC/dlasd1.f b/SRC/dlasd1.f index 259a18eed4..237ccca4d8 100644 --- a/SRC/dlasd1.f +++ b/SRC/dlasd1.f @@ -200,7 +200,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, + SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, + $ LDVT, $ IDXQ, IWORK, WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -229,7 +230,8 @@ SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, DOUBLE PRECISION ORGNRM * .. * .. External Subroutines .. - EXTERNAL DLAMRG, DLASCL, DLASD2, DLASD3, XERBLA + EXTERNAL DLAMRG, DLASCL, DLASD2, DLASD3, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -288,7 +290,8 @@ SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, * * Deflate singular values. * - CALL DLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, LDU, + CALL DLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, + $ LDU, $ VT, LDVT, WORK( ISIGMA ), WORK( IU2 ), LDU2, $ WORK( IVT2 ), LDVT2, IWORK( IDXP ), IWORK( IDX ), $ IWORK( IDXC ), IDXQ, IWORK( COLTYP ), INFO ) @@ -296,7 +299,8 @@ SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, * Solve Secular Equation and update singular vectors. * LDQ = K - CALL DLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, WORK( ISIGMA ), + CALL DLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, + $ WORK( ISIGMA ), $ U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ), $ LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ), $ INFO ) diff --git a/SRC/dlasd2.f b/SRC/dlasd2.f index 7c5d3398ef..dcc027149e 100644 --- a/SRC/dlasd2.f +++ b/SRC/dlasd2.f @@ -264,7 +264,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, + SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, + $ VT, $ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX, $ IDXC, IDXQ, COLTYP, INFO ) * @@ -304,7 +305,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, EXTERNAL DLAMCH, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DLAMRG, DLASET, DROT, XERBLA + EXTERNAL DCOPY, DLACPY, DLAMRG, DLASET, DROT, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -480,7 +482,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, IDXJ = IDXJ - 1 END IF CALL DROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S ) - CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C, + CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, + $ C, $ S ) IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN COLTYP( J ) = 3 @@ -615,7 +618,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, CALL DCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 ) CALL DLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ), $ LDU ) - CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ), + CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, + $ 1 ), $ LDVT ) END IF * diff --git a/SRC/dlasd3.f b/SRC/dlasd3.f index a9d53fdcfe..f1b26066f5 100644 --- a/SRC/dlasd3.f +++ b/SRC/dlasd3.f @@ -212,7 +212,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, + SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, + $ U2, $ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z, $ INFO ) * @@ -247,7 +248,8 @@ SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, EXTERNAL DNRM2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DLACPY, DLASCL, DLASD4, XERBLA + EXTERNAL DCOPY, DGEMM, DLACPY, DLASCL, DLASD4, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, SIGN, SQRT @@ -365,16 +367,19 @@ SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, * Update the left singular vector matrix. * IF( K.EQ.2 ) THEN - CALL DGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, U, + CALL DGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, + $ U, $ LDU ) GO TO 100 END IF IF( CTOT( 1 ).GT.0 ) THEN - CALL DGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), LDU2, + CALL DGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), + $ LDU2, $ Q( 2, 1 ), LDQ, ZERO, U( 1, 1 ), LDU ) IF( CTOT( 3 ).GT.0 ) THEN KTEMP = 2 + CTOT( 1 ) + CTOT( 2 ) - CALL DGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ), + CALL DGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, + $ KTEMP ), $ LDU2, Q( KTEMP, 1 ), LDQ, ONE, U( 1, 1 ), LDU ) END IF ELSE IF( CTOT( 3 ).GT.0 ) THEN @@ -387,7 +392,8 @@ SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, CALL DCOPY( K, Q( 1, 1 ), LDQ, U( NLP1, 1 ), LDU ) KTEMP = 2 + CTOT( 1 ) CTEMP = CTOT( 2 ) + CTOT( 3 ) - CALL DGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), LDU2, + CALL DGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), + $ LDU2, $ Q( KTEMP, 1 ), LDQ, ZERO, U( NLP2, 1 ), LDU ) * * Generate the right singular vectors. @@ -405,7 +411,8 @@ SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, * Update the right singular vector matrix. * IF( K.EQ.2 ) THEN - CALL DGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, ZERO, + CALL DGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, + $ ZERO, $ VT, LDVT ) RETURN END IF @@ -414,7 +421,8 @@ SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, $ VT2( 1, 1 ), LDVT2, ZERO, VT( 1, 1 ), LDVT ) KTEMP = 2 + CTOT( 1 ) + CTOT( 2 ) IF( KTEMP.LE.LDVT2 ) - $ CALL DGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, KTEMP ), + $ CALL DGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, + $ KTEMP ), $ LDQ, VT2( KTEMP, 1 ), LDVT2, ONE, VT( 1, 1 ), $ LDVT ) * diff --git a/SRC/dlasd6.f b/SRC/dlasd6.f index fb21015e97..95a1e50ba0 100644 --- a/SRC/dlasd6.f +++ b/SRC/dlasd6.f @@ -307,7 +307,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, + SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, + $ BETA, $ IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) @@ -341,7 +342,8 @@ SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, DOUBLE PRECISION ORGNRM * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAMRG, DLASCL, DLASD7, DLASD8, XERBLA + EXTERNAL DCOPY, DLAMRG, DLASCL, DLASD7, DLASD8, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX diff --git a/SRC/dlasd7.f b/SRC/dlasd7.f index a366b68114..1e266607a1 100644 --- a/SRC/dlasd7.f +++ b/SRC/dlasd7.f @@ -274,7 +274,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL, + SUBROUTINE DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, + $ VL, $ VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ C, S, INFO ) diff --git a/SRC/dlasd8.f b/SRC/dlasd8.f index e1772ee71b..a84569bd20 100644 --- a/SRC/dlasd8.f +++ b/SRC/dlasd8.f @@ -187,7 +187,8 @@ SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLASCL, DLASD4, DLASET, XERBLA + EXTERNAL DCOPY, DLASCL, DLASD4, DLASET, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DDOT, DLAMC3, DNRM2 @@ -296,11 +297,13 @@ SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, * from doing x+(y+z). * DO 60 I = 1, J - 1 - WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), DSIGJ )-DIFLJ ) + WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), + $ DSIGJ )-DIFLJ ) $ / ( DSIGMA( I )+DJ ) 60 CONTINUE DO 70 I = J + 1, K - WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), DSIGJP )+DIFRJ ) + WORK( I ) = Z( I ) / ( DLAMC3( DSIGMA( I ), + $ DSIGJP )+DIFRJ ) $ / ( DSIGMA( I )+DJ ) 70 CONTINUE TEMP = DNRM2( K, WORK, 1 ) diff --git a/SRC/dlasda.f b/SRC/dlasda.f index 8b75ba3ddc..e0e44c599d 100644 --- a/SRC/dlasda.f +++ b/SRC/dlasda.f @@ -268,7 +268,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, + SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, + $ K, $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, $ PERM, GIVNUM, C, S, WORK, IWORK, INFO ) * @@ -302,7 +303,8 @@ SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, DOUBLE PRECISION ALPHA, BETA * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLASD6, DLASDQ, DLASDT, DLASET, XERBLA + EXTERNAL DCOPY, DLASD6, DLASDQ, DLASDT, DLASET, + $ XERBLA * .. * .. Executable Statements .. * @@ -334,10 +336,12 @@ SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, * IF( N.LE.SMLSIZ ) THEN IF( ICOMPQ.EQ.0 ) THEN - CALL DLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, LDU, + CALL DLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, + $ LDU, $ U, LDU, WORK, INFO ) ELSE - CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, LDU, + CALL DLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, + $ LDU, $ U, LDU, WORK, INFO ) END IF RETURN @@ -398,7 +402,8 @@ SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, CALL DCOPY( NLP1, WORK( ITEMP ), 1, WORK( VLI ), 1 ) ELSE CALL DLASET( 'A', NL, NL, ZERO, ONE, U( NLF, 1 ), LDU ) - CALL DLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), LDU ) + CALL DLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), + $ LDU ) CALL DLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), $ E( NLF ), VT( NLF, 1 ), LDU, U( NLF, 1 ), LDU, $ U( NLF, 1 ), LDU, WORK( NWORK1 ), INFO ) @@ -432,7 +437,8 @@ SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, CALL DCOPY( NRP1, WORK( ITEMP ), 1, WORK( VLI ), 1 ) ELSE CALL DLASET( 'A', NR, NR, ZERO, ONE, U( NRF, 1 ), LDU ) - CALL DLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), LDU ) + CALL DLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), + $ LDU ) CALL DLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), $ E( NRF ), VT( NRF, 1 ), LDU, U( NRF, 1 ), LDU, $ U( NRF, 1 ), LDU, WORK( NWORK1 ), INFO ) diff --git a/SRC/dlasdq.f b/SRC/dlasdq.f index 1ca92992c9..3e99cbe838 100644 --- a/SRC/dlasdq.f +++ b/SRC/dlasdq.f @@ -207,7 +207,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, + SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, + $ LDVT, $ U, LDU, C, LDC, WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -235,7 +236,8 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, DOUBLE PRECISION CS, R, SMIN, SN * .. * .. External Subroutines .. - EXTERNAL DBDSQR, DLARTG, DLASR, DSWAP, XERBLA + EXTERNAL DBDSQR, DLARTG, DLASR, DSWAP, + $ XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -396,7 +398,8 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, D( ISUB ) = D( I ) D( I ) = SMIN IF( NCVT.GT.0 ) - $ CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), LDVT ) + $ CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), + $ LDVT ) IF( NRU.GT.0 ) $ CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, I ), 1 ) IF( NCC.GT.0 ) diff --git a/SRC/dlasq1.f b/SRC/dlasq1.f index 08c6e9d4a8..869af8f60b 100644 --- a/SRC/dlasq1.f +++ b/SRC/dlasq1.f @@ -129,7 +129,8 @@ SUBROUTINE DLASQ1( N, D, E, WORK, INFO ) DOUBLE PRECISION EPS, SCALE, SAFMIN, SIGMN, SIGMX * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, XERBLA + EXTERNAL DCOPY, DLAS2, DLASCL, DLASQ2, DLASRT, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DLAMCH diff --git a/SRC/dlasq2.f b/SRC/dlasq2.f index 2e1fb48e96..d62c364064 100644 --- a/SRC/dlasq2.f +++ b/SRC/dlasq2.f @@ -464,7 +464,8 @@ SUBROUTINE DLASQ2( N, Z, INFO ) * * While submatrix unfinished take a good dqds step. * - CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, + CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, + $ NFAIL, $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * diff --git a/SRC/dlasq3.f b/SRC/dlasq3.f index 399c4cc498..e20a883127 100644 --- a/SRC/dlasq3.f +++ b/SRC/dlasq3.f @@ -177,7 +177,8 @@ *> \ingroup lasq3 * * ===================================================================== - SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, + SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, + $ NFAIL, $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * diff --git a/SRC/dlasq5.f b/SRC/dlasq5.f index f7974af04a..e24b5d8357 100644 --- a/SRC/dlasq5.f +++ b/SRC/dlasq5.f @@ -140,7 +140,8 @@ *> \ingroup lasq5 * * ===================================================================== - SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, + SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, + $ DMIN2, $ DN, DNM1, DNM2, IEEE, EPS ) * * -- LAPACK computational routine -- diff --git a/SRC/dlasr.f b/SRC/dlasr.f index 7d8dec44f9..b2d9bce0f8 100644 --- a/SRC/dlasr.f +++ b/SRC/dlasr.f @@ -235,12 +235,14 @@ SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * Test the input parameters * INFO = 0 - IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN + IF( .NOT.( LSAME( SIDE, 'L' ) .OR. + $ LSAME( SIDE, 'R' ) ) ) THEN INFO = 1 ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN INFO = 2 - ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) + ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. + $ LSAME( DIRECT, 'B' ) ) ) $ THEN INFO = 3 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/dlasyf.f b/SRC/dlasyf.f index f0858b1a51..bdc001f941 100644 --- a/SRC/dlasyf.f +++ b/SRC/dlasyf.f @@ -173,7 +173,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -244,7 +245,8 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * CALL DCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 ) IF( K.LT.N ) - $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), LDA, + $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 ) * KSTEP = 1 @@ -286,7 +288,8 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL DCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) IF( K.LT.N ) - $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), + $ CALL DGEMV( 'No transpose', K, N-K, -ONE, A( 1, + $ K+1 ), $ LDA, W( IMAX, KW+1 ), LDW, ONE, $ W( 1, KW-1 ), 1 ) * @@ -487,7 +490,8 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Update the rectangular superdiagonal block * - CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, -ONE, + CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, + $ -ONE, $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE, $ A( 1, J ), LDA ) 50 CONTINUE @@ -540,7 +544,8 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * Copy column K of A to column K of W and update it * CALL DCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 ) - CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), LDA, + CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, ONE, W( K, K ), 1 ) * KSTEP = 1 @@ -578,10 +583,13 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) - CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ), + CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), $ 1 ) - CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), + CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, + $ K+1 ), + $ 1 ) + CALL DGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, ONE, W( K, K+1 ), 1 ) * * JMAX is the column-index of the largest off-diagonal @@ -639,7 +647,8 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL DCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) IF( KP.LT.N ) - $ CALL DCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL DCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/dlasyf_aa.f b/SRC/dlasyf_aa.f index fe876bd483..ea62f7c298 100644 --- a/SRC/dlasyf_aa.f +++ b/SRC/dlasyf_aa.f @@ -173,7 +173,8 @@ SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, IDAMAX * .. * .. External Subroutines .. - EXTERNAL DGEMV, DAXPY, DCOPY, DSWAP, DSCAL, DLASET, + EXTERNAL DGEMV, DAXPY, DCOPY, DSWAP, DSCAL, + $ DLASET, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dlasyf_rk.f b/SRC/dlasyf_rk.f index 40c5f72f53..9bd76b060f 100644 --- a/SRC/dlasyf_rk.f +++ b/SRC/dlasyf_rk.f @@ -406,7 +406,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL DCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -505,7 +506,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * and last N-K+2 columns of W * CALL DSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL DSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL DSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -522,7 +524,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL DSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -729,7 +732,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -749,7 +753,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = ABS( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -771,7 +776,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -797,7 +803,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -832,7 +839,8 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL DCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/dlasyf_rook.f b/SRC/dlasyf_rook.f index c7b6498e04..2e31ba04b1 100644 --- a/SRC/dlasyf_rook.f +++ b/SRC/dlasyf_rook.f @@ -318,7 +318,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL DCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL DCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -417,7 +418,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * and last N-K+2 columns of W * CALL DSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL DSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL DSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -434,7 +436,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL DSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL DSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -644,7 +647,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL DCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL DCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -664,7 +668,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IDAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = ABS( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -686,7 +691,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -712,7 +718,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL DCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -747,7 +754,8 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL DCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL DCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/dlatbs.f b/SRC/dlatbs.f index 2775a94a10..bcbe7b0874 100644 --- a/SRC/dlatbs.f +++ b/SRC/dlatbs.f @@ -238,7 +238,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, + SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, + $ X, $ SCALE, CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -703,7 +704,8 @@ SUBROUTINE DLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, ELSE JLEN = MIN( KD, N-J ) IF( JLEN.GT.0 ) - $ SUMJ = DDOT( JLEN, AB( 2, J ), 1, X( J+1 ), 1 ) + $ SUMJ = DDOT( JLEN, AB( 2, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * diff --git a/SRC/dlatdf.f b/SRC/dlatdf.f index c381cd508b..0d4435e02f 100644 --- a/SRC/dlatdf.f +++ b/SRC/dlatdf.f @@ -200,7 +200,8 @@ SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, DOUBLE PRECISION WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGECON, DGESC2, DLASSQ, DLASWP, + EXTERNAL DAXPY, DCOPY, DGECON, DGESC2, DLASSQ, + $ DLASWP, $ DSCAL * .. * .. External Functions .. @@ -230,7 +231,8 @@ SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, * Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and * SMIN computed more efficiently than in BSOLVE [1]. * - SPLUS = SPLUS + DDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 ) + SPLUS = SPLUS + DDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), + $ 1 ) SMINU = DDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) SPLUS = SPLUS*RHS( J ) IF( SPLUS.GT.SMINU ) THEN diff --git a/SRC/dlatps.f b/SRC/dlatps.f index 79e7fab5ff..65058b01e4 100644 --- a/SRC/dlatps.f +++ b/SRC/dlatps.f @@ -618,7 +618,8 @@ SUBROUTINE DLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * Compute the update * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) * - CALL DAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X, + CALL DAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, + $ X, $ 1 ) I = IDAMAX( J-1, X, 1 ) XMAX = ABS( X( I ) ) diff --git a/SRC/dlatrd.f b/SRC/dlatrd.f index 774818cfd6..6d1e4a4e87 100644 --- a/SRC/dlatrd.f +++ b/SRC/dlatrd.f @@ -249,7 +249,8 @@ SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * CALL DGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ), $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 ) - CALL DGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ), + CALL DGEMV( 'No transpose', I, N-I, -ONE, W( 1, + $ IW+1 ), $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 ) END IF IF( I.GT.1 ) THEN @@ -257,7 +258,8 @@ SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * Generate elementary reflector H(i) to annihilate * A(1:i-2,i) * - CALL DLARFG( I-1, A( I-1, I ), A( 1, I ), 1, TAU( I-1 ) ) + CALL DLARFG( I-1, A( I-1, I ), A( 1, I ), 1, + $ TAU( I-1 ) ) E( I-1 ) = A( I-1, I ) A( I-1, I ) = ONE * @@ -266,12 +268,14 @@ SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) CALL DSYMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1, $ ZERO, W( 1, IW ), 1 ) IF( I.LT.N ) THEN - CALL DGEMV( 'Transpose', I-1, N-I, ONE, W( 1, IW+1 ), + CALL DGEMV( 'Transpose', I-1, N-I, ONE, W( 1, + $ IW+1 ), $ LDW, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 ) CALL DGEMV( 'No transpose', I-1, N-I, -ONE, $ A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE, $ W( 1, IW ), 1 ) - CALL DGEMV( 'Transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL DGEMV( 'Transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 ) CALL DGEMV( 'No transpose', I-1, N-I, -ONE, $ W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE, @@ -301,7 +305,8 @@ SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * Generate elementary reflector H(i) to annihilate * A(i+2:n,i) * - CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, + CALL DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), + $ 1, $ TAU( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE @@ -310,18 +315,23 @@ SUBROUTINE DLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * CALL DSYMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA, $ A( I+1, I ), 1, ZERO, W( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), LDW, + CALL DGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), + $ LDW, $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ), + CALL DGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) - CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ), + CALL DGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, + $ 1 ), $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL DSCAL( N-I, TAU( I ), W( I+1, I ), 1 ) ALPHA = -HALF*TAU( I )*DDOT( N-I, W( I+1, I ), 1, $ A( I+1, I ), 1 ) - CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 ) + CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), + $ 1 ) END IF * 20 CONTINUE diff --git a/SRC/dlatrs.f b/SRC/dlatrs.f index cf103f59fe..43a9df03c2 100644 --- a/SRC/dlatrs.f +++ b/SRC/dlatrs.f @@ -234,7 +234,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, + SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, + $ SCALE, $ CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -269,7 +270,8 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, LOGICAL LSAME INTEGER IDAMAX DOUBLE PRECISION DASUM, DDOT, DLAMCH, DLANGE - EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH, DLANGE + EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH, + $ DLANGE * .. * .. External Subroutines .. EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA @@ -366,8 +368,8 @@ SUBROUTINE DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, * A is upper triangular. * DO J = 2, N - TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, WORK ), - $ TMAX ) + TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, + $ WORK ), TMAX ) END DO ELSE * diff --git a/SRC/dlatrs3.f b/SRC/dlatrs3.f index dc1d6631cb..eaf4980458 100644 --- a/SRC/dlatrs3.f +++ b/SRC/dlatrs3.f @@ -267,7 +267,8 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANGE, DLARMM - EXTERNAL DLAMCH, DLANGE, DLARMM, ILAENV, LSAME + EXTERNAL DLAMCH, DLANGE, DLARMM, ILAENV, + $ LSAME * .. * .. External Subroutines .. EXTERNAL DLATRS, DSCAL, XERBLA @@ -369,7 +370,8 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, CALL DLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X( 1, 1), $ SCALE( 1 ), CNORM, INFO ) DO K = 2, NRHS - CALL DLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, K ), + CALL DLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -396,10 +398,12 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute upper bound of A( I1:I2-1, J1:J2-1 ). * IF( NOTRAN ) THEN - ANRM = DLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = DLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + I+(J-1)*NBA ) = ANRM ELSE - ANRM = DLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = DLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + J+(I-1)*NBA ) = ANRM END IF TMAX = MAX( TMAX, ANRM ) @@ -416,7 +420,8 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * in the computation of the column norms CNORM. * DO K = 1, NRHS - CALL DLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, K ), + CALL DLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -600,7 +605,8 @@ SUBROUTINE DLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute scaling factor to survive the linear update * simulating consistent scaling. * - BNRM = DLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, W ) + BNRM = DLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, + $ W ) BNRM = BNRM*( SCAMIN / WORK( I+KK*LDS ) ) XNRM( KK ) = XNRM( KK )*(SCAMIN / WORK( J+KK*LDS )) ANRM = WORK( AWRK + I+(J-1)*NBA ) diff --git a/SRC/dlauu2.f b/SRC/dlauu2.f index c04ee253b5..8052edfc87 100644 --- a/SRC/dlauu2.f +++ b/SRC/dlauu2.f @@ -165,8 +165,10 @@ SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO ) DO 10 I = 1, N AII = A( I, I ) IF( I.LT.N ) THEN - A( I, I ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA ) - CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + A( I, I ) = DDOT( N-I+1, A( I, I ), LDA, A( I, I ), + $ LDA ) + CALL DGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 ) ELSE CALL DSCAL( I, AII, A( 1, I ), 1 ) @@ -181,7 +183,8 @@ SUBROUTINE DLAUU2( UPLO, N, A, LDA, INFO ) AII = A( I, I ) IF( I.LT.N ) THEN A( I, I ) = DDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 ) - CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL DGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, AII, A( I, 1 ), LDA ) ELSE CALL DSCAL( I, AII, A( I, 1 ), LDA ) diff --git a/SRC/dlauum.f b/SRC/dlauum.f index 53da74d78a..816f4dc2b0 100644 --- a/SRC/dlauum.f +++ b/SRC/dlauum.f @@ -195,14 +195,16 @@ SUBROUTINE DLAUUM( UPLO, N, A, LDA, INFO ) * DO 20 I = 1, N, NB IB = MIN( NB, N-I+1 ) - CALL DTRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB, + CALL DTRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', + $ IB, $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA ) CALL DLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) IF( I+IB.LE.N ) THEN CALL DGEMM( 'Transpose', 'No transpose', IB, I-1, $ N-I-IB+1, ONE, A( I+IB, I ), LDA, $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA ) - CALL DSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE, + CALL DSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, + $ ONE, $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA ) END IF 20 CONTINUE diff --git a/SRC/dopmtr.f b/SRC/dopmtr.f index 9c35116a9b..71be4395c2 100644 --- a/SRC/dopmtr.f +++ b/SRC/dopmtr.f @@ -146,7 +146,8 @@ *> \ingroup upmtr * * ===================================================================== - SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, + SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- @@ -263,7 +264,8 @@ SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, * AII = AP( II ) AP( II ) = ONE - CALL DLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, LDC, + CALL DLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, + $ LDC, $ WORK ) AP( II ) = AII * diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f index 3bd4289006..b22875dcd2 100644 --- a/SRC/dorbdb.f +++ b/SRC/dorbdb.f @@ -282,7 +282,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, + $ LDX12, $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1, $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, DOUBLE PRECISION Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DLARF, DLARFGP, DSCAL, XERBLA + EXTERNAL DAXPY, DLARF, DLARFGP, DSCAL, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DNRM2 @@ -399,14 +401,16 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL DSCAL( P-I+1, Z1, X11(I,I), 1 ) ELSE CALL DSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), 1 ) - CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I,I-1), + CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I, + $ I-1), $ 1, X11(I,I), 1 ) END IF IF( I .EQ. 1 ) THEN CALL DSCAL( M-P-I+1, Z2, X21(I,I), 1 ) ELSE CALL DSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), 1 ) - CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I,I-1), + CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I, + $ I-1), $ 1, X21(I,I), 1 ) END IF * @@ -414,7 +418,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ DNRM2( P-I+1, X11(I,I), 1 ) ) * IF( P .GT. I ) THEN - CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, + $ TAUP1(I) ) ELSE IF( P .EQ. I ) THEN CALL DLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF @@ -423,7 +428,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) ELSE IF ( M-P .EQ. I ) THEN - CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, TAUP2(I) ) + CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, + $ TAUP2(I) ) END IF X21(I,I) = ONE * @@ -432,7 +438,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X11(I,I+1), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I), + CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ TAUP1(I), $ X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN @@ -440,18 +447,22 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I), + CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ TAUP2(I), $ X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1), $ LDX11 ) - CALL DAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), LDX21, + CALL DAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), + $ LDX21, $ X11(I,I+1), LDX11 ) END IF - CALL DSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), LDX12 ) - CALL DAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), LDX22, + CALL DSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), + $ LDX12 ) + CALL DAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), + $ LDX22, $ X12(I,I), LDX12 ) * IF( I .LT. Q ) @@ -480,13 +491,16 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL DLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL DLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN @@ -511,7 +525,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) @@ -534,7 +549,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, END IF X22(Q+I,P+I) = ONE IF ( I .LT. M-P-Q ) THEN - CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, + CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + $ LDX22, $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) END IF * @@ -550,21 +566,25 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL DSCAL( P-I+1, Z1, X11(I,I), LDX11 ) ELSE CALL DSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), LDX11 ) - CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1,I), + CALL DAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1, + $ I), $ LDX12, X11(I,I), LDX11 ) END IF IF( I .EQ. 1 ) THEN CALL DSCAL( M-P-I+1, Z2, X21(I,I), LDX21 ) ELSE - CALL DSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), LDX21 ) - CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1,I), + CALL DSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), + $ LDX21 ) + CALL DAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1, + $ I), $ LDX22, X21(I,I), LDX21 ) END IF * THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(I,I), LDX21 ), $ DNRM2( P-I+1, X11(I,I), LDX11 ) ) * - CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) + CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, + $ TAUP1(I) ) X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, @@ -576,7 +596,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), + CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), $ X11(I+1,I), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN @@ -584,7 +605,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ TAUP1(I), X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), + CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), $ X21(I+1,I), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN @@ -633,7 +655,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN - CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I), + CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ TAUQ2(I), $ X22(I,I+1), LDX22, WORK ) END IF * @@ -644,7 +667,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, DO I = Q + 1, P * CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 ) - CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF ( P .GT. I ) THEN @@ -652,7 +676,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I), + $ CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ TAUQ2(I), $ X22(I,Q+1), LDX22, WORK ) * END DO @@ -663,10 +688,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 ) IF ( M-P-Q .EQ. I ) THEN - CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), 1, + CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), + $ 1, $ TAUQ2(P+I) ) ELSE - CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1, + CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), + $ 1, $ TAUQ2(P+I) ) CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK ) diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f index f562217985..588d47c08b 100644 --- a/SRC/dorbdb1.f +++ b/SRC/dorbdb1.f @@ -199,7 +199,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -228,7 +229,8 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, XERBLA + EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DNRM2 @@ -288,14 +290,17 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, S = SIN( THETA(I) ) X11(I,I) = ONE X21(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN - CALL DROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, S ) - CALL DLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) ) + CALL DROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, + $ S ) + CALL DLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, + $ TAUQ1(I) ) S = X21(I,I+1) X21(I,I+1) = ONE CALL DLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f index 0276a0183b..e17550fac8 100644 --- a/SRC/dorbdb2.f +++ b/SRC/dorbdb2.f @@ -198,7 +198,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, DSCAL, XERBLA + EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, DSCAL, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DNRM2 @@ -281,7 +283,8 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = 1, P * IF( I .GT. 1 ) THEN - CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S ) + CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, + $ S ) END IF CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = X11(I,I) diff --git a/SRC/dorbdb3.f b/SRC/dorbdb3.f index 3d0743a97e..15bfb51c5e 100644 --- a/SRC/dorbdb3.f +++ b/SRC/dorbdb3.f @@ -197,7 +197,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -226,7 +227,8 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, XERBLA + EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DNRM2 @@ -280,7 +282,8 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = 1, M-P * IF( I .GT. 1 ) THEN - CALL DROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S ) + CALL DROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, + $ S ) END IF * CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) @@ -299,7 +302,8 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) IF( I .LT. M-P ) THEN - CALL DLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) ) + CALL DLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, + $ TAUP2(I) ) PHI(I) = ATAN2( X21(I+1,I), X11(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) @@ -308,7 +312,8 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF X11(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) * END DO @@ -318,7 +323,8 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = M-P + 1, Q CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) X11(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) END DO * diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f index 63d0a867dc..f77083c488 100644 --- a/SRC/dorbdb4.f +++ b/SRC/dorbdb4.f @@ -208,7 +208,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * @@ -238,7 +239,8 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, DSCAL, XERBLA + EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, DSCAL, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DNRM2 @@ -301,13 +303,15 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ LORBDB5, CHILDINFO ) CALL DSCAL( P, NEGONE, PHANTOM(1), 1 ) CALL DLARFGP( P, PHANTOM(1), PHANTOM(2), 1, TAUP1(1) ) - CALL DLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, TAUP2(1) ) + CALL DLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, + $ TAUP2(1) ) THETA(I) = ATAN2( PHANTOM(1), PHANTOM(P+1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) PHANTOM(1) = ONE PHANTOM(P+1) = ONE - CALL DLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, LDX11, + CALL DLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, + $ LDX11, $ WORK(ILARF) ) CALL DLARF( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, $ LDX21, WORK(ILARF) ) @@ -316,7 +320,8 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), $ LDX21, WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL DSCAL( P-I+1, NEGONE, X11(I,I-1), 1 ) - CALL DLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, TAUP1(I) ) + CALL DLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, + $ TAUP1(I) ) CALL DLARFGP( M-P-I+1, X21(I,I-1), X21(I+1,I-1), 1, $ TAUP2(I) ) THETA(I) = ATAN2( X11(I,I-1), X21(I,I-1) ) @@ -360,10 +365,12 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, * Reduce the bottom-right portion of X21 to [ 0 I ] * DO I = P + 1, Q - CALL DLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), LDX21, + CALL DLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), + $ LDX21, $ TAUQ1(I) ) X21(M-Q+I-P,I) = ONE - CALL DLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, TAUQ1(I), + CALL DLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) END DO * diff --git a/SRC/dorbdb5.f b/SRC/dorbdb5.f index ecfab40dfb..9c1258e533 100644 --- a/SRC/dorbdb5.f +++ b/SRC/dorbdb5.f @@ -152,7 +152,8 @@ *> \ingroup unbdb5 * * ===================================================================== - SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE DORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dorbdb6.f b/SRC/dorbdb6.f index 106410b091..189ac3104d 100644 --- a/SRC/dorbdb6.f +++ b/SRC/dorbdb6.f @@ -155,7 +155,8 @@ *> \ingroup unbdb6 * * ===================================================================== - SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -238,11 +239,13 @@ SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL DGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL DGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL DGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL DGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL DGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) @@ -284,11 +287,13 @@ SUBROUTINE DORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL DGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL DGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL DGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL DGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL DGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) diff --git a/SRC/dorcsd.f b/SRC/dorcsd.f index 61a2d270f6..20188c1acb 100644 --- a/SRC/dorcsd.f +++ b/SRC/dorcsd.f @@ -293,7 +293,8 @@ *> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, @@ -405,7 +406,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL DORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL DORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, IWORK, INFO ) @@ -495,7 +497,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -505,7 +508,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -521,7 +525,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -538,7 +543,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL DORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL DORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -554,7 +560,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL DORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL DORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -568,7 +575,8 @@ RECURSIVE SUBROUTINE DORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL DBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D), diff --git a/SRC/dorcsd2by1.f b/SRC/dorcsd2by1.f index a9387317bc..afb8b0c6e2 100644 --- a/SRC/dorcsd2by1.f +++ b/SRC/dorcsd2by1.f @@ -228,7 +228,8 @@ *> \ingroup uncsd2by1 * * ===================================================================== - SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, + SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, + $ LDX11, $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, IWORK, INFO ) * @@ -267,7 +268,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, DOUBLE PRECISION DUM1(1), DUM2(1,1) * .. * .. External Subroutines .. - EXTERNAL DBBCSD, DCOPY, DLACPY, DLAPMR, DLAPMT, DORBDB1, + EXTERNAL DBBCSD, DCOPY, DLACPY, DLAPMR, DLAPMT, + $ DORBDB1, $ DORBDB2, DORBDB3, DORBDB4, DORGLQ, DORGQR, $ XERBLA * .. @@ -371,7 +373,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, + CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, + $ THETA, $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, $ DUM2, 1, DUM1, DUM1, DUM1, $ DUM1, DUM1, DUM1, DUM1, @@ -400,7 +403,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, + CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, + $ THETA, $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, $ U2, LDU2, DUM1, DUM1, DUM1, $ DUM1, DUM1, DUM1, DUM1, @@ -504,7 +508,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -520,7 +525,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END DO CALL DLACPY( 'U', Q-1, Q-1, X21(1,2), LDX21, V1T(2,2), $ LDV1T ) - CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL DORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF * @@ -563,7 +569,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, U1(1,J) = ZERO U1(J,1) = ZERO END DO - CALL DLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), LDU1 ) + CALL DLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), + $ LDU1 ) CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, WORK(ITAUP1), $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF @@ -613,7 +620,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL DLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL DORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -696,7 +704,8 @@ SUBROUTINE DORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL DLACPY( 'U', M-Q, Q, X21, LDX21, V1T, LDV1T ) - CALL DLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), LDX11, + CALL DLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), + $ LDX11, $ V1T(M-Q+1,M-Q+1), LDV1T ) CALL DLACPY( 'U', -P+Q, Q-P, X21(M-Q+1,P+1), LDX21, $ V1T(P+1,P+1), LDV1T ) diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index 9671ebd120..203cb133cf 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -178,7 +178,8 @@ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, + CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, $ LDA, WORK ) CALL DSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) diff --git a/SRC/dorgbr.f b/SRC/dorgbr.f index d1fb414e71..a965dd0b53 100644 --- a/SRC/dorgbr.f +++ b/SRC/dorgbr.f @@ -154,7 +154,8 @@ *> \ingroup ungbr * * ===================================================================== - SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dorghr.f b/SRC/dorghr.f index 05eca94ab5..bbe3ce1e82 100644 --- a/SRC/dorghr.f +++ b/SRC/dorghr.f @@ -123,7 +123,8 @@ *> \ingroup unghr * * ===================================================================== - SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dorglq.f b/SRC/dorglq.f index 1a926cba1d..faff1ca523 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -212,7 +212,8 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -253,12 +254,14 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right * - CALL DLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise', + CALL DLARFB( 'Right', 'Transpose', 'Forward', + $ 'Rowwise', $ M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK, $ LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ), $ LDWORK ) @@ -266,7 +269,8 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**T to columns i:n of current block * - CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set columns 1:i-1 of current block to zero diff --git a/SRC/dorgql.f b/SRC/dorgql.f index 7e84341eda..2d8d1e4d39 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -222,7 +222,8 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORGQL', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DORGQL', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f index 120f9df0bf..bb3da27bdd 100644 --- a/SRC/dorgqr.f +++ b/SRC/dorgqr.f @@ -213,7 +213,8 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DORGQR', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -267,7 +268,8 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H to rows i:m of current block * - CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL DORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set rows 1:i-1 of current block to zero diff --git a/SRC/dorgr2.f b/SRC/dorgr2.f index af17a8a9de..0daf7eb2bb 100644 --- a/SRC/dorgr2.f +++ b/SRC/dorgr2.f @@ -182,7 +182,8 @@ SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the right * A( II, N-M+II ) = ONE - CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ), + CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + $ TAU( I ), $ A, LDA, WORK ) CALL DSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - TAU( I ) diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index 26f7a3f847..9e9ae020f7 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -222,7 +222,8 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORGRQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DORGRQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -266,14 +267,16 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * - CALL DLARFB( 'Right', 'Transpose', 'Backward', 'Rowwise', + CALL DLARFB( 'Right', 'Transpose', 'Backward', + $ 'Rowwise', $ II-1, N-K+I+IB-1, IB, A( II, 1 ), LDA, WORK, $ LDWORK, A, LDA, WORK( IB+1 ), LDWORK ) END IF * * Apply H**T to columns 1:n-k+i+ib-1 of current block * - CALL DORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ), + CALL DORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) * * Set columns n-k+i+ib:n of current block to zero diff --git a/SRC/dorgtr.f b/SRC/dorgtr.f index d069866bd8..4c8749f6a3 100644 --- a/SRC/dorgtr.f +++ b/SRC/dorgtr.f @@ -217,7 +217,8 @@ SUBROUTINE DORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Generate Q(1:n-1,1:n-1) * - CALL DORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO ) + CALL DORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, + $ IINFO ) * ELSE * diff --git a/SRC/dorhr_col.f b/SRC/dorhr_col.f index 476931b7db..88048ef41f 100644 --- a/SRC/dorhr_col.f +++ b/SRC/dorhr_col.f @@ -281,7 +281,8 @@ SUBROUTINE DORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) $ NPLUSONE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAORHR_COL_GETRFNP, DSCAL, DTRSM, + EXTERNAL DCOPY, DLAORHR_COL_GETRFNP, DSCAL, + $ DTRSM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dorm22.f b/SRC/dorm22.f index 7f78b19385..40c729477c 100644 --- a/SRC/dorm22.f +++ b/SRC/dorm22.f @@ -217,7 +217,8 @@ SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, IF( N1.EQ.0 .OR. N2.EQ.0 ) NW = 1 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN @@ -283,13 +284,15 @@ SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL DLACPY( 'All', N1, LEN, C( N2+1, I ), LDC, WORK, $ LDWORK ) - CALL DTRMM( 'Left', 'Lower', 'No Transpose', 'Non-Unit', + CALL DTRMM( 'Left', 'Lower', 'No Transpose', + $ 'Non-Unit', $ N1, LEN, ONE, Q( 1, N2+1 ), LDQ, WORK, $ LDWORK ) * * Multiply top part of C by Q11. * - CALL DGEMM( 'No Transpose', 'No Transpose', N1, LEN, N2, + CALL DGEMM( 'No Transpose', 'No Transpose', N1, LEN, + $ N2, $ ONE, Q, LDQ, C( 1, I ), LDC, ONE, WORK, $ LDWORK ) * @@ -297,13 +300,15 @@ SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL DLACPY( 'All', N2, LEN, C( 1, I ), LDC, $ WORK( N1+1 ), LDWORK ) - CALL DTRMM( 'Left', 'Upper', 'No Transpose', 'Non-Unit', + CALL DTRMM( 'Left', 'Upper', 'No Transpose', + $ 'Non-Unit', $ N2, LEN, ONE, Q( N1+1, 1 ), LDQ, $ WORK( N1+1 ), LDWORK ) * * Multiply bottom part of C by Q22. * - CALL DGEMM( 'No Transpose', 'No Transpose', N2, LEN, N1, + CALL DGEMM( 'No Transpose', 'No Transpose', N2, LEN, + $ N1, $ ONE, Q( N1+1, N2+1 ), LDQ, C( N2+1, I ), LDC, $ ONE, WORK( N1+1 ), LDWORK ) * @@ -361,13 +366,15 @@ SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL DLACPY( 'All', LEN, N2, C( I, N1+1 ), LDC, WORK, $ LDWORK ) - CALL DTRMM( 'Right', 'Upper', 'No Transpose', 'Non-Unit', + CALL DTRMM( 'Right', 'Upper', 'No Transpose', + $ 'Non-Unit', $ LEN, N2, ONE, Q( N1+1, 1 ), LDQ, WORK, $ LDWORK ) * * Multiply left part of C by Q11. * - CALL DGEMM( 'No Transpose', 'No Transpose', LEN, N2, N1, + CALL DGEMM( 'No Transpose', 'No Transpose', LEN, N2, + $ N1, $ ONE, C( I, 1 ), LDC, Q, LDQ, ONE, WORK, $ LDWORK ) * @@ -375,13 +382,15 @@ SUBROUTINE DORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL DLACPY( 'All', LEN, N1, C( I, 1 ), LDC, $ WORK( 1 + N2*LDWORK ), LDWORK ) - CALL DTRMM( 'Right', 'Lower', 'No Transpose', 'Non-Unit', + CALL DTRMM( 'Right', 'Lower', 'No Transpose', + $ 'Non-Unit', $ LEN, N1, ONE, Q( 1, N2+1 ), LDQ, $ WORK( 1 + N2*LDWORK ), LDWORK ) * * Multiply right part of C by Q22. * - CALL DGEMM( 'No Transpose', 'No Transpose', LEN, N1, N2, + CALL DGEMM( 'No Transpose', 'No Transpose', LEN, N1, + $ N2, $ ONE, C( I, N1+1 ), LDC, Q( N1+1, N2+1 ), LDQ, $ ONE, WORK( 1 + N2*LDWORK ), LDWORK ) * diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index 32ae96e8b0..5bdc2ea18e 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -269,7 +269,8 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * AII = A( I, I ) A( I, I ) = ONE - CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ), + CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + $ JC ), $ LDC, WORK ) A( I, I ) = AII 10 CONTINUE diff --git a/SRC/dormbr.f b/SRC/dormbr.f index 15be46c579..46c617e5c0 100644 --- a/SRC/dormbr.f +++ b/SRC/dormbr.f @@ -325,7 +325,8 @@ SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, I1 = 1 I2 = 2 END IF - CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, + $ TAU, $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) END IF ELSE diff --git a/SRC/dormhr.f b/SRC/dormhr.f index 696969b3d1..02e1a534a0 100644 --- a/SRC/dormhr.f +++ b/SRC/dormhr.f @@ -226,7 +226,8 @@ SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/dormlq.f b/SRC/dormlq.f index 1f86956f23..1e42594707 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -242,7 +242,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT @@ -267,7 +268,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -276,7 +278,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -332,7 +335,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB, + CALL DLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, + $ IB, $ A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/dormql.f b/SRC/dormql.f index 9b2fe12733..8193e22bd7 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -244,7 +244,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'DORMQL', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -269,7 +270,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'DORMQL', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -278,7 +280,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -324,7 +327,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + CALL DLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, + $ NI, $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, $ WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/dormqr.f b/SRC/dormqr.f index 4a0dd3caa3..6e7a39b795 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -241,7 +241,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT @@ -266,7 +267,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -275,7 +277,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -307,7 +310,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * @@ -325,7 +329,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, + $ NI, $ IB, A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/dormr3.f b/SRC/dormr3.f index 92023ead15..a2f7adba10 100644 --- a/SRC/dormr3.f +++ b/SRC/dormr3.f @@ -174,7 +174,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dormrq.f b/SRC/dormrq.f index a17e757beb..a90e359f55 100644 --- a/SRC/dormrq.f +++ b/SRC/dormrq.f @@ -245,7 +245,8 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -270,7 +271,8 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -279,7 +281,8 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * diff --git a/SRC/dormrz.f b/SRC/dormrz.f index d04bf0961c..4d6d4f5d21 100644 --- a/SRC/dormrz.f +++ b/SRC/dormrz.f @@ -183,7 +183,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -268,7 +269,8 @@ SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -294,7 +296,8 @@ SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -343,7 +346,8 @@ SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA, + CALL DLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), + $ LDA, $ TAU( I ), WORK( IWT ), LDT ) * IF( LEFT ) THEN diff --git a/SRC/dormtr.f b/SRC/dormtr.f index f0dc28891d..3297cd322b 100644 --- a/SRC/dormtr.f +++ b/SRC/dormtr.f @@ -167,7 +167,8 @@ *> \ingroup unmtr * * ===================================================================== - SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -221,7 +222,8 @@ SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -3 ELSE IF( M.LT.0 ) THEN @@ -284,7 +286,8 @@ SUBROUTINE DORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, * * Q was determined by a call to DSYTRD with UPLO = 'U' * - CALL DORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + CALL DORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, + $ C, $ LDC, WORK, LWORK, IINFO ) ELSE * diff --git a/SRC/dpbcon.f b/SRC/dpbcon.f index fd932c7a71..e003510220 100644 --- a/SRC/dpbcon.f +++ b/SRC/dpbcon.f @@ -224,14 +224,16 @@ SUBROUTINE DPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * * Multiply by inv(U). * - CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ), $ INFO ) ELSE * * Multiply by inv(L). * - CALL DLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ), $ INFO ) NORMIN = 'Y' diff --git a/SRC/dpbequ.f b/SRC/dpbequ.f index 8ef15c496d..9013375d45 100644 --- a/SRC/dpbequ.f +++ b/SRC/dpbequ.f @@ -126,7 +126,8 @@ *> \ingroup pbequ * * ===================================================================== - SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) + SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dpbrfs.f b/SRC/dpbrfs.f index 304815835b..ce056e5207 100644 --- a/SRC/dpbrfs.f +++ b/SRC/dpbrfs.f @@ -225,7 +225,8 @@ SUBROUTINE DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DPBTRS, DSBMV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DPBTRS, DSBMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -398,14 +399,16 @@ SUBROUTINE DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N, + CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), + $ N, $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( N+I )*WORK( I ) @@ -417,7 +420,8 @@ SUBROUTINE DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, DO 120 I = 1, N WORK( N+I ) = WORK( N+I )*WORK( I ) 120 CONTINUE - CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N, + CALL DPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/dpbsv.f b/SRC/dpbsv.f index b5c81f4033..ca5ba38abb 100644 --- a/SRC/dpbsv.f +++ b/SRC/dpbsv.f @@ -192,7 +192,8 @@ SUBROUTINE DPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dpbsvx.f b/SRC/dpbsvx.f index 8b1b326ee1..e93b29543c 100644 --- a/SRC/dpbsvx.f +++ b/SRC/dpbsvx.f @@ -338,7 +338,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, + $ LDAFB, $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -375,7 +376,8 @@ SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EXTERNAL LSAME, DLAMCH, DLANSB * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DLAQSB, DPBCON, DPBEQU, DPBRFS, + EXTERNAL DCOPY, DLACPY, DLAQSB, DPBCON, DPBEQU, + $ DPBRFS, $ DPBTRF, DPBTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -398,7 +400,9 @@ SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN @@ -455,7 +459,8 @@ SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Equilibrate the matrix. * - CALL DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + CALL DLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) RCEQU = LSAME( EQUED, 'Y' ) END IF END IF @@ -503,7 +508,8 @@ SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Compute the reciprocal of the condition number of A. * - CALL DPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, IWORK, + CALL DPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * Compute the solution matrix X. @@ -514,7 +520,8 @@ SUBROUTINE DPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, + CALL DPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/dpbtrf.f b/SRC/dpbtrf.f index f7a6b1bdca..bcd2042a1a 100644 --- a/SRC/dpbtrf.f +++ b/SRC/dpbtrf.f @@ -173,7 +173,8 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DGEMM, DPBTF2, DPOTF2, DSYRK, DTRSM, XERBLA + EXTERNAL DGEMM, DPBTF2, DPOTF2, DSYRK, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -300,7 +301,8 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * Update A23 * IF( I2.GT.0 ) - $ CALL DGEMM( 'Transpose', 'No Transpose', I2, I3, + $ CALL DGEMM( 'Transpose', 'No Transpose', I2, + $ I3, $ IB, -ONE, AB( KD+1-IB, I+IB ), $ LDAB-1, WORK, LDWORK, ONE, $ AB( 1+IB, I+KD ), LDAB-1 ) @@ -376,7 +378,8 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A22 * - CALL DSYRK( 'Lower', 'No Transpose', I2, IB, -ONE, + CALL DSYRK( 'Lower', 'No Transpose', I2, IB, + $ -ONE, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1, I+IB ), LDAB-1 ) END IF @@ -400,14 +403,16 @@ SUBROUTINE DPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * Update A32 * IF( I2.GT.0 ) - $ CALL DGEMM( 'No transpose', 'Transpose', I3, I2, + $ CALL DGEMM( 'No transpose', 'Transpose', I3, + $ I2, $ IB, -ONE, WORK, LDWORK, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1+KD-IB, I+IB ), LDAB-1 ) * * Update A33 * - CALL DSYRK( 'Lower', 'No Transpose', I3, IB, -ONE, + CALL DSYRK( 'Lower', 'No Transpose', I3, IB, + $ -ONE, $ WORK, LDWORK, ONE, AB( 1, I+KD ), $ LDAB-1 ) * diff --git a/SRC/dpbtrs.f b/SRC/dpbtrs.f index c1e6256d5d..5f9d08a579 100644 --- a/SRC/dpbtrs.f +++ b/SRC/dpbtrs.f @@ -190,7 +190,8 @@ SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve U*X = B, overwriting B with X. * - CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB, + CALL DTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) 10 CONTINUE ELSE @@ -201,7 +202,8 @@ SUBROUTINE DPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL DTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB, + CALL DTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) * * Solve L**T *X = B, overwriting B with X. diff --git a/SRC/dpftrf.f b/SRC/dpftrf.f index 64ca2ffb65..534190e66e 100644 --- a/SRC/dpftrf.f +++ b/SRC/dpftrf.f @@ -291,7 +291,8 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) CALL DPOTRF( 'L', N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), N, + CALL DTRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), + $ N, $ A( N1 ), N ) CALL DSYRK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE, $ A( N ), N ) @@ -308,7 +309,8 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) CALL DPOTRF( 'L', N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), N, + CALL DTRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), + $ N, $ A( 0 ), N ) CALL DSYRK( 'U', 'T', N2, N1, -ONE, A( 0 ), N, ONE, $ A( N1 ), N ) @@ -331,9 +333,11 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) CALL DPOTRF( 'U', N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), N1, + CALL DTRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), + $ N1, $ A( N1*N1 ), N1 ) - CALL DSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, ONE, + CALL DSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, + $ ONE, $ A( 1 ), N1 ) CALL DPOTRF( 'L', N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -348,7 +352,8 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) CALL DPOTRF( 'U', N1, A( N2*N2 ), N2, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, A( N2*N2 ), + CALL DTRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, + $ A( N2*N2 ), $ N2, A( 0 ), N2 ) CALL DSYRK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE, $ A( N1*N2 ), N2 ) @@ -377,7 +382,8 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) CALL DPOTRF( 'L', K, A( 1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), N+1, + CALL DTRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), + $ N+1, $ A( K+1 ), N+1 ) CALL DSYRK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE, $ A( 0 ), N+1 ) @@ -419,7 +425,8 @@ SUBROUTINE DPFTRF( TRANSR, UPLO, N, A, INFO ) $ RETURN CALL DTRSM( 'L', 'U', 'T', 'N', K, K, ONE, A( K ), N1, $ A( K*( K+1 ) ), K ) - CALL DSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, ONE, + CALL DSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( 0 ), K ) CALL DPOTRF( 'L', K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) diff --git a/SRC/dpftri.f b/SRC/dpftri.f index 6b9f83d047..e4de32f088 100644 --- a/SRC/dpftri.f +++ b/SRC/dpftri.f @@ -216,7 +216,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, DTFTRI, DLAUUM, DTRMM, DSYRK + EXTERNAL XERBLA, DTFTRI, DLAUUM, DTRMM, + $ DSYRK * .. * .. Intrinsic Functions .. INTRINSIC MOD @@ -291,7 +292,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'L', N1, A( 0 ), N, INFO ) CALL DSYRK( 'L', 'T', N1, N2, ONE, A( N1 ), N, ONE, $ A( 0 ), N ) - CALL DTRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), N, + CALL DTRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), + $ N, $ A( N1 ), N ) CALL DLAUUM( 'U', N2, A( N ), N, INFO ) * @@ -304,7 +306,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'L', N1, A( N2 ), N, INFO ) CALL DSYRK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE, $ A( N2 ), N ) - CALL DTRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), N, + CALL DTRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), + $ N, $ A( 0 ), N ) CALL DLAUUM( 'U', N2, A( N1 ), N, INFO ) * @@ -320,9 +323,11 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1) * CALL DLAUUM( 'U', N1, A( 0 ), N1, INFO ) - CALL DSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE, + CALL DSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, + $ ONE, $ A( 0 ), N1 ) - CALL DTRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), N1, + CALL DTRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), + $ N1, $ A( N1*N1 ), N1 ) CALL DLAUUM( 'L', N2, A( 1 ), N1, INFO ) * @@ -334,7 +339,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'U', N1, A( N2*N2 ), N2, INFO ) CALL DSYRK( 'U', 'T', N1, N2, ONE, A( 0 ), N2, ONE, $ A( N2*N2 ), N2 ) - CALL DTRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, A( N1*N2 ), + CALL DTRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, + $ A( N1*N2 ), $ N2, A( 0 ), N2 ) CALL DLAUUM( 'L', N2, A( N1*N2 ), N2, INFO ) * @@ -359,7 +365,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'L', K, A( 1 ), N+1, INFO ) CALL DSYRK( 'L', 'T', K, K, ONE, A( K+1 ), N+1, ONE, $ A( 1 ), N+1 ) - CALL DTRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), N+1, + CALL DTRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) CALL DLAUUM( 'U', K, A( 0 ), N+1, INFO ) * @@ -372,7 +379,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'L', K, A( K+1 ), N+1, INFO ) CALL DSYRK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE, $ A( K+1 ), N+1 ) - CALL DTRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), N+1, + CALL DTRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) CALL DLAUUM( 'U', K, A( K ), N+1, INFO ) * @@ -389,7 +397,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k * CALL DLAUUM( 'U', K, A( K ), K, INFO ) - CALL DSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE, + CALL DSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( K ), K ) CALL DTRMM( 'R', 'L', 'N', 'N', K, K, ONE, A( 0 ), K, $ A( K*( K+1 ) ), K ) @@ -404,7 +413,8 @@ SUBROUTINE DPFTRI( TRANSR, UPLO, N, A, INFO ) CALL DLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO ) CALL DSYRK( 'U', 'T', K, K, ONE, A( 0 ), K, ONE, $ A( K*( K+1 ) ), K ) - CALL DTRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), K, + CALL DTRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), + $ K, $ A( 0 ), K ) CALL DLAUUM( 'L', K, A( K*K ), K, INFO ) * diff --git a/SRC/dpocon.f b/SRC/dpocon.f index a542ebeeff..31a74c1343 100644 --- a/SRC/dpocon.f +++ b/SRC/dpocon.f @@ -204,25 +204,29 @@ SUBROUTINE DPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, * * Multiply by inv(U**T). * - CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL DLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * * Multiply by inv(U). * - CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(L). * - CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * * Multiply by inv(L**T). * - CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL DLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) END IF * diff --git a/SRC/dporfs.f b/SRC/dporfs.f index 25b6022539..ced7a6335b 100644 --- a/SRC/dporfs.f +++ b/SRC/dporfs.f @@ -219,7 +219,8 @@ SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DPOTRS, DSYMV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DPOTRS, DSYMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -387,14 +388,16 @@ SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO ) + CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, + $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 110 CONTINUE @@ -405,7 +408,8 @@ SUBROUTINE DPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO ) + CALL DPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/dporfsx.f b/SRC/dporfsx.f index edb30f2eb1..bb00fc22aa 100644 --- a/SRC/dporfsx.f +++ b/SRC/dporfsx.f @@ -388,7 +388,8 @@ *> \ingroup porfsx * * ===================================================================== - SUBROUTINE DPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, + SUBROUTINE DPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, + $ B, $ LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) @@ -596,7 +597,8 @@ SUBROUTINE DPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, $ INFO ) END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). diff --git a/SRC/dposv.f b/SRC/dposv.f index 1fb180be2c..0487b1bd73 100644 --- a/SRC/dposv.f +++ b/SRC/dposv.f @@ -158,7 +158,8 @@ SUBROUTINE DPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dposvx.f b/SRC/dposvx.f index 8ba02e42b2..80f38b371c 100644 --- a/SRC/dposvx.f +++ b/SRC/dposvx.f @@ -302,7 +302,8 @@ *> \ingroup posvx * * ===================================================================== - SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, $ IWORK, INFO ) * @@ -339,7 +340,8 @@ SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, EXTERNAL LSAME, DLAMCH, DLANSY * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLAQSY, DPOCON, DPOEQU, DPORFS, DPOTRF, + EXTERNAL DLACPY, DLAQSY, DPOCON, DPOEQU, DPORFS, + $ DPOTRF, $ DPOTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -361,10 +363,13 @@ SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -453,7 +458,8 @@ SUBROUTINE DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Compute the reciprocal of the condition number of A. * - CALL DPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL DPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/dposvxx.f b/SRC/dposvxx.f index 7df488b067..b5fecabcc3 100644 --- a/SRC/dposvxx.f +++ b/SRC/dposvxx.f @@ -488,7 +488,8 @@ *> \ingroup posvxx * * ===================================================================== - SUBROUTINE DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, IWORK, INFO ) @@ -538,7 +539,8 @@ SUBROUTINE DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, DOUBLE PRECISION DLAMCH, DLA_PORPVGRW * .. * .. External Subroutines .. - EXTERNAL DPOEQUB, DPOTRF, DPOTRS, DLACPY, DLAQSY, + EXTERNAL DPOEQUB, DPOTRF, DPOTRS, DLACPY, + $ DLAQSY, $ XERBLA, DLASCL2, DPORFSX * .. * .. Intrinsic Functions .. @@ -646,7 +648,8 @@ SUBROUTINE DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * Compute the reciprocal pivot growth factor of the * leading rank-deficient INFO columns of A. * - RPVGRW = DLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, WORK ) + RPVGRW = DLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, + $ WORK ) RETURN ENDIF END IF diff --git a/SRC/dpotf2.f b/SRC/dpotf2.f index f3b354573c..1972387fda 100644 --- a/SRC/dpotf2.f +++ b/SRC/dpotf2.f @@ -209,7 +209,8 @@ SUBROUTINE DPOTF2( UPLO, N, A, LDA, INFO ) * Compute elements J+1:N of column J. * IF( J.LT.N ) THEN - CALL DGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ), + CALL DGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, + $ 1 ), $ LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 ) CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) END IF diff --git a/SRC/dpotrf.f b/SRC/dpotrf.f index 34c66b1e16..027ab9dabe 100644 --- a/SRC/dpotrf.f +++ b/SRC/dpotrf.f @@ -134,7 +134,8 @@ SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DGEMM, DPOTRF2, DSYRK, DTRSM, XERBLA + EXTERNAL DGEMM, DPOTRF2, DSYRK, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -193,10 +194,12 @@ SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block row. * - CALL DGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1, + CALL DGEMM( 'Transpose', 'No transpose', JB, + $ N-J-JB+1, $ J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ), $ LDA, ONE, A( J, J+JB ), LDA ) - CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', + CALL DTRSM( 'Left', 'Upper', 'Transpose', + $ 'Non-unit', $ JB, N-J-JB+1, ONE, A( J, J ), LDA, $ A( J, J+JB ), LDA ) END IF @@ -221,10 +224,12 @@ SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block column. * - CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, + CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, + $ JB, $ J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ), $ LDA, ONE, A( J+JB, J ), LDA ) - CALL DTRSM( 'Right', 'Lower', 'Transpose', 'Non-unit', + CALL DTRSM( 'Right', 'Lower', 'Transpose', + $ 'Non-unit', $ N-J-JB+1, JB, ONE, A( J, J ), LDA, $ A( J+JB, J ), LDA ) END IF diff --git a/SRC/dpotri.f b/SRC/dpotri.f index 614422456a..520a9b6f3a 100644 --- a/SRC/dpotri.f +++ b/SRC/dpotri.f @@ -123,7 +123,8 @@ SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dpotrs.f b/SRC/dpotrs.f index 6bc53048dc..53fc026850 100644 --- a/SRC/dpotrs.f +++ b/SRC/dpotrs.f @@ -173,7 +173,8 @@ SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve U**T *X = B, overwriting B with X. * - CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, + CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -191,7 +192,8 @@ SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve L**T *X = B, overwriting B with X. * - CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS, + CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) END IF * diff --git a/SRC/dppcon.f b/SRC/dppcon.f index b4c6a1b263..fa4c1a2068 100644 --- a/SRC/dppcon.f +++ b/SRC/dppcon.f @@ -115,7 +115,8 @@ *> \ingroup ppcon * * ===================================================================== - SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO ) + SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -205,13 +206,15 @@ SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO ) * * Multiply by inv(U). * - CALL DLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(L). * - CALL DLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL DLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * diff --git a/SRC/dpprfs.f b/SRC/dpprfs.f index 1a82618295..c388a0ec7f 100644 --- a/SRC/dpprfs.f +++ b/SRC/dpprfs.f @@ -167,7 +167,8 @@ *> \ingroup pprfs * * ===================================================================== - SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -207,7 +208,8 @@ SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DPPTRS, DSPMV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DPPTRS, DSPMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -270,7 +272,8 @@ SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * Compute residual R = B - A * X * CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ), + CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, + $ WORK( N+1 ), $ 1 ) * * Compute componentwise relative backward error from formula @@ -378,7 +381,8 @@ SUBROUTINE DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/dppsv.f b/SRC/dppsv.f index 8a1def83f9..6981a4aa8d 100644 --- a/SRC/dppsv.f +++ b/SRC/dppsv.f @@ -172,7 +172,8 @@ SUBROUTINE DPPSV( UPLO, N, NRHS, AP, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dppsvx.f b/SRC/dppsvx.f index 2f0542d8c2..29d64c52e6 100644 --- a/SRC/dppsvx.f +++ b/SRC/dppsvx.f @@ -307,7 +307,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, + SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, + $ LDB, $ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK driver routine -- @@ -342,7 +343,8 @@ SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, EXTERNAL LSAME, DLAMCH, DLANSP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DLAQSP, DPPCON, DPPEQU, DPPRFS, + EXTERNAL DCOPY, DLACPY, DLAQSP, DPPCON, DPPEQU, + $ DPPRFS, $ DPPTRF, DPPTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -364,10 +366,13 @@ SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -462,7 +467,8 @@ SUBROUTINE DPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, + CALL DPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + $ BERR, $ WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/dpstf2.f b/SRC/dpstf2.f index 5475ceb6fe..6aef2e0387 100644 --- a/SRC/dpstf2.f +++ b/SRC/dpstf2.f @@ -138,7 +138,8 @@ *> \ingroup pstf2 * * ===================================================================== - SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -273,7 +274,8 @@ SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) IF( PVT.LT.N ) $ CALL DSWAP( N-PVT, A( J, PVT+1 ), LDA, $ A( PVT, PVT+1 ), LDA ) - CALL DSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), 1 ) + CALL DSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), + $ 1 ) * * Swap dot products and PIV * @@ -334,9 +336,11 @@ SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) A( PVT, PVT ) = A( J, J ) CALL DSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) IF( PVT.LT.N ) - $ CALL DSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ), + $ CALL DSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, + $ PVT ), $ 1 ) - CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), LDA ) + CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), + $ LDA ) * * Swap dot products and PIV * @@ -354,7 +358,8 @@ SUBROUTINE DPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Compute elements J+1:N of column J * IF( J.LT.N ) THEN - CALL DGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), LDA, + CALL DGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), + $ LDA, $ A( J, 1 ), LDA, ONE, A( J+1, J ), 1 ) CALL DSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) END IF diff --git a/SRC/dpstrf.f b/SRC/dpstrf.f index d577cabd10..ae70bca5e8 100644 --- a/SRC/dpstrf.f +++ b/SRC/dpstrf.f @@ -139,7 +139,8 @@ *> \ingroup pstrf * * ===================================================================== - SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -173,7 +174,8 @@ SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL DLAMCH, ILAENV, LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL DGEMV, DPSTF2, DSCAL, DSWAP, DSYRK, XERBLA + EXTERNAL DGEMV, DPSTF2, DSCAL, DSWAP, DSYRK, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT, MAXLOC @@ -315,7 +317,8 @@ SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Compute elements J+1:N of row J. * IF( J.LT.N ) THEN - CALL DGEMV( 'Trans', J-K, N-J, -ONE, A( K, J+1 ), + CALL DGEMV( 'Trans', J-K, N-J, -ONE, A( K, + $ J+1 ), $ LDA, A( K, J ), 1, ONE, A( J, J+1 ), $ LDA ) CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA ) @@ -379,11 +382,13 @@ SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Pivot OK, so can now swap pivot rows and columns * A( PVT, PVT ) = A( J, J ) - CALL DSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) + CALL DSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), + $ LDA ) IF( PVT.LT.N ) $ CALL DSWAP( N-PVT, A( PVT+1, J ), 1, $ A( PVT+1, PVT ), 1 ) - CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), + CALL DSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, + $ J+1 ), $ LDA ) * * Swap dot products and PIV diff --git a/SRC/dptsvx.f b/SRC/dptsvx.f index 137faf17ec..f474eca16f 100644 --- a/SRC/dptsvx.f +++ b/SRC/dptsvx.f @@ -258,7 +258,8 @@ SUBROUTINE DPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, EXTERNAL LSAME, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DPTCON, DPTRFS, DPTTRF, DPTTRS, + EXTERNAL DCOPY, DLACPY, DPTCON, DPTRFS, DPTTRF, + $ DPTTRS, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f index 327cdeb291..9507b43c31 100644 --- a/SRC/dsb2st_kernels.f +++ b/SRC/dsb2st_kernels.f @@ -288,7 +288,8 @@ SUBROUTINE DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = ( A( DPOS-NB, J1 ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP * CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), diff --git a/SRC/dsbev.f b/SRC/dsbev.f index e05322ccc5..87a19dff0f 100644 --- a/SRC/dsbev.f +++ b/SRC/dsbev.f @@ -175,7 +175,8 @@ SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, DLAMCH, DLANSB * .. * .. External Subroutines .. - EXTERNAL DLASCL, DSBTRD, DSCAL, DSTEQR, DSTERF, XERBLA + EXTERNAL DLASCL, DSBTRD, DSCAL, DSTEQR, DSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -245,9 +246,11 @@ SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -255,7 +258,8 @@ SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, * INDE = 1 INDWRK = INDE + N - CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, call SSTEQR. @@ -263,7 +267,8 @@ SUBROUTINE DSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF * diff --git a/SRC/dsbev_2stage.f b/SRC/dsbev_2stage.f index 4261823861..b578c307cf 100644 --- a/SRC/dsbev_2stage.f +++ b/SRC/dsbev_2stage.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, INFO ) * IMPLICIT NONE @@ -237,7 +238,8 @@ SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DLASCL, DSCAL, DSTEQR, DSTERF, XERBLA, + EXTERNAL DLASCL, DSCAL, DSTEQR, DSTERF, + $ XERBLA, $ DSYTRD_SB2ST * .. * .. Intrinsic Functions .. @@ -330,9 +332,11 @@ SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -352,7 +356,8 @@ SUBROUTINE DSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF * diff --git a/SRC/dsbevd.f b/SRC/dsbevd.f index 429114b86e..bf464bc9e2 100644 --- a/SRC/dsbevd.f +++ b/SRC/dsbevd.f @@ -183,7 +183,8 @@ *> \ingroup hbevd * * ===================================================================== - SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, + SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -218,7 +219,8 @@ SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, DLAMCH, DLANSB * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASCL, DSBTRD, DSCAL, DSTEDC, + EXTERNAL DGEMM, DLACPY, DLASCL, DSBTRD, DSCAL, + $ DSTEDC, $ DSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -311,9 +313,11 @@ SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -323,7 +327,8 @@ SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, INDWRK = INDE + N INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 - CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL DSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, call SSTEDC. @@ -333,7 +338,8 @@ SUBROUTINE DSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, ELSE CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/dsbevd_2stage.f b/SRC/dsbevd_2stage.f index f0d0ce2ccc..5365394134 100644 --- a/SRC/dsbevd_2stage.f +++ b/SRC/dsbevd_2stage.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -263,7 +264,8 @@ SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASCL, DSCAL, DSTEDC, + EXTERNAL DGEMM, DLACPY, DLASCL, DSCAL, + $ DSTEDC, $ DSTERF, XERBLA, DSYTRD_SB2ST * .. * .. Intrinsic Functions .. @@ -282,9 +284,12 @@ SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LIWMIN = 1 LWMIN = 1 ELSE - IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', JOBZ, N, KD, IB, + $ -1 ) IF( WANTZ ) THEN LIWMIN = 3 + 5*N LWMIN = 1 + 5*N + 2*N**2 @@ -359,9 +364,11 @@ SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -385,7 +392,8 @@ SUBROUTINE DSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, ELSE CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/dsbevx.f b/SRC/dsbevx.f index ead24537c1..275a3285dc 100644 --- a/SRC/dsbevx.f +++ b/SRC/dsbevx.f @@ -260,7 +260,8 @@ *> \ingroup hbevx * * ===================================================================== - SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, + SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, + $ VL, $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * @@ -300,7 +301,8 @@ SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, EXTERNAL LSAME, DLAMCH, DLANSB * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DSBTRD, DSCAL, + EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DSBTRD, + $ DSCAL, $ DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -408,9 +410,11 @@ SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/dsbevx_2stage.f b/SRC/dsbevx_2stage.f index b7c494e0ad..4796456e98 100644 --- a/SRC/dsbevx_2stage.f +++ b/SRC/dsbevx_2stage.f @@ -317,7 +317,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, + SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, + $ Q, $ LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, LWORK, IWORK, IFAIL, INFO ) * @@ -362,7 +363,8 @@ SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, EXTERNAL LSAME, DLAMCH, DLANSB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, DSCAL, + EXTERNAL DCOPY, DGEMV, DLACPY, DLASCL, + $ DSCAL, $ DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA, $ DSYTRD_SB2ST * .. @@ -493,9 +495,11 @@ SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL DLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA @@ -513,7 +517,8 @@ SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, INDWRK = INDHOUS + LHTRD LLWORK = LWORK - INDWRK + 1 * - CALL DSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ), + CALL DSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, + $ WORK( INDD ), $ WORK( INDE ), WORK( INDHOUS ), LHTRD, $ WORK( INDWRK ), LLWORK, IINFO ) * diff --git a/SRC/dsbgst.f b/SRC/dsbgst.f index 9d3a720954..a7138c423f 100644 --- a/SRC/dsbgst.f +++ b/SRC/dsbgst.f @@ -155,7 +155,8 @@ *> \ingroup hbgst * * ===================================================================== - SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, + SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ X, $ LDX, WORK, INFO ) * * -- LAPACK computational routine -- @@ -188,7 +189,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DGER, DLAR2V, DLARGV, DLARTG, DLARTV, DLASET, + EXTERNAL DGER, DLAR2V, DLARGV, DLARTG, DLARTV, + $ DLASET, $ DROT, DSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -428,7 +430,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL DLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1, + $ CALL DLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), + $ KA1, $ WORK( N+J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -652,7 +655,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * * generate rotation to annihilate a(i-k+ka+1,i) * - CALL DLARTG( AB( KA1-K, I ), RA1, WORK( N+I-K+KA-M ), + CALL DLARTG( AB( KA1-K, I ), RA1, + $ WORK( N+I-K+KA-M ), $ WORK( I-K+KA-M ), RA ) * * create nonzero element a(i-k+ka+1,i-k) outside the @@ -688,7 +692,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL DLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ), + $ CALL DLARGV( NRT, AB( KA1, J2T-KA ), INCA, + $ WORK( J2T-M ), $ KA1, WORK( N+J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -703,7 +708,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 1st set from both sides to diagonal * blocks * - CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, WORK( N+J2-M ), WORK( J2-M ), KA1 ) * END IF @@ -784,7 +790,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL DLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1, + CALL DLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), + $ KA1, $ WORK( N+J2 ), KA1 ) * * apply rotations in 2nd set from the left @@ -798,7 +805,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from both sides to diagonal * blocks * - CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL DLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, WORK( N+J2 ), WORK( J2 ), KA1 ) * END IF @@ -937,7 +945,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL DSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, I+1 ), + $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, + $ I+1 ), $ LDBB-1, X( 1, I+1 ), LDX ) END IF * @@ -995,7 +1004,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL DLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1, + $ CALL DLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), + $ KA1, $ WORK( N+J1 ), KA1 ) IF( NR.GT.0 ) THEN * @@ -1095,7 +1105,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL DLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ), + CALL DLARGV( NR, AB( 1, J1+KA ), INCA, + $ WORK( M-KB+J1 ), $ KA1, WORK( N+M-KB+J1 ), KA1 ) * * apply rotations in 2nd set from the left @@ -1201,7 +1212,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL DSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), 1, + $ CALL DGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), + $ 1, $ X( 1, I+1 ), LDX ) END IF * @@ -1259,14 +1271,16 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL DLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1, + $ CALL DLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), + $ KA1, $ WORK( N+J1 ), KA1 ) IF( NR.GT.0 ) THEN * * apply rotations in 1st set from the right * DO 810 L = 1, KA - 1 - CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, WORK( N+J1 ), WORK( J1 ), KA1 ) 810 CONTINUE * @@ -1364,7 +1378,8 @@ SUBROUTINE DSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from the right * DO 890 L = 1, KA - 1 - CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL DLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, WORK( N+M-KB+J1 ), WORK( M-KB+J1 ), $ KA1 ) 890 CONTINUE diff --git a/SRC/dsbgv.f b/SRC/dsbgv.f index cc318ecfb7..ad82da1d8e 100644 --- a/SRC/dsbgv.f +++ b/SRC/dsbgv.f @@ -173,7 +173,8 @@ *> \ingroup hbgv * * ===================================================================== - SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, + SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + $ Z, $ LDZ, WORK, INFO ) * * -- LAPACK driver routine -- @@ -201,7 +202,8 @@ SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DPBSTF, DSBGST, DSBTRD, DSTEQR, DSTERF, XERBLA + EXTERNAL DPBSTF, DSBGST, DSBTRD, DSTEQR, DSTERF, + $ XERBLA * .. * .. Executable Statements .. * @@ -260,7 +262,8 @@ SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, ELSE VECT = 'N' END IF - CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, call SSTEQR. @@ -268,7 +271,8 @@ SUBROUTINE DSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF RETURN diff --git a/SRC/dsbgvd.f b/SRC/dsbgvd.f index f0347dfc0d..d43d837578 100644 --- a/SRC/dsbgvd.f +++ b/SRC/dsbgvd.f @@ -217,7 +217,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -251,7 +252,8 @@ SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DPBSTF, DSBGST, DSBTRD, DSTEDC, + EXTERNAL DGEMM, DLACPY, DPBSTF, DSBGST, DSBTRD, + $ DSTEDC, $ DSTERF, XERBLA * .. * .. Executable Statements .. @@ -339,7 +341,8 @@ SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, ELSE VECT = 'N' END IF - CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL DSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, call SSTEDC. @@ -349,7 +352,8 @@ SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, ELSE CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL DGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL DLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/dsbgvx.f b/SRC/dsbgvx.f index 57114609e2..ffceb9da74 100644 --- a/SRC/dsbgvx.f +++ b/SRC/dsbgvx.f @@ -327,7 +327,8 @@ SUBROUTINE DSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DLACPY, DPBSTF, DSBGST, DSBTRD, + EXTERNAL DCOPY, DGEMV, DLACPY, DPBSTF, DSBGST, + $ DSBTRD, $ DSTEBZ, DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dsbtrd.f b/SRC/dsbtrd.f index 48a664ba66..e4f7a9de6d 100644 --- a/SRC/dsbtrd.f +++ b/SRC/dsbtrd.f @@ -189,7 +189,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, DOUBLE PRECISION TEMP * .. * .. External Subroutines .. - EXTERNAL DLAR2V, DLARGV, DLARTG, DLARTV, DLASET, DROT, + EXTERNAL DLAR2V, DLARGV, DLARTG, DLARTV, DLASET, + $ DROT, $ XERBLA * .. * .. Intrinsic Functions .. @@ -271,7 +272,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * generate plane rotations to annihilate nonzero * elements which have been created outside the band * - CALL DLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ), + CALL DLARGV( NR, AB( 1, J1-1 ), INCA, + $ WORK( J1 ), $ KD1, D( J1 ), KD1 ) * * apply rotations from the right @@ -342,7 +344,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL DLARTV( NRT, AB( KD-L, J1+L ), INCA, + $ CALL DLARTV( NRT, AB( KD-L, J1+L ), + $ INCA, $ AB( KD-L+1, J1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 30 CONTINUE @@ -350,7 +353,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, J1END = J1 + KD1*( NR-2 ) IF( J1END.GE.J1 ) THEN DO 40 JIN = J1, J1END, KD1 - CALL DROT( KD-1, AB( KD-1, JIN+1 ), INCX, + CALL DROT( KD-1, AB( KD-1, JIN+1 ), + $ INCX, $ AB( KD, JIN+1 ), INCX, $ D( JIN ), WORK( JIN ) ) 40 CONTINUE @@ -385,13 +389,15 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 50 CONTINUE ELSE * DO 60 J = J1, J2, KD1 - CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 60 CONTINUE END IF @@ -474,7 +480,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * IF( NR.GT.2*KD-1 ) THEN DO 130 L = 1, KD - 1 - CALL DLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA, + CALL DLARTV( NR, AB( KD1-L, J1-KD1+L ), + $ INCA, $ AB( KD1-L+1, J1-KD1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 130 CONTINUE @@ -532,7 +539,8 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL DLARTV( NRT, AB( L+2, J1-1 ), INCA, + $ CALL DLARTV( NRT, AB( L+2, J1-1 ), + $ INCA, $ AB( L+1, J1 ), INCA, D( J1 ), $ WORK( J1 ), KD1 ) 150 CONTINUE @@ -577,13 +585,15 @@ SUBROUTINE DSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL DROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 170 CONTINUE ELSE * DO 180 J = J1, J2, KD1 - CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL DROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 180 CONTINUE END IF diff --git a/SRC/dsfrk.f b/SRC/dsfrk.f index 5356cdfdfc..da26f70c00 100644 --- a/SRC/dsfrk.f +++ b/SRC/dsfrk.f @@ -162,7 +162,8 @@ *> \ingroup hfrk * * ===================================================================== - SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, + $ BETA, $ C ) * * -- LAPACK computational routine -- @@ -283,9 +284,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ), + CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N ) * ELSE @@ -294,9 +297,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ), + CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N ) * END IF @@ -311,7 +316,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA, + CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N ) @@ -322,7 +328,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), LDA, + CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N ) @@ -345,7 +352,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( N1+1, 1 ), LDA, BETA, @@ -357,7 +365,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, N1+1 ), LDA, BETA, @@ -375,9 +384,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ), + CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 ) * ELSE @@ -386,9 +397,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ), + CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 ) * END IF @@ -415,9 +428,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ), + CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ), $ N+1 ) * @@ -427,9 +442,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ), + CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ), $ N+1 ) * @@ -445,7 +462,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ), @@ -457,7 +475,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ), @@ -481,7 +500,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, BETA, @@ -493,7 +513,8 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, BETA, @@ -511,9 +532,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ), + CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK ) * ELSE @@ -522,9 +545,11 @@ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ), + CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK ) * END IF diff --git a/SRC/dsgesv.f b/SRC/dsgesv.f index 00dce352fe..9f221382a3 100644 --- a/SRC/dsgesv.f +++ b/SRC/dsgesv.f @@ -228,7 +228,8 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM * * .. External Subroutines .. - EXTERNAL DAXPY, DGEMM, DLACPY, DLAG2S, DGETRF, DGETRS, + EXTERNAL DAXPY, DGEMM, DLACPY, DLAG2S, DGETRF, + $ DGETRS, $ SGETRF, SGETRS, SLAG2D, XERBLA * .. * .. External Functions .. @@ -328,7 +329,8 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) * - CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, A, + CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, + $ A, $ LDA, X, LDX, ONE, WORK, N ) * * Check whether the NRHS normwise backward errors satisfy the @@ -363,7 +365,8 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * * Solve the system SA*SX = SR. * - CALL SGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, + CALL SGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, + $ IPIV, $ SWORK( PTSX ), N, INFO ) * * Convert SX back to double precision and update the current @@ -379,7 +382,8 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * CALL DLACPY( 'All', N, NRHS, B, LDB, WORK, N ) * - CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, + CALL DGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, + $ NEGONE, $ A, LDA, X, LDX, ONE, WORK, N ) * * Check whether the NRHS normwise backward errors satisfy the diff --git a/SRC/dspcon.f b/SRC/dspcon.f index d7de9042b8..7b227d02b5 100644 --- a/SRC/dspcon.f +++ b/SRC/dspcon.f @@ -121,7 +121,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE DSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, + SUBROUTINE DSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dspev.f b/SRC/dspev.f index 55f6faf8f0..e4adb00137 100644 --- a/SRC/dspev.f +++ b/SRC/dspev.f @@ -159,7 +159,8 @@ SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, DLAMCH, DLANSP * .. * .. External Subroutines .. - EXTERNAL DOPGTR, DSCAL, DSPTRD, DSTEQR, DSTERF, XERBLA + EXTERNAL DOPGTR, DSCAL, DSPTRD, DSTEQR, DSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -173,7 +174,8 @@ SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -227,7 +229,8 @@ SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) * INDE = 1 INDTAU = INDE + N - CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO ) + CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), + $ IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, first call * DOPGTR to generate the orthogonal matrix, then call DSTEQR. @@ -238,7 +241,8 @@ SUBROUTINE DSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) INDWRK = INDTAU + N CALL DOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ, $ WORK( INDWRK ), IINFO ) - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDTAU ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/dspevd.f b/SRC/dspevd.f index fcd44eee94..0df1c9d727 100644 --- a/SRC/dspevd.f +++ b/SRC/dspevd.f @@ -203,7 +203,8 @@ SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, EXTERNAL LSAME, DLAMCH, DLANSP * .. * .. External Subroutines .. - EXTERNAL DOPMTR, DSCAL, DSPTRD, DSTEDC, DSTERF, XERBLA + EXTERNAL DOPMTR, DSCAL, DSPTRD, DSTEDC, DSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -218,7 +219,8 @@ SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -297,7 +299,8 @@ SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, * INDE = 1 INDTAU = INDE + N - CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO ) + CALL DSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), + $ IINFO ) * * For eigenvalues only, call DSTERF. For eigenvectors, first call * DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the @@ -309,9 +312,11 @@ SUBROUTINE DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, ELSE INDWRK = INDTAU + N LLWORK = LWORK - INDWRK + 1 - CALL DSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL DSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ LLWORK, IWORK, LIWORK, INFO ) - CALL DOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ, + CALL DOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/dspevx.f b/SRC/dspevx.f index 8fcdd58b14..129a79e497 100644 --- a/SRC/dspevx.f +++ b/SRC/dspevx.f @@ -268,7 +268,8 @@ SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, EXTERNAL LSAME, DLAMCH, DLANSP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DOPGTR, DOPMTR, DSCAL, DSPTRD, DSTEBZ, + EXTERNAL DCOPY, DOPGTR, DOPMTR, DSCAL, DSPTRD, + $ DSTEBZ, $ DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -288,7 +289,8 @@ SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, INFO = -1 ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN INFO = -2 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -440,7 +442,8 @@ SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, * Apply orthogonal matrix used in reduction to tridiagonal * form to eigenvectors returned by DSTEIN. * - CALL DOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ, + CALL DOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/dspgst.f b/SRC/dspgst.f index 3a5c460a4f..e9fe6c15fd 100644 --- a/SRC/dspgst.f +++ b/SRC/dspgst.f @@ -136,7 +136,8 @@ SUBROUTINE DSPGST( ITYPE, UPLO, N, AP, BP, INFO ) DOUBLE PRECISION AJJ, AKK, BJJ, BKK, CT * .. * .. External Subroutines .. - EXTERNAL DAXPY, DSCAL, DSPMV, DSPR2, DTPMV, DTPSV, + EXTERNAL DAXPY, DSCAL, DSPMV, DSPR2, DTPMV, + $ DTPSV, $ XERBLA * .. * .. External Functions .. @@ -182,7 +183,8 @@ SUBROUTINE DSPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL DSPMV( UPLO, J-1, -ONE, AP, BP( J1 ), 1, ONE, $ AP( J1 ), 1 ) CALL DSCAL( J-1, ONE / BJJ, AP( J1 ), 1 ) - AP( JJ ) = ( AP( JJ )-DDOT( J-1, AP( J1 ), 1, BP( J1 ), + AP( JJ ) = ( AP( JJ )-DDOT( J-1, AP( J1 ), 1, + $ BP( J1 ), $ 1 ) ) / BJJ 10 CONTINUE ELSE diff --git a/SRC/dspgv.f b/SRC/dspgv.f index 91b49b46f8..77aba6acd7 100644 --- a/SRC/dspgv.f +++ b/SRC/dspgv.f @@ -156,7 +156,8 @@ *> \ingroup hpgv * * ===================================================================== - SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ INFO ) * * -- LAPACK driver routine -- @@ -184,7 +185,8 @@ SUBROUTINE DSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DPPTRF, DSPEV, DSPGST, DTPMV, DTPSV, XERBLA + EXTERNAL DPPTRF, DSPEV, DSPGST, DTPMV, DTPSV, + $ XERBLA * .. * .. Executable Statements .. * diff --git a/SRC/dspgvd.f b/SRC/dspgvd.f index dbe818e852..42ca4de2c6 100644 --- a/SRC/dspgvd.f +++ b/SRC/dspgvd.f @@ -200,7 +200,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE DSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE DSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -229,7 +230,8 @@ SUBROUTINE DSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DPPTRF, DSPEVD, DSPGST, DTPMV, DTPSV, XERBLA + EXTERNAL DPPTRF, DSPEVD, DSPGST, DTPMV, DTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX diff --git a/SRC/dspgvx.f b/SRC/dspgvx.f index b8f8782a45..220918692d 100644 --- a/SRC/dspgvx.f +++ b/SRC/dspgvx.f @@ -298,7 +298,8 @@ SUBROUTINE DSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DPPTRF, DSPEVX, DSPGST, DTPMV, DTPSV, XERBLA + EXTERNAL DPPTRF, DSPEVX, DSPGST, DTPMV, DTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -365,7 +366,8 @@ SUBROUTINE DSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * Transform problem to standard eigenvalue problem and solve. * CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO ) - CALL DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, + CALL DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, + $ M, $ W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN diff --git a/SRC/dsposv.f b/SRC/dsposv.f index 75672633ac..3d5cb9f46c 100644 --- a/SRC/dsposv.f +++ b/SRC/dsposv.f @@ -232,7 +232,8 @@ SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, DOUBLE PRECISION ANRM, CTE, EPS, RNRM, XNRM * * .. External Subroutines .. - EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, SLAG2D, + EXTERNAL DAXPY, DSYMM, DLACPY, DLAT2S, DLAG2S, + $ SLAG2D, $ SPOTRF, SPOTRS, DPOTRF, DPOTRS, XERBLA * .. * .. External Functions .. @@ -251,7 +252,8 @@ SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, * * Test the input parameters. * - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -370,7 +372,8 @@ SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, * * Solve the system SA*SX = SR. * - CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, + CALL SPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), + $ N, $ INFO ) * * Convert SX back to double precision and update the current diff --git a/SRC/dsprfs.f b/SRC/dsprfs.f index 2bfd0d2eee..961db78b5e 100644 --- a/SRC/dsprfs.f +++ b/SRC/dsprfs.f @@ -175,7 +175,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -215,7 +216,8 @@ SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DSPMV, DSPTRS, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DSPMV, DSPTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -278,7 +280,8 @@ SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * Compute residual R = B - A * X * CALL DCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ), + CALL DSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, + $ WORK( N+1 ), $ 1 ) * * Compute componentwise relative backward error from formula @@ -347,7 +350,8 @@ SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * * Update solution and try again. * - CALL DSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, INFO ) + CALL DSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, + $ INFO ) CALL DAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 ) LSTRES = BERR( J ) COUNT = COUNT + 1 @@ -386,7 +390,8 @@ SUBROUTINE DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/dspsv.f b/SRC/dspsv.f index d296d99b3f..64a6b272e9 100644 --- a/SRC/dspsv.f +++ b/SRC/dspsv.f @@ -191,7 +191,8 @@ SUBROUTINE DSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dspsvx.f b/SRC/dspsvx.f index 0eafdb340a..543654bfc9 100644 --- a/SRC/dspsvx.f +++ b/SRC/dspsvx.f @@ -272,7 +272,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK driver routine -- @@ -306,7 +307,8 @@ SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, DLAMCH, DLANSP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DSPCON, DSPRFS, DSPTRF, DSPTRS, + EXTERNAL DCOPY, DLACPY, DSPCON, DSPRFS, DSPTRF, + $ DSPTRS, $ XERBLA * .. * .. Intrinsic Functions .. @@ -320,7 +322,8 @@ SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -358,7 +361,8 @@ SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * * Compute the reciprocal of the condition number of A. * - CALL DSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, INFO ) + CALL DSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution vectors X. * @@ -368,7 +372,8 @@ SUBROUTINE DSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL DSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, IWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/dsptrd.f b/SRC/dsptrd.f index d0369698e8..3054b7105f 100644 --- a/SRC/dsptrd.f +++ b/SRC/dsptrd.f @@ -267,7 +267,8 @@ SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO ) * * Compute y := tau * A * v storing y in TAU(i:n-1) * - CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, + CALL DSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), + $ 1, $ ZERO, TAU( I ), 1 ) * * Compute w := y - 1/2 * tau * (y**T *v) * v @@ -279,7 +280,8 @@ SUBROUTINE DSPTRD( UPLO, N, AP, D, E, TAU, INFO ) * Apply the transformation as a rank-2 update: * A := A - v * w**T - w * v**T * - CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, + CALL DSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), + $ 1, $ AP( I1I1 ) ) * AP( II+1 ) = E( I ) diff --git a/SRC/dsptrf.f b/SRC/dsptrf.f index 83c01e47d1..0d0f1ec4b0 100644 --- a/SRC/dsptrf.f +++ b/SRC/dsptrf.f @@ -501,7 +501,8 @@ SUBROUTINE DSPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL DSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL DSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/dsptri.f b/SRC/dsptri.f index 03aa3d3dd1..74c6122d95 100644 --- a/SRC/dsptri.f +++ b/SRC/dsptri.f @@ -218,7 +218,8 @@ SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL DCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ DDOT( K-1, WORK, 1, AP( KC ), 1 ) @@ -243,12 +244,14 @@ SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL DCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ DDOT( K-1, WORK, 1, AP( KC ), 1 ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ DDOT( K-1, AP( KC ), 1, AP( KCNEXT ), + $ DDOT( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL DCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL DSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, @@ -322,7 +325,8 @@ SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL DCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) CALL DSPMV( UPLO, N-K, -ONE, AP( KC+N-K+1 ), WORK, 1, $ ZERO, AP( KC+1 ), 1 ) - AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), 1 ) + AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), + $ 1 ) END IF KSTEP = 1 ELSE @@ -344,14 +348,17 @@ SUBROUTINE DSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL DCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KC+1 ), 1 ) - AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), 1 ) + AP( KC ) = AP( KC ) - DDOT( N-K, WORK, 1, AP( KC+1 ), + $ 1 ) AP( KCNEXT+1 ) = AP( KCNEXT+1 ) - $ DDOT( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL DCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL DSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - $ DDOT( N-K, WORK, 1, AP( KCNEXT+2 ), 1 ) diff --git a/SRC/dsptrs.f b/SRC/dsptrs.f index 92e8531bcc..733903b247 100644 --- a/SRC/dsptrs.f +++ b/SRC/dsptrs.f @@ -268,7 +268,8 @@ SUBROUTINE DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -285,7 +286,8 @@ SUBROUTINE DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB ) @@ -356,7 +358,8 @@ SUBROUTINE DSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL DGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL DGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL DGER( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/dstebz.f b/SRC/dstebz.f index f16f86a9a0..0c886beb1d 100644 --- a/SRC/dstebz.f +++ b/SRC/dstebz.f @@ -268,7 +268,8 @@ *> \ingroup stebz * * ===================================================================== - SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, + SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, + $ E, $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * @@ -482,7 +483,8 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, IWORK( 5 ) = IL - 1 IWORK( 6 ) = IU * - CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E, + CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, + $ E, $ WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT, $ IWORK, W, IBLOCK, IINFO ) * @@ -624,7 +626,8 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, * ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) / $ LOG( TWO ) ) + 2 - CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, + CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, + $ PIVMIN, $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ), $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT, $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) diff --git a/SRC/dstedc.f b/SRC/dstedc.f index 1d47289c25..a1a1992ec6 100644 --- a/SRC/dstedc.f +++ b/SRC/dstedc.f @@ -213,7 +213,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, DLASRT, + EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, + $ DLASRT, $ DSTEQR, DSTERF, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -378,9 +379,11 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * Scale. * ORGNRM = DLANST( 'M', M, D( START ), E( START ) ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), + $ M, $ INFO ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, + $ E( START ), $ M-1, INFO ) * IF( ICOMPZ.EQ.1 ) THEN @@ -399,7 +402,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * * Scale back. * - CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), + $ M, $ INFO ) * ELSE @@ -409,7 +413,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * the length of D, we must solve the sub-problem in a * workspace and then multiply back into Z. * - CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, M, + CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, + $ M, $ WORK( M*M+1 ), INFO ) CALL DLACPY( 'A', N, M, Z( 1, START ), LDZ, $ WORK( STOREZ ), N ) diff --git a/SRC/dstein.f b/SRC/dstein.f index 2e8b45c25c..d7499ab5bb 100644 --- a/SRC/dstein.f +++ b/SRC/dstein.f @@ -211,7 +211,8 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, EXTERNAL IDAMAX, DDOT, DLAMCH, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLAGTF, DLAGTS, DLARNV, DSCAL, + EXTERNAL DAXPY, DCOPY, DLAGTF, DLAGTS, DLARNV, + $ DSCAL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -355,7 +356,8 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Compute LU factors with partial pivoting ( PT = LU ) * TOL = ZERO - CALL DLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ), + CALL DLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK, $ IINFO ) * @@ -376,7 +378,8 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * * Solve the system LU = Pb. * - CALL DLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ), + CALL DLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK, $ WORK( INDRV1+1 ), TOL, IINFO ) * @@ -389,7 +392,8 @@ SUBROUTINE DSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, $ GPIND = J IF( GPIND.NE.J ) THEN DO 80 I = GPIND, J - 1 - ZTR = -DDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, I ), + ZTR = -DDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, + $ I ), $ 1 ) CALL DAXPY( BLKSIZ, ZTR, Z( B1, I ), 1, $ WORK( INDRV1+1 ), 1 ) diff --git a/SRC/dstemr.f b/SRC/dstemr.f index e2fc88b318..ec7728fc39 100644 --- a/SRC/dstemr.f +++ b/SRC/dstemr.f @@ -364,7 +364,8 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, EXTERNAL LSAME, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAE2, DLAEV2, DLARRC, DLARRE, DLARRJ, + EXTERNAL DCOPY, DLAE2, DLAEV2, DLARRC, DLARRE, + $ DLARRJ, $ DLARRR, DLARRV, DLASRT, DSCAL, DSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dsteqr.f b/SRC/dsteqr.f index 328dea4180..dec5c3a14a 100644 --- a/SRC/dsteqr.f +++ b/SRC/dsteqr.f @@ -164,7 +164,8 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, DLAMCH, DLANST, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASET, DLASR, + EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASET, + $ DLASR, $ DLASRT, DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -270,13 +271,15 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) $ GO TO 10 IF( ANORM.GT.SSFMAX ) THEN ISCALE = 1 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) @@ -319,7 +322,8 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L+1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S ) + CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, + $ S ) WORK( L ) = C WORK( N-1+L ) = S CALL DLASR( 'R', 'V', 'B', N, 2, WORK( L ), @@ -378,7 +382,8 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = M - L + 1 - CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ), + CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ), + $ WORK( N-1+L ), $ Z( 1, L ), LDZ ) END IF * @@ -426,7 +431,8 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L-1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S ) + CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, + $ S ) WORK( M ) = C WORK( N-1+M ) = S CALL DLASR( 'R', 'V', 'F', N, 2, WORK( M ), @@ -485,7 +491,8 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = L - M + 1 - CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ), + CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ), + $ WORK( N-1+M ), $ Z( 1, M ), LDZ ) END IF * @@ -511,12 +518,14 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) IF( ISCALE.EQ.1 ) THEN CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) ELSE IF( ISCALE.EQ.2 ) THEN CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) END IF * diff --git a/SRC/dsterf.f b/SRC/dsterf.f index 2fb0ad2a56..9f7f4ba950 100644 --- a/SRC/dsterf.f +++ b/SRC/dsterf.f @@ -191,13 +191,15 @@ SUBROUTINE DSTERF( N, D, E, INFO ) $ GO TO 10 IF( (ANORM.GT.SSFMAX) ) THEN ISCALE = 1 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) diff --git a/SRC/dstevd.f b/SRC/dstevd.f index 2f6668aead..4c967099bb 100644 --- a/SRC/dstevd.f +++ b/SRC/dstevd.f @@ -275,7 +275,8 @@ SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, D, E, INFO ) ELSE - CALL DSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, + CALL DSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, + $ LIWORK, $ INFO ) END IF * diff --git a/SRC/dstevr.f b/SRC/dstevr.f index d2b5e20800..1ce3b2f4a8 100644 --- a/SRC/dstevr.f +++ b/SRC/dstevr.f @@ -299,7 +299,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, + SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * @@ -340,7 +341,8 @@ SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, EXTERNAL LSAME, ILAENV, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEMR, DSTEIN, DSTERF, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEMR, DSTEIN, + $ DSTERF, $ DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -522,12 +524,14 @@ SUBROUTINE DSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, ORDER = 'E' END IF - CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, + CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + $ M, $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), WORK, $ IWORK( INDIWO ), INFO ) * IF( WANTZ ) THEN - CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ), + CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), + $ IWORK( INDISP ), $ Z, LDZ, WORK, IWORK( INDIWO ), IWORK( INDIFL ), $ INFO ) END IF diff --git a/SRC/dstevx.f b/SRC/dstevx.f index 15f02ade3f..7cd328d5e3 100644 --- a/SRC/dstevx.f +++ b/SRC/dstevx.f @@ -223,7 +223,8 @@ *> \ingroup stevx * * ===================================================================== - SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, + SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * * -- LAPACK driver routine -- @@ -260,7 +261,8 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, EXTERNAL LSAME, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEIN, DSTEQR, DSTERF, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTEIN, DSTEQR, + $ DSTERF, $ DSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -378,7 +380,8 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK, INFO ) ELSE - CALL DSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), INFO ) + CALL DSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), + $ INFO ) IF( INFO.EQ.0 ) THEN DO 10 I = 1, N IFAIL( I ) = 0 @@ -402,7 +405,8 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, INDWRK = 1 INDISP = 1 + N INDIWO = INDISP + N - CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, + CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + $ M, $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ), $ WORK( INDWRK ), IWORK( INDIWO ), INFO ) * diff --git a/SRC/dsycon_rook.f b/SRC/dsycon_rook.f index 6ac6622301..727c226cb8 100644 --- a/SRC/dsycon_rook.f +++ b/SRC/dsycon_rook.f @@ -140,7 +140,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE DSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ IWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dsyequb.f b/SRC/dsyequb.f index 69e092e0a6..a6e0fc85a7 100644 --- a/SRC/dsyequb.f +++ b/SRC/dsyequb.f @@ -128,7 +128,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -173,7 +174,8 @@ SUBROUTINE DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/dsyev.f b/SRC/dsyev.f index 4c2e15a345..23f9e7f173 100644 --- a/SRC/dsyev.f +++ b/SRC/dsyev.f @@ -163,7 +163,8 @@ SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY * .. * .. External Subroutines .. - EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, DSYTRD, + EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, + $ DSYTRD, $ XERBLA * .. * .. Intrinsic Functions .. @@ -256,9 +257,11 @@ SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/dsyev_2stage.f b/SRC/dsyev_2stage.f index 17ea86256c..1cfe4f3266 100644 --- a/SRC/dsyev_2stage.f +++ b/SRC/dsyev_2stage.f @@ -216,7 +216,8 @@ SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, DSTERF, + EXTERNAL DLASCL, DORGTR, DSCAL, DSTEQR, + $ DSTERF, $ XERBLA, DSYTRD_2STAGE * .. * .. Intrinsic Functions .. @@ -242,10 +243,14 @@ SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = 2*N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -318,9 +323,11 @@ SUBROUTINE DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, * Not available in this release, and argument checking should not * let it getting here RETURN - CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) - CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ), + CALL DSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/dsyevd.f b/SRC/dsyevd.f index e83e86b0c7..daf0df848b 100644 --- a/SRC/dsyevd.f +++ b/SRC/dsyevd.f @@ -173,7 +173,8 @@ *> * ===================================================================== - SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, + SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ IWORK, $ LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -210,7 +211,8 @@ SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF, + EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, + $ DSTERF, $ DSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -250,7 +252,8 @@ SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LWMIN = 2*N + 1 END IF LOPT = MAX( LWMIN, 2*N + - $ N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) ) + $ N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, + $ -1 ) ) LIOPT = LIWMIN END IF WORK( 1 ) = LOPT diff --git a/SRC/dsyevd_2stage.f b/SRC/dsyevd_2stage.f index db96461dfa..8f4a5a3bef 100644 --- a/SRC/dsyevd_2stage.f +++ b/SRC/dsyevd_2stage.f @@ -217,7 +217,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + SUBROUTINE DSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, + $ LWORK, $ IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -257,7 +258,8 @@ SUBROUTINE DSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF, + EXTERNAL DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, + $ DSTERF, $ DSYTRD_2STAGE, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 23182c5574..9f22ffce4d 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -331,7 +331,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * @@ -373,7 +374,8 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY * .. * .. External Subroutines .. - EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, DSTEIN, + EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, + $ DSTEIN, $ DSTERF, DSWAP, DSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -633,7 +635,8 @@ SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 3a763fc4c6..5eb29cbed1 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -420,10 +420,12 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV, ILAENV2STAGE DOUBLE PRECISION DLAMCH, DLANSY - EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV, ILAENV2STAGE + EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV, + $ ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, DSTEIN, + EXTERNAL DCOPY, DORMTR, DSCAL, DSTEBZ, DSTEMR, + $ DSTEIN, $ DSTERF, DSWAP, DSYTRD_2STAGE, XERBLA * .. * .. Intrinsic Functions .. @@ -693,7 +695,8 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/dsyevx.f b/SRC/dsyevx.f index 8b7f9a20ac..5dfee0980e 100644 --- a/SRC/dsyevx.f +++ b/SRC/dsyevx.f @@ -248,7 +248,8 @@ *> \ingroup heevx * * ===================================================================== - SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * @@ -290,7 +291,8 @@ SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, DSTEBZ, + EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, + $ DSTEBZ, $ DSTEIN, DSTEQR, DSTERF, DSWAP, DSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -343,7 +345,8 @@ SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ELSE LWKMIN = 8*N NB = ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) - NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, -1 ) ) + NB = MAX( NB, ILAENV( 1, 'DORMTR', UPLO, N, -1, -1, + $ -1 ) ) LWKOPT = MAX( LWKMIN, ( NB + 3 )*N ) END IF WORK( 1 ) = LWKOPT @@ -495,7 +498,8 @@ SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/dsyevx_2stage.f b/SRC/dsyevx_2stage.f index bde4ff533e..b92d61a657 100644 --- a/SRC/dsyevx_2stage.f +++ b/SRC/dsyevx_2stage.f @@ -339,7 +339,8 @@ SUBROUTINE DSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, EXTERNAL LSAME, DLAMCH, DLANSY, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, DSTEBZ, + EXTERNAL DCOPY, DLACPY, DORGTR, DORMTR, DSCAL, + $ DSTEBZ, $ DSTEIN, DSTEQR, DSTERF, DSWAP, XERBLA, $ DSYTRD_2STAGE * .. @@ -553,7 +554,8 @@ SUBROUTINE DSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL DORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/dsygs2.f b/SRC/dsygs2.f index 4050e9813f..bcf1463bbd 100644 --- a/SRC/dsygs2.f +++ b/SRC/dsygs2.f @@ -150,7 +150,8 @@ SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) DOUBLE PRECISION AKK, BKK, CT * .. * .. External Subroutines .. - EXTERNAL DAXPY, DSCAL, DSYR2, DTRMV, DTRSV, XERBLA + EXTERNAL DAXPY, DSCAL, DSYR2, DTRMV, DTRSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -222,10 +223,12 @@ SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) IF( K.LT.N ) THEN CALL DSCAL( N-K, ONE / BKK, A( K+1, K ), 1 ) CT = -HALF*AKK - CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL DSYR2( UPLO, N-K, -ONE, A( K+1, K ), 1, $ B( K+1, K ), 1, A( K+1, K+1 ), LDA ) - CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL DAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL DTRSV( UPLO, 'No transpose', 'Non-unit', N-K, $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 ) END IF @@ -246,7 +249,8 @@ SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDB, A( 1, K ), 1 ) CT = HALF*AKK CALL DAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) - CALL DSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), 1, + CALL DSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), + $ 1, $ A, LDA ) CALL DAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) CALL DSCAL( K-1, BKK, A( 1, K ), 1 ) @@ -262,7 +266,8 @@ SUBROUTINE DSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * AKK = A( K, K ) BKK = B( K, K ) - CALL DTRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, LDB, + CALL DTRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, + $ LDB, $ A( K, 1 ), LDA ) CT = HALF*AKK CALL DAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) diff --git a/SRC/dsygst.f b/SRC/dsygst.f index f92f5f090d..75cb7ffa1d 100644 --- a/SRC/dsygst.f +++ b/SRC/dsygst.f @@ -149,7 +149,8 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) INTEGER K, KB, NB * .. * .. External Subroutines .. - EXTERNAL DSYGS2, DSYMM, DSYR2K, DTRMM, DTRSM, XERBLA + EXTERNAL DSYGS2, DSYMM, DSYR2K, DTRMM, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -212,13 +213,15 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL DTRSM( 'Left', UPLO, 'Transpose', 'Non-unit', + CALL DTRSM( 'Left', UPLO, 'Transpose', + $ 'Non-unit', $ KB, N-K-KB+1, ONE, B( K, K ), LDB, $ A( K, K+KB ), LDA ) CALL DSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE, $ A( K, K+KB ), LDA ) - CALL DSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, -ONE, + CALL DSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, + $ -ONE, $ A( K, K+KB ), LDA, B( K, K+KB ), LDB, $ ONE, A( K+KB, K+KB ), LDA ) CALL DSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, @@ -242,7 +245,8 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL DTRSM( 'Right', UPLO, 'Transpose', 'Non-unit', + CALL DTRSM( 'Right', UPLO, 'Transpose', + $ 'Non-unit', $ N-K-KB+1, KB, ONE, B( K, K ), LDB, $ A( K+KB, K ), LDA ) CALL DSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF, @@ -271,14 +275,17 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the upper triangle of A(1:k+kb-1,1:k+kb-1) * - CALL DTRMM( 'Left', UPLO, 'No transpose', 'Non-unit', + CALL DTRMM( 'Left', UPLO, 'No transpose', + $ 'Non-unit', $ K-1, KB, ONE, B, LDB, A( 1, K ), LDA ) - CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA ) CALL DSYR2K( UPLO, 'No transpose', K-1, KB, ONE, $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A, $ LDA ) - CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL DSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA ) CALL DTRMM( 'Right', UPLO, 'Transpose', 'Non-unit', $ K-1, KB, ONE, B( K, K ), LDB, A( 1, K ), @@ -295,7 +302,8 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the lower triangle of A(1:k+kb-1,1:k+kb-1) * - CALL DTRMM( 'Right', UPLO, 'No transpose', 'Non-unit', + CALL DTRMM( 'Right', UPLO, 'No transpose', + $ 'Non-unit', $ KB, K-1, ONE, B, LDB, A( K, 1 ), LDA ) CALL DSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA ) @@ -304,7 +312,8 @@ SUBROUTINE DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDA ) CALL DSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA ) - CALL DTRMM( 'Left', UPLO, 'Transpose', 'Non-unit', KB, + CALL DTRMM( 'Left', UPLO, 'Transpose', 'Non-unit', + $ KB, $ K-1, ONE, B( K, K ), LDB, A( K, 1 ), LDA ) CALL DSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) diff --git a/SRC/dsygv.f b/SRC/dsygv.f index f11057e59c..82e81654d9 100644 --- a/SRC/dsygv.f +++ b/SRC/dsygv.f @@ -171,7 +171,8 @@ *> \ingroup hegv * * ===================================================================== - SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -203,7 +204,8 @@ SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DPOTRF, DSYEV, DSYGST, DTRMM, DTRSM, XERBLA + EXTERNAL DPOTRF, DSYEV, DSYGST, DTRMM, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -285,7 +287,8 @@ SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'T' END IF * - CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -299,7 +302,8 @@ SUBROUTINE DSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'N' END IF * - CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/dsygv_2stage.f b/SRC/dsygv_2stage.f index aae7b9843c..ffd951319b 100644 --- a/SRC/dsygv_2stage.f +++ b/SRC/dsygv_2stage.f @@ -222,7 +222,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, + $ W, $ WORK, LWORK, INFO ) * IMPLICIT NONE @@ -256,7 +257,8 @@ SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, EXTERNAL LSAME, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DPOTRF, DSYGST, DTRMM, DTRSM, XERBLA, + EXTERNAL DPOTRF, DSYGST, DTRMM, DTRSM, + $ XERBLA, $ DSYEV_2STAGE * .. * .. Intrinsic Functions .. @@ -286,10 +288,14 @@ SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = 2*N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -321,7 +327,8 @@ SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, * Transform problem to standard eigenvalue problem and solve. * CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) + CALL DSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ INFO ) * IF( WANTZ ) THEN * @@ -341,7 +348,8 @@ SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'T' END IF * - CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -355,7 +363,8 @@ SUBROUTINE DSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'N' END IF * - CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/dsygvd.f b/SRC/dsygvd.f index e8e8b02abf..80530a9a56 100644 --- a/SRC/dsygvd.f +++ b/SRC/dsygvd.f @@ -217,7 +217,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA *> * ===================================================================== - SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -249,7 +250,8 @@ SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DPOTRF, DSYEVD, DSYGST, DTRMM, DTRSM, XERBLA + EXTERNAL DPOTRF, DSYEVD, DSYGST, DTRMM, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX @@ -323,7 +325,8 @@ SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, + CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, + $ LIWORK, $ INFO ) LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) ) LIOPT = INT( MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) ) diff --git a/SRC/dsygvx.f b/SRC/dsygvx.f index b1f38f3ea7..68cd289a17 100644 --- a/SRC/dsygvx.f +++ b/SRC/dsygvx.f @@ -328,7 +328,8 @@ SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DPOTRF, DSYEVX, DSYGST, DTRMM, DTRSM, XERBLA + EXTERNAL DPOTRF, DSYEVX, DSYGST, DTRMM, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -413,7 +414,8 @@ SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, * Transform problem to standard eigenvalue problem and solve. * CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, + CALL DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN @@ -433,7 +435,8 @@ SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'T' END IF * - CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B, + CALL DTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, + $ B, $ LDB, Z, LDZ ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -447,7 +450,8 @@ SUBROUTINE DSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'N' END IF * - CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B, + CALL DTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, + $ B, $ LDB, Z, LDZ ) END IF END IF diff --git a/SRC/dsyrfs.f b/SRC/dsyrfs.f index 08502e0368..5e7a14d031 100644 --- a/SRC/dsyrfs.f +++ b/SRC/dsyrfs.f @@ -187,7 +187,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DSYMV, DSYTRS, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DSYMV, DSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -396,14 +398,16 @@ SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * KASE = 0 100 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) @@ -415,7 +419,8 @@ SUBROUTINE DSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL DSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/dsyrfsx.f b/SRC/dsyrfsx.f index 8da24eee66..716a0ff0d0 100644 --- a/SRC/dsyrfsx.f +++ b/SRC/dsyrfsx.f @@ -396,7 +396,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE DSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE DSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) @@ -518,7 +519,8 @@ SUBROUTINE DSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF ( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF ( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -603,7 +605,8 @@ SUBROUTINE DSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, $ INFO ) END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) )*DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) )*DLAMCH( 'Epsilon' ) IF (N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1) THEN * * Compute scaled normwise condition number cond(A*C). @@ -657,7 +660,8 @@ SUBROUTINE DSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, DO J = 1, NRHS IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG ) $ THEN - RCOND_TMP = DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = DLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ 1, X(1,J), INFO, WORK, IWORK ) ELSE RCOND_TMP = 0.0D+0 diff --git a/SRC/dsysv.f b/SRC/dsysv.f index 2a4d7d0334..446991fd97 100644 --- a/SRC/dsysv.f +++ b/SRC/dsysv.f @@ -205,7 +205,8 @@ SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dsysv_rk.f b/SRC/dsysv_rk.f index 8804b18cd8..e8ccba1cdb 100644 --- a/SRC/dsysv_rk.f +++ b/SRC/dsysv_rk.f @@ -262,7 +262,8 @@ SUBROUTINE DSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -280,7 +281,8 @@ SUBROUTINE DSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT @@ -302,7 +304,8 @@ SUBROUTINE DSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/dsysv_rook.f b/SRC/dsysv_rook.f index fb366123ec..3a6678f471 100644 --- a/SRC/dsysv_rook.f +++ b/SRC/dsysv_rook.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -238,7 +239,8 @@ SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -278,7 +280,8 @@ SUBROUTINE DSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS_ROOK ( Use Level 2 BLAS) * - CALL DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/dsysvx.f b/SRC/dsysvx.f index b9e2bde2b9..7df4766084 100644 --- a/SRC/dsysvx.f +++ b/SRC/dsysvx.f @@ -279,7 +279,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ IWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL LSAME, ILAENV, DLAMCH, DLANSY * .. * .. External Subroutines .. - EXTERNAL DLACPY, DSYCON, DSYRFS, DSYTRF, DSYTRS, XERBLA + EXTERNAL DLACPY, DSYCON, DSYRFS, DSYTRF, DSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -331,7 +333,8 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LWKMIN = MAX( 1, 3*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -387,7 +390,8 @@ SUBROUTINE DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL DSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, IWORK, + CALL DSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * Compute the solution vectors X. diff --git a/SRC/dsysvxx.f b/SRC/dsysvxx.f index 1b9a02a3d0..081bbd44b9 100644 --- a/SRC/dsysvxx.f +++ b/SRC/dsysvxx.f @@ -499,7 +499,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE DSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE DSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, IWORK, INFO ) @@ -627,7 +628,8 @@ SUBROUTINE DSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL DSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -646,7 +648,8 @@ SUBROUTINE DSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^T or UDU^T factorization of A. * CALL DLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL DSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL DSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * diff --git a/SRC/dsytd2.f b/SRC/dsytd2.f index 5ee0866f9c..83dd437106 100644 --- a/SRC/dsytd2.f +++ b/SRC/dsytd2.f @@ -250,7 +250,8 @@ SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute x := tau * A * v storing x in TAU(1:i) * - CALL DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, + CALL DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, + $ ZERO, $ TAU, 1 ) * * Compute w := x - 1/2 * tau * (x**T * v) * v @@ -296,14 +297,16 @@ SUBROUTINE DSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute w := x - 1/2 * tau * (x**T * v) * v * - ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, A( I+1, I ), + ALPHA = -HALF*TAUI*DDOT( N-I, TAU( I ), 1, A( I+1, + $ I ), $ 1 ) CALL DAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**T - w * v**T * - CALL DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, + CALL DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), + $ 1, $ A( I+1, I+1 ), LDA ) * A( I+1, I ) = E( I ) diff --git a/SRC/dsytf2.f b/SRC/dsytf2.f index 9065407b74..d1568daaca 100644 --- a/SRC/dsytf2.f +++ b/SRC/dsytf2.f @@ -285,7 +285,8 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ DISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -455,7 +456,8 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ DISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -477,7 +479,8 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) ) END IF * @@ -509,7 +512,8 @@ SUBROUTINE DSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) T = A( KK, KK ) diff --git a/SRC/dsytf2_rk.f b/SRC/dsytf2_rk.f index 8a67b8762c..f4b87fe691 100644 --- a/SRC/dsytf2_rk.f +++ b/SRC/dsytf2_rk.f @@ -461,7 +461,8 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL DSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL DSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -476,7 +477,8 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.GT.1 ) $ CALL DSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -518,7 +520,8 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / A( K, K ) - CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -537,7 +540,8 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -695,14 +699,16 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IDAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = ABS( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -761,7 +767,8 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( P.LT.N ) $ CALL DSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL DSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL DSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -783,9 +790,11 @@ SUBROUTINE DSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/dsytf2_rook.f b/SRC/dsytf2_rook.f index f9a6859bbe..29a7a30c1a 100644 --- a/SRC/dsytf2_rook.f +++ b/SRC/dsytf2_rook.f @@ -411,7 +411,8 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.GT.1 ) $ CALL DSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL DSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -445,7 +446,8 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / A( K, K ) - CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -464,7 +466,8 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL DSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -594,14 +597,16 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IDAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IDAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IDAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = ABS( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -660,7 +665,8 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( P.LT.N ) $ CALL DSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL DSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL DSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -675,9 +681,11 @@ SUBROUTINE DSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL DSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL DSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/dsytrd.f b/SRC/dsytrd.f index a611760419..3a9b414227 100644 --- a/SRC/dsytrd.f +++ b/SRC/dsytrd.f @@ -189,7 +189,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) + SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -316,7 +317,8 @@ SUBROUTINE DSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * Update the unreduced submatrix A(1:i-1,1:i-1), using an * update of the form: A := A - V*W**T - W*V**T * - CALL DSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, I ), + CALL DSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, + $ I ), $ LDA, WORK, LDWORK, ONE, A, LDA ) * * Copy superdiagonal elements back into A, and diagonal diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index bd17e90bbb..dd74b0990a 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -277,7 +277,8 @@ SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, $ TPOS, WPOS, S2POS, S1POS * .. * .. External Subroutines .. - EXTERNAL XERBLA, DSYR2K, DSYMM, DGEMM, DCOPY, + EXTERNAL XERBLA, DSYR2K, DSYMM, DGEMM, + $ DCOPY, $ DLARFT, DGELQF, DGEQRF, DLASET * .. * .. Intrinsic Functions .. @@ -385,7 +386,8 @@ SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, * DO 20 J = I, I+PK-1 LK = MIN( KD, N-J ) + 1 - CALL DCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 ) + CALL DCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), + $ LDAB-1 ) 20 CONTINUE * CALL DLASET( 'Lower', PK, PK, ZERO, ONE, diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f index 84f50ad278..6cf5416d69 100644 --- a/SRC/dsytrf.f +++ b/SRC/dsytrf.f @@ -250,7 +250,8 @@ SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'DSYTRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'DSYTRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -320,13 +321,15 @@ SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL DLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL DLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, LDWORK, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL DSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL DSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 006365de2b..1fe87c1ff1 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -165,7 +165,8 @@ SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLASYF_AA, DGEMM, DGEMV, DSCAL, DCOPY, DSWAP, + EXTERNAL DLASYF_AA, DGEMM, DGEMV, DSCAL, DCOPY, + $ DSWAP, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/dsytrf_rk.f b/SRC/dsytrf_rk.f index 9e58d15ad6..1daff24bf3 100644 --- a/SRC/dsytrf_rk.f +++ b/SRC/dsytrf_rk.f @@ -426,7 +426,8 @@ SUBROUTINE DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL DLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL DLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/dsytrf_rook.f b/SRC/dsytrf_rook.f index 63f4dc9fc0..717935d27f 100644 --- a/SRC/dsytrf_rook.f +++ b/SRC/dsytrf_rook.f @@ -205,7 +205,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/dsytri.f b/SRC/dsytri.f index 4f0f1385a0..380018a126 100644 --- a/SRC/dsytri.f +++ b/SRC/dsytri.f @@ -249,7 +249,8 @@ SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL DCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -308,9 +309,11 @@ SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -333,15 +336,19 @@ SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ DDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ DDOT( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL DCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - $ DDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 ) diff --git a/SRC/dsytri2x.f b/SRC/dsytri2x.f index cad9dcb432..186cd21e37 100644 --- a/SRC/dsytri2x.f +++ b/SRC/dsytri2x.f @@ -383,8 +383,10 @@ SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -569,12 +571,16 @@ SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP, I ) + IF ( I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP, + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/dsytri_3x.f b/SRC/dsytri_3x.f index 921ea4af3a..a7fe288fb0 100644 --- a/SRC/dsytri_3x.f +++ b/SRC/dsytri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -188,7 +189,8 @@ SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DGEMM, DSYSWAPR, DTRTRI, DTRMM, XERBLA + EXTERNAL DGEMM, DSYSWAPR, DTRTRI, DTRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MOD @@ -432,8 +434,10 @@ SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -628,8 +632,10 @@ SUBROUTINE DSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL DSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/dsytri_rook.f b/SRC/dsytri_rook.f index d854650775..cb33c92e50 100644 --- a/SRC/dsytri_rook.f +++ b/SRC/dsytri_rook.f @@ -264,7 +264,8 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) A( K, K ) = A( K, K ) - DDOT( K-1, WORK, 1, A( 1, K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ DDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL DCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL DSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -283,7 +284,8 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL DSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -297,7 +299,8 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL DSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -312,7 +315,8 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL DSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL DSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -350,9 +354,11 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -375,15 +381,19 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL DCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - DDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ DDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ DDOT( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL DCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL DSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - $ DDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 ) @@ -399,8 +409,10 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -413,8 +425,10 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -428,8 +442,10 @@ SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL DSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL DSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP diff --git a/SRC/dsytrs.f b/SRC/dsytrs.f index 276fc38f45..69b515520d 100644 --- a/SRC/dsytrs.f +++ b/SRC/dsytrs.f @@ -271,7 +271,8 @@ SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -287,7 +288,8 @@ SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) CALL DGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB ) @@ -355,7 +357,8 @@ SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/dsytrs2.f b/SRC/dsytrs2.f index 3bf9aae84d..61b188f646 100644 --- a/SRC/dsytrs2.f +++ b/SRC/dsytrs2.f @@ -160,7 +160,8 @@ SUBROUTINE DSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSYCONV, DSWAP, DTRSM, XERBLA + EXTERNAL DSCAL, DSYCONV, DSWAP, DTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX diff --git a/SRC/dsytrs_3.f b/SRC/dsytrs_3.f index 619f30a063..05e679124d 100644 --- a/SRC/dsytrs_3.f +++ b/SRC/dsytrs_3.f @@ -247,7 +247,8 @@ SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL DTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL DTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -273,7 +274,8 @@ SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ] * - CALL DTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL DTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**T \ (D \ (U \P**T * B) )) ] * @@ -314,7 +316,8 @@ SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL DTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL DTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -340,7 +343,8 @@ SUBROUTINE DSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ] * - CALL DTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL DTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**T \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/dsytrs_aa.f b/SRC/dsytrs_aa.f index dfede5a39b..cb9361c146 100644 --- a/SRC/dsytrs_aa.f +++ b/SRC/dsytrs_aa.f @@ -220,7 +220,8 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, DO K = 1, N KP = IPIV( K ) IF( KP.NE.K ) - $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), + $ LDB ) END DO * * Compute U**T \ B -> B [ (U**T \P**T * B) ] @@ -235,10 +236,13 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL DLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN - CALL DLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 ) - CALL DLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 ) + CALL DLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL DLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL DGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, + CALL DGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, + $ LDB, $ INFO ) * * 3) Backward substitution with U @@ -247,7 +251,8 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL DTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL DTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -277,7 +282,8 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L \ B -> B [ (L \P**T * B) ] * - CALL DTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL DTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -287,10 +293,13 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL DLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL DLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 ) - CALL DLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 ) + CALL DLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL DLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL DGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, + CALL DGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, + $ LDB, $ INFO) * * 3) Backward substitution with L**T @@ -299,7 +308,8 @@ SUBROUTINE DSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL DTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL DTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/dsytrs_aa_2stage.f b/SRC/dsytrs_aa_2stage.f index fc6db7b706..c29b2b1ff7 100644 --- a/SRC/dsytrs_aa_2stage.f +++ b/SRC/dsytrs_aa_2stage.f @@ -216,7 +216,8 @@ SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * - CALL DTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL DTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -229,7 +230,8 @@ SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL DTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL DTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -250,7 +252,8 @@ SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \ B) -> B [ (L \P**T * B) ] * - CALL DTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL DTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -263,7 +266,8 @@ SUBROUTINE DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL DTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL DTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/dsytrs_rook.f b/SRC/dsytrs_rook.f index 609217b06f..1f7494f88d 100644 --- a/SRC/dsytrs_rook.f +++ b/SRC/dsytrs_rook.f @@ -251,7 +251,8 @@ SUBROUTINE DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, IF( K.GT.2 ) THEN CALL DGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), $ LDB, B( 1, 1 ), LDB ) - CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), + CALL DGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, + $ 1 ), $ LDB, B( 1, 1 ), LDB ) END IF * @@ -389,7 +390,8 @@ SUBROUTINE DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL DGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/dtbcon.f b/SRC/dtbcon.f index 5e7df9bf5a..9e5d38abb6 100644 --- a/SRC/dtbcon.f +++ b/SRC/dtbcon.f @@ -139,7 +139,8 @@ *> \ingroup tbcon * * ===================================================================== - SUBROUTINE DTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, + SUBROUTINE DTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, + $ WORK, $ IWORK, INFO ) * * -- LAPACK computational routine -- @@ -239,19 +240,22 @@ SUBROUTINE DTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, END IF KASE = 0 10 CONTINUE - CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * * Multiply by inv(A). * - CALL DLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD, + CALL DLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ KD, $ AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(A**T). * - CALL DLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, AB, + CALL DLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, + $ AB, $ LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO ) END IF NORMIN = 'Y' diff --git a/SRC/dtbrfs.f b/SRC/dtbrfs.f index c27d2ed2f0..c32383eeb7 100644 --- a/SRC/dtbrfs.f +++ b/SRC/dtbrfs.f @@ -219,7 +219,8 @@ SUBROUTINE DTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DTBMV, DTBSV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DTBMV, DTBSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -440,7 +441,8 @@ SUBROUTINE DTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * KASE = 0 210 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/dtbtrs.f b/SRC/dtbtrs.f index ef5268daab..b43e48ac17 100644 --- a/SRC/dtbtrs.f +++ b/SRC/dtbtrs.f @@ -187,7 +187,8 @@ SUBROUTINE DTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 @@ -232,7 +233,8 @@ SUBROUTINE DTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * Solve A * X = B or A**T * X = B. * DO 30 J = 1, NRHS - CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) + CALL DTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), + $ 1 ) 30 CONTINUE * RETURN diff --git a/SRC/dtfsm.f b/SRC/dtfsm.f index a16d76dd8e..a770940337 100644 --- a/SRC/dtfsm.f +++ b/SRC/dtfsm.f @@ -273,7 +273,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, + SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, + $ A, $ B, LDB ) * * -- LAPACK computational routine -- @@ -328,7 +329,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, INFO = -3 ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN INFO = -4 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -5 ELSE IF( M.LT.0 ) THEN @@ -400,12 +402,15 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A, M, B, LDB ) ELSE - CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) - CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), + CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, + $ A( M1 ), $ M, B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, $ A( M ), M, B( M1, 0 ), LDB ) @@ -417,12 +422,15 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'T' * IF( M.EQ.1 ) THEN - CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) ELSE - CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, + $ ALPHA, $ A( M ), M, B( M1, 0 ), LDB ) - CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), + CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, + $ A( M1 ), $ M, B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, $ A( 0 ), M, B, LDB ) @@ -441,7 +449,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, $ A( M2 ), M, B, LDB ) - CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), M, + CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), + $ M, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, $ A( M1 ), M, B( M1, 0 ), LDB ) @@ -453,7 +462,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, $ A( M1 ), M, B( M1, 0 ), LDB ) - CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), M, + CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), + $ M, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, $ A( M2 ), M, B, LDB ) @@ -476,10 +486,12 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, $ A( M1*M1 ), M1, B, LDB, ALPHA, @@ -494,10 +506,12 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'T' * IF( M.EQ.1 ) THEN - CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, + CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, + $ ALPHA, $ A( 1 ), M1, B( M1, 0 ), LDB ) CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, $ A( M1*M1 ), M1, B( M1, 0 ), LDB, @@ -519,7 +533,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, $ A( M2*M2 ), M2, B, LDB ) - CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), M2, + CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), + $ M2, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL DTRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) @@ -531,7 +546,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) - CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), M2, + CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), + $ M2, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, $ A( M2*M2 ), M2, B, LDB ) @@ -591,7 +607,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, $ A( K+1 ), M+1, B, LDB ) - CALL DGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), M+1, + CALL DGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), + $ M+1, $ B, LDB, ALPHA, B( K, 0 ), LDB ) CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ONE, $ A( K ), M+1, B( K, 0 ), LDB ) @@ -602,7 +619,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * and TRANS = 'T' CALL DTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, $ A( K ), M+1, B( K, 0 ), LDB ) - CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), M+1, + CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), + $ M+1, $ B( K, 0 ), LDB, ALPHA, B, LDB ) CALL DTRSM( 'L', 'L', 'T', DIAG, K, N, ONE, $ A( K+1 ), M+1, B, LDB ) @@ -658,7 +676,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA, $ A( K*( K+1 ) ), K, B, LDB ) - CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, B, + CALL DGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, + $ B, $ LDB, ALPHA, B( K, 0 ), LDB ) CALL DTRSM( 'L', 'L', 'N', DIAG, K, N, ONE, $ A( K*K ), K, B( K, 0 ), LDB ) @@ -724,7 +743,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA, $ A( N ), N, B( 0, N1 ), LDB ) - CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ), + CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ), $ LDB ) CALL DTRSM( 'R', 'L', 'N', DIAG, M, N1, ONE, @@ -737,7 +757,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA, $ A( 0 ), N, B( 0, 0 ), LDB ) - CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ), + CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL DTRSM( 'R', 'U', 'N', DIAG, M, N2, ONE, @@ -756,7 +777,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA, $ A( N2 ), N, B( 0, 0 ), LDB ) - CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ), + CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL DTRSM( 'R', 'U', 'N', DIAG, M, N2, ONE, @@ -769,7 +791,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA, $ A( N1 ), N, B( 0, N1 ), LDB ) - CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ), + CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB ) CALL DTRSM( 'R', 'L', 'N', DIAG, M, N1, ONE, $ A( N2 ), N, B( 0, 0 ), LDB ) @@ -793,7 +816,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( 1 ), N1, B( 0, N1 ), LDB ) - CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ), + CALL DGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ), $ LDB ) CALL DTRSM( 'R', 'U', 'T', DIAG, M, N1, ONE, @@ -806,7 +830,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( 0 ), N1, B( 0, 0 ), LDB ) - CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ), + CALL DGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ), $ LDB ) CALL DTRSM( 'R', 'L', 'T', DIAG, M, N2, ONE, @@ -825,7 +850,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) - CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ), + CALL DGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ), $ LDB ) CALL DTRSM( 'R', 'L', 'T', DIAG, M, N2, ONE, @@ -838,7 +864,8 @@ SUBROUTINE DTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL DTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) - CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ), + CALL DGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ), $ LDB ) CALL DTRSM( 'R', 'U', 'T', DIAG, M, N1, ONE, diff --git a/SRC/dtftri.f b/SRC/dtftri.f index acc162cb26..b48c4c138d 100644 --- a/SRC/dtftri.f +++ b/SRC/dtftri.f @@ -243,7 +243,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) INFO = -1 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -306,7 +307,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), N, + CALL DTRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), + $ N, $ A( N1 ), N ) * ELSE @@ -318,7 +320,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL DTRTRI( 'L', DIAG, N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, A( N2 ), + CALL DTRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, + $ A( N2 ), $ N, A( 0 ), N ) CALL DTRTRI( 'U', DIAG, N2, A( N1 ), N, INFO ) IF( INFO.GT.0 ) @@ -397,7 +400,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), N+1, + CALL DTRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) * ELSE @@ -416,7 +420,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), N+1, + CALL DTRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) END IF ELSE @@ -432,7 +437,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL DTRTRI( 'U', DIAG, K, A( K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), K, + CALL DTRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), + $ K, $ A( K*( K+1 ) ), K ) CALL DTRTRI( 'L', DIAG, K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) @@ -457,7 +463,8 @@ SUBROUTINE DTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL DTRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), K, + CALL DTRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), + $ K, $ A( 0 ), K ) END IF END IF diff --git a/SRC/dtgevc.f b/SRC/dtgevc.f index 25b17078f6..ca952a1d7f 100644 --- a/SRC/dtgevc.f +++ b/SRC/dtgevc.f @@ -338,7 +338,8 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGEMV, DLACPY, DLAG2, DLALN2, XERBLA + EXTERNAL DGEMV, DLACPY, DLAG2, DLALN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -765,7 +766,8 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * Solve ( a A - b B ) y = SUM(,) * with scaling and perturbation of the denominator * - CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS, + CALL DLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), + $ LDS, $ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR, $ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP, $ IINFO ) @@ -791,11 +793,13 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, $ WORK( ( JW+2 )*N+JE ), 1, ZERO, $ WORK( ( JW+4 )*N+1 ), 1 ) 170 CONTINUE - CALL DLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, JE ), + CALL DLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, + $ JE ), $ LDVL ) IBEG = 1 ELSE - CALL DLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, IEIG ), + CALL DLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, + $ IEIG ), $ LDVL ) IBEG = JE END IF @@ -954,7 +958,8 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * * Complex eigenvalue * - CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP, + CALL DLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), + $ LDP, $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2, $ BCOEFI ) IF( BCOEFI.EQ.ZERO ) THEN diff --git a/SRC/dtgex2.f b/SRC/dtgex2.f index 0944162e0c..f8b95db692 100644 --- a/SRC/dtgex2.f +++ b/SRC/dtgex2.f @@ -267,7 +267,8 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGEMM, DGEQR2, DGERQ2, DLACPY, DLAGV2, DLARTG, + EXTERNAL DGEMM, DGEQR2, DGERQ2, DLACPY, DLAGV2, + $ DLARTG, $ DLASET, DLASSQ, DORG2R, DORGR2, DORM2R, DORMR2, $ DROT, DSCAL, DTGSY2 * .. @@ -346,10 +347,12 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL DROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ), $ IR( 2, 1 ) ) IF( SA.GE.SB ) THEN - CALL DLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ), + CALL DLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, + $ 1 ), $ DDUM ) ELSE - CALL DLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ), + CALL DLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, + $ 1 ), $ DDUM ) END IF CALL DROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ), @@ -374,22 +377,28 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * and * F-norm((B-QL**H*T*QR)) <= O(EPS*F-norm((B))) * - CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ), + CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, + $ WORK( M*M+1 ), $ M ) - CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, + CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, + $ ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM ) SA = DSCALE*SQRT( DSUM ) * - CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ), + CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, + $ WORK( M*M+1 ), $ M ) - CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, + CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, + $ ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL DGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE @@ -489,11 +498,13 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S, + CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, + $ S, $ LDST ) CALL DGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T, + CALL DGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, + $ T, $ LDST ) CALL DLACPY( 'F', M, M, S, LDST, SCPY, LDST ) CALL DLACPY( 'F', M, M, T, LDST, TCPY, LDST ) @@ -506,11 +517,13 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL DGERQ2( M, M, T, LDST, TAUR, WORK, LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL DORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK, + CALL DORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, + $ WORK, $ LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL DORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK, + CALL DORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, + $ WORK, $ LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 @@ -530,9 +543,11 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL DGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL DORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST, + CALL DORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, + $ LDST, $ WORK, INFO ) - CALL DORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST, + CALL DORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, + $ LDST, $ WORK, INFO ) IF( LINFO.NE.0 ) $ GO TO 70 @@ -570,22 +585,28 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * and * F-norm((B-QL**H*T*QR)) <= O(EPS*F-norm((B))) * - CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ), + CALL DLACPY( 'Full', M, M, A( J1, J1 ), LDA, + $ WORK( M*M+1 ), $ M ) - CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, + CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, + $ ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE CALL DLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM ) SA = DSCALE*SQRT( DSUM ) * - CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ), + CALL DLACPY( 'Full', M, M, B( J1, J1 ), LDB, + $ WORK( M*M+1 ), $ M ) - CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, + CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, + $ ZERO, $ WORK, M ) - CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL DGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE @@ -615,7 +636,8 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( 1, 1 ) = ONE IDUM = LWORK - M*M - 2 IF( N2.GT.1 ) THEN - CALL DLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE, + CALL DLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, + $ BE, $ WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) ) WORK( M+1 ) = -WORK( 2 ) WORK( M+2 ) = WORK( 1 ) @@ -626,7 +648,8 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( M, M ) = ONE * IF( N1.GT.1 ) THEN - CALL DLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB, + CALL DLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), + $ LDB, $ TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ), $ WORK( N2*M+N2+2 ), T( N2+1, N2+1 ), $ T( M, M-1 ) ) @@ -635,13 +658,17 @@ SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( M, M ) = T( N2+1, N2+1 ) T( M-1, M ) = -T( M, M-1 ) END IF - CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ), + CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, + $ J1+N2 ), $ LDA, ZERO, WORK( M*M+1 ), N2 ) - CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ), + CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, + $ J1+N2 ), $ LDA ) - CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ), + CALL DGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, + $ J1+N2 ), $ LDB, ZERO, WORK( M*M+1 ), N2 ) - CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ), + CALL DLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, + $ J1+N2 ), $ LDB ) CALL DGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO, $ WORK( M*M+1 ), M ) diff --git a/SRC/dtgexc.f b/SRC/dtgexc.f index e1a84c2ed6..66cdb071f6 100644 --- a/SRC/dtgexc.f +++ b/SRC/dtgexc.f @@ -382,7 +382,8 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap two 1-by-1 blocks. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -400,7 +401,8 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did not split. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK, $ INFO ) IF( INFO.NE.0 ) THEN @@ -412,14 +414,16 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did split. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE RETURN END IF HERE = HERE + 1 - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -485,7 +489,8 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap two 1-by-1 blocks. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -502,7 +507,8 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did not split. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -513,14 +519,16 @@ SUBROUTINE DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did split. * - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE RETURN END IF HERE = HERE - 1 - CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE diff --git a/SRC/dtgsen.f b/SRC/dtgsen.f index 945d4b0133..17dffa28db 100644 --- a/SRC/dtgsen.f +++ b/SRC/dtgsen.f @@ -446,7 +446,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -487,7 +488,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, DTGSYL, + EXTERNAL DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, + $ DTGSYL, $ XERBLA * .. * .. External Functions .. @@ -635,7 +637,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * KK = K IF( K.NE.KS ) - $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, KK, KS, WORK, LWORK, IERR ) * IF( IERR.GT.0 ) THEN @@ -669,7 +672,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, I = N1 + 1 IJB = 0 CALL DLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1, @@ -711,14 +715,16 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu-estimate. * - CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl-estimate. * - CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -747,7 +753,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -756,7 +763,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -776,7 +784,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -785,7 +794,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -827,7 +837,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, WORK( 6 ) = B( K+1, K ) WORK( 7 ) = B( K, K+1 ) WORK( 8 ) = B( K+1, K+1 ) - CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ), + CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, + $ BETA( K ), $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ), $ ALPHAI( K ) ) ALPHAI( K+1 ) = -ALPHAI( K ) diff --git a/SRC/dtgsja.f b/SRC/dtgsja.f index 25c1f0316e..fbbf857df3 100644 --- a/SRC/dtgsja.f +++ b/SRC/dtgsja.f @@ -413,7 +413,8 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAGS2, DLAPLL, DLARTG, DLASET, DROT, + EXTERNAL DCOPY, DLAGS2, DLAPLL, DLARTG, DLASET, + $ DROT, $ DSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -436,9 +437,13 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, INFO = 0 IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITV .OR. + $ WANTV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITQ .OR. + $ WANTQ .OR. + $ LSAME( JOBQ, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -508,7 +513,8 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, * Update (K+I)-th and (K+J)-th rows of matrix A: U**T *A * IF( K+J.LE.M ) - $ CALL DROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ), + $ CALL DROT( L, A( K+J, N-L+1 ), LDA, A( K+I, + $ N-L+1 ), $ LDA, CSU, SNU ) * * Update I-th and J-th rows of matrix B: V**T *B @@ -542,10 +548,12 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ SNU ) * IF( WANTV ) - $ CALL DROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV ) + $ CALL DROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, + $ SNV ) * IF( WANTQ ) - $ CALL DROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ, + $ CALL DROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, + $ CSQ, $ SNQ ) * 10 CONTINUE @@ -562,7 +570,8 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, ERROR = ZERO DO 30 I = 1, MIN( L, M-K ) CALL DCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 ) - CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 ) + CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), + $ 1 ) CALL DLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN ) ERROR = MAX( ERROR, SSMIN ) 30 CONTINUE @@ -607,16 +616,19 @@ SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ CALL DSCAL( P, -ONE, V( 1, I ), 1 ) END IF * - CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ), + CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), + $ ALPHA( K+I ), $ RWK ) * IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN - CALL DSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ), + CALL DSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, + $ N-L+I ), $ LDA ) ELSE CALL DSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ), $ LDB ) - CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ), + CALL DCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, + $ N-L+I ), $ LDA ) END IF * diff --git a/SRC/dtgsna.f b/SRC/dtgsna.f index 5c99bb5cf6..982814aa3b 100644 --- a/SRC/dtgsna.f +++ b/SRC/dtgsna.f @@ -421,7 +421,8 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DGEMV, DLACPY, DLAG2, DTGEXC, DTGSYL, XERBLA + EXTERNAL DGEMV, DLACPY, DLAG2, DTGEXC, DTGSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT @@ -559,7 +560,8 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, $ DNRM2( N, VR( 1, KS+1 ), 1 ) ) LNRM = DLAPY2( DNRM2( N, VL( 1, KS ), 1 ), $ DNRM2( N, VL( 1, KS+1 ), 1 ) ) - CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO, + CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) TMPRR = DDOT( N, WORK, 1, VL( 1, KS ), 1 ) TMPRI = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 ) @@ -569,7 +571,8 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, TMPIR = DDOT( N, WORK, 1, VL( 1, KS ), 1 ) UHAV = TMPRR + TMPII UHAVI = TMPIR - TMPRI - CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO, + CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) TMPRR = DDOT( N, WORK, 1, VL( 1, KS ), 1 ) TMPRI = DDOT( N, WORK, 1, VL( 1, KS+1 ), 1 ) @@ -591,10 +594,12 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * RNRM = DNRM2( N, VR( 1, KS ), 1 ) LNRM = DNRM2( N, VL( 1, KS ), 1 ) - CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO, + CALL DGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) UHAV = DDOT( N, WORK, 1, VL( 1, KS ), 1 ) - CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO, + CALL DGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) UHBV = DDOT( N, WORK, 1, VL( 1, KS ), 1 ) COND = DLAPY2( UHAV, UHBV ) @@ -646,7 +651,8 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, IFST = K ILST = 1 * - CALL DTGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), N, + CALL DTGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), + $ N, $ DUMMY, 1, DUMMY1, 1, IFST, ILST, $ WORK( N*N*2+1 ), LWORK-2*N*N, IERR ) * @@ -672,7 +678,8 @@ SUBROUTINE DTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, ELSE I = N*N + 1 IZ = 2*N*N + 1 - CALL DTGSYL( 'N', DIFDRI, N2, N1, WORK( N*N1+N1+1 ), + CALL DTGSYL( 'N', DIFDRI, N2, N1, + $ WORK( N*N1+N1+1 ), $ N, WORK, N, WORK( N1+1 ), N, $ WORK( N*N1+N1+I ), N, WORK( I ), N, $ WORK( N1+I ), N, SCALE, DIF( KS ), diff --git a/SRC/dtgsy2.f b/SRC/dtgsy2.f index 99a08c9f45..c192a53e2e 100644 --- a/SRC/dtgsy2.f +++ b/SRC/dtgsy2.f @@ -269,7 +269,8 @@ *> Umea University, S-901 87 Umea, Sweden. * * ===================================================================== - SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, $ IWORK, PQ, INFO ) * @@ -314,7 +315,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DGER, DGESC2, + EXTERNAL DAXPY, DCOPY, DGEMM, DGEMV, DGER, + $ DGESC2, $ DGETC2, DLASET, DLATDF, DSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -467,9 +469,11 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( I.GT.1 ) THEN ALPHA = -RHS( 1 ) - CALL DAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ), + CALL DAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, + $ JS ), $ 1 ) - CALL DAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ), + CALL DAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, + $ JS ), $ 1 ) END IF IF( J.LT.Q ) THEN @@ -542,9 +546,11 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( I.GT.1 ) THEN - CALL DGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ), + CALL DGER( IS-1, NB, -ONE, A( 1, IS ), 1, + $ RHS( 1 ), $ 1, C( 1, JS ), LDC ) - CALL DGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ), + CALL DGER( IS-1, NB, -ONE, D( 1, IS ), 1, + $ RHS( 1 ), $ 1, F( 1, JS ), LDF ) END IF IF( J.LT.Q ) THEN @@ -552,9 +558,11 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ C( IS, JE+1 ), LDC ) CALL DAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE, $ F( IS, JE+1 ), LDF ) - CALL DAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB, + CALL DAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), + $ LDB, $ C( IS, JE+1 ), LDC ) - CALL DAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE, + CALL DAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), + $ LDE, $ F( IS, JE+1 ), LDF ) END IF * @@ -620,9 +628,11 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( I.GT.1 ) THEN - CALL DGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA, + CALL DGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), + $ LDA, $ RHS( 1 ), 1, ONE, C( 1, JS ), 1 ) - CALL DGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD, + CALL DGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), + $ LDD, $ RHS( 1 ), 1, ONE, F( 1, JS ), 1 ) END IF IF( J.LT.Q ) THEN @@ -680,7 +690,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 80 JJ = 0, NB - 1 CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 ) - CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 ) + CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), + $ 1 ) K = K + MB II = II + MB 80 CONTINUE @@ -711,7 +722,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 100 JJ = 0, NB - 1 CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 ) - CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 ) + CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), + $ 1 ) K = K + MB II = II + MB 100 CONTINUE @@ -729,10 +741,12 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, END IF IF( J.LT.Q ) THEN K = MB*NB + 1 - CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ), + CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, + $ RHS( K ), $ MB, B( JS, JE+1 ), LDB, ONE, $ C( IS, JE+1 ), LDC ) - CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ), + CALL DGEMM( 'N', 'N', MB, N-JE, NB, ONE, + $ RHS( K ), $ MB, E( JS, JE+1 ), LDE, ONE, $ F( IS, JE+1 ), LDF ) END IF @@ -783,7 +797,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 130 K = 1, N CALL DSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -802,10 +817,12 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( J.GT.P+2 ) THEN ALPHA = RHS( 1 ) - CALL DAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ), + CALL DAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, + $ 1 ), $ LDF ) ALPHA = RHS( 2 ) - CALL DAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ), + CALL DAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, + $ 1 ), $ LDF ) END IF IF( I.LT.P ) THEN @@ -853,7 +870,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, CALL DGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR ) IF( IERR.GT.0 ) $ INFO = IERR - CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 140 K = 1, N CALL DSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -926,7 +944,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 150 K = 1, N CALL DSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -946,9 +965,11 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( J.GT.P+2 ) THEN - CALL DGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ), + CALL DGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, + $ JS ), $ 1, F( IS, 1 ), LDF ) - CALL DGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ), + CALL DGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, + $ JS ), $ 1, F( IS, 1 ), LDF ) END IF IF( I.LT.P ) THEN @@ -1008,7 +1029,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 160 JJ = 0, NB - 1 CALL DCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 ) - CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 ) + CALL DCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), + $ 1 ) K = K + MB II = II + MB 160 CONTINUE @@ -1020,7 +1042,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL DGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 170 K = 1, N CALL DSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -1035,7 +1058,8 @@ SUBROUTINE DTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 180 JJ = 0, NB - 1 CALL DCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 ) - CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 ) + CALL DCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), + $ 1 ) K = K + MB II = II + MB 180 CONTINUE diff --git a/SRC/dtgsyl.f b/SRC/dtgsyl.f index 9cbcf7a65c..4f2b88df87 100644 --- a/SRC/dtgsyl.f +++ b/SRC/dtgsyl.f @@ -294,7 +294,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, $ IWORK, INFO ) * @@ -335,7 +336,8 @@ SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLACPY, DLASET, DSCAL, DTGSY2, XERBLA + EXTERNAL DGEMM, DLACPY, DLASET, DSCAL, DTGSY2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, SQRT @@ -438,7 +440,8 @@ SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, DSCALE = ZERO DSUM = ONE PQ = 0 - CALL DTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D, + CALL DTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE, $ IWORK, PQ, INFO ) IF( DSCALE.NE.ZERO ) THEN @@ -532,7 +535,8 @@ SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IE = IWORK( I+1 ) - 1 MB = IE - IS + 1 PPQQ = 0 - CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA, + CALL DTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), + $ LDA, $ B( JS, JS ), LDB, C( IS, JS ), LDC, $ D( IS, IS ), LDD, E( JS, JS ), LDE, $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE, @@ -651,10 +655,12 @@ SUBROUTINE DTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * Substitute R(I, J) and L(I, J) into remaining equation. * IF( J.GT.P+2 ) THEN - CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ), + CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, + $ JS ), $ LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ), $ LDF ) - CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ), + CALL DGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, + $ JS ), $ LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ), $ LDF ) END IF diff --git a/SRC/dtpcon.f b/SRC/dtpcon.f index a597f9fdde..4dd5c8385f 100644 --- a/SRC/dtpcon.f +++ b/SRC/dtpcon.f @@ -222,13 +222,15 @@ SUBROUTINE DTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK, END IF KASE = 0 10 CONTINUE - CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * * Multiply by inv(A). * - CALL DLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP, + CALL DLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ AP, $ WORK, SCALE, WORK( 2*N+1 ), INFO ) ELSE * diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f index 794ecf7694..1b55433a4f 100644 --- a/SRC/dtpmlqt.f +++ b/SRC/dtpmlqt.f @@ -210,7 +210,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, + SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dtpmqrt.f b/SRC/dtpmqrt.f index 6378bf5aa3..54bd6a806e 100644 --- a/SRC/dtpmqrt.f +++ b/SRC/dtpmqrt.f @@ -212,7 +212,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, + SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/dtprfb.f b/SRC/dtprfb.f index 272ec6bebb..c38d7ea65d 100644 --- a/SRC/dtprfb.f +++ b/SRC/dtprfb.f @@ -430,7 +430,8 @@ SUBROUTINE DTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL DGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL DGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL DGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB ) CALL DTRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( NP, 1 ), LDV, $ WORK, LDWORK ) @@ -671,7 +672,8 @@ SUBROUTINE DTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL DGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL DGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL DGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) CALL DTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV, $ WORK, LDWORK ) diff --git a/SRC/dtprfs.f b/SRC/dtprfs.f index ff7acb5777..1f130f0619 100644 --- a/SRC/dtprfs.f +++ b/SRC/dtprfs.f @@ -171,7 +171,8 @@ *> \ingroup tprfs * * ===================================================================== - SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, + SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -206,7 +207,8 @@ SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DTPMV, DTPSV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DTPMV, DTPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -430,14 +432,16 @@ SUBROUTINE DTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, * KASE = 0 210 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL DTPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), 1 ) + CALL DTPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), + $ 1 ) DO 220 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 220 CONTINUE diff --git a/SRC/dtptrs.f b/SRC/dtptrs.f index bc79145ea8..ec2a785c4d 100644 --- a/SRC/dtptrs.f +++ b/SRC/dtptrs.f @@ -127,7 +127,8 @@ *> \ingroup tptrs * * ===================================================================== - SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) + SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/dtrcon.f b/SRC/dtrcon.f index b166eba65b..bcd45434a3 100644 --- a/SRC/dtrcon.f +++ b/SRC/dtrcon.f @@ -231,7 +231,8 @@ SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, END IF KASE = 0 10 CONTINUE - CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL DLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * @@ -243,7 +244,8 @@ SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, * * Multiply by inv(A**T). * - CALL DLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA, + CALL DLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, + $ LDA, $ WORK, SCALE, WORK( 2*N+1 ), INFO ) END IF NORMIN = 'Y' diff --git a/SRC/dtrevc.f b/SRC/dtrevc.f index 8c5c526913..0a143ed1ac 100644 --- a/SRC/dtrevc.f +++ b/SRC/dtrevc.f @@ -218,7 +218,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, INFO ) * * -- LAPACK computational routine -- @@ -255,7 +256,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA + EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -432,7 +434,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * 1-by-1 diagonal block * - CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ ZERO, X, 2, SCALE, XNORM, IERR ) * @@ -563,7 +566,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * 1-by-1 diagonal block * - CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, WI, $ X, 2, SCALE, XNORM, IERR ) * @@ -673,7 +677,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( 1+N2 ), 1, WORK( KI+N2 ), $ VR( 1, KI ), 1 ) ELSE - CALL DSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 ) + CALL DSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), + $ 1 ) CALL DSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 ) END IF * @@ -782,7 +787,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Solve (T(J,J)-WR)**T*X = WORK * - CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ ZERO, X, 2, SCALE, XNORM, IERR ) * @@ -842,7 +848,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Copy the vector x or Q*x to VL and normalize. * IF( .NOT.OVER ) THEN - CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) + CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), + $ 1 ) * II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 REMAX = ONE / ABS( VL( II, IS ) ) @@ -855,7 +862,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, ELSE * IF( KI.LT.N ) - $ CALL DGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL, + $ CALL DGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1+N ), 1, WORK( KI+N ), $ VL( 1, KI ), 1 ) * @@ -934,7 +942,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 * - CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ -WI, X, 2, SCALE, XNORM, IERR ) * @@ -979,7 +988,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( KI+2+N ), 1 ) * WORK( J+1+N2 ) = WORK( J+1+N2 ) - - $ DDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ DDOT( J-KI-2, T( KI+2, J+1 ), + $ 1, $ WORK( KI+2+N2 ), 1 ) * * Solve 2-by-2 complex linear equation @@ -1010,8 +1020,10 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Copy the vector x or Q*x to VL and normalize. * IF( .NOT.OVER ) THEN - CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) - CALL DCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ), + CALL DCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), + $ 1 ) + CALL DCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, + $ IS+1 ), $ 1 ) * EMAX = ZERO @@ -1037,7 +1049,8 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) ELSE CALL DSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 ) - CALL DSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) + CALL DSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), + $ 1 ) END IF * EMAX = ZERO diff --git a/SRC/dtrevc3.f b/SRC/dtrevc3.f index c411980a4b..ebed269b68 100644 --- a/SRC/dtrevc3.f +++ b/SRC/dtrevc3.f @@ -275,7 +275,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, EXTERNAL LSAME, IDAMAX, ILAENV, DDOT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA, + EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, + $ XERBLA, $ DGEMM, DLASET, DLACPY * .. * .. Intrinsic Functions .. @@ -490,7 +491,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * 1-by-1 diagonal block * - CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + 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 ) * @@ -557,7 +559,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 ) ) @@ -636,7 +639,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * 1-by-1 diagonal block * - CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + 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 ) * @@ -654,8 +658,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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 ) @@ -694,8 +700,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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 ) @@ -720,8 +728,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 @@ -748,8 +758,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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) + 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 @@ -928,14 +940,16 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * Solve [ T(J,J) - WR ]**T * X = WORK * - CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + 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 ) + $ 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 @@ -960,7 +974,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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, + $ DDOT( J-KI-1, T( KI+1, J+1 ), + $ 1, $ WORK( KI+1+IV*N ), 1 ) * * Solve @@ -974,7 +989,8 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * Scale if necessary * IF( SCALE.NE.ONE ) - $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + $ 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 ) * @@ -1080,30 +1096,37 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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, + $ 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, + $ 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 ), + 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) + 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 ) @@ -1121,8 +1144,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 @@ -1136,11 +1161,13 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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, + $ 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, + $ DDOT( J-KI-2, T( KI+2, J+1 ), + $ 1, $ WORK( KI+2+(IV+1)*N ), 1 ) * * Solve 2-by-2 complex linear equation @@ -1154,8 +1181,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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) + 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 ) @@ -1208,8 +1237,10 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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) + 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 diff --git a/SRC/dtrexc.f b/SRC/dtrexc.f index 30a358efab..585de53005 100644 --- a/SRC/dtrexc.f +++ b/SRC/dtrexc.f @@ -296,7 +296,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * Swap two 1 by 1 blocks, no problems possible * - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, + $ NBNEXT, $ WORK, INFO ) HERE = HERE + 1 ELSE @@ -322,7 +323,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1, $ WORK, INFO ) - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, + $ 1, $ WORK, INFO ) HERE = HERE + 2 END IF @@ -347,7 +349,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, IF( T( HERE-1, HERE-2 ).NE.ZERO ) $ NBNEXT = 2 END IF - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, + $ NBNEXT, $ NBF, WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -372,7 +375,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, IF( T( HERE-1, HERE-2 ).NE.ZERO ) $ NBNEXT = 2 END IF - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, + $ NBNEXT, $ 1, WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -382,7 +386,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * Swap two 1 by 1 blocks, no problems possible * - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, + $ 1, $ WORK, INFO ) HERE = HERE - 1 ELSE @@ -395,7 +400,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * 2 by 2 Block did not split * - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, + $ 1, $ WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -408,7 +414,8 @@ SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1, $ WORK, INFO ) - CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1, + CALL DLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, + $ 1, $ WORK, INFO ) HERE = HERE - 2 END IF diff --git a/SRC/dtrrfs.f b/SRC/dtrrfs.f index fa3e7546ca..01debe1b38 100644 --- a/SRC/dtrrfs.f +++ b/SRC/dtrrfs.f @@ -178,7 +178,8 @@ *> \ingroup trrfs * * ===================================================================== - SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, + SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -213,7 +214,8 @@ SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLACN2, DTRMV, DTRSV, XERBLA + EXTERNAL DAXPY, DCOPY, DLACN2, DTRMV, DTRSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -427,14 +429,16 @@ SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, * KASE = 0 210 CONTINUE - CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL DLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL DTRSV( UPLO, TRANST, DIAG, N, A, LDA, WORK( N+1 ), + CALL DTRSV( UPLO, TRANST, DIAG, N, A, LDA, + $ WORK( N+1 ), $ 1 ) DO 220 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) diff --git a/SRC/dtrsen.f b/SRC/dtrsen.f index e0ee7cbafe..8adcbe4315 100644 --- a/SRC/dtrsen.f +++ b/SRC/dtrsen.f @@ -309,7 +309,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, + SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, + $ WI, $ M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK computational routine -- @@ -350,7 +351,8 @@ SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, EXTERNAL LSAME, DLANGE * .. * .. External Subroutines .. - EXTERNAL DLACN2, DLACPY, DTREXC, DTRSYL, XERBLA + EXTERNAL DLACN2, DLACPY, DTREXC, DTRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -471,7 +473,8 @@ SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, IERR = 0 KK = K IF( K.NE.KS ) - $ CALL DTREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, WORK, + $ CALL DTREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, + $ WORK, $ IERR ) IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN * @@ -519,7 +522,8 @@ SUBROUTINE DTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, EST = ZERO KASE = 0 30 CONTINUE - CALL DLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, ISAVE ) + CALL DLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * diff --git a/SRC/dtrsna.f b/SRC/dtrsna.f index adc19079bd..b7bb7e78af 100644 --- a/SRC/dtrsna.f +++ b/SRC/dtrsna.f @@ -260,7 +260,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, $ INFO ) * @@ -301,7 +302,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA + EXTERNAL DLACN2, DLACPY, DLAQTR, DTREXC, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -441,10 +443,12 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Complex eigenvalue. * PROD1 = DDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 ) - PROD1 = PROD1 + DDOT( N, VR( 1, KS+1 ), 1, VL( 1, KS+1 ), + PROD1 = PROD1 + DDOT( N, VR( 1, KS+1 ), 1, VL( 1, + $ KS+1 ), $ 1 ) PROD2 = DDOT( N, VL( 1, KS ), 1, VR( 1, KS+1 ), 1 ) - PROD2 = PROD2 - DDOT( N, VL( 1, KS+1 ), 1, VR( 1, KS ), + PROD2 = PROD2 - DDOT( N, VL( 1, KS+1 ), 1, VR( 1, + $ KS ), $ 1 ) RNRM = DLAPY2( DNRM2( N, VR( 1, KS ), 1 ), $ DNRM2( N, VR( 1, KS+1 ), 1 ) ) @@ -467,7 +471,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, CALL DLACPY( 'Full', N, N, T, LDT, WORK, LDWORK ) IFST = K ILST = 1 - CALL DTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, ILST, + CALL DTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, + $ ILST, $ WORK( 1, N+1 ), IERR ) * IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN @@ -535,7 +540,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EST = ZERO KASE = 0 50 CONTINUE - CALL DLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), IWORK, + CALL DLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), + $ IWORK, $ EST, KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN @@ -543,7 +549,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Real eigenvalue: solve C**T*x = scale*c. * - CALL DLAQTR( .TRUE., .TRUE., N-1, WORK( 2, 2 ), + CALL DLAQTR( .TRUE., .TRUE., N-1, WORK( 2, + $ 2 ), $ LDWORK, DUMMY, DUMM, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) @@ -552,7 +559,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Complex eigenvalue: solve * C**T*(p+iq) = scale*(c+id) in real arithmetic. * - CALL DLAQTR( .TRUE., .FALSE., N-1, WORK( 2, 2 ), + CALL DLAQTR( .TRUE., .FALSE., N-1, WORK( 2, + $ 2 ), $ LDWORK, WORK( 1, N+1 ), MU, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) @@ -562,7 +570,8 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Real eigenvalue: solve C*x = scale*c. * - CALL DLAQTR( .FALSE., .TRUE., N-1, WORK( 2, 2 ), + CALL DLAQTR( .FALSE., .TRUE., N-1, WORK( 2, + $ 2 ), $ LDWORK, DUMMY, DUMM, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) diff --git a/SRC/dtrsyl.f b/SRC/dtrsyl.f index 8f45dfb6ff..661f91a156 100644 --- a/SRC/dtrsyl.f +++ b/SRC/dtrsyl.f @@ -592,7 +592,8 @@ SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, SUMR = DDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL DLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ), + CALL DLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) @@ -776,7 +777,8 @@ SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, $ B( L2, MIN( L2+1, N ) ), LDB ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL DLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ), + CALL DLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) @@ -969,7 +971,8 @@ SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, $ B( L2, MIN( L2+1, N ) ), LDB ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL DLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ), + CALL DLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index 37397c86e5..8330cb9bd0 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -176,7 +176,8 @@ * Angelika Schwarz, Umea University, Sweden. * * ===================================================================== - SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, + SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, + $ C, $ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK, $ INFO ) IMPLICIT NONE @@ -210,10 +211,12 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLANGE, DLAMCH, DLARMM - EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV, LSAME + EXTERNAL DLANGE, DLAMCH, DLARMM, ILAENV, + $ LSAME * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, XERBLA + EXTERNAL DGEMM, DLASCL, DSCAL, DTRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, EXPONENT, MAX, MIN diff --git a/SRC/dtrtri.f b/SRC/dtrtri.f index 7368a184bf..3c2ade626a 100644 --- a/SRC/dtrtri.f +++ b/SRC/dtrtri.f @@ -198,9 +198,11 @@ SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * * Compute rows 1:j-1 of current block column * - CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, + CALL DTRMM( 'Left', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, + CALL DTRSM( 'Right', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) * * Compute inverse of current diagonal block diff --git a/SRC/dtrtrs.f b/SRC/dtrtrs.f index e79264f47e..bb796a8d67 100644 --- a/SRC/dtrtrs.f +++ b/SRC/dtrtrs.f @@ -176,10 +176,12 @@ SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * INFO = 0 NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/dtzrzf.f b/SRC/dtzrzf.f index 1fa7b0f9fe..b0ab574f64 100644 --- a/SRC/dtzrzf.f +++ b/SRC/dtzrzf.f @@ -281,7 +281,8 @@ SUBROUTINE DTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ), + CALL DLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, + $ M1 ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:i-1,i:n) from the right diff --git a/SRC/ilaenv2stage.f b/SRC/ilaenv2stage.f index 5f4f29915d..a66fb8e6e6 100644 --- a/SRC/ilaenv2stage.f +++ b/SRC/ilaenv2stage.f @@ -146,7 +146,8 @@ *> \endverbatim *> * ===================================================================== - INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) + INTEGER FUNCTION ILAENV2STAGE( ISPEC, NAME, OPTS, N1, N2, N3, + $ N4 ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/iparmq.f b/SRC/iparmq.f index 07f89d1ae4..88376c21eb 100644 --- a/SRC/iparmq.f +++ b/SRC/iparmq.f @@ -227,7 +227,8 @@ *> \endverbatim *> * ===================================================================== - INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, LWORK ) + INTEGER FUNCTION IPARMQ( ISPEC, NAME, OPTS, N, ILO, IHI, + $ LWORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/la_xisnan.F90 b/SRC/la_xisnan.F90 index 9bf63519b7..50966a5c18 100644 --- a/SRC/la_xisnan.F90 +++ b/SRC/la_xisnan.F90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" module LA_XISNAN interface LA_ISNAN diff --git a/SRC/sbbcsd.f b/SRC/sbbcsd.f index 99d52da2f1..a347bc7de3 100644 --- a/SRC/sbbcsd.f +++ b/SRC/sbbcsd.f @@ -326,7 +326,8 @@ *> \ingroup bbcsd * * ===================================================================== - SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, + $ Q, $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T, $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) @@ -373,7 +374,8 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ UNFL, X1, X2, Y1, Y2 * * .. External Subroutines .. - EXTERNAL SLASR, SSCAL, SSWAP, SLARTGP, SLARTGS, SLAS2, + EXTERNAL SLASR, SSCAL, SSWAP, SLARTGP, SLARTGS, + $ SLAS2, $ XERBLA * .. * .. External Functions .. @@ -560,9 +562,11 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * * Compute shifts for B11 and B21 and use the lesser * - CALL SLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11, + CALL SLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), + $ SIGMA11, $ DUMMY ) - CALL SLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21, + CALL SLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), + $ SIGMA21, $ DUMMY ) * IF( SIGMA11 .LE. SIGMA21 ) THEN @@ -698,7 +702,8 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART21 ) THEN - CALL SLARTGP( X2, X1, WORK(IV1TSN+I-1), WORK(IV1TCS+I-1), + CALL SLARTGP( X2, X1, WORK(IV1TSN+I-1), + $ WORK(IV1TCS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART21 ) THEN CALL SLARTGP( B11BULGE, B11E(I-1), WORK(IV1TSN+I-1), @@ -725,10 +730,12 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL SLARTGP( B22BULGE, B22D(I-1), WORK(IV2TSN+I-1-1), $ WORK(IV2TCS+I-1-1), R ) ELSE IF( NU .LT. MU ) THEN - CALL SLARTGS( B12E(I-1), B12D(I), NU, WORK(IV2TCS+I-1-1), + CALL SLARTGS( B12E(I-1), B12D(I), NU, + $ WORK(IV2TCS+I-1-1), $ WORK(IV2TSN+I-1-1) ) ELSE - CALL SLARTGS( B22E(I-1), B22D(I), MU, WORK(IV2TCS+I-1-1), + CALL SLARTGS( B22E(I-1), B22D(I), MU, + $ WORK(IV2TCS+I-1-1), $ WORK(IV2TSN+I-1-1) ) END IF * @@ -781,7 +788,8 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN - CALL SLARTGP( X2, X1, WORK(IU1SN+I-1), WORK(IU1CS+I-1), + CALL SLARTGP( X2, X1, WORK(IU1SN+I-1), + $ WORK(IU1CS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN CALL SLARTGP( B11BULGE, B11D(I), WORK(IU1SN+I-1), @@ -797,7 +805,8 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ WORK(IU1SN+I-1) ) END IF IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN - CALL SLARTGP( Y2, Y1, WORK(IU2SN+I-1), WORK(IU2CS+I-1), + CALL SLARTGP( Y2, Y1, WORK(IU2SN+I-1), + $ WORK(IU2CS+I-1), $ R ) ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN CALL SLARTGP( B21BULGE, B21D(I), WORK(IU2SN+I-1), @@ -863,10 +872,12 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL SLARTGP( Y2, Y1, WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN - CALL SLARTGP( B12BULGE, B12D(IMAX-1), WORK(IV2TSN+IMAX-1-1), + CALL SLARTGP( B12BULGE, B12D(IMAX-1), + $ WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN - CALL SLARTGP( B22BULGE, B22D(IMAX-1), WORK(IV2TSN+IMAX-1-1), + CALL SLARTGP( B22BULGE, B22D(IMAX-1), + $ WORK(IV2TSN+IMAX-1-1), $ WORK(IV2TCS+IMAX-1-1), R ) ELSE IF( NU .LT. MU ) THEN CALL SLARTGS( B12E(IMAX-1), B12D(IMAX), NU, @@ -1053,7 +1064,8 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( WANTU2 ) $ CALL SSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 ) IF( WANTV1T ) - $ CALL SSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T ) + $ CALL SSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), + $ LDV1T ) IF( WANTV2T ) $ CALL SSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1), $ LDV2T ) diff --git a/SRC/sbdsdc.f b/SRC/sbdsdc.f index 0b9641def3..0c0401b7f3 100644 --- a/SRC/sbdsdc.f +++ b/SRC/sbdsdc.f @@ -194,7 +194,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, + SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, + $ IQ, $ WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -234,7 +235,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, EXTERNAL SLAMCH, SLANST, ILAENV, LSAME * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, SLASDQ, + EXTERNAL SCOPY, SLARTG, SLASCL, SLASD0, SLASDA, + $ SLASDQ, $ SLASET, SLASR, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -341,14 +343,17 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, IF( ICOMPQ.EQ.2 ) THEN CALL SLASET( 'A', N, N, ZERO, ONE, U, LDU ) CALL SLASET( 'A', N, N, ZERO, ONE, VT, LDVT ) - CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, U, + CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, VT, LDVT, U, LDU, + $ U, $ LDU, WORK( WSTART ), INFO ) ELSE IF( ICOMPQ.EQ.1 ) THEN IU = 1 IVT = IU + N - CALL SLASET( 'A', N, N, ZERO, ONE, Q( IU+( QSTART-1 )*N ), + CALL SLASET( 'A', N, N, ZERO, ONE, + $ Q( IU+( QSTART-1 )*N ), $ N ) - CALL SLASET( 'A', N, N, ZERO, ONE, Q( IVT+( QSTART-1 )*N ), + CALL SLASET( 'A', N, N, ZERO, ONE, + $ Q( IVT+( QSTART-1 )*N ), $ N ) CALL SLASDQ( 'U', 0, N, N, N, 0, D, E, $ Q( IVT+( QSTART-1 )*N ), N, @@ -506,7 +511,8 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, * which rotated B to be upper bidiagonal * IF( ( IUPLO.EQ.2 ) .AND. ( ICOMPQ.EQ.2 ) ) - $ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, LDU ) + $ CALL SLASR( 'L', 'V', 'B', N, N, WORK( 1 ), WORK( N ), U, + $ LDU ) * RETURN * diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index cf0009038b..6c379e20b0 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -287,7 +287,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, EXTERNAL LSAME, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SLARTG, SLAS2, SLASQ1, SLASR, SLASV2, SROT, + EXTERNAL SLARTG, SLAS2, SLASQ1, SLASR, SLASV2, + $ SROT, $ SSCAL, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -368,10 +369,12 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NRU.GT.0 ) - $ CALL SLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U, + $ CALL SLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), + $ U, $ LDU ) IF( NCC.GT.0 ) - $ CALL SLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C, + $ CALL SLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), + $ C, $ LDC ) END IF * @@ -493,10 +496,12 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Compute singular vectors, if desired * IF( NCVT.GT.0 ) - $ CALL SROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR, + $ CALL SROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, + $ COSR, $ SINR ) IF( NRU.GT.0 ) - $ CALL SROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL ) + $ CALL SROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, + $ SINL ) IF( NCC.GT.0 ) $ CALL SROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL, $ SINL ) @@ -629,7 +634,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL SLARTG( D( I )*CS, E( I ), CS, SN, R ) IF( I.GT.LL ) $ E( I-1 ) = OLDSN*R - CALL SLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL SLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, + $ D( I ) ) WORK( I-LL+1 ) = CS WORK( I-LL+1+NM1 ) = SN WORK( I-LL+1+NM12 ) = OLDCS @@ -645,10 +651,12 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ), $ WORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ), + $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ), + $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -667,7 +675,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL SLARTG( D( I )*CS, E( I-1 ), CS, SN, R ) IF( I.LT.M ) $ E( I ) = OLDSN*R - CALL SLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL SLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, + $ D( I ) ) WORK( I-LL ) = CS WORK( I-LL+NM1 ) = -SN WORK( I-LL+NM12 ) = OLDCS @@ -680,7 +689,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors * IF( NCVT.GT.0 ) - $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ), + $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL SLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ), @@ -735,10 +745,12 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ), $ WORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ), + $ CALL SLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ), + $ CALL SLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -785,7 +797,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NCVT.GT.0 ) - $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ), + $ CALL SLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ WORK( NM12+1 ), $ WORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL SLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ), @@ -841,7 +854,8 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, IF( NRU.GT.0 ) $ CALL SSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 ) IF( NCC.GT.0 ) - $ CALL SSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC ) + $ CALL SSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), + $ LDC ) END IF 190 CONTINUE GO TO 220 diff --git a/SRC/sbdsvdx.f b/SRC/sbdsvdx.f index 28dbf5c2fe..5e30c8b36d 100644 --- a/SRC/sbdsvdx.f +++ b/SRC/sbdsvdx.f @@ -264,10 +264,12 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, LOGICAL LSAME INTEGER ISAMAX REAL SDOT, SLAMCH, SNRM2 - EXTERNAL ISAMAX, LSAME, SAXPY, SDOT, SLAMCH, SNRM2 + EXTERNAL ISAMAX, LSAME, SAXPY, SDOT, SLAMCH, + $ SNRM2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLASET, SSCAL, SSWAP, SSTEVX, XERBLA + EXTERNAL SCOPY, SLASET, SSCAL, SSWAP, SSTEVX, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, SIGN, SQRT @@ -424,7 +426,8 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( NS.EQ.0 ) THEN RETURN ELSE - IF( WANTZ ) 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 * @@ -461,7 +464,8 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - IF( WANTZ ) 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. @@ -588,7 +592,8 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * WORK( ITEMP: ): 2*5*NTGK * IWORK( 1: ): 2*6*NTGK * - CALL SSTEVX( JOBZ, RNGVX, NTGK, WORK( IDTGK+ISPLT-1 ), + CALL SSTEVX( JOBZ, RNGVX, NTGK, + $ WORK( IDTGK+ISPLT-1 ), $ WORK( IETGK+ISPLT-1 ), VLTGK, VUTGK, $ ILTGK, IUTGK, ABSTOL, NSL, S( ISBEG ), $ Z( IROWZ,ICOLZ ), LDZ, WORK( ITEMP ), @@ -643,13 +648,15 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ ABS( NRMU-ORTOL )*SQRT2.GT.ONE ) $ THEN DO J = 0, I-1 - ZJTJI = -SDOT( NRU, Z( IROWU, ICOLZ+J ), + ZJTJI = -SDOT( NRU, Z( IROWU, + $ ICOLZ+J ), $ 2, Z( IROWU, ICOLZ+I ), 2 ) CALL SAXPY( NRU, ZJTJI, $ Z( IROWU, ICOLZ+J ), 2, $ Z( IROWU, ICOLZ+I ), 2 ) END DO - NRMU = SNRM2( NRU, Z( IROWU, ICOLZ+I ), 2 ) + NRMU = SNRM2( NRU, Z( IROWU, ICOLZ+I ), + $ 2 ) CALL SSCAL( NRU, ONE/NRMU, $ Z( IROWU,ICOLZ+I ), 2 ) END IF @@ -666,13 +673,15 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ ABS( NRMV-ORTOL )*SQRT2.GT.ONE ) $ THEN DO J = 0, I-1 - ZJTJI = -SDOT( NRV, Z( IROWV, ICOLZ+J ), + ZJTJI = -SDOT( NRV, Z( IROWV, + $ ICOLZ+J ), $ 2, Z( IROWV, ICOLZ+I ), 2 ) CALL SAXPY( NRU, ZJTJI, $ Z( IROWV, ICOLZ+J ), 2, $ Z( IROWV, ICOLZ+I ), 2 ) END DO - NRMV = SNRM2( NRV, Z( IROWV, ICOLZ+I ), 2 ) + NRMV = SNRM2( NRV, Z( IROWV, ICOLZ+I ), + $ 2 ) CALL SSCAL( NRV, ONE/NRMV, $ Z( IROWV,ICOLZ+I ), 2 ) END IF @@ -752,7 +761,8 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - IF( WANTZ ) 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 * diff --git a/SRC/sgbbrd.f b/SRC/sgbbrd.f index fabcdb1658..aaa5e03ddd 100644 --- a/SRC/sgbbrd.f +++ b/SRC/sgbbrd.f @@ -212,7 +212,8 @@ SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, REAL RA, RB, RC, RS * .. * .. External Subroutines .. - EXTERNAL SLARGV, SLARTG, SLARTV, SLASET, SROT, XERBLA + EXTERNAL SLARGV, SLARTG, SLARTV, SLASET, SROT, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -329,7 +330,8 @@ SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL SLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA, + $ CALL SLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), + $ INCA, $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA, $ WORK( MN+J1 ), WORK( J1 ), KB1 ) 10 CONTINUE @@ -369,7 +371,8 @@ SUBROUTINE SGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, * apply plane rotations to C * DO 30 J = J1, J2, KB1 - CALL SROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC, + CALL SROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), + $ LDC, $ WORK( MN+J ), WORK( J ) ) 30 CONTINUE END IF diff --git a/SRC/sgbcon.f b/SRC/sgbcon.f index f1f3f086d2..d8996001b7 100644 --- a/SRC/sgbcon.f +++ b/SRC/sgbcon.f @@ -181,7 +181,8 @@ SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SLACN2, SLATBS, SRSCL, XERBLA + EXTERNAL SAXPY, SLACN2, SLATBS, SRSCL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN @@ -257,7 +258,8 @@ SUBROUTINE SGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, * * Multiply by inv(U). * - CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KL+KU, AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), $ INFO ) ELSE diff --git a/SRC/sgbequ.f b/SRC/sgbequ.f index 35cfafdbd5..78696edf27 100644 --- a/SRC/sgbequ.f +++ b/SRC/sgbequ.f @@ -149,7 +149,8 @@ *> \ingroup gbequ * * ===================================================================== - SUBROUTINE SGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE SGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/sgbequb.f b/SRC/sgbequb.f index a5656643e8..55d5b69fc3 100644 --- a/SRC/sgbequb.f +++ b/SRC/sgbequb.f @@ -156,7 +156,8 @@ *> \ingroup gbequb * * ===================================================================== - SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/sgbrfs.f b/SRC/sgbrfs.f index 3155e4ff87..1d53c99d51 100644 --- a/SRC/sgbrfs.f +++ b/SRC/sgbrfs.f @@ -200,7 +200,8 @@ *> \ingroup gbrfs * * ===================================================================== - SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, $ INFO ) * @@ -242,7 +243,8 @@ SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGBMV, SGBTRS, SLACN2, XERBLA + EXTERNAL SAXPY, SCOPY, SGBMV, SGBTRS, SLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -321,7 +323,8 @@ SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL SGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), 1, + CALL SGBMV( TRANS, N, N, KL, KU, -ONE, AB, LDAB, X( 1, J ), + $ 1, $ ONE, WORK( N+1 ), 1 ) * * Compute componentwise relative backward error from formula @@ -419,7 +422,8 @@ SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/sgbrfsx.f b/SRC/sgbrfsx.f index 655dd45652..25b43a9f76 100644 --- a/SRC/sgbrfsx.f +++ b/SRC/sgbrfsx.f @@ -433,7 +433,8 @@ *> \ingroup gbrfsx * * ===================================================================== - SUBROUTINE SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, @@ -648,14 +649,16 @@ SUBROUTINE SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, PREC_TYPE = ILAPREC( 'D' ) IF ( NOTRAN ) THEN - CALL SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK( N+1 ), WORK( 1 ), WORK( 2*N+1 ), $ WORK( 1 ), RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, $ IGNORE_CWISE, INFO ) ELSE - CALL SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK( N+1 ), WORK( 1 ), WORK( 2*N+1 ), @@ -722,7 +725,8 @@ SUBROUTINE SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, DO J = 1, NRHS IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG ) $ THEN - RCOND_TMP = SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, 1, X( 1, J ), INFO, WORK, IWORK ) ELSE RCOND_TMP = 0.0 diff --git a/SRC/sgbsv.f b/SRC/sgbsv.f index be49686de8..bbb9fe090b 100644 --- a/SRC/sgbsv.f +++ b/SRC/sgbsv.f @@ -159,7 +159,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) + SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) * * Solve the system A*X = B, overwriting B with X. * - CALL SGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV, + CALL SGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, + $ IPIV, $ B, LDB, INFO ) END IF RETURN diff --git a/SRC/sgbsvx.f b/SRC/sgbsvx.f index 5432a9ea11..3f5e388146 100644 --- a/SRC/sgbsvx.f +++ b/SRC/sgbsvx.f @@ -405,7 +405,8 @@ SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, EXTERNAL LSAME, SLAMCH, SLANGB, SLANTB * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGBCON, SGBEQU, SGBRFS, SGBTRF, SGBTRS, + EXTERNAL SCOPY, SGBCON, SGBEQU, SGBRFS, SGBTRF, + $ SGBTRS, $ SLACPY, SLAQGB, XERBLA * .. * .. Intrinsic Functions .. @@ -430,7 +431,9 @@ SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -506,7 +509,8 @@ SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -557,7 +561,8 @@ SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) 80 CONTINUE 90 CONTINUE - RPVGRW = SLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), + RPVGRW = SLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, + $ KL+KU ), $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, $ WORK ) IF( RPVGRW.EQ.ZERO ) THEN @@ -601,7 +606,8 @@ SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, + CALL SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/sgbsvxx.f b/SRC/sgbsvxx.f index 8c607a6dda..cb18efe321 100644 --- a/SRC/sgbsvxx.f +++ b/SRC/sgbsvxx.f @@ -556,7 +556,8 @@ *> \ingroup gbsvxx * * ===================================================================== - SUBROUTINE SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, $ RCOND, RPVGRW, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, @@ -607,7 +608,8 @@ SUBROUTINE SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, REAL SLAMCH, SLA_GBRPVGRW * .. * .. External Subroutines .. - EXTERNAL SGBEQUB, SGBTRF, SGBTRS, SLACPY, SLAQGB, + EXTERNAL SGBEQUB, SGBTRF, SGBTRS, SLACPY, + $ SLAQGB, $ XERBLA, SLASCL2, SGBRFSX * .. * .. Intrinsic Functions .. @@ -714,7 +716,8 @@ SUBROUTINE SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -780,7 +783,8 @@ SUBROUTINE SGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + CALL SGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) diff --git a/SRC/sgbtf2.f b/SRC/sgbtf2.f index 4836dbebe5..cfe01affcc 100644 --- a/SRC/sgbtf2.f +++ b/SRC/sgbtf2.f @@ -250,7 +250,8 @@ SUBROUTINE SGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers. * - CALL SSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 ) + CALL SSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), + $ 1 ) * * Update trailing submatrix within the band. * diff --git a/SRC/sgbtrf.f b/SRC/sgbtrf.f index c3ff28a2e5..91fdfb1862 100644 --- a/SRC/sgbtrf.f +++ b/SRC/sgbtrf.f @@ -177,7 +177,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) EXTERNAL ILAENV, ISAMAX * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGBTF2, SGEMM, SGER, SLASWP, SSCAL, + EXTERNAL SCOPY, SGBTF2, SGEMM, SGER, SLASWP, + $ SSCAL, $ SSWAP, STRSM, XERBLA * .. * .. Intrinsic Functions .. @@ -325,7 +326,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers * - CALL SSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ), + CALL SSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, + $ JJ ), $ 1 ) * * Update trailing submatrix within the band and within @@ -394,7 +396,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A12 * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL STRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J2, ONE, AB( KV+1, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1 ) * @@ -402,7 +405,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A22 * - CALL SGEMM( 'No transpose', 'No transpose', I2, J2, + CALL SGEMM( 'No transpose', 'No transpose', I2, + $ J2, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+1, J+JB ), LDAB-1 ) @@ -412,7 +416,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A32 * - CALL SGEMM( 'No transpose', 'No transpose', I3, J2, + CALL SGEMM( 'No transpose', 'No transpose', I3, + $ J2, $ JB, -ONE, WORK31, LDWORK, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+KL+1-JB, J+JB ), LDAB-1 ) @@ -432,7 +437,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A13 in the work array * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL STRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J3, ONE, AB( KV+1, J ), LDAB-1, $ WORK13, LDWORK ) * @@ -440,7 +446,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A23 * - CALL SGEMM( 'No transpose', 'No transpose', I2, J3, + CALL SGEMM( 'No transpose', 'No transpose', I2, + $ J3, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ), $ LDAB-1 ) @@ -450,7 +457,8 @@ SUBROUTINE SGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A33 * - CALL SGEMM( 'No transpose', 'No transpose', I3, J3, + CALL SGEMM( 'No transpose', 'No transpose', I3, + $ J3, $ JB, -ONE, WORK31, LDWORK, WORK13, $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 ) END IF diff --git a/SRC/sgbtrs.f b/SRC/sgbtrs.f index b0e5e24bd3..b894eb65b7 100644 --- a/SRC/sgbtrs.f +++ b/SRC/sgbtrs.f @@ -134,7 +134,8 @@ *> \ingroup gbtrs * * ===================================================================== - SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -222,7 +223,8 @@ SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, L = IPIV( J ) IF( L.NE.J ) $ CALL SSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) - CALL SGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ), + CALL SGER( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, + $ 1 ), $ LDB, B( J+1, 1 ), LDB ) 10 CONTINUE END IF @@ -231,7 +233,8 @@ SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U*X = B, overwriting B with X. * - CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU, + CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, + $ KL+KU, $ AB, LDAB, B( 1, I ), 1 ) 20 CONTINUE * @@ -243,7 +246,8 @@ SUBROUTINE SGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**T*X = B, overwriting B with X. * - CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB, + CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, + $ AB, $ LDAB, B( 1, I ), 1 ) 30 CONTINUE * diff --git a/SRC/sgebak.f b/SRC/sgebak.f index 0c7770ef66..597a1e4436 100644 --- a/SRC/sgebak.f +++ b/SRC/sgebak.f @@ -170,8 +170,10 @@ SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/sgebal.f b/SRC/sgebal.f index a157ff217a..e62c33fbdd 100644 --- a/SRC/sgebal.f +++ b/SRC/sgebal.f @@ -194,7 +194,8 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) LOGICAL SISNAN, LSAME INTEGER ISAMAX REAL SLAMCH, SNRM2 - EXTERNAL SISNAN, LSAME, ISAMAX, SLAMCH, SNRM2 + EXTERNAL SISNAN, LSAME, ISAMAX, SLAMCH, + $ SNRM2 * .. * .. External Subroutines .. EXTERNAL SSCAL, SSWAP, XERBLA @@ -205,8 +206,10 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -263,7 +266,8 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( L ) = I IF( I.NE.L ) THEN CALL SSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) - CALL SSWAP( N-K+1, A( I, K ), LDA, A( L, K ), LDA ) + CALL SSWAP( N-K+1, A( I, K ), LDA, A( L, K ), + $ LDA ) END IF NOCONV = .TRUE. * @@ -298,7 +302,8 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( K ) = J IF( J.NE.K ) THEN CALL SSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) - CALL SSWAP( N-K+1, A( J, K ), LDA, A( K, K ), LDA ) + CALL SSWAP( N-K+1, A( J, K ), LDA, A( K, K ), + $ LDA ) END IF NOCONV = .TRUE. * diff --git a/SRC/sgebd2.f b/SRC/sgebd2.f index 88fceb8171..cd76f6c2c2 100644 --- a/SRC/sgebd2.f +++ b/SRC/sgebd2.f @@ -248,7 +248,8 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * Apply H(i) to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ), + $ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, + $ TAUQ( I ), $ A( I, I+1 ), LDA, WORK ) A( I, I ) = D( I ) * @@ -279,7 +280,8 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * * Generate elementary reflector G(i) to annihilate A(i,i+1:n) * - CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, + CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), + $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) A( I, I ) = ONE @@ -296,14 +298,16 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * Generate elementary reflector H(i) to annihilate * A(i+2:m,i) * - CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1, + CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), + $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE * * Apply H(i) to A(i+1:m,i+1:n) from the left * - CALL SLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ), + CALL SLARF( 'Left', M-I, N-I, A( I+1, I ), 1, + $ TAUQ( I ), $ A( I+1, I+1 ), LDA, WORK ) A( I+1, I ) = E( I ) ELSE diff --git a/SRC/sgebrd.f b/SRC/sgebrd.f index 3d53c8c456..49c801c43c 100644 --- a/SRC/sgebrd.f +++ b/SRC/sgebrd.f @@ -316,7 +316,8 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * the matrices X and Y which are needed to update the unreduced * part of the matrix * - CALL SLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ), + CALL SLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), + $ E( I ), $ TAUQ( I ), TAUP( I ), WORK, LDWRKX, $ WORK( LDWRKX*NB+1 ), LDWRKY ) * @@ -327,7 +328,8 @@ SUBROUTINE SGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ NB, -ONE, A( I+NB, I ), LDA, $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE, $ A( I+NB, I+NB ), LDA ) - CALL SGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1, + CALL SGEMM( 'No transpose', 'No transpose', M-I-NB+1, + $ N-I-NB+1, $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA, $ ONE, A( I+NB, I+NB ), LDA ) * diff --git a/SRC/sgecon.f b/SRC/sgecon.f index c5e009b5a9..f1b5de21ce 100644 --- a/SRC/sgecon.f +++ b/SRC/sgecon.f @@ -230,18 +230,21 @@ SUBROUTINE SGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, * * Multiply by inv(L). * - CALL SLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A, + CALL SLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, + $ A, $ LDA, WORK, SL, WORK( 2*N+1 ), INFO ) * * Multiply by inv(U). * - CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SU, WORK( 3*N+1 ), INFO ) ELSE * * Multiply by inv(U**T). * - CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SU, WORK( 3*N+1 ), INFO ) * * Multiply by inv(L**T). diff --git a/SRC/sgees.f b/SRC/sgees.f index 25de49792c..cb6306aa26 100644 --- a/SRC/sgees.f +++ b/SRC/sgees.f @@ -251,7 +251,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, + EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, + $ SLACPY, $ SLASCL, SORGHR, SSWAP, STRSEN, XERBLA * .. * .. External Functions .. @@ -273,7 +274,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, WANTST = LSAME( SORT, 'S' ) IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -4 @@ -301,7 +303,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 ) MINWRK = 3*N * - CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, + CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, + $ LDVS, $ WORK, -1, IEVAL ) HSWORK = INT( WORK( 1 ) ) * @@ -379,7 +382,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, * Generate orthogonal matrix in VS * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -420,7 +424,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, * Undo balancing * (Workspace: need N) * - CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS, + CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -463,12 +468,14 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, WI( I ) = ZERO WI( I+1 ) = ZERO IF( I.GT.1 ) - $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 ) + $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), + $ 1 ) IF( N.GT.I+1 ) $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) IF( WANTVS ) THEN - CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), + $ 1 ) END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index c626893047..0b7c5789e7 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -318,7 +318,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, + EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, + $ SHSEQR, $ SLACPY, SLASCL, SORGHR, SSWAP, STRSEN, XERBLA * .. * .. External Functions .. @@ -345,7 +346,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -381,7 +383,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, MAXWRK = 2*N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 ) MINWRK = 3*N * - CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, + CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, + $ LDVS, $ WORK, -1, IEVAL ) HSWORK = INT( WORK( 1 ) ) * @@ -467,7 +470,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * Generate orthogonal matrix in VS * (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -500,7 +504,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM) * otherwise, need 0 ) * - CALL STRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI, + CALL STRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, + $ WI, $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1, $ IWORK, LIWORK, ICOND ) IF( .NOT.WANTSN ) @@ -528,7 +533,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * Undo balancing * (RWorkspace: need N) * - CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS, + CALL SGEBAK( 'P', 'R', N, ILO, IHI, WORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -540,7 +546,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, CALL SCOPY( N, A, LDA+1, WR, 1 ) IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN DUM( 1 ) = RCONDV - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR ) + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, + $ IERR ) RCONDV = DUM( 1 ) END IF IF( CSCALE.EQ.SMLNUM ) THEN @@ -576,12 +583,14 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WI( I ) = ZERO WI( I+1 ) = ZERO IF( I.GT.1 ) - $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 ) + $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), + $ 1 ) IF( N.GT.I+1 ) $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) IF( WANTVS ) THEN - CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), + $ 1 ) END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO diff --git a/SRC/sgeev.f b/SRC/sgeev.f index 25d78fd25c..d891359a1b 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -188,7 +188,8 @@ *> \ingroup geev * * ===================================================================== - SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, + SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, + $ VR, $ LDVR, WORK, LWORK, INFO ) implicit none * @@ -224,7 +225,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, SLARTG, + EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, + $ SLARTG, $ SLASCL, SORGHR, SROT, SSCAL, STREVC3, XERBLA * .. * .. External Functions .. @@ -247,7 +249,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, WANTVR = LSAME( JOBVR, 'V' ) IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 @@ -279,7 +282,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, 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, VL, LDVL, + CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, + $ LDVL, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -293,7 +297,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, 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, + CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -305,7 +310,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N - CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, + CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) @@ -378,14 +384,16 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Generate orthogonal matrix in VL * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL, + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, + $ LDVL, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * IF( WANTVR ) THEN @@ -408,14 +416,16 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Generate orthogonal matrix in VR * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * ELSE @@ -424,7 +434,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * (Workspace: need N+1, prefer N+HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL SHSEQR( 'E', 'N', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * @@ -438,7 +449,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Compute left and/or right eigenvectors * (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * @@ -447,7 +459,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Undo balancing of left eigenvectors * (Workspace: need N) * - CALL SGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, LDVL, + CALL SGEBAK( 'B', 'L', N, ILO, IHI, WORK( IBAL ), N, VL, + $ LDVL, $ IERR ) * * Normalize left eigenvectors and make largest component real @@ -477,7 +490,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * Undo balancing of right eigenvectors * (Workspace: need N) * - CALL SGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, LDVR, + CALL SGEBAK( 'B', 'R', N, ILO, IHI, WORK( IBAL ), N, VR, + $ LDVR, $ IERR ) * * Normalize right eigenvectors and make largest component real @@ -506,9 +520,11 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, * 50 CONTINUE IF( SCALEA ) THEN - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ), + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WR( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ), + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WI( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.GT.0 ) THEN CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, WR, N, diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index 924a31a220..347465dd92 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -301,7 +301,8 @@ *> \ingroup geevx * * ===================================================================== - SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, + 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 @@ -342,7 +343,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, + EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, + $ SLACPY, $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ STRSNA, XERBLA * .. @@ -369,12 +371,16 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, 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' ) ) ) + $ .OR. + $ LSAME( BALANC, 'P' ) .OR. + $ LSAME( BALANC, 'B' ) ) ) $ THEN INFO = -1 - ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVL ) .AND. + $ ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR. $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND. @@ -413,7 +419,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ 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, + 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, @@ -421,7 +428,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ 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, + CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, + $ LDVR, $ WORK, -1, INFO ) ELSE IF( WNTSNN ) THEN @@ -446,7 +454,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) ) $ MINWRK = MAX( MINWRK, N*N + 6*N ) MAXWRK = MAX( MAXWRK, HSWORK ) - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'SORGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'SORGHR', $ ' ', N, 1, N, -1 ) ) IF( ( .NOT.WNTSNN ) .AND. ( .NOT.WNTSNE ) ) $ MAXWRK = MAX( MAXWRK, N*N + 6*N ) @@ -525,14 +534,16 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Generate orthogonal matrix in VL * (Workspace: need 2*N-1, prefer N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, LDVL, + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VL, + $ LDVL, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * IF( WANTVR ) THEN @@ -555,14 +566,16 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Generate orthogonal matrix in VR * (Workspace: need 2*N-1, prefer N+(N-1)*NB) * - CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL SORGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL SHSEQR( 'S', 'V', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) * ELSE @@ -579,7 +592,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * (Workspace: need 1, prefer HSWORK (see comments) ) * IWRK = ITAU - CALL SHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, LDVR, + CALL SHSEQR( JOB, 'N', N, ILO, IHI, A, LDA, WR, WI, VR, + $ LDVR, $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * @@ -593,7 +607,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * Compute left and/or right eigenvectors * (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * @@ -601,7 +616,8 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * (Workspace: need N*N+6*N unless SENSE = 'E') * IF( .NOT.WNTSNN ) THEN - CALL STRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL STRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, IWORK, $ ICOND ) END IF @@ -668,9 +684,11 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, * 50 CONTINUE IF( SCALEA ) THEN - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WR( INFO+1 ), + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WR( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) - CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, WI( INFO+1 ), + CALL SLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ WI( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.EQ.0 ) THEN IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 ) diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index 7ba5414e72..62163a9f20 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -164,7 +164,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -194,7 +195,8 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) REAL EI * .. * .. External Subroutines .. - EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, STRMM, + EXTERNAL SAXPY, SGEHD2, SGEMM, SLAHR2, SLARFB, + $ STRMM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index dae204d5cf..43ca22a33a 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -515,7 +515,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, EXTERNAL ISAMAX, LSAME, SLAMCH, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGELQF, SGEQP3, SGEQRF, SLACPY, SLASCL, + EXTERNAL SCOPY, SGELQF, SGEQP3, SGEQRF, SLACPY, + $ SLASCL, $ SLASET, SLASSQ, SLASWP, SORGQR, SORMLQ, $ SORMQR, SPOCON, SSCAL, SSWAP, STRSM, XERBLA * @@ -693,8 +694,10 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL SLACPY( 'A', M, 1, A, LDA, U, LDU ) * computing all M left singular vectors of the M x 1 matrix IF ( N1 .NE. N ) THEN - CALL SGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N,IERR ) - CALL SORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N,IERR ) + CALL SGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N, + $ IERR ) + CALL SORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N, + $ IERR ) CALL SCOPY( M, A(1,1), 1, U(1,1), 1 ) END IF END IF @@ -1116,7 +1119,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 1949 CONTINUE 1947 CONTINUE ELSE - CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), LDA ) + CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), + $ LDA ) END IF * * .. and one-sided Jacobi rotations are started on a lower @@ -1140,7 +1144,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, DO 1998 p = 1, NR CALL SCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) 1998 CONTINUE - CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) * CALL SGESVJ( 'L','U','N', N, NR, V,LDV, SVA, NR, A,LDA, $ WORK, LWORK, INFO ) @@ -1152,25 +1157,32 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * .. two more QR factorizations ( one QRF is not enough, two require * accumulated product of Jacobi rotations, three are perfect ) * - CALL SLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), LDA ) - CALL SGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, IERR) + CALL SLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), + $ LDA ) + CALL SGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, + $ IERR) CALL SLACPY( 'Lower', NR, NR, A, LDA, V, LDV ) - CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) CALL SGEQRF( NR, NR, V, LDV, WORK(N+1), WORK(2*N+1), $ LWORK-2*N, IERR ) DO 8998 p = 1, NR CALL SCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) 8998 CONTINUE - CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL SLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) * CALL SGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, WORK(N+1), LWORK-N, INFO ) SCALEM = WORK(N+1) NUMRANK = NINT(WORK(N+2)) IF ( NR .LT. N ) THEN - CALL SLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), LDV ) - CALL SLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), LDV ) - CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), LDV ) + CALL SLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), + $ LDV ) + CALL SLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), + $ LDV ) + CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), + $ LDV ) END IF * CALL SORMLQ( 'Left', 'Transpose', N, N, NR, A, LDA, WORK, @@ -1214,8 +1226,10 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. M ) THEN CALL SLASET( 'A', M-NR, NR,ZERO, ZERO, U(NR+1,1), LDU ) IF ( NR .LT. N1 ) THEN - CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), LDU ) - CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), LDU ) + CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), + $ LDU ) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1277,7 +1291,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 2968 CONTINUE 2969 CONTINUE ELSE - CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL SLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), + $ LDV ) END IF * * Estimate the row scaled condition number of R1 @@ -1433,7 +1448,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * equation is Q2*V2 = the product of the Jacobi rotations * used in SGESVJ, premultiplied with the orthogonal matrix * from the second QR factorization. - CALL STRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V,LDV ) + CALL STRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V, + $ LDV ) ELSE * .. R1 is well conditioned, but non-square. Transpose(R2) * is inverted to get the product of the Jacobi rotations @@ -1444,7 +1460,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) END IF CALL SORMQR('L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1458,7 +1475,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * is Q3^T*V3 = the product of the Jacobi rotations (applied to * the lower triangular L3 from the LQ factorization of * R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL SGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, + CALL SGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) SCALEM = WORK(2*N+N*NR+NR+1) NUMRANK = NINT(WORK(2*N+N*NR+NR+2)) @@ -1466,7 +1484,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL SCOPY( NR, V(1,p), 1, U(1,p), 1 ) CALL SSCAL( NR, SVA(p), U(1,p), 1 ) 3870 CONTINUE - CALL STRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U,LDU) + CALL STRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U, + $ LDU) * .. apply the permutation from the second QR factorization DO 873 q = 1, NR DO 872 p = 1, NR @@ -1479,7 +1498,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN CALL SLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) CALL SLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV ) END IF CALL SORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) @@ -1495,14 +1515,16 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * defense ensures that SGEJSV completes the task. * Compute the full SVD of L3 using SGESVJ with explicit * accumulation of Jacobi rotations. - CALL SGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, + CALL SGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) SCALEM = WORK(2*N+N*NR+NR+1) NUMRANK = NINT(WORK(2*N+N*NR+NR+2)) IF ( NR .LT. N ) THEN CALL SLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) CALL SLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + CALL SLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV ) END IF CALL SORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) @@ -1540,10 +1562,12 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * At this moment, V contains the right singular vectors of A. * Next, assemble the left singular vector matrix U (M x N). IF ( NR .LT. M ) THEN - CALL SLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) + CALL SLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) - CALL SLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1),LDU) + CALL SLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), + $ LDU) END IF END IF * @@ -1612,8 +1636,10 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( N .LT. M ) THEN CALL SLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU ) IF ( N .LT. N1 ) THEN - CALL SLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) - CALL SLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU ) + CALL SLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1), + $ LDU ) + CALL SLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1), + $ LDU ) END IF END IF CALL SORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, @@ -1720,8 +1746,10 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. M ) THEN CALL SLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) IF ( NR .LT. N1 ) THEN - CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU ) - CALL SLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU ) + CALL SLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), + $ LDU ) + CALL SLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1746,7 +1774,8 @@ SUBROUTINE SGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL SLASCL( '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/SRC/sgelq2.f b/SRC/sgelq2.f index e4eb7c4e39..de7700c7e4 100644 --- a/SRC/sgelq2.f +++ b/SRC/sgelq2.f @@ -186,7 +186,8 @@ SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ), + CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), $ A( I+1, I ), LDA, WORK ) A( I, I ) = AII END IF diff --git a/SRC/sgelqf.f b/SRC/sgelqf.f index ed7e1adab2..03cbbc1442 100644 --- a/SRC/sgelqf.f +++ b/SRC/sgelqf.f @@ -253,7 +253,8 @@ SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/sgels.f b/SRC/sgels.f index 8c83d31aad..41f0ab5190 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -179,7 +179,8 @@ *> \ingroup gels * * ===================================================================== - SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -215,7 +216,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGELQF, SGEQRF, SLASCL, SLASET, SORMLQ, + EXTERNAL SGELQF, SGEQRF, SLASCL, SLASET, + $ SORMLQ, $ SORMQR, STRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -228,7 +230,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'T' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -346,7 +349,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * compute QR factorization of A * - CALL SGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL SGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least N, optimally N*NB @@ -365,7 +369,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -411,7 +416,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Compute LQ factorization of A * - CALL SGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL SGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least M, optimally M*NB. @@ -422,7 +428,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL STRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL STRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/sgelsd.f b/SRC/sgelsd.f index 7d4b257356..0e3b6e7f3d 100644 --- a/SRC/sgelsd.f +++ b/SRC/sgelsd.f @@ -230,7 +230,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL SGEBRD, SGELQF, SGEQRF, SLACPY, SLALSD, SLASCL, + EXTERNAL SGEBRD, SGELQF, SGEQRF, SLACPY, SLALSD, + $ SLASCL, $ SLASET, SORMBR, SORMLQ, SORMQR, XERBLA * .. * .. External Functions .. @@ -285,9 +286,11 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * columns. * MM = N - MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'SGEQRF', ' ', M, + MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'SGEQRF', ' ', + $ M, $ N, -1, -1 ) ) - MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'SORMQR', 'LT', + MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'SORMQR', + $ 'LT', $ M, NRHS, N, -1 ) ) END IF IF( M.GE.N ) THEN @@ -319,7 +322,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, $ 'SGEBRD', ' ', M, M, -1, -1 ) ) MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1, $ 'SORMBR', 'QLT', M, NRHS, M, -1 ) ) - MAXWRK = MAX( MAXWRK, M*M + 4*M + ( M - 1 )*ILAENV( 1, + MAXWRK = MAX( MAXWRK, + $ M*M + 4*M + ( M - 1 )*ILAENV( 1, $ 'SORMBR', 'PLN', M, NRHS, M, -1 ) ) IF( NRHS.GT.1 ) THEN MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS ) @@ -337,9 +341,11 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * * Path 2 - remaining underdetermined cases. * - MAXWRK = 3*M + ( N + M )*ILAENV( 1, 'SGEBRD', ' ', M, + MAXWRK = 3*M + ( N + M )*ILAENV( 1, 'SGEBRD', ' ', + $ M, $ N, -1, -1 ) - MAXWRK = MAX( MAXWRK, 3*M + NRHS*ILAENV( 1, 'SORMBR', + MAXWRK = MAX( MAXWRK, 3*M + NRHS*ILAENV( 1, + $ 'SORMBR', $ 'QLT', M, NRHS, N, -1 ) ) MAXWRK = MAX( MAXWRK, 3*M + M*ILAENV( 1, 'SORMBR', $ 'PLN', N, NRHS, M, -1 ) ) @@ -412,13 +418,15 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * * Scale matrix norm up to SMLNUM. * - CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM. * - CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -451,13 +459,15 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * Multiply B by transpose(Q). * (Workspace: need N+NRHS, prefer N+NRHS*NB) * - CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Zero out below R. * IF( N.GT.1 ) THEN - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) END IF END IF * @@ -476,7 +486,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * Multiply B by transpose of left bidiagonalizing vectors of R. * (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB) * - CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -489,7 +500,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * * Multiply B by right bidiagonalizing vectors of R. * - CALL SORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ), + CALL SORMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+ @@ -579,7 +591,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * Multiply B by transpose of left bidiagonalizing vectors. * (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB) * - CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -592,7 +605,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * * Multiply B by right bidiagonalizing vectors of A. * - CALL SORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ), + CALL SORMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * END IF @@ -600,18 +614,22 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * Undo scaling. * IF( IASCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 10 CONTINUE diff --git a/SRC/sgelss.f b/SRC/sgelss.f index 5e46e19ee0..8193fda754 100644 --- a/SRC/sgelss.f +++ b/SRC/sgelss.f @@ -202,7 +202,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, SGEMV, + EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, + $ SGEMV, $ SGEQRF, SLACPY, SLASCL, SLASET, SORGBR, $ SORMBR, SORMLQ, SORMQR, SRSCL, XERBLA * .. @@ -275,7 +276,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ DUM(1), DUM(1), -1, INFO ) LWORK_SGEBRD = INT( DUM(1) ) * Compute space needed for SORMBR - CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1), + CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ DUM(1), $ B, LDB, DUM(1), -1, INFO ) LWORK_SORMBR = INT( DUM(1) ) * Compute space needed for SORGBR @@ -417,13 +419,15 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -451,13 +455,15 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose(Q) * (Workspace: need N+NRHS, prefer N+NRHS*NB) * - CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL SORMQR( 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Zero out below R * IF( N.GT.1 ) - $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + $ CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) END IF * IE = 1 @@ -475,7 +481,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors of R * (Workspace: need 3*N+NRHS, prefer 3*N+NRHS*NB) * - CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL SORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors of R in A @@ -506,7 +513,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 10 CONTINUE * @@ -514,14 +522,16 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need N, prefer N*NRHS) * IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN - CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, ZERO, + CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, A, LDA, B, LDB, + $ ZERO, $ WORK, LDB ) CALL SLACPY( 'G', N, NRHS, WORK, LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = LWORK / N DO 20 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL SGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, I ), + CALL SGEMM( 'T', 'N', N, BL, N, ONE, A, LDA, B( 1, + $ I ), $ LDB, ZERO, WORK, N ) CALL SLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB ) 20 CONTINUE @@ -576,7 +586,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Generate right bidiagonalizing vectors of R in WORK(IL) * (Workspace: need M*M+5*M-1, prefer M*M+4*M+(M-1)*NB) * - CALL SORGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ), + CALL SORGBR( 'P', M, M, M, WORK( IL ), LDWORK, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, INFO ) IWORK = IE + M * @@ -601,7 +612,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 30 CONTINUE IWORK = IE @@ -610,21 +622,23 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need M*M+2*M, prefer M*M+M+M*NRHS) * IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN - CALL SGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), LDWORK, + CALL SGEMM( 'T', 'N', M, NRHS, M, ONE, WORK( IL ), + $ LDWORK, $ B, LDB, ZERO, WORK( IWORK ), LDB ) CALL SLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = ( LWORK-IWORK+1 ) / M DO 40 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL SGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), LDWORK, + CALL SGEMM( 'T', 'N', M, BL, M, ONE, WORK( IL ), + $ LDWORK, $ B( 1, I ), LDB, ZERO, WORK( IWORK ), M ) CALL SLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ), $ LDB ) 40 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL SGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, 1 ), - $ 1, ZERO, WORK( IWORK ), 1 ) + CALL SGEMV( 'T', M, M, ONE, WORK( IL ), LDWORK, B( 1, + $ 1 ), 1, ZERO, WORK( IWORK ), 1 ) CALL SCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 ) END IF * @@ -658,7 +672,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors * (Workspace: need 3*M+NRHS, prefer 3*M+NRHS*NB) * - CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL SORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors in A @@ -689,7 +704,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL SRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL SLASET( 'F', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) END IF 50 CONTINUE * @@ -697,14 +713,16 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (Workspace: need N, prefer N*NRHS) * IF( LWORK.GE.LDB*NRHS .AND. NRHS.GT.1 ) THEN - CALL SGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, ZERO, + CALL SGEMM( 'T', 'N', N, NRHS, M, ONE, A, LDA, B, LDB, + $ ZERO, $ WORK, LDB ) CALL SLACPY( 'F', N, NRHS, WORK, LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = LWORK / N DO 60 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL SGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, I ), + CALL SGEMM( 'T', 'N', N, BL, M, ONE, A, LDA, B( 1, + $ I ), $ LDB, ZERO, WORK, N ) CALL SLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB ) 60 CONTINUE @@ -717,18 +735,22 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/sgelst.f b/SRC/sgelst.f index a00f3fecef..8c2d7dbff9 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -190,7 +190,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -240,7 +241,8 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'T' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'T' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -377,13 +379,15 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL SGEMQRT( 'Left', 'Transpose', M, NRHS, N, NB, A, LDA, + CALL SGEMQRT( 'Left', 'Transpose', M, NRHS, N, NB, A, + $ LDA, $ WORK( 1 ), NB, B, LDB, WORK( MN*NB+1 ), $ INFO ) * * Compute B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL STRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -450,7 +454,8 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Block 1: B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL STRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL STRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -470,7 +475,8 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL SGEMLQT( 'Left', 'Transpose', N, NRHS, M, NB, A, LDA, + CALL SGEMLQT( 'Left', 'Transpose', N, NRHS, M, NB, A, + $ LDA, $ WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index e14c8dd684..dfe6776577 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -202,7 +202,8 @@ *> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n *> * ===================================================================== - SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, + SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, $ WORK, LWORK, INFO ) * * -- LAPACK driver routine -- @@ -239,7 +240,8 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, EXTERNAL ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEQP3, SLAIC1, SLASCL, SLASET, + EXTERNAL SCOPY, SGEQP3, SLAIC1, SLASCL, + $ SLASET, $ SORMQR, SORMRZ, STRSM, STZRZF, XERBLA * .. * .. Intrinsic Functions .. @@ -340,13 +342,15 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -413,7 +417,8 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), + CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), $ B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) ) * @@ -454,18 +459,22 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/sgeql2.f b/SRC/sgeql2.f index 9a0289080b..73d4e95b1e 100644 --- a/SRC/sgeql2.f +++ b/SRC/sgeql2.f @@ -180,7 +180,8 @@ SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * AII = A( M-K+I, N-K+I ) A( M-K+I, N-K+I ) = ONE - CALL SLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ), + CALL SLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + $ TAU( I ), $ A, LDA, WORK ) A( M-K+I, N-K+I ) = AII 10 CONTINUE diff --git a/SRC/sgeqlf.f b/SRC/sgeqlf.f index c6e5a49215..6b4a5c5c9b 100644 --- a/SRC/sgeqlf.f +++ b/SRC/sgeqlf.f @@ -250,7 +250,8 @@ SUBROUTINE SGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the QL factorization of the current block * A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1) * - CALL SGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ), + CALL SGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( N-K+I.GT.1 ) THEN * diff --git a/SRC/sgeqp3.f b/SRC/sgeqp3.f index 9a3fe7f682..187ccfb255 100644 --- a/SRC/sgeqp3.f +++ b/SRC/sgeqp3.f @@ -174,7 +174,8 @@ SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SLAQP2, SLAQPS, SORMQR, SSWAP, XERBLA + EXTERNAL SGEQRF, SLAQP2, SLAQPS, SORMQR, SSWAP, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -253,7 +254,8 @@ SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) IF( NA.LT.N ) THEN *CC CALL SORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA, *CC $ TAU, A( 1, NA+1 ), LDA, WORK, INFO ) - CALL SORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU, + CALL SORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, + $ TAU, $ A( 1, NA+1 ), LDA, WORK, LWORK, INFO ) IWS = MAX( IWS, INT( WORK( 1 ) ) ) END IF @@ -294,7 +296,8 @@ SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = ( LWORK-2*SN ) / ( SN+1 ) - NBMIN = MAX( 2, ILAENV( INBMIN, 'SGEQRF', ' ', SM, SN, + NBMIN = MAX( 2, ILAENV( INBMIN, 'SGEQRF', ' ', SM, + $ SN, $ -1, -1 ) ) * * diff --git a/SRC/sgeqrt.f b/SRC/sgeqrt.f index 050e920c55..d7760d4367 100644 --- a/SRC/sgeqrt.f +++ b/SRC/sgeqrt.f @@ -196,9 +196,11 @@ SUBROUTINE SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) * Compute the QR factorization of the current block A(I:M,I:I+IB-1) * IF( USE_RECURSIVE_QR ) THEN - CALL SGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL SGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) ELSE - CALL SGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL SGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) END IF IF( I+IB.LE.N ) THEN * diff --git a/SRC/sgerfs.f b/SRC/sgerfs.f index 1c5b5b79ff..d327f95551 100644 --- a/SRC/sgerfs.f +++ b/SRC/sgerfs.f @@ -181,7 +181,8 @@ *> \ingroup gerfs * * ===================================================================== - SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -222,7 +223,8 @@ SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMV, SGETRS, SLACN2, XERBLA + EXTERNAL SAXPY, SCOPY, SGEMV, SGETRS, SLACN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -393,14 +395,16 @@ SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL SGETRS( TRANST, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + CALL SGETRS( TRANST, N, 1, AF, LDAF, IPIV, + $ WORK( N+1 ), $ N, INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) @@ -412,7 +416,8 @@ SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL SGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL SGETRS( TRANS, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/sgerfsx.f b/SRC/sgerfsx.f index 2e47f4f980..2956679c57 100644 --- a/SRC/sgerfsx.f +++ b/SRC/sgerfsx.f @@ -408,7 +408,8 @@ *> \ingroup gerfsx * * ===================================================================== - SUBROUTINE SGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE SGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) @@ -607,7 +608,8 @@ SUBROUTINE SGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, NORM = '1' END IF ANORM = SLANGE( NORM, N, N, A, LDA, WORK ) - CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Perform refinement on each right-hand side * @@ -638,13 +640,16 @@ SUBROUTINE SGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ -1, C, INFO, WORK, IWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ -1, R, INFO, WORK, IWORK ) ELSE - RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = SLA_GERCOND( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ 0, R, INFO, WORK, IWORK ) END IF DO J = 1, NRHS diff --git a/SRC/sgerqf.f b/SRC/sgerqf.f index ea8b1453a0..1fec504520 100644 --- a/SRC/sgerqf.f +++ b/SRC/sgerqf.f @@ -250,7 +250,8 @@ SUBROUTINE SGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the RQ factorization of the current block * A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1) * - CALL SGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ), + CALL SGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( M-K+I.GT.1 ) THEN * diff --git a/SRC/sgesdd.f b/SRC/sgesdd.f index 2c5fca007d..f75f83c9a4 100644 --- a/SRC/sgesdd.f +++ b/SRC/sgesdd.f @@ -255,7 +255,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SBDSDC, SGEBRD, SGELQF, SGEMM, SGEQRF, SLACPY, + EXTERNAL SBDSDC, SGEBRD, SGELQF, SGEMM, SGEQRF, + $ SLACPY, $ SLASCL, SLASET, SORGBR, SORGLQ, SORGQR, SORMBR, $ XERBLA * .. @@ -338,10 +339,12 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ IERR ) LWORK_SORGBR_Q_NN = INT( DUM(1) ) * - CALL SORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + 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 ) + 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, @@ -460,13 +463,15 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, 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 ) + 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 ) + 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, @@ -626,12 +631,14 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Workspace: need N [tau] + N [work] * Workspace: prefer N [tau] + N*NB [work] * - CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Zero out below R * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N @@ -641,7 +648,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NWORK = IE + N @@ -649,7 +657,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, computing singular values only * Workspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, + $ 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN @@ -674,13 +683,15 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ 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 @@ -712,7 +723,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of bidiagonal matrix in VT * 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, + CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), + $ N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, $ INFO ) * @@ -721,10 +733,12 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, + CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -760,13 +774,15 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ 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 @@ -802,11 +818,13 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * - CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, + CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -815,7 +833,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA, + $ WORK( IR ), $ LDWRKR, ZERO, U, LDU ) * ELSE IF( WNTQA ) THEN @@ -836,7 +855,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'L', M, N, A, LDA, U, LDU ) * @@ -848,7 +868,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Produce R in A, zeroing out other entries * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N @@ -858,7 +879,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -867,7 +889,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of bidiagonal matrix in VT * Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * - CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, + CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), + $ N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, $ INFO ) * @@ -887,7 +910,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * WORK(IU), storing result in A * Workspace: need N*N [U] * - CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), + CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU, + $ WORK( IU ), $ LDWRKU, ZERO, A, LDA ) * * Copy left singular vectors of A from A to U @@ -921,7 +945,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, only computing singular values * Workspace: need 3*N [e, tauq, taup] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, + 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') @@ -980,7 +1005,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy left singular vectors of A from WORK(IU) to A * - CALL SLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) + CALL SLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, + $ LDA ) ELSE * * Path 5o-slow @@ -999,7 +1025,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 20 I = 1, M, LDWRKR CHUNK = MIN( M - I + 1, LDWRKR ) - CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) CALL SLACPY( 'F', CHUNK, N, WORK( IR ), LDWRKR, @@ -1047,7 +1074,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 * @@ -1086,12 +1114,14 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Workspace: need M [tau] + M [work] * Workspace: prefer M [tau] + M*NB [work] * - CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL SGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Zero out above L * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = 1 ITAUQ = IE + M ITAUP = ITAUQ + M @@ -1101,7 +1131,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NWORK = IE + M @@ -1109,7 +1140,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, computing singular values only * Workspace: need M [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, + $ 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN @@ -1138,7 +1170,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it @@ -1180,10 +1213,12 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, + CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * @@ -1195,7 +1230,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 30 I = 1, N, CHUNK BLK = MIN( N - I + 1, CHUNK ) - CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, + 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, $ A( 1, I ), LDA ) @@ -1219,7 +1255,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it @@ -1261,10 +1298,12 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) - CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, + CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) * @@ -1273,7 +1312,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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, + CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), + $ LDWRKL, $ A, LDA, ZERO, VT, LDVT ) * ELSE IF( WNTQA ) THEN @@ -1294,7 +1334,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT ) * @@ -1307,7 +1348,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Produce L in A, zeroing out other entries * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M @@ -1317,7 +1359,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -1346,7 +1389,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Q in VT, storing result in A * Workspace: need M*M [VT] * - CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, + CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), + $ LDWKVT, $ VT, LDVT, ZERO, A, LDA ) * * Copy right singular vectors of A from A to VT @@ -1380,7 +1424,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * Perform bidiagonal SVD, only computing singular values * Workspace: need 3*M [e, tauq, taup] + BDSPAC * - CALL SBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, + 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') @@ -1437,7 +1482,8 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy right singular vectors of A from WORK(IVT) to A * - CALL SLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) + CALL SLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, + $ LDA ) ELSE * * Path 5to-slow @@ -1456,10 +1502,12 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N - I + 1, CHUNK ) - CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), + CALL SGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) - CALL SLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, I ), + CALL SLACPY( 'F', M, BLK, WORK( IL ), M, A( 1, + $ I ), $ LDA ) 40 CONTINUE END IF diff --git a/SRC/sgesvd.f b/SRC/sgesvd.f index 8d6f825f88..6f3e837454 100644 --- a/SRC/sgesvd.f +++ b/SRC/sgesvd.f @@ -207,7 +207,8 @@ *> \ingroup gesvd * * ===================================================================== - SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, + SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, + $ LDVT, $ WORK, LWORK, INFO ) * * -- LAPACK driver routine -- @@ -245,7 +246,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SBDSQR, SGEBRD, SGELQF, SGEMM, SGEQRF, SLACPY, + EXTERNAL SBDSQR, SGEBRD, SGELQF, SGEMM, SGEQRF, + $ SLACPY, $ SLASCL, SLASET, SORGBR, SORGLQ, SORGQR, SORMBR, $ XERBLA * .. @@ -475,7 +477,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL SGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) LWORK_SGELQF = INT( DUM(1) ) * Compute space needed for SORGLQ - CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) LWORK_SORGLQ_N = INT( DUM(1) ) CALL SORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) LWORK_SORGLQ_M = INT( DUM(1) ) @@ -686,7 +689,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Compute A=Q*R * (Workspace: need 2*N, prefer N+N*NB) * - CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R @@ -703,7 +707,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) * - CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), + CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) NCVT = 0 @@ -722,7 +727,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in A if desired * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA, + CALL SBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, + $ LDA, $ DUM, 1, DUM, 1, WORK( IWORK ), INFO ) * * If right singular vectors desired in VT, copy them there @@ -771,8 +777,10 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy R to WORK(IR) and zero 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 SLACPY( 'U', N, N, A, LDA, WORK( IR ), + $ LDWRKR ) + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -788,7 +796,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Bidiagonalize R in WORK(IR) * (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) * - CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), + CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -804,7 +813,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of R in WORK(IR) * (Workspace: need N*N+BDSPAC) * - CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1, + CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + $ 1, $ WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) IU = IE + N @@ -815,7 +825,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, ZERO, $ WORK( IU ), LDWRKU ) CALL SLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -849,7 +860,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1, + CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + $ 1, $ A, LDA, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -916,7 +928,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL SGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL SLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) + CALL SLACPY( '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) @@ -937,7 +950,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of R in VT * (Workspace: need N*N+BDSPAC) * - CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT, + CALL SBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, + $ LDVT, $ WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) IU = IE + N @@ -948,7 +962,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), + CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, ZERO, $ WORK( IU ), LDWRKU ) CALL SLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -1011,7 +1026,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in VT * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT, + CALL SBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, + $ LDVT, $ A, LDA, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -1086,7 +1102,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of R in WORK(IR) * (Workspace: need N*N+BDSPAC) * - CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), + $ DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) * @@ -1147,7 +1164,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in U * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), + $ DUM, $ 1, U, LDU, DUM, 1, WORK( IWORK ), $ INFO ) * @@ -1310,7 +1328,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate right vectors bidiagonalizing R in A * (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1395,7 +1414,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (Workspace: need N*N+4*N-1, * prefer N*N+3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1464,7 +1484,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate right bidiagonalizing vectors in VT * (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1552,7 +1573,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of R in WORK(IR) * (Workspace: need N*N+BDSPAC) * - CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, + CALL SBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), + $ DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, $ WORK( IWORK ), INFO ) * @@ -1618,7 +1640,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in U * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, + CALL SBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), + $ DUM, $ 1, U, LDU, DUM, 1, WORK( IWORK ), $ INFO ) * @@ -1786,7 +1809,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate right bidiagonalizing vectors in A * (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1872,7 +1896,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * (Workspace: need N*N+4*N-1, * prefer N*N+3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -1945,7 +1970,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate right bidiagonalizing vectors in VT * (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) * - CALL SORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL SORGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + N * @@ -2049,7 +2075,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * vectors in A * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA, + CALL SBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) ELSE * @@ -2083,12 +2110,14 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Compute A=L*Q * (Workspace: need 2*M, prefer M+M*NB) * - CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL SGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out above L * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA ) + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + $ LDA ) IE = 1 ITAUQ = IE + M ITAUP = ITAUQ + M @@ -2097,7 +2126,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Bidiagonalize L in A * (Workspace: need 4*M, prefer 3*M+2*M*NB) * - CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), + CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) IF( WNTUO .OR. WNTUAS ) THEN @@ -2117,7 +2147,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * vectors of A in A if desired * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A, + CALL SBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, + $ A, $ LDA, DUM, 1, WORK( IWORK ), INFO ) * * If left singular vectors desired in U, copy them there @@ -2169,7 +2200,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Copy L to WORK(IR) and zero out above it * - CALL SLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR ) + CALL SLACPY( 'L', M, M, A, LDA, WORK( IR ), + $ LDWRKR ) CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, $ WORK( IR+LDWRKR ), LDWRKR ) * @@ -2186,7 +2218,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Bidiagonalize L in WORK(IR) * (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) * - CALL SGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ), + CALL SGEBRD( M, M, WORK( IR ), LDWRKR, S, + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -2213,7 +2246,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ), + CALL SGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, ZERO, $ WORK( IU ), LDWRKU ) CALL SLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2247,7 +2281,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL SBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA, + CALL SBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, + $ LDA, $ DUM, 1, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -2316,7 +2351,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, CALL SGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL SLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) + CALL SLACPY( '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) @@ -2348,7 +2384,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ), + CALL SGEMM( 'N', 'N', M, BLK, M, ONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, ZERO, $ WORK( IU ), LDWRKU ) CALL SLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2410,7 +2447,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * singular vectors of A in A * (Workspace: need BDSPAC) * - CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA, + CALL SBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) * END IF @@ -2526,7 +2564,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Zero out above L in A * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -2689,7 +2728,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Zero out above L in A * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -2709,7 +2749,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors of L in A * (Workspace: need 4*M, prefer 3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2794,7 +2835,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors in U * (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2837,7 +2879,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Copy L to U, zeroing out above it * CALL SLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, + $ 2 ), $ LDU ) IE = ITAU ITAUQ = IE + M @@ -2862,7 +2905,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors in U * (Workspace: need 4*M, prefer 3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -2992,7 +3036,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Zero out above L in A * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -3160,7 +3205,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * * Zero out above L in A * - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, + $ 2 ), $ LDA ) * * Bidiagonalize L in A @@ -3181,7 +3227,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors in A * (Workspace: need 4*M, prefer 3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3266,7 +3313,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors in U * (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3313,7 +3361,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Copy L to U, zeroing out above it * CALL SLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, + $ 2 ), $ LDU ) IE = ITAU ITAUQ = IE + M @@ -3338,7 +3387,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * Generate left bidiagonalizing vectors in U * (Workspace: need 4*M, prefer 3*M+M*NB) * - CALL SORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL SORGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IWORK = IE + M * @@ -3442,7 +3492,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, * vectors in A * (Workspace: need BDSPAC) * - CALL SBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA, + CALL SBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, + $ LDA, $ U, LDU, DUM, 1, WORK( IWORK ), INFO ) ELSE * @@ -3482,13 +3533,15 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ IERR ) IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM ) - $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ), + $ CALL SLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, + $ WORK( 2 ), $ MINMN, IERR ) IF( ANRM.LT.SMLNUM ) $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ IERR ) IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM ) - $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ), + $ CALL SLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, + $ WORK( 2 ), $ MINMN, IERR ) END IF * diff --git a/SRC/sgesvdq.f b/SRC/sgesvdq.f index f492cc6d96..8f5e0c6d5d 100644 --- a/SRC/sgesvdq.f +++ b/SRC/sgesvdq.f @@ -446,9 +446,9 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, REAL RDUMMY(1) * .. * .. External Subroutines (BLAS, LAPACK) - EXTERNAL SGELQF, SGEQP3, SGEQRF, SGESVD, SLACPY, SLAPMT, - $ SLASCL, SLASET, SLASWP, SSCAL, SPOCON, SORMLQ, - $ SORMQR, XERBLA + EXTERNAL SGELQF, SGEQP3, SGEQRF, SGESVD, SLACPY, + $ SLAPMT, SLASCL, SLASET, SLASWP, SSCAL, + $ SPOCON, SORMLQ, SORMQR, XERBLA * .. * .. External Functions (BLAS, LAPACK) LOGICAL LSAME @@ -679,10 +679,12 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL SGEQRF(N,N/2,U,LDU,RDUMMY,RDUMMY,-1,IERR) LWRK_SGEQRF = INT( RDUMMY(1) ) - CALL SGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + CALL SGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U, + $ LDU, $ V, LDV, RDUMMY, -1, IERR ) LWRK_SGESVD2 = INT( RDUMMY(1) ) - CALL SORMQR( 'R', 'C', N, N, N/2, U, LDU, RDUMMY, + CALL SORMQR( 'R', 'C', N, N, N/2, U, LDU, + $ RDUMMY, $ V, LDV, RDUMMY, -1, IERR ) LWRK_SORMQR2 = INT( RDUMMY(1) ) OPTWRK2 = MAX( LWRK_SGEQP3, N/2+LWRK_SGEQRF, @@ -701,10 +703,12 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL SGELQF(N/2,N,U,LDU,RDUMMY,RDUMMY,-1,IERR) LWRK_SGELQF = INT( RDUMMY(1) ) - CALL SGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + CALL SGESVD( 'S','O', N/2,N/2, V, LDV, S, U, + $ LDU, $ V, LDV, RDUMMY, -1, IERR ) LWRK_SGESVD2 = INT( RDUMMY(1) ) - CALL SORMLQ( 'R', 'N', N, N, N/2, U, LDU, RDUMMY, + CALL SORMLQ( 'R', 'N', N, N, N/2, U, LDU, + $ RDUMMY, $ V, LDV, RDUMMY,-1,IERR ) LWRK_SORMLQ = INT( RDUMMY(1) ) OPTWRK2 = MAX( LWRK_SGEQP3, N/2+LWRK_SGELQF, @@ -804,7 +808,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RWORK(1) .GT. BIG / SQRT(REAL(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL SLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + CALL SLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF CALL SLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) @@ -826,7 +831,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RTMP .GT. BIG / SQRT(REAL(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL SLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + CALL SLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF END IF @@ -994,7 +1000,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [U] and overwrite [U] with the left singular vectors CALL SLACPY( 'U', NR, N, A, LDA, U, LDU ) IF ( NR .GT. 1 ) - $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), LDU ) + $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), + $ LDU ) * .. the right singular vectors not computed, the NR left singular * vectors overwrite [U](1:NR,1:NR) CALL SGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, @@ -1085,7 +1092,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into V and overwrite V with the right singular vectors CALL SLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), LDV ) + $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), + $ LDV ) * .. the right singular vectors overwrite V, the NR left singular * vectors stored in U(1:NR,1:NR) IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1157,9 +1165,11 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1117 CONTINUE * IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1210,7 +1220,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL SLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1), + $ LDU) CALL SLASET('A',M-N,N1-N,ZERO,ONE, $ U(N+1,N+1), LDU ) END IF @@ -1237,7 +1248,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V,LDV, WORK(N+NR+1),LWORK-N-NR, INFO ) CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) CALL SORMQR('R','C', N, N, NR, U(1,NR+1), LDU, $ WORK(N+1),V,LDV,WORK(N+NR+1),LWORK-N-NR,IERR) CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1246,7 +1258,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL SLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) IF ( NR .LT. N1 ) THEN - CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1),LDU) END IF @@ -1272,9 +1285,11 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1308,7 +1323,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL SLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1), + $ LDU) CALL SLASET( 'A',M-N,N1-N,ZERO,ONE, $ U(N+1,N+1), LDU ) END IF @@ -1326,7 +1342,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V, LDV, WORK(N+NR+1), LWORK-N-NR, INFO ) CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1), + $ LDV) CALL SORMLQ('R','N',N,N,NR,U(NR+1,1),LDU,WORK(N+1), $ V, LDV, WORK(N+NR+1),LWORK-N-NR,IERR) CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1335,7 +1352,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL SLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) IF ( NR .LT. N1 ) THEN - CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), + $ LDU) CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1368,7 +1386,8 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * * .. if numerical rank deficiency is detected, the truncated * singular values are set to zero. - IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) + IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), + $ N ) * .. undo scaling; this may cause overflow in the largest singular * values. IF ( ASCALED ) diff --git a/SRC/sgesvdx.f b/SRC/sgesvdx.f index 7e369da3a3..e1ac33f52d 100644 --- a/SRC/sgesvdx.f +++ b/SRC/sgesvdx.f @@ -295,7 +295,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SBDSVDX, SGEBRD, SGELQF, SGEQRF, SLACPY, + EXTERNAL SBDSVDX, SGEBRD, SGELQF, SGEQRF, + $ SLACPY, $ SLASCL, SLASET, SORMBR, SORMLQ, SORMQR, $ SCOPY, XERBLA * .. @@ -385,7 +386,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MAXWRK = 1 IF( MINMN.GT.0 ) THEN IF( M.GE.N ) THEN - MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( M.GE.MNTHR ) THEN * * Path 1 (M much larger than N) @@ -420,7 +422,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE - MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( N.GE.MNTHR ) THEN * * Path 1t (N much larger than M) @@ -542,8 +545,10 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, ITAUP = ITAUQ + N ITEMP = ITAUP + N CALL SLACPY( 'U', N, N, A, LDA, WORK( IQRF ), N ) - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IQRF+1 ), N ) - CALL SGEBRD( N, N, WORK( IQRF ), N, WORK( ID ), WORK( IE ), + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IQRF+1 ), + $ N ) + CALL SGEBRD( N, N, WORK( IQRF ), N, WORK( ID ), + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) * @@ -552,7 +557,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + N*(N*2+1) - CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), WORK( IE ), + CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ N*2, WORK( ITEMP ), IWORK, INFO) * @@ -564,7 +570,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, NS, 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) @@ -621,7 +628,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + N*(N*2+1) - CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), WORK( IE ), + CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ N*2, WORK( ITEMP ), IWORK, INFO) * @@ -633,7 +641,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, NS, 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) @@ -690,8 +699,10 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, ITAUP = ITAUQ + M ITEMP = ITAUP + M CALL SLACPY( 'L', M, M, A, LDA, WORK( ILQF ), M ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( ILQF+M ), M ) - CALL SGEBRD( M, M, WORK( ILQF ), M, WORK( ID ), WORK( IE ), + CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, WORK( ILQF+M ), + $ M ) + CALL SGEBRD( M, M, WORK( ILQF ), M, WORK( ID ), + $ WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) * @@ -700,7 +711,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + M*(M*2+1) - CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, WORK( ID ), WORK( IE ), + CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ M*2, WORK( ITEMP ), IWORK, INFO) * @@ -729,7 +741,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', NS, 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) @@ -769,7 +782,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * ITGKZ = ITEMP ITEMP = ITGKZ + M*(M*2+1) - CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, WORK( ID ), WORK( IE ), + CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, WORK( ID ), + $ WORK( IE ), $ VL, VU, ILTGK, IUTGK, NS, S, WORK( ITGKZ ), $ M*2, WORK( ITEMP ), IWORK, INFO) * @@ -798,7 +812,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', NS, 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/SRC/sgesvj.f b/SRC/sgesvj.f index 79f898a4f3..c0aad8b983 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -410,9 +410,13 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN + ELSE IF( .NOT.( LSVEC .OR. + $ UCTOL .OR. + $ LSAME( JOBU, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( RSVEC .OR. + $ APPLV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -768,11 +772,13 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( UPPER ) THEN * * - CALL SGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, LDV, + CALL SGSVJ0( JOBV, N4, N4, A, LDA, WORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 2, WORK( N+1 ), LWORK-N, $ IERR ) * - CALL SGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, WORK( N4+1 ), + CALL SGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, + $ WORK( N4+1 ), $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV, $ EPSLN, SFMIN, TOL, 1, WORK( N+1 ), LWORK-N, $ IERR ) @@ -875,7 +881,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAQQ.GE.ONE ) THEN ROTOK = ( SMALL*AAPP ).LE.AAQQ IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -890,7 +897,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE ROTOK = AAPP.LE.( AAQQ / SMALL ) IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -967,7 +975,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, FASTR( 4 ) = -T*AQOAP WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q )*CS - CALL SROTM( M, A( 1, p ), 1, + CALL SROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL SROTM( MVL, @@ -983,7 +992,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q ) / CS IF( RSVEC ) THEN - CALL SAXPY( MVL, -T*AQOAP, + CALL SAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL SAXPY( MVL, @@ -997,13 +1007,15 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL SAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL SAXPY( M, -CS*SN*AQOAP, + CALL SAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) WORK( p ) = WORK( p ) / CS WORK( q ) = WORK( q )*CS IF( RSVEC ) THEN - CALL SAXPY( MVL, T*APOAQ, + CALL SAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL SAXPY( MVL, @@ -1017,7 +1029,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL SAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL SAXPY( M, CS*SN*APOAQ, + CALL SAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) WORK( p ) = WORK( p )*CS @@ -1060,15 +1073,19 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * .. have to use modified Gram-Schmidt like transformation CALL SCOPY( M, A( 1, p ), 1, $ WORK( N+1 ), 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL SLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK( N+1 ), LDA, $ IERR ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) TEMP1 = -AAPQ*WORK( p ) / WORK( q ) - CALL SAXPY( M, TEMP1, WORK( N+1 ), 1, + CALL SAXPY( M, TEMP1, WORK( N+1 ), + $ 1, $ A( 1, q ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL SLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) @@ -1083,7 +1100,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SNRM2( M, A( 1, q ), 1 )* + SVA( q ) = SNRM2( M, A( 1, q ), + $ 1 )* $ WORK( q ) ELSE T = ZERO @@ -1182,7 +1200,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -1201,7 +1220,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*WORK( p )*WORK( q ) / $ AAQQ ) / AAPP ELSE @@ -1273,7 +1293,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, FASTR( 4 ) = -T*AQOAP WORK( p ) = WORK( p )*CS WORK( q ) = WORK( q )*CS - CALL SROTM( M, A( 1, p ), 1, + CALL SROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL SROTM( MVL, @@ -1287,7 +1308,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, -T*AQOAP, + CALL SAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL SAXPY( MVL, @@ -1303,11 +1325,13 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL SAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL SAXPY( M, -CS*SN*AQOAP, + CALL SAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, T*APOAQ, + CALL SAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL SAXPY( MVL, @@ -1323,7 +1347,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, CALL SAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL SAXPY( M, CS*SN*APOAQ, + CALL SAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) WORK( p ) = WORK( p )*CS @@ -1366,16 +1391,20 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAPP.GT.AAQQ ) THEN CALL SCOPY( M, A( 1, p ), 1, $ WORK( N+1 ), 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK( N+1 ), LDA, $ IERR ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*WORK( p ) / WORK( q ) - CALL SAXPY( M, TEMP1, WORK( N+1 ), + CALL SAXPY( M, TEMP1, + $ WORK( N+1 ), $ 1, A( 1, q ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAQQ, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -1384,16 +1413,20 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE CALL SCOPY( M, A( 1, q ), 1, $ WORK( N+1 ), 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK( N+1 ), LDA, $ IERR ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*WORK( q ) / WORK( p ) - CALL SAXPY( M, TEMP1, WORK( N+1 ), + CALL SAXPY( M, TEMP1, + $ WORK( N+1 ), $ 1, A( 1, p ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAPP, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -1409,7 +1442,8 @@ SUBROUTINE SGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SNRM2( M, A( 1, q ), 1 )* + SVA( q ) = SNRM2( M, A( 1, q ), + $ 1 )* $ WORK( q ) ELSE T = ZERO diff --git a/SRC/sgesvx.f b/SRC/sgesvx.f index aa138e9a76..3451082fd7 100644 --- a/SRC/sgesvx.f +++ b/SRC/sgesvx.f @@ -344,7 +344,8 @@ *> \ingroup gesvx * * ===================================================================== - SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -383,7 +384,8 @@ SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EXTERNAL LSAME, SLAMCH, SLANGE, SLANTR * .. * .. External Subroutines .. - EXTERNAL SGECON, SGEEQU, SGERFS, SGETRF, SGETRS, SLACPY, + EXTERNAL SGECON, SGEEQU, SGERFS, SGETRF, SGETRS, + $ SLACPY, $ SLAQGE, XERBLA * .. * .. Intrinsic Functions .. @@ -408,7 +410,9 @@ SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -474,7 +478,8 @@ SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL SGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) + CALL SGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -549,7 +554,8 @@ SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute the reciprocal of the condition number of A. * - CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/sgesvxx.f b/SRC/sgesvxx.f index 942c4e0e1a..e0c79765e4 100644 --- a/SRC/sgesvxx.f +++ b/SRC/sgesvxx.f @@ -536,7 +536,8 @@ *> \ingroup gesvxx * * ===================================================================== - SUBROUTINE SGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE SGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, @@ -587,7 +588,8 @@ SUBROUTINE SGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, REAL SLAMCH, SLA_GERPVGRW * .. * .. External Subroutines .. - EXTERNAL SGEEQUB, SGETRF, SGETRS, SLACPY, SLAQGE, + EXTERNAL SGEEQUB, SGETRF, SGETRS, SLACPY, + $ SLAQGE, $ XERBLA, SLASCL2, SGERFSX * .. * .. Intrinsic Functions .. diff --git a/SRC/sgetf2.f b/SRC/sgetf2.f index bca031e86c..ca89da5056 100644 --- a/SRC/sgetf2.f +++ b/SRC/sgetf2.f @@ -200,7 +200,8 @@ SUBROUTINE SGETF2( M, N, A, LDA, IPIV, INFO ) * * Update trailing submatrix. * - CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA, + CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), + $ LDA, $ A( J+1, J+1 ), LDA ) END IF 10 CONTINUE diff --git a/SRC/sgetrf.f b/SRC/sgetrf.f index 0ebb24f2c4..9cc061ea7a 100644 --- a/SRC/sgetrf.f +++ b/SRC/sgetrf.f @@ -129,7 +129,8 @@ SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO ) INTEGER I, IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL SGEMM, SGETRF2, SLASWP, STRSM, XERBLA + EXTERNAL SGEMM, SGETRF2, SLASWP, STRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -178,7 +179,8 @@ SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO ) * Factor diagonal and subdiagonal blocks and test for exact * singularity. * - CALL SGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) + CALL SGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), + $ IINFO ) * * Adjust INFO and the pivot indices. * @@ -201,14 +203,16 @@ SUBROUTINE SGETRF( M, N, A, LDA, IPIV, INFO ) * * Compute block row of U. * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL SGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL SGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/sgetri.f b/SRC/sgetri.f index c8628638ae..4fedd76ce0 100644 --- a/SRC/sgetri.f +++ b/SRC/sgetri.f @@ -143,7 +143,8 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, XERBLA + EXTERNAL SGEMM, SGEMV, SSWAP, STRSM, STRTRI, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -190,7 +191,8 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = MAX( LDWORK*NB, 1 ) IF( LWORK.LT.IWS ) THEN NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SGETRI', ' ', N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SGETRI', ' ', N, -1, -1, + $ -1 ) ) END IF ELSE IWS = N @@ -241,7 +243,8 @@ SUBROUTINE SGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL SGEMM( 'No transpose', 'No transpose', N, JB, $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) - CALL STRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB, + CALL STRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ JB, $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 50 CONTINUE END IF diff --git a/SRC/sgetrs.f b/SRC/sgetrs.f index 2e0a1af81a..a68238ecb7 100644 --- a/SRC/sgetrs.f +++ b/SRC/sgetrs.f @@ -190,7 +190,8 @@ SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -203,12 +204,14 @@ SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve U**T *X = B, overwriting B with X. * - CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, + CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve L**T *X = B, overwriting B with X. * - CALL STRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE, + CALL STRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, + $ ONE, $ A, LDA, B, LDB ) * * Apply row interchanges to the solution vectors. diff --git a/SRC/sgetsqrhrt.f b/SRC/sgetsqrhrt.f index 18d94615f0..908d0cdd40 100644 --- a/SRC/sgetsqrhrt.f +++ b/SRC/sgetsqrhrt.f @@ -178,7 +178,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, + SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, + $ WORK, $ LWORK, INFO ) IMPLICIT NONE * @@ -209,7 +210,8 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLATSQR, SORGTSQR_ROW, SORHR_COL, + EXTERNAL SCOPY, SLATSQR, SORGTSQR_ROW, + $ SORHR_COL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -346,7 +348,8 @@ SUBROUTINE SGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, A( I, J ) = -ONE * WORK( LWT+N*(J-1)+I ) END DO ELSE - CALL SCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), LDA ) + CALL SCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), + $ LDA ) END IF END DO * diff --git a/SRC/sggbak.f b/SRC/sggbak.f index 602a7edc31..1410f1ded2 100644 --- a/SRC/sggbak.f +++ b/SRC/sggbak.f @@ -143,7 +143,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, + SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, + $ V, $ LDV, INFO ) * * -- LAPACK computational routine -- @@ -182,8 +183,10 @@ SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/sggbal.f b/SRC/sggbal.f index ba32485306..bdbf591f90 100644 --- a/SRC/sggbal.f +++ b/SRC/sggbal.f @@ -222,8 +222,10 @@ SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -502,8 +504,10 @@ SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, IF( CMAX.LT.HALF ) $ GO TO 350 * - CALL SAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 ) - CALL SAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 ) + CALL SAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), + $ 1 ) + CALL SAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), + $ 1 ) * PGAMMA = GAMMA IT = IT + 1 diff --git a/SRC/sgges.f b/SRC/sgges.f index acb79cb682..fd32e85e50 100644 --- a/SRC/sgges.f +++ b/SRC/sgges.f @@ -279,7 +279,8 @@ *> \ingroup gges * * ===================================================================== - SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, + SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, + $ LDB, $ SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, $ LDVSR, WORK, LWORK, BWORK, INFO ) * @@ -322,7 +323,8 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN * .. * .. External Functions .. @@ -370,7 +372,8 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -400,7 +403,8 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, $ N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, -1 ) ) IF( ILVSL ) THEN MAXWRK = MAX( MAXWRK, MINWRK - N + - $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) ) + $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, + $ -1 ) ) END IF ELSE MINWRK = 1 @@ -545,15 +549,18 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, $ IERR ) END IF IF( ILBSCL ) - $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * - CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR, + CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHAR, $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, $ IERR ) @@ -615,8 +622,10 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * IF( ILASCL ) THEN CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sgges3.f b/SRC/sgges3.f index 2bb7a26b05..e75cb79d5b 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -322,7 +322,8 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN, XERBLA * .. * .. External Functions .. @@ -375,7 +376,8 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -551,15 +553,18 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, $ IERR ) END IF IF( ILBSCL ) - $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * - CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHAR, + CALL STGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHAR, $ ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, $ PVSR, DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, $ IERR ) @@ -620,8 +625,10 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * IF( ILASCL ) THEN CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sggesx.f b/SRC/sggesx.f index d8e6c179ca..44cfd45727 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -359,7 +359,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, + SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, + $ LDA, $ B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, $ VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK, $ LIWORK, BWORK, INFO ) @@ -406,7 +407,8 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN, XERBLA * .. * .. External Functions .. @@ -467,7 +469,8 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -661,12 +664,14 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, $ IERR ) END IF IF( ILBSCL ) - $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL SLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * DO 10 I = 1, N - BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), BETA( I ) ) + BWORK( I ) = SELCTG( ALPHAR( I ), ALPHAI( I ), + $ BETA( I ) ) 10 CONTINUE * * Reorder eigenvalues, transform Generalized Schur vectors, and @@ -754,8 +759,10 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, * IF( ILASCL ) THEN CALL SLASCL( 'H', 0, 0, ANRMTO, ANRM, N, N, A, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sggev.f b/SRC/sggev.f index 0775613305..0261a30b3d 100644 --- a/SRC/sggev.f +++ b/SRC/sggev.f @@ -222,7 +222,8 @@ *> \ingroup ggev * * ===================================================================== - SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, + SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) * * -- LAPACK driver routine -- @@ -258,7 +259,8 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC, XERBLA * .. * .. External Functions .. @@ -488,7 +490,8 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, ELSE CHTEMP = 'R' END IF - CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), IERR ) IF( IERR.NE.0 ) THEN INFO = N + 2 @@ -572,8 +575,10 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, 110 CONTINUE * IF( ILASCL ) THEN - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sggev3.f b/SRC/sggev3.f index 786eb2006d..a26e73e40a 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -260,7 +260,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC * .. * .. External Functions .. @@ -493,7 +494,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ELSE CHTEMP = 'R' END IF - CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL STGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), IERR ) IF( IERR.NE.0 ) THEN INFO = N + 2 @@ -576,8 +578,10 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, 110 CONTINUE * IF( ILASCL ) THEN - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sggevx.f b/SRC/sggevx.f index 58403490dc..6bd5f92f0b 100644 --- a/SRC/sggevx.f +++ b/SRC/sggevx.f @@ -385,7 +385,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, + SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO, $ IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, $ RCONDV, WORK, LWORK, IWORK, BWORK, INFO ) @@ -428,7 +429,8 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, + $ SLACPY, $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC, STGSNA, $ XERBLA * .. @@ -525,12 +527,15 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF MAXWRK = MINWRK MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'SGEQRF', ' ', N, 1, N, + $ 0 ) ) MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'SORMQR', ' ', N, 1, N, + $ 0 ) ) IF( ILVL ) THEN MAXWRK = MAX( MAXWRK, N + - $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, 0 ) ) + $ N*ILAENV( 1, 'SORGQR', ' ', N, 1, N, + $ 0 ) ) END IF END IF WORK( 1 ) = SROUNDUP_LWORK(MAXWRK) @@ -592,7 +597,8 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * Permute and/or balance the matrix pair (A,B) * (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) * - CALL SGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, + CALL SGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, + $ RSCALE, $ WORK, IERR ) * * Compute ABNRM and BBNRM @@ -777,7 +783,8 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * (Workspace: none needed) * IF( ILVL ) THEN - CALL SGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL, + CALL SGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, + $ VL, $ LDVL, IERR ) * DO 70 JC = 1, N @@ -810,7 +817,8 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, 70 CONTINUE END IF IF( ILVR ) THEN - CALL SGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR, + CALL SGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, + $ VR, $ LDVR, IERR ) DO 120 JC = 1, N IF( ALPHAI( JC ).LT.ZERO ) @@ -847,8 +855,10 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, 130 CONTINUE * IF( ILASCL ) THEN - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, IERR ) - CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAR, N, + $ IERR ) + CALL SLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHAI, N, + $ IERR ) END IF * IF( ILBSCL ) THEN diff --git a/SRC/sggglm.f b/SRC/sggglm.f index 26d531900c..46c4595f94 100644 --- a/SRC/sggglm.f +++ b/SRC/sggglm.f @@ -181,7 +181,8 @@ *> \ingroup ggglm * * ===================================================================== - SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, + SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -208,7 +209,8 @@ SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, $ NB4, NP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SGGQRF, SORMQR, SORMRQ, STRTRS, + EXTERNAL SCOPY, SGEMV, SGGQRF, SORMQR, SORMRQ, + $ STRTRS, $ XERBLA * .. * .. External Functions .. @@ -327,7 +329,8 @@ SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * Solve triangular system: R11*x = d1 * IF( M.GT.0 ) THEN - CALL STRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA, + CALL STRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, + $ LDA, $ D, M, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/sgghd3.f b/SRC/sgghd3.f index 054d5a3053..3bc6975f57 100644 --- a/SRC/sgghd3.f +++ b/SRC/sgghd3.f @@ -226,7 +226,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -265,7 +266,8 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGGHRD, SLARTG, SLASET, SORM22, SROT, SGEMM, + EXTERNAL SGGHRD, SLARTG, SLASET, SORM22, SROT, + $ SGEMM, $ SGEMV, STRMV, SLACPY, XERBLA * .. * .. Intrinsic Functions .. @@ -389,7 +391,8 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * N2NB = ( IHI-JCOL-1 ) / NNB - 1 NBLST = IHI - JCOL - N2NB*NNB - CALL SLASET( 'All', NBLST, NBLST, ZERO, ONE, WORK, NBLST ) + CALL SLASET( 'All', NBLST, NBLST, ZERO, ONE, WORK, + $ NBLST ) PW = NBLST * NBLST + 1 DO I = 1, N2NB CALL SLASET( 'All', 2*NNB, 2*NNB, ZERO, ONE, @@ -586,10 +589,12 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, WORK( PPW ) = A( I, J+1 ) PPW = PPW + 1 END DO - CALL STRMV( 'Upper', 'Transpose', 'Non-unit', LEN, + CALL STRMV( 'Upper', 'Transpose', 'Non-unit', + $ LEN, $ WORK( PPWO + NNB ), 2*NNB, WORK( PW ), $ 1 ) - CALL STRMV( 'Lower', 'Transpose', 'Non-unit', NNB, + CALL STRMV( 'Lower', 'Transpose', 'Non-unit', + $ NNB, $ WORK( PPWO + 2*LEN*NNB ), $ 2*NNB, WORK( PW + LEN ), 1 ) CALL SGEMV( 'Transpose', NNB, LEN, ONE, @@ -778,7 +783,8 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL SORM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL SORM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ A( 1, J ), LDA, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -809,7 +815,8 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL SORM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL SORM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ B( 1, J ), LDB, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -889,7 +896,8 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END IF * IF ( JCOL.LT.IHI ) - $ CALL SGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, + $ CALL SGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, IERR ) * WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) diff --git a/SRC/sgghrd.f b/SRC/sgghrd.f index 701a0a2edb..bcd5a338a7 100644 --- a/SRC/sgghrd.f +++ b/SRC/sgghrd.f @@ -203,7 +203,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, INFO ) * * -- LAPACK computational routine -- @@ -336,7 +337,8 @@ SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL SROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB, $ B( JROW, JROW-1 ), LDB, C, S ) IF( ILQ ) - $ CALL SROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, S ) + $ CALL SROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, + $ S ) * * Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1) * @@ -344,11 +346,13 @@ SUBROUTINE SGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL SLARTG( TEMP, B( JROW, JROW-1 ), C, S, $ B( JROW, JROW ) ) B( JROW, JROW-1 ) = ZERO - CALL SROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S ) + CALL SROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, + $ S ) CALL SROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C, $ S ) IF( ILZ ) - $ CALL SROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S ) + $ CALL SROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, + $ S ) 30 CONTINUE 40 CONTINUE * diff --git a/SRC/sgglse.f b/SRC/sgglse.f index 2c5049fa06..5ec6517612 100644 --- a/SRC/sgglse.f +++ b/SRC/sgglse.f @@ -176,7 +176,8 @@ *> \ingroup gglse * * ===================================================================== - SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, + SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -203,7 +204,8 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, $ NB4, NR * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMV, SGGRQF, SORMQR, SORMRQ, + EXTERNAL SAXPY, SCOPY, SGEMV, SGGRQF, SORMQR, + $ SORMRQ, $ STRMV, STRTRS, XERBLA * .. * .. External Functions .. @@ -283,7 +285,8 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * Update c = Z**T *c = ( c1 ) N-P * ( c2 ) M+P-N * - CALL SORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, WORK( P+1 ), + CALL SORMQR( 'Left', 'Transpose', M, 1, MN, A, LDA, + $ WORK( P+1 ), $ C, MAX( 1, M ), WORK( P+MN+1 ), LWORK-P-MN, INFO ) LOPT = MAX( LOPT, INT( WORK( P+MN+1 ) ) ) * @@ -304,7 +307,8 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Update c1 * - CALL SGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), LDA, + CALL SGEMV( 'No transpose', N-P, P, -ONE, A( 1, N-P+1 ), + $ LDA, $ D, 1, ONE, C, 1 ) END IF * @@ -329,7 +333,8 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, IF( M.LT.N ) THEN NR = M + P - N IF( NR.GT.0 ) - $ CALL SGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, M+1 ), + $ CALL SGEMV( 'No transpose', NR, N-M, -ONE, A( N-P+1, + $ M+1 ), $ LDA, D( NR+1 ), 1, ONE, C( N-P+1 ), 1 ) ELSE NR = P @@ -342,7 +347,8 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Backward transformation x = Q**T*x * - CALL SORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), X, + CALL SORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), + $ X, $ N, WORK( P+MN+1 ), LWORK-P-MN, INFO ) WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) * diff --git a/SRC/sggqrf.f b/SRC/sggqrf.f index b257e2a2a5..4b973c9a7f 100644 --- a/SRC/sggqrf.f +++ b/SRC/sggqrf.f @@ -284,7 +284,8 @@ SUBROUTINE SGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * * Update B := Q**T*B. * - CALL SORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, TAUA, + CALL SORMQR( 'Left', 'Transpose', N, P, MIN( N, M ), A, LDA, + $ TAUA, $ B, LDB, WORK, LWORK, INFO ) LOPT = MAX( LOPT, INT( WORK( 1 ) ) ) * diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index ab7b781b40..d9239e0645 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -424,7 +424,8 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, WORK, $ WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/SRC/sggsvp3.f b/SRC/sggsvp3.f index 44c59952f4..a76388afe1 100644 --- a/SRC/sggsvp3.f +++ b/SRC/sggsvp3.f @@ -306,7 +306,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, EXTERNAL SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEQP3, SGEQR2, SGERQ2, SLACPY, SLAPMT, + EXTERNAL SGEQP3, SGEQR2, SGERQ2, SLACPY, + $ SLAPMT, $ SLASET, SORG2R, SORM2R, SORMR2, XERBLA * .. * .. Intrinsic Functions .. @@ -443,7 +444,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, + CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, $ LDQ, WORK, INFO ) END IF * @@ -490,7 +492,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL SLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), + $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, + $ 1 ), $ LDU ) CALL SORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF @@ -511,7 +514,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -523,7 +527,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, + CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, $ Q, LDQ, WORK, INFO ) END IF * @@ -548,7 +553,8 @@ SUBROUTINE SGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL SORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), + CALL SORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, + $ L ), $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, $ WORK, INFO ) END IF diff --git a/SRC/sgsvj0.f b/SRC/sgsvj0.f index b18ec5acd0..6fe0319078 100644 --- a/SRC/sgsvj0.f +++ b/SRC/sgsvj0.f @@ -260,7 +260,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, EXTERNAL ISAMAX, LSAME, SDOT, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP, + EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, + $ SSWAP, $ XERBLA * .. * .. Executable Statements .. @@ -425,12 +426,15 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( AAQQ.GE.ONE ) THEN ROTOK = ( SMALL*AAPP ).LE.AAQQ IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, D( p ), + CALL SCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -438,12 +442,15 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ELSE ROTOK = AAPP.LE.( AAQQ / SMALL ) IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL SCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -512,7 +519,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL SROTM( M, A( 1, p ), 1, + CALL SROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL SROTM( MVL, @@ -528,7 +536,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, D( p ) = D( p )*CS D( q ) = D( q ) / CS IF( RSVEC ) THEN - CALL SAXPY( MVL, -T*AQOAP, + CALL SAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL SAXPY( MVL, @@ -542,13 +551,15 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL SAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL SAXPY( M, -CS*SN*AQOAP, + CALL SAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) D( p ) = D( p ) / CS D( q ) = D( q )*CS IF( RSVEC ) THEN - CALL SAXPY( MVL, T*APOAQ, + CALL SAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL SAXPY( MVL, @@ -561,7 +572,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL SAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL SAXPY( M, CS*SN*APOAQ, + CALL SAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -602,15 +614,19 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * ELSE * .. have to use modified Gram-Schmidt like transformation - CALL SCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL SCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL SAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL SLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) @@ -624,7 +640,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SNRM2( M, A( 1, q ), 1 )* + SVA( q ) = SNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO @@ -725,12 +742,15 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, D( p ), + CALL SCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -742,12 +762,15 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL SCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -811,7 +834,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL SROTM( M, A( 1, p ), 1, + CALL SROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL SROTM( MVL, @@ -825,7 +849,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, -T*AQOAP, + CALL SAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL SAXPY( MVL, @@ -841,11 +866,13 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL SAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL SAXPY( M, -CS*SN*AQOAP, + CALL SAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, T*APOAQ, + CALL SAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL SAXPY( MVL, @@ -860,7 +887,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, CALL SAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL SAXPY( M, CS*SN*APOAQ, + CALL SAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -901,34 +929,42 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * ELSE IF( AAPP.GT.AAQQ ) THEN - CALL SCOPY( M, A( 1, p ), 1, WORK, + CALL SCOPY( M, A( 1, p ), 1, + $ WORK, $ 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL SAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAQQ, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) MXSINJ = MAX( MXSINJ, SFMIN ) ELSE - CALL SCOPY( M, A( 1, q ), 1, WORK, + CALL SCOPY( M, A( 1, q ), 1, + $ WORK, $ 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*D( q ) / D( p ) CALL SAXPY( M, TEMP1, WORK, 1, $ A( 1, p ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAPP, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -944,7 +980,8 @@ SUBROUTINE SGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SNRM2( M, A( 1, q ), 1 )* + SVA( q ) = SNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO diff --git a/SRC/sgsvj1.f b/SRC/sgsvj1.f index 2c39fc4563..a8503d734e 100644 --- a/SRC/sgsvj1.f +++ b/SRC/sgsvj1.f @@ -278,7 +278,8 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, EXTERNAL ISAMAX, LSAME, SDOT, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, SSWAP, + EXTERNAL SAXPY, SCOPY, SLASCL, SLASSQ, SROTM, + $ SSWAP, $ XERBLA * .. * .. Executable Statements .. @@ -424,12 +425,15 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ROTOK = ( SMALL*AAQQ ).LE.AAPP END IF IF( AAPP.LT.( BIG / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, p ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, D( p ), + CALL SCOPY( M, A( 1, p ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAPP, + $ D( p ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, q ), $ 1 )*D( q ) / AAQQ @@ -441,12 +445,15 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ROTOK = AAQQ.LE.( AAPP / SMALL ) END IF IF( AAPP.GT.( SMALL / AAQQ ) ) THEN - AAPQ = ( SDOT( M, A( 1, p ), 1, A( 1, + AAPQ = ( SDOT( M, A( 1, p ), 1, + $ A( 1, $ q ), 1 )*D( p )*D( q ) / AAQQ ) $ / AAPP ELSE - CALL SCOPY( M, A( 1, q ), 1, WORK, 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, D( q ), + CALL SCOPY( M, A( 1, q ), 1, WORK, + $ 1 ) + CALL SLASCL( 'G', 0, 0, AAQQ, + $ D( q ), $ M, 1, WORK, LDA, IERR ) AAPQ = SDOT( M, WORK, 1, A( 1, p ), $ 1 )*D( p ) / AAPP @@ -510,7 +517,8 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, FASTR( 4 ) = -T*AQOAP D( p ) = D( p )*CS D( q ) = D( q )*CS - CALL SROTM( M, A( 1, p ), 1, + CALL SROTM( M, A( 1, p ), + $ 1, $ A( 1, q ), 1, $ FASTR ) IF( RSVEC )CALL SROTM( MVL, @@ -524,7 +532,8 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ A( 1, p ), 1, $ A( 1, q ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, -T*AQOAP, + CALL SAXPY( MVL, + $ -T*AQOAP, $ V( 1, q ), 1, $ V( 1, p ), 1 ) CALL SAXPY( MVL, @@ -540,11 +549,13 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, CALL SAXPY( M, T*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) - CALL SAXPY( M, -CS*SN*AQOAP, + CALL SAXPY( M, + $ -CS*SN*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) IF( RSVEC ) THEN - CALL SAXPY( MVL, T*APOAQ, + CALL SAXPY( MVL, + $ T*APOAQ, $ V( 1, p ), 1, $ V( 1, q ), 1 ) CALL SAXPY( MVL, @@ -559,7 +570,8 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, CALL SAXPY( M, -T*AQOAP, $ A( 1, q ), 1, $ A( 1, p ), 1 ) - CALL SAXPY( M, CS*SN*APOAQ, + CALL SAXPY( M, + $ CS*SN*APOAQ, $ A( 1, p ), 1, $ A( 1, q ), 1 ) D( p ) = D( p )*CS @@ -600,34 +612,42 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ELSE IF( AAPP.GT.AAQQ ) THEN - CALL SCOPY( M, A( 1, p ), 1, WORK, + CALL SCOPY( M, A( 1, p ), 1, + $ WORK, $ 1 ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) TEMP1 = -AAPQ*D( p ) / D( q ) CALL SAXPY( M, TEMP1, WORK, 1, $ A( 1, q ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAQQ, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) MXSINJ = MAX( MXSINJ, SFMIN ) ELSE - CALL SCOPY( M, A( 1, q ), 1, WORK, + CALL SCOPY( M, A( 1, q ), 1, + $ WORK, $ 1 ) - CALL SLASCL( 'G', 0, 0, AAQQ, ONE, + CALL SLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK, LDA, IERR ) - CALL SLASCL( 'G', 0, 0, AAPP, ONE, + CALL SLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) TEMP1 = -AAPQ*D( q ) / D( p ) CALL SAXPY( M, TEMP1, WORK, 1, $ A( 1, p ), 1 ) - CALL SLASCL( 'G', 0, 0, ONE, AAPP, + CALL SLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -643,7 +663,8 @@ SUBROUTINE SGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = SNRM2( M, A( 1, q ), 1 )* + SVA( q ) = SNRM2( M, A( 1, q ), + $ 1 )* $ D( q ) ELSE T = ZERO diff --git a/SRC/sgtcon.f b/SRC/sgtcon.f index 28e0695fd7..969648e862 100644 --- a/SRC/sgtcon.f +++ b/SRC/sgtcon.f @@ -235,7 +235,8 @@ SUBROUTINE SGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, * * Multiply by inv(L**T)*inv(U**T). * - CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, WORK, + CALL SGTTRS( 'Transpose', N, 1, DL, D, DU, DU2, IPIV, + $ WORK, $ N, INFO ) END IF GO TO 20 diff --git a/SRC/sgtrfs.f b/SRC/sgtrfs.f index 42a5c26d9b..dc39771468 100644 --- a/SRC/sgtrfs.f +++ b/SRC/sgtrfs.f @@ -204,7 +204,8 @@ *> \ingroup gtrfs * * ===================================================================== - SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + $ DU2, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, $ INFO ) * @@ -245,7 +246,8 @@ SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGTTRS, SLACN2, SLAGTM, XERBLA + EXTERNAL SAXPY, SCOPY, SGTTRS, SLACN2, SLAGTM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -318,7 +320,8 @@ SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL SLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE, + CALL SLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, + $ ONE, $ WORK( N+1 ), N ) * * Compute abs(op(A))*abs(x) + abs(b) for use in the backward @@ -429,7 +432,8 @@ SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * KASE = 0 70 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/sgtsvx.f b/SRC/sgtsvx.f index 88c3995723..84c797b620 100644 --- a/SRC/sgtsvx.f +++ b/SRC/sgtsvx.f @@ -288,7 +288,8 @@ *> \ingroup gtsvx * * ===================================================================== - SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, + $ DUF, $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -325,7 +326,8 @@ SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, EXTERNAL LSAME, SLAMCH, SLANGT * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGTCON, SGTRFS, SGTTRF, SGTTRS, SLACPY, + EXTERNAL SCOPY, SGTCON, SGTRFS, SGTTRF, SGTTRS, + $ SLACPY, $ XERBLA * .. * .. Intrinsic Functions .. @@ -385,7 +387,8 @@ SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * * Compute the reciprocal of the condition number of A. * - CALL SGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK, + CALL SGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, + $ WORK, $ IWORK, INFO ) * * Compute the solution vectors X. @@ -397,7 +400,8 @@ SUBROUTINE SGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, + CALL SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/sgttrs.f b/SRC/sgttrs.f index b940e5efe2..35cd0c21de 100644 --- a/SRC/sgttrs.f +++ b/SRC/sgttrs.f @@ -134,7 +134,8 @@ *> \ingroup gttrs * * ===================================================================== - SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, + SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -211,7 +212,8 @@ SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, ELSE DO 10 J = 1, NRHS, NB JB = MIN( NRHS-J+1, NB ) - CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), + CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, + $ J ), $ LDB ) 10 CONTINUE END IF diff --git a/SRC/sgtts2.f b/SRC/sgtts2.f index 3640794700..b8fc5da9a0 100644 --- a/SRC/sgtts2.f +++ b/SRC/sgtts2.f @@ -125,7 +125,8 @@ *> \ingroup gtts2 * * ===================================================================== - SUBROUTINE SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) + SUBROUTINE SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/shgeqz.f b/SRC/shgeqz.f index 8b8ac80f0c..d6d9e818f7 100644 --- a/SRC/shgeqz.f +++ b/SRC/shgeqz.f @@ -299,7 +299,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, + SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, + $ LDT, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * @@ -352,7 +353,8 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLAG2, SLARFG, SLARTG, SLASET, SLASV2, SROT, + EXTERNAL SLAG2, SLARFG, SLARTG, SLASET, SLASV2, + $ SROT, $ XERBLA * .. * .. Intrinsic Functions .. @@ -599,7 +601,8 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL SROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT, $ T( JCH+1, JCH+1 ), LDT, C, S ) IF( ILQ ) - $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, S ) IF( ILAZR2 ) $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C @@ -626,12 +629,14 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( JCH, JCH+1 ) ) T( JCH+1, JCH+1 ) = ZERO IF( JCH.LT.ILASTM-1 ) - $ CALL SROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT, + $ CALL SROT( ILASTM-JCH-1, T( JCH, JCH+2 ), + $ LDT, $ T( JCH+1, JCH+2 ), LDT, C, S ) CALL SROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH, $ H( JCH+1, JCH-1 ), LDH, C, S ) IF( ILQ ) - $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL SROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, S ) TEMP = H( JCH+1, JCH ) CALL SLARTG( TEMP, H( JCH+1, JCH-1 ), C, S, @@ -642,7 +647,8 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL SROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1, $ T( IFRSTM, JCH-1 ), 1, C, S ) IF( ILZ ) - $ CALL SROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1, + $ CALL SROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), + $ 1, $ C, S ) 50 CONTINUE GO TO 70 @@ -677,7 +683,8 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL SROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1, $ T( IFRSTM, ILAST-1 ), 1, C, S ) IF( ILZ ) - $ CALL SROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S ) + $ CALL SROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, + $ S ) * * H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHAR, ALPHAI, * and BETA @@ -909,10 +916,12 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( IFRSTM, ILAST ), 1, CR, SR ) * IF( ILQ ) - $ CALL SROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, CL, + $ CALL SROT( N, Q( 1, ILAST-1 ), 1, Q( 1, ILAST ), 1, + $ CL, $ SL ) IF( ILZ ) - $ CALL SROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, CR, + $ CALL SROT( N, Z( 1, ILAST-1 ), 1, Z( 1, ILAST ), 1, + $ CR, $ SR ) * T( ILAST-1, ILAST-1 ) = B11 diff --git a/SRC/shsein.f b/SRC/shsein.f index db4ccdc3fc..6850adbd42 100644 --- a/SRC/shsein.f +++ b/SRC/shsein.f @@ -258,7 +258,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, + SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, + $ WI, $ VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, $ IFAILR, INFO ) * @@ -458,7 +459,8 @@ SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, * * Compute left eigenvector. * - CALL SLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH, + CALL SLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), + $ LDH, $ WKR, WKI, VL( KL, KSR ), VL( KL, KSI ), $ WORK, LDWORK, WORK( N*N+N+1 ), EPS3, SMLNUM, $ BIGNUM, IINFO ) diff --git a/SRC/shseqr.f b/SRC/shseqr.f index 99752b7a5a..6c5209f633 100644 --- a/SRC/shseqr.f +++ b/SRC/shseqr.f @@ -363,7 +363,8 @@ SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLAHQR, SLAQR0, SLASET, XERBLA + EXTERNAL SLACPY, SLAHQR, SLAQR0, SLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, REAL @@ -456,13 +457,15 @@ SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * ==== SLAQR0 for big matrices; SLAHQR for small ones ==== * IF( N.GT.NMIN ) THEN - CALL SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO, + CALL SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, + $ ILO, $ IHI, Z, LDZ, WORK, LWORK, INFO ) ELSE * * ==== Small matrix ==== * - CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILO, + CALL SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, + $ ILO, $ IHI, Z, LDZ, INFO ) * IF( INFO.GT.0 ) THEN @@ -477,7 +480,8 @@ SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * ==== Larger matrices have enough subdiagonal scratch * . space to call SLAQR0 directly. ==== * - CALL SLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, WR, + CALL SLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, + $ WR, $ WI, ILO, IHI, Z, LDZ, WORK, LWORK, INFO ) * ELSE @@ -489,9 +493,11 @@ SUBROUTINE SHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, * CALL SLACPY( 'A', N, N, H, LDH, HL, NL ) HL( N+1, N ) = ZERO - CALL SLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ), + CALL SLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, + $ N+1 ), $ NL ) - CALL SLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, WR, + CALL SLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, + $ WR, $ WI, ILO, IHI, Z, LDZ, WORKL, NL, INFO ) IF( WANTT .OR. INFO.NE.0 ) $ CALL SLACPY( 'A', N, N, HL, NL, H, LDH ) diff --git a/SRC/sla_gbrcond.f b/SRC/sla_gbrcond.f index b33c81b787..68a4a14d73 100644 --- a/SRC/sla_gbrcond.f +++ b/SRC/sla_gbrcond.f @@ -164,7 +164,8 @@ *> \ingroup la_gbrcond * * ===================================================================== - REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, + REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, + $ LDAFB, $ IPIV, CMODE, C, INFO, WORK, IWORK ) * * -- LAPACK computational routine -- @@ -293,7 +294,8 @@ REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, CALL SGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, $ IPIV, WORK, N, INFO ) ELSE - CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV, + CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, + $ IPIV, $ WORK, N, INFO ) END IF * @@ -323,7 +325,8 @@ REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB, END IF IF ( NOTRANS ) THEN - CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, IPIV, + CALL SGBTRS( 'Transpose', N, KL, KU, 1, AFB, LDAFB, + $ IPIV, $ WORK, N, INFO ) ELSE CALL SGBTRS( 'No transpose', N, KL, KU, 1, AFB, LDAFB, diff --git a/SRC/sla_gbrfsx_extended.f b/SRC/sla_gbrfsx_extended.f index 36f9e28080..0c4aca6e62 100644 --- a/SRC/sla_gbrfsx_extended.f +++ b/SRC/sla_gbrfsx_extended.f @@ -401,7 +401,8 @@ *> \ingroup la_gbrfsx_extended * * ===================================================================== - SUBROUTINE SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + SUBROUTINE SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, $ COLEQU, C, B, LDB, Y, LDY, $ BERR_OUT, N_NORMS, ERR_BNDS_NORM, @@ -466,7 +467,8 @@ SUBROUTINE SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGBTRS, SGBMV, BLAS_SGBMV_X, + EXTERNAL SAXPY, SCOPY, SGBTRS, SGBMV, + $ BLAS_SGBMV_X, $ BLAS_SGBMV2_X, SLA_GBAMV, SLA_WWADDW, SLAMCH, $ CHLA_TRANSTYPE, SLA_LIN_BERR REAL SLAMCH @@ -531,7 +533,8 @@ SUBROUTINE SLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, ! XXX: RES is no longer needed. CALL SCOPY( N, RES, 1, DY, 1 ) - CALL SGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, N, + CALL SGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, + $ N, $ INFO ) * * Calculate relative changes DX_X, DZ_Z and ratios DXRAT, DZRAT. diff --git a/SRC/sla_geamv.f b/SRC/sla_geamv.f index 44308b9fc9..e536148e62 100644 --- a/SRC/sla_geamv.f +++ b/SRC/sla_geamv.f @@ -172,7 +172,8 @@ *> \ingroup la_geamv * * ===================================================================== - SUBROUTINE SLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, + SUBROUTINE SLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, + $ BETA, $ Y, INCY ) * * -- LAPACK computational routine -- diff --git a/SRC/sla_gerfsx_extended.f b/SRC/sla_gerfsx_extended.f index 61019af521..5d2b19dce6 100644 --- a/SRC/sla_gerfsx_extended.f +++ b/SRC/sla_gerfsx_extended.f @@ -389,7 +389,8 @@ *> \ingroup la_gerfsx_extended * * ===================================================================== - SUBROUTINE SLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, + SUBROUTINE SLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, + $ A, $ LDA, AF, LDAF, IPIV, COLEQU, C, B, $ LDB, Y, LDY, BERR_OUT, N_NORMS, $ ERRS_N, ERRS_C, RES, @@ -454,7 +455,8 @@ SUBROUTINE SLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGETRS, SGEMV, BLAS_SGEMV_X, + EXTERNAL SAXPY, SCOPY, SGETRS, SGEMV, + $ BLAS_SGEMV_X, $ BLAS_SGEMV2_X, SLA_GEAMV, SLA_WWADDW, SLAMCH, $ CHLA_TRANSTYPE, SLA_LIN_BERR REAL SLAMCH @@ -666,7 +668,8 @@ SUBROUTINE SLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, * op(A) = A, A**T, or A**H depending on TRANS (and type). * CALL SCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL SGEMV( TRANS, N, N, -1.0, A, LDA, Y(1,J), 1, 1.0, RES, 1 ) + CALL SGEMV( TRANS, N, N, -1.0, A, LDA, Y(1,J), 1, 1.0, RES, + $ 1 ) DO I = 1, N AYB( I ) = ABS( B( I, J ) ) diff --git a/SRC/sla_porfsx_extended.f b/SRC/sla_porfsx_extended.f index 5f1bdfd6f5..ee4d819baf 100644 --- a/SRC/sla_porfsx_extended.f +++ b/SRC/sla_porfsx_extended.f @@ -378,7 +378,8 @@ *> \ingroup la_porfsx_extended * * ===================================================================== - SUBROUTINE SLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE SLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, COLEQU, C, B, LDB, Y, $ LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -447,7 +448,8 @@ SUBROUTINE SLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SPOTRS, SSYMV, BLAS_SSYMV_X, + EXTERNAL SAXPY, SCOPY, SPOTRS, SSYMV, + $ BLAS_SSYMV_X, $ BLAS_SSYMV2_X, SLA_SYAMV, SLA_WWADDW, $ SLA_LIN_BERR REAL SLAMCH diff --git a/SRC/sla_porpvgrw.f b/SRC/sla_porpvgrw.f index a82fd68da6..c91ced2bf4 100644 --- a/SRC/sla_porpvgrw.f +++ b/SRC/sla_porpvgrw.f @@ -101,7 +101,8 @@ *> \ingroup la_porpvgrw * * ===================================================================== - REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK ) + REAL FUNCTION SLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/sla_syrcond.f b/SRC/sla_syrcond.f index e3222b6610..64e3dacdb1 100644 --- a/SRC/sla_syrcond.f +++ b/SRC/sla_syrcond.f @@ -142,7 +142,8 @@ *> \ingroup la_hercond * * ===================================================================== - REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, + REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, + $ CMODE, $ C, INFO, WORK, IWORK ) * * -- LAPACK computational routine -- @@ -281,9 +282,11 @@ REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, END DO IF ( UP ) THEN - CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ELSE - CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ENDIF * * Multiply by inv(C). @@ -312,9 +315,11 @@ REAL FUNCTION SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, END IF IF ( UP ) THEN - CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL SSYTRS( 'U', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ELSE - CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL SSYTRS( 'L', N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) ENDIF * * Multiply by R. diff --git a/SRC/sla_syrfsx_extended.f b/SRC/sla_syrfsx_extended.f index 2a357171cc..9f7e517dc6 100644 --- a/SRC/sla_syrfsx_extended.f +++ b/SRC/sla_syrfsx_extended.f @@ -387,7 +387,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE SLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE SLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -457,7 +458,8 @@ SUBROUTINE SLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SSYTRS, SSYMV, BLAS_SSYMV_X, + EXTERNAL SAXPY, SCOPY, SSYTRS, SSYMV, + $ BLAS_SSYMV_X, $ BLAS_SSYMV2_X, SLA_SYAMV, SLA_WWADDW, $ SLA_LIN_BERR REAL SLAMCH diff --git a/SRC/sla_syrpvgrw.f b/SRC/sla_syrpvgrw.f index 086eb3d0c8..32b7b2a54e 100644 --- a/SRC/sla_syrpvgrw.f +++ b/SRC/sla_syrpvgrw.f @@ -118,7 +118,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - REAL FUNCTION SLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, + REAL FUNCTION SLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ IPIV, $ WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/slabrd.f b/SRC/slabrd.f index b21f77823d..f4c1d4440c 100644 --- a/SRC/slabrd.f +++ b/SRC/slabrd.f @@ -206,7 +206,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, + SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, + $ Y, $ LDY ) * * -- LAPACK auxiliary routine -- @@ -268,11 +269,14 @@ SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL SGEMV( 'Transpose', M-I+1, N-I, ONE, A( I, I+1 ), $ LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), LDA, + CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, A( I, 1 ), + $ LDA, $ A( I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), LDX, + CALL SGEMV( 'Transpose', M-I+1, I-1, ONE, X( I, 1 ), + $ LDX, $ A( I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL SGEMV( 'Transpose', I-1, N-I, -ONE, A( 1, I+1 ), $ LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) @@ -294,15 +298,19 @@ SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL SGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ), + CALL SGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), LDY, + CALL SGEMV( 'Transpose', N-I, I, ONE, Y( I+1, 1 ), + $ LDY, $ A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) CALL SGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) - CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL SSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) END IF @@ -317,12 +325,14 @@ SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL SGEMV( 'No transpose', N-I+1, I-1, -ONE, Y( I, 1 ), $ LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA ) - CALL SGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), LDA, + CALL SGEMV( 'Transpose', I-1, N-I+1, -ONE, A( 1, I ), + $ LDA, $ X( I, 1 ), LDX, ONE, A( I, I ), LDA ) * * Generate reflection P(i) to annihilate A(i,i+1:n) * - CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, + CALL SLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), + $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) IF( I.LT.M ) THEN @@ -330,28 +340,35 @@ SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL SGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ), + CALL SGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), LDY, + CALL SGEMV( 'Transpose', N-I+1, I-1, ONE, Y( I, 1 ), + $ LDY, $ A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL SGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ), + CALL SGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL SGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL SSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) * * Update A(i+1:m,i) * - CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL SGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 ) CALL SGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ), $ LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 ) * * Generate reflection Q(i) to annihilate A(i+2:m,i) * - CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1, + CALL SLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), + $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE @@ -360,13 +377,17 @@ SUBROUTINE SLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * CALL SGEMV( 'Transpose', M-I, N-I, ONE, A( I+1, I+1 ), $ LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL SGEMV( 'Transpose', M-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL SGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), LDX, + CALL SGEMV( 'Transpose', M-I, I, ONE, X( I+1, 1 ), + $ LDX, $ A( I+1, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL SGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), LDA, + CALL SGEMV( 'Transpose', I, N-I, -ONE, A( 1, I+1 ), + $ LDA, $ Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL SSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 ) END IF diff --git a/SRC/slaed0.f b/SRC/slaed0.f index 1a18b47be4..52b28e8b1f 100644 --- a/SRC/slaed0.f +++ b/SRC/slaed0.f @@ -198,7 +198,8 @@ SUBROUTINE SLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, REAL TEMP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SLACPY, SLAED1, SLAED7, SSTEQR, + EXTERNAL SCOPY, SGEMM, SLACPY, SLAED1, SLAED7, + $ SSTEQR, $ XERBLA * .. * .. External Functions .. @@ -374,7 +375,8 @@ SUBROUTINE SLAED0( ICOMPQ, QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, $ E( SUBMAT+MSD2-1 ), MSD2, WORK, $ IWORK( SUBPBS+1 ), INFO ) ELSE - CALL SLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, CURPRB, + CALL SLAED7( ICOMPQ, MATSIZ, QSIZ, TLVLS, CURLVL, + $ CURPRB, $ D( SUBMAT ), QSTORE( 1, SUBMAT ), LDQS, $ IWORK( INDXQ+SUBMAT ), E( SUBMAT+MSD2-1 ), $ MSD2, WORK( IQ ), IWORK( IQPTR ), diff --git a/SRC/slaed1.f b/SRC/slaed1.f index 4e1e4d1035..f2175afbc5 100644 --- a/SRC/slaed1.f +++ b/SRC/slaed1.f @@ -159,7 +159,8 @@ *> Modified by Francoise Tisseur, University of Tennessee *> * ===================================================================== - SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, + SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, + $ IWORK, $ INFO ) * * -- LAPACK computational routine -- @@ -182,7 +183,8 @@ SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ IQ2, IS, IW, IZ, K, N1, N2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAED2, SLAED3, SLAMRG, XERBLA + EXTERNAL SCOPY, SLAED2, SLAED3, SLAMRG, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -230,7 +232,8 @@ SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, * CALL SCOPY( CUTPNT, Q( CUTPNT, 1 ), LDQ, WORK( IZ ), 1 ) CPP1 = CUTPNT + 1 - CALL SCOPY( N-CUTPNT, Q( CPP1, CPP1 ), LDQ, WORK( IZ+CUTPNT ), 1 ) + CALL SCOPY( N-CUTPNT, Q( CPP1, CPP1 ), LDQ, WORK( IZ+CUTPNT ), + $ 1 ) * * Deflate eigenvalues. * diff --git a/SRC/slaed2.f b/SRC/slaed2.f index c01fb17a39..59c856435c 100644 --- a/SRC/slaed2.f +++ b/SRC/slaed2.f @@ -208,7 +208,8 @@ *> Modified by Francoise Tisseur, University of Tennessee *> * ===================================================================== - SUBROUTINE SLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, W, + SUBROUTINE SLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, + $ W, $ Q2, INDX, INDXC, INDXP, COLTYP, INFO ) * * -- LAPACK computational routine -- @@ -247,7 +248,8 @@ SUBROUTINE SLAED2( K, N, N1, D, Q, LDQ, INDXQ, RHO, Z, DLAMBDA, W, EXTERNAL ISAMAX, SLAMCH, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, XERBLA + EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT diff --git a/SRC/slaed3.f b/SRC/slaed3.f index 3332a923e5..86a986c797 100644 --- a/SRC/slaed3.f +++ b/SRC/slaed3.f @@ -205,7 +205,8 @@ SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, EXTERNAL SNRM2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SLACPY, SLAED4, SLASET, XERBLA + EXTERNAL SCOPY, SGEMM, SLACPY, SLAED4, SLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, SIGN, SQRT @@ -234,7 +235,8 @@ SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, $ RETURN * DO 20 J = 1, K - CALL SLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), INFO ) + CALL SLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), + $ INFO ) * * If the zero finder fails, the computation is terminated. * @@ -299,7 +301,8 @@ SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, CALL SLACPY( 'A', N23, K, Q( CTOT( 1 )+1, 1 ), LDQ, S, N23 ) IQ2 = N1*N12 + 1 IF( N23.NE.0 ) THEN - CALL SGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, N23, + CALL SGEMM( 'N', 'N', N2, K, N23, ONE, Q2( IQ2 ), N2, S, + $ N23, $ ZERO, Q( N1+1, 1 ), LDQ ) ELSE CALL SLASET( 'A', N2, K, ZERO, ZERO, Q( N1+1, 1 ), LDQ ) @@ -307,7 +310,8 @@ SUBROUTINE SLAED3( K, N, N1, D, Q, LDQ, RHO, DLAMBDA, Q2, INDX, * CALL SLACPY( 'A', N12, K, Q, LDQ, S, N12 ) IF( N12.NE.0 ) THEN - CALL SGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, Q, + CALL SGEMM( 'N', 'N', N1, K, N12, ONE, Q2, N1, S, N12, ZERO, + $ Q, $ LDQ ) ELSE CALL SLASET( 'A', N1, K, ZERO, ZERO, Q( 1, 1 ), LDQ ) diff --git a/SRC/slaed4.f b/SRC/slaed4.f index b4884ab5db..2310dc079a 100644 --- a/SRC/slaed4.f +++ b/SRC/slaed4.f @@ -833,7 +833,8 @@ SUBROUTINE SLAED4( N, I, D, Z, DELTA, RHO, DLAM, INFO ) ZZ( 3 ) = Z( IIP1 )*Z( IIP1 ) END IF END IF - CALL SLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, ETA, + CALL SLAED6( NITER, ORGATI, C, DELTA( IIM1 ), ZZ, W, + $ ETA, $ INFO ) IF( INFO.NE.0 ) $ GO TO 250 diff --git a/SRC/slaed6.f b/SRC/slaed6.f index 889c83d4fa..d4e9640921 100644 --- a/SRC/slaed6.f +++ b/SRC/slaed6.f @@ -137,7 +137,8 @@ *> at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO ) + SUBROUTINE SLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/slaed7.f b/SRC/slaed7.f index a68d6cf3e5..5e7eaecdbc 100644 --- a/SRC/slaed7.f +++ b/SRC/slaed7.f @@ -254,7 +254,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, + $ Q, $ LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR, $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) @@ -286,7 +287,8 @@ SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, $ IQ2, IS, IW, IZ, K, LDQ2, N1, N2, PTR * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLAED8, SLAED9, SLAEDA, SLAMRG, XERBLA + EXTERNAL SGEMM, SLAED8, SLAED9, SLAEDA, SLAMRG, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -375,7 +377,8 @@ SUBROUTINE SLAED7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, * Solve Secular Equation. * IF( K.NE.0 ) THEN - CALL SLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, WORK( IDLMDA ), + CALL SLAED9( K, 1, K, N, D, WORK( IS ), K, RHO, + $ WORK( IDLMDA ), $ WORK( IW ), QSTORE( QPTR( CURR ) ), K, INFO ) IF( INFO.NE.0 ) $ GO TO 30 diff --git a/SRC/slaed8.f b/SRC/slaed8.f index 5bd0e1ae47..84d07d3688 100644 --- a/SRC/slaed8.f +++ b/SRC/slaed8.f @@ -276,7 +276,8 @@ SUBROUTINE SLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, EXTERNAL ISAMAX, SLAMCH, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, XERBLA + EXTERNAL SCOPY, SLACPY, SLAMRG, SROT, SSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -371,7 +372,8 @@ SUBROUTINE SLAED8( ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, ELSE DO 60 J = 1, N PERM( J ) = INDXQ( INDX( J ) ) - CALL SCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) + CALL SCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), + $ 1 ) 60 CONTINUE CALL SLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), $ LDQ ) diff --git a/SRC/slaed9.f b/SRC/slaed9.f index 260a3cd32b..3af1fb9c20 100644 --- a/SRC/slaed9.f +++ b/SRC/slaed9.f @@ -152,7 +152,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE SLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMBDA, + SUBROUTINE SLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, + $ DLAMBDA, $ W, S, LDS, INFO ) * * -- LAPACK computational routine -- @@ -215,7 +216,8 @@ SUBROUTINE SLAED9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMBDA, $ RETURN * DO 20 J = KSTART, KSTOP - CALL SLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), INFO ) + CALL SLAED4( K, J, DLAMBDA, W, Q( 1, J ), RHO, D( J ), + $ INFO ) * * If the zero finder fails, the computation is terminated. * diff --git a/SRC/slaeda.f b/SRC/slaeda.f index df6cc6beeb..56fbe09868 100644 --- a/SRC/slaeda.f +++ b/SRC/slaeda.f @@ -162,7 +162,8 @@ *> at Berkeley, USA * * ===================================================================== - SUBROUTINE SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, + SUBROUTINE SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, + $ GIVPTR, $ GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO ) * * -- LAPACK computational routine -- @@ -287,7 +288,8 @@ SUBROUTINE SLAEDA( N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, CALL SGEMV( 'T', BSIZ1, BSIZ1, ONE, Q( QPTR( CURR ) ), $ BSIZ1, ZTEMP( 1 ), 1, ZERO, Z( ZPTR1 ), 1 ) END IF - CALL SCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, Z( ZPTR1+BSIZ1 ), + CALL SCOPY( PSIZ1-BSIZ1, ZTEMP( BSIZ1+1 ), 1, + $ Z( ZPTR1+BSIZ1 ), $ 1 ) IF( BSIZ2.GT.0 ) THEN CALL SGEMV( 'T', BSIZ2, BSIZ2, ONE, Q( QPTR( CURR+1 ) ), diff --git a/SRC/slaein.f b/SRC/slaein.f index c44a104335..792b84d6b5 100644 --- a/SRC/slaein.f +++ b/SRC/slaein.f @@ -168,7 +168,8 @@ *> \ingroup laein * * ===================================================================== - SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, + SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, + $ B, $ LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO ) * * -- LAPACK auxiliary routine -- @@ -333,7 +334,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, * or U**T*x = scale*v for a left eigenvector, * overwriting x on v. * - CALL SLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, + CALL SLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, + $ LDB, $ VR, SCALE, WORK, IERR ) NORMIN = 'Y' * @@ -570,7 +572,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, * * Divide by diagonal element of B. * - CALL SLADIV( XR, XI, B( I, I ), B( I+1, I ), VR( I ), + CALL SLADIV( XR, XI, B( I, I ), B( I+1, I ), + $ VR( I ), $ VI( I ) ) VMAX = MAX( ABS( VR( I ) )+ABS( VI( I ) ), VMAX ) VCRIT = BIGNUM / VMAX diff --git a/SRC/slaexc.f b/SRC/slaexc.f index f0d85c948f..bb24e8bf07 100644 --- a/SRC/slaexc.f +++ b/SRC/slaexc.f @@ -174,7 +174,8 @@ SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLANV2, SLARFG, SLARFX, SLARTG, SLASY2, + EXTERNAL SLACPY, SLANV2, SLARFG, SLARFX, SLARTG, + $ SLASY2, $ SROT * .. * .. Intrinsic Functions .. @@ -209,7 +210,8 @@ SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * Apply transformation to the matrix T. * IF( J3.LE.N ) - $ CALL SROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, CS, + $ CALL SROT( N-J1-1, T( J1, J3 ), LDT, T( J2, J3 ), LDT, + $ CS, $ SN ) CALL SROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN ) * @@ -277,7 +279,8 @@ SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * * Accept swap: apply transformation to the entire matrix T. * - CALL SLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, WORK ) + CALL SLARFX( 'L', 3, N-J1+1, U, TAU, T( J1, J1 ), LDT, + $ WORK ) CALL SLARFX( 'R', J2, 3, U, TAU, T( 1, J1 ), LDT, WORK ) * T( J3, J1 ) = ZERO @@ -371,9 +374,11 @@ SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * * Accept swap: apply transformation to the entire matrix T. * - CALL SLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, WORK ) + CALL SLARFX( 'L', 3, N-J1+1, U1, TAU1, T( J1, J1 ), LDT, + $ WORK ) CALL SLARFX( 'R', J4, 3, U1, TAU1, T( 1, J1 ), LDT, WORK ) - CALL SLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, WORK ) + CALL SLARFX( 'L', 3, N-J1+1, U2, TAU2, T( J2, J1 ), LDT, + $ WORK ) CALL SLARFX( 'R', J4, 3, U2, TAU2, T( 1, J2 ), LDT, WORK ) * T( J3, J1 ) = ZERO @@ -397,7 +402,8 @@ SUBROUTINE SLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, * CALL SLANV2( T( J1, J1 ), T( J1, J2 ), T( J2, J1 ), $ T( J2, J2 ), WR1, WI1, WR2, WI2, CS, SN ) - CALL SROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), LDT, + CALL SROT( N-J1-1, T( J1, J1+2 ), LDT, T( J2, J1+2 ), + $ LDT, $ CS, SN ) CALL SROT( J1-1, T( 1, J1 ), 1, T( 1, J2 ), 1, CS, SN ) IF( WANTQ ) diff --git a/SRC/slags2.f b/SRC/slags2.f index c80af499ef..f7512245f8 100644 --- a/SRC/slags2.f +++ b/SRC/slags2.f @@ -148,7 +148,8 @@ *> \ingroup lags2 * * ===================================================================== - SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, + SUBROUTINE SLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, + $ CSV, $ SNV, CSQ, SNQ ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/slagtm.f b/SRC/slagtm.f index 2eaf8e57fe..226c5546b7 100644 --- a/SRC/slagtm.f +++ b/SRC/slagtm.f @@ -141,7 +141,8 @@ *> \ingroup lagtm * * ===================================================================== - SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, + SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, + $ BETA, $ B, LDB ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/slagv2.f b/SRC/slagv2.f index 0f067cbdf7..c6b51a3f45 100644 --- a/SRC/slagv2.f +++ b/SRC/slagv2.f @@ -153,7 +153,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL, + SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, + $ SNL, $ CSR, SNR ) * * -- LAPACK auxiliary routine -- @@ -254,7 +255,8 @@ SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL, * * B is nonsingular, first compute the eigenvalues of (A,B) * - CALL SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2, + CALL SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, + $ WR2, $ WI ) * IF( WI.EQ.ZERO ) THEN diff --git a/SRC/slahqr.f b/SRC/slahqr.f index 5f25218748..d604eeb427 100644 --- a/SRC/slahqr.f +++ b/SRC/slahqr.f @@ -596,13 +596,15 @@ SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, IF( I2.GT.I ) $ CALL SROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH, $ CS, SN ) - CALL SROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN ) + CALL SROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, + $ SN ) END IF IF( WANTZ ) THEN * * Apply the transformation to Z. * - CALL SROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN ) + CALL SROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, + $ SN ) END IF END IF * reset deflation counter diff --git a/SRC/slahr2.f b/SRC/slahr2.f index 87764409b2..1c01bd04d7 100644 --- a/SRC/slahr2.f +++ b/SRC/slahr2.f @@ -224,7 +224,8 @@ SUBROUTINE SLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Update I-th column of A - Y * V**T * - CALL SGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY, + CALL SGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), + $ LDY, $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 ) * * Apply I - V * T**T * V**T to this column (call it b) from the @@ -273,7 +274,8 @@ SUBROUTINE SLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(I) to annihilate * A(K+I+1:N,I) * - CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, + CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, $ TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE diff --git a/SRC/slals0.f b/SRC/slals0.f index b0b1995605..f44026ca70 100644 --- a/SRC/slals0.f +++ b/SRC/slals0.f @@ -263,7 +263,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, + SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, + $ LDBX, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO ) * @@ -294,7 +295,8 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SROT, SSCAL, + EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SROT, + $ SSCAL, $ XERBLA * .. * .. External Functions .. @@ -358,7 +360,8 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * CALL SCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX ) DO 20 I = 2, N - CALL SCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX ) + CALL SCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), + $ LDBX ) 20 CONTINUE * * Step (3L): apply the inverse of the left singular vector @@ -412,7 +415,8 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, 40 CONTINUE WORK( 1 ) = NEGONE TEMP = SNRM2( K, WORK, 1 ) - CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO, + CALL SGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, + $ ZERO, $ B( J, 1 ), LDB ) CALL SLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ), $ LDB, INFO ) @@ -451,7 +455,8 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * parentheses (x+y)+z. The goal is to prevent * optimizing compilers from doing x+(y+z). * - WORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, -POLES( I+1, + WORK( I ) = Z( J ) / ( SLAMC3( DSIGJ, + $ -POLES( I+1, $ 2 ) )-DIFR( I, 1 ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -475,10 +480,12 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * IF( SQRE.EQ.1 ) THEN CALL SCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX ) - CALL SROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S ) + CALL SROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, + $ S ) END IF IF( K.LT.MAX( M, N ) ) - $ CALL SLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ), + $ CALL SLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, + $ 1 ), $ LDBX ) * * Step (3R): permute rows of B. @@ -488,7 +495,8 @@ SUBROUTINE SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, CALL SCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB ) END IF DO 90 I = 2, N - CALL SCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB ) + CALL SCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), + $ LDB ) 90 CONTINUE * * Step (4R): apply back the Givens rotations performed. diff --git a/SRC/slalsa.f b/SRC/slalsa.f index fe1215a420..5e2db8e343 100644 --- a/SRC/slalsa.f +++ b/SRC/slalsa.f @@ -261,7 +261,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, + SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, + $ U, $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, $ IWORK, INFO ) @@ -296,7 +297,8 @@ SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, $ NR, NRF, NRP1, SQRE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SLALS0, SLASDT, XERBLA + EXTERNAL SCOPY, SGEMM, SLALS0, SLASDT, + $ XERBLA * .. * .. Executable Statements .. * @@ -403,7 +405,8 @@ SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, NLF = IC - NL NRF = IC + 1 J = J - 1 - CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX, + CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), + $ LDBX, $ B( NLF, 1 ), LDB, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -448,7 +451,8 @@ SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, SQRE = 1 END IF J = J + 1 - CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB, + CALL SLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), + $ LDB, $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -476,9 +480,11 @@ SUBROUTINE SLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, END IF NLF = IC - NL NRF = IC + 1 - CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ B( NLF, 1 ), LDB, ZERO, BX( NLF, 1 ), LDBX ) - CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL SGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ B( NRF, 1 ), LDB, ZERO, BX( NRF, 1 ), LDBX ) 80 CONTINUE * diff --git a/SRC/slalsd.f b/SRC/slalsd.f index 2a2336a323..ec92fe9a22 100644 --- a/SRC/slalsd.f +++ b/SRC/slalsd.f @@ -205,7 +205,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, EXTERNAL ISAMAX, SLAMCH, SLANST * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SLACPY, SLALSA, SLARTG, SLASCL, + EXTERNAL SCOPY, SGEMM, SLACPY, SLALSA, SLARTG, + $ SLASCL, $ SLASDA, SLASDQ, SLASET, SLASRT, SROT, XERBLA * .. * .. Intrinsic Functions .. @@ -250,7 +251,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, B, LDB ) ELSE RANK = 1 - CALL SLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, + $ INFO ) D( 1 ) = ABS( D( 1 ) ) END IF RETURN @@ -276,7 +278,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, DO 20 J = 1, N - 1 CS = WORK( J*2-1 ) SN = WORK( J*2 ) - CALL SROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN ) + CALL SROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, + $ SN ) 20 CONTINUE 30 CONTINUE END IF @@ -300,7 +303,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, IF( N.LE.SMLSIZ ) THEN NWORK = 1 + N*N CALL SLASET( 'A', N, N, ZERO, ONE, WORK, N ) - CALL SLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, B, + CALL SLASDQ( 'U', 0, N, N, 0, NRHS, D, E, WORK, N, WORK, N, + $ B, $ LDB, WORK( NWORK ), INFO ) IF( INFO.NE.0 ) THEN RETURN @@ -308,14 +312,17 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, TOL = RCND*ABS( D( ISAMAX( N, D, 1 ) ) ) DO 40 I = 1, N IF( D( I ).LE.TOL ) THEN - CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), LDB ) + CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, B( I, 1 ), + $ LDB ) ELSE - CALL SLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ), + CALL SLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, + $ 1 ), $ LDB, INFO ) RANK = RANK + 1 END IF 40 CONTINUE - CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, ZERO, + CALL SGEMM( 'T', 'N', N, NRHS, N, ONE, WORK, N, B, LDB, + $ ZERO, $ WORK( NWORK ), N ) CALL SLACPY( 'A', N, NRHS, WORK( NWORK ), N, B, LDB ) * @@ -463,7 +470,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * subproblems were not solved explicitly. * IF( ABS( D( I ) ).LE.TOL ) THEN - CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), N ) + CALL SLASET( 'A', 1, NRHS, ZERO, ZERO, WORK( BX+I-1 ), + $ N ) ELSE RANK = RANK + 1 CALL SLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, @@ -487,7 +495,8 @@ SUBROUTINE SLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, $ WORK( VT+ST1 ), N, WORK( BXST ), N, ZERO, $ B( ST, 1 ), LDB ) ELSE - CALL SLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N, + CALL SLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), + $ N, $ B( ST, 1 ), LDB, WORK( U+ST1 ), N, $ WORK( VT+ST1 ), IWORK( K+ST1 ), $ WORK( DIFL+ST1 ), WORK( DIFR+ST1 ), diff --git a/SRC/slangb.f b/SRC/slangb.f index 2508e176ba..3f3df3f0a0 100644 --- a/SRC/slangb.f +++ b/SRC/slangb.f @@ -201,7 +201,8 @@ REAL FUNCTION SLANGB( NORM, N, KL, KU, AB, LDAB, TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -210,7 +211,8 @@ REAL FUNCTION SLANGB( NORM, N, KL, KU, AB, LDAB, DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, + $ SUM ) 90 CONTINUE VALUE = SCALE*SQRT( SUM ) END IF diff --git a/SRC/slange.f b/SRC/slange.f index 296c88af4e..838ab249d8 100644 --- a/SRC/slange.f +++ b/SRC/slange.f @@ -189,7 +189,8 @@ REAL FUNCTION SLANGE( NORM, M, N, A, LDA, WORK ) TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slangt.f b/SRC/slangt.f index e6a363f910..356dcae01a 100644 --- a/SRC/slangt.f +++ b/SRC/slangt.f @@ -147,11 +147,13 @@ REAL FUNCTION SLANGT( NORM, N, DL, D, DU ) * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. + $ SISNAN( ABS( DL( I ) ) ) ) $ ANORM = ABS(DL(I)) IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) ) $ ANORM = ABS(D(I)) - IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) ) + IF( ANORM.LT.ABS( DU( I ) ) .OR. + $ SISNAN (ABS( DU( I ) ) ) ) $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN @@ -184,7 +186,8 @@ REAL FUNCTION SLANGT( NORM, N, DL, D, DU ) IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slanhs.f b/SRC/slanhs.f index 36564c456f..8d54a1feb1 100644 --- a/SRC/slanhs.f +++ b/SRC/slanhs.f @@ -183,7 +183,8 @@ REAL FUNCTION SLANHS( NORM, N, A, LDA, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slansb.f b/SRC/slansb.f index f91f7a7558..8a265b6a34 100644 --- a/SRC/slansb.f +++ b/SRC/slansb.f @@ -184,7 +184,8 @@ REAL FUNCTION SLANSB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -220,7 +221,8 @@ REAL FUNCTION SLANSB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -229,7 +231,8 @@ REAL FUNCTION SLANSB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/slansf.f b/SRC/slansf.f index 1d245e918e..f18103ce97 100644 --- a/SRC/slansf.f +++ b/SRC/slansf.f @@ -334,7 +334,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) END DO END IF END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -779,7 +780,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -793,7 +795,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 3 - CALL SLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(k,0) END DO DO J = 0, K - 1 @@ -809,11 +812,13 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL SLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * trap L at A(0,0) END DO DO J = 0, K - 2 - CALL SLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S ) + CALL SLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO S = S + S @@ -828,7 +833,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**T is upper DO J = 1, K - 2 - CALL SLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) + CALL SLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k) END DO DO J = 0, K - 2 @@ -844,7 +850,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * double s for the off diagonal elements CALL SLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S ) * tri U at A(0,k) - CALL SLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S ) + CALL SLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, + $ S ) * tri L at A(0,k-1) ELSE * A**T is lower @@ -857,7 +864,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k-1 rect. at A(0,k) END DO DO J = 0, K - 3 - CALL SLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(1,0) END DO S = S + S @@ -875,7 +883,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 2 - CALL SLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(k+1,0) END DO DO J = 0, K - 1 @@ -891,7 +900,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL SLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, + $ S ) * trap L at A(1,0) END DO DO J = 1, K - 1 @@ -910,7 +920,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**T is upper DO J = 1, K - 1 - CALL SLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) + CALL SLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k+1) END DO DO J = 0, K - 1 @@ -918,20 +929,23 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,0) END DO DO J = 0, K - 2 - CALL SLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, + CALL SLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, + $ SCALE, $ S ) * L at A(0,k) END DO S = S + S * double s for the off diagonal elements - CALL SLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S ) + CALL SLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, + $ S ) * tri U at A(0,k+1) CALL SLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S ) * tri L at A(0,k) ELSE * A**T is lower DO J = 1, K - 1 - CALL SLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) + CALL SLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO DO J = K + 1, N @@ -939,7 +953,8 @@ REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,k+1) END DO DO J = 0, K - 2 - CALL SLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL SLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(0,0) END DO S = S + S diff --git a/SRC/slansp.f b/SRC/slansp.f index 95149fe408..f43970885f 100644 --- a/SRC/slansp.f +++ b/SRC/slansp.f @@ -173,7 +173,8 @@ REAL FUNCTION SLANSP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -212,7 +213,8 @@ REAL FUNCTION SLANSP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slanst.f b/SRC/slanst.f index 6798707af7..d646d5a697 100644 --- a/SRC/slanst.f +++ b/SRC/slanst.f @@ -162,7 +162,8 @@ REAL FUNCTION SLANST( NORM, N, D, E ) IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slansy.f b/SRC/slansy.f index d0ffd6eebc..461c59e0db 100644 --- a/SRC/slansy.f +++ b/SRC/slansy.f @@ -177,7 +177,8 @@ REAL FUNCTION SLANSY( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -211,7 +212,8 @@ REAL FUNCTION SLANSY( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slantb.f b/SRC/slantb.f index 23b9c5f9bd..fb91b300e8 100644 --- a/SRC/slantb.f +++ b/SRC/slantb.f @@ -186,14 +186,16 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,14 +205,16 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -306,7 +310,8 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -325,7 +330,8 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 290 J = 1, N - CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), + CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 290 CONTINUE END IF @@ -335,7 +341,8 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, + CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ SCALE, $ SUM ) 300 CONTINUE END IF @@ -343,7 +350,8 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 310 J = 1, N - CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, + CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ SCALE, $ SUM ) 310 CONTINUE END IF diff --git a/SRC/slantp.f b/SRC/slantp.f index 5e0a140b74..a98201ea0e 100644 --- a/SRC/slantp.f +++ b/SRC/slantp.f @@ -121,7 +121,8 @@ *> \ingroup lantp * * ===================================================================== - REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) + REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, + $ WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 20 J = 1, N DO 10 I = K, K + J - 2 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -179,7 +181,8 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 40 J = 1, N DO 30 I = K + 1, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -190,7 +193,8 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 60 J = 1, N DO 50 I = K, K + J - 1 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE @@ -198,7 +202,8 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 80 J = 1, N DO 70 I = K, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -301,7 +306,8 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/slantr.f b/SRC/slantr.f index a3d2721f43..5f04d6d5ea 100644 --- a/SRC/slantr.f +++ b/SRC/slantr.f @@ -137,7 +137,8 @@ *> \ingroup lantr * * ===================================================================== - REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) * * -- LAPACK auxiliary routine -- @@ -187,14 +188,16 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,14 +207,16 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -306,7 +311,8 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -315,13 +321,15 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE diff --git a/SRC/slaorhr_col_getrfnp.f b/SRC/slaorhr_col_getrfnp.f index 840f25c392..4e4724e77c 100644 --- a/SRC/slaorhr_col_getrfnp.f +++ b/SRC/slaorhr_col_getrfnp.f @@ -167,7 +167,8 @@ SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) INTEGER IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLAORHR_COL_GETRFNP2, STRSM, XERBLA + EXTERNAL SGEMM, SLAORHR_COL_GETRFNP2, STRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -224,14 +225,16 @@ SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) * * Compute block row of U. * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL SGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL SGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/slaorhr_col_getrfnp2.f b/SRC/slaorhr_col_getrfnp2.f index ba21dfa69b..75ad3625c5 100644 --- a/SRC/slaorhr_col_getrfnp2.f +++ b/SRC/slaorhr_col_getrfnp2.f @@ -164,7 +164,8 @@ *> \endverbatim * * ===================================================================== - RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, + $ INFO ) IMPLICIT NONE * * -- LAPACK computational routine -- diff --git a/SRC/slaqgb.f b/SRC/slaqgb.f index b2f0513c6c..f85b038cae 100644 --- a/SRC/slaqgb.f +++ b/SRC/slaqgb.f @@ -155,7 +155,8 @@ *> \ingroup laqgb * * ===================================================================== - SUBROUTINE SLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE SLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/slaqp2.f b/SRC/slaqp2.f index 259c45f115..d12bea6414 100644 --- a/SRC/slaqp2.f +++ b/SRC/slaqp2.f @@ -209,7 +209,8 @@ SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * Generate elementary reflector H(i). * IF( OFFPI.LT.M ) THEN - CALL SLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1, + CALL SLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), + $ 1, $ TAU( I ) ) ELSE CALL SLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) ) diff --git a/SRC/slaqps.f b/SRC/slaqps.f index 49eb84b271..3be1d88b76 100644 --- a/SRC/slaqps.f +++ b/SRC/slaqps.f @@ -174,7 +174,8 @@ *> \endhtmlonly * * ===================================================================== - SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, + SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, + $ VN1, $ VN2, AUXV, F, LDF ) * * -- LAPACK auxiliary routine -- @@ -242,14 +243,16 @@ SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)**T. * IF( K.GT.1 ) THEN - CALL SGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ), + CALL SGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, + $ 1 ), $ LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 ) END IF * * Generate elementary reflector H(k). * IF( RK.LT.M ) THEN - CALL SLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) ) + CALL SLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, + $ TAU( K ) ) ELSE CALL SLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) ) END IF @@ -278,7 +281,8 @@ SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * *A(RK:M,K). * IF( K.GT.1 ) THEN - CALL SGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ), + CALL SGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, + $ 1 ), $ LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 ) * CALL SGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF, @@ -289,7 +293,8 @@ SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**T. * IF( K.LT.N ) THEN - CALL SGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF, + CALL SGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), + $ LDF, $ A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA ) END IF * @@ -329,7 +334,8 @@ SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**T. * IF( KB.LT.MIN( N, M-OFFSET ) ) THEN - CALL SGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE, + CALL SGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, + $ -ONE, $ A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE, $ A( RK+1, KB+1 ), LDA ) END IF diff --git a/SRC/slaqr0.f b/SRC/slaqr0.f index 4e74b123f0..f9ab04ecbf 100644 --- a/SRC/slaqr0.f +++ b/SRC/slaqr0.f @@ -313,7 +313,8 @@ SUBROUTINE SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, REAL ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR3, SLAQR4, SLAQR5 + EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR3, SLAQR4, + $ SLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, MAX, MIN, MOD, REAL @@ -516,7 +517,8 @@ SUBROUTINE SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * * ==== Aggressive early deflation ==== * - CALL SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH, $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, $ WORK, LWORK ) @@ -560,7 +562,8 @@ SUBROUTINE SLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, BB = SS CC = WILK2*SS DD = AA - CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ), + CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), + $ WI( I-1 ), $ WR( I ), WI( I ), CS, SN ) 30 CONTINUE IF( KS.EQ.KTOP ) THEN diff --git a/SRC/slaqr2.f b/SRC/slaqr2.f index ad05d186d2..9d0079ddac 100644 --- a/SRC/slaqr2.f +++ b/SRC/slaqr2.f @@ -273,7 +273,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * @@ -310,7 +311,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, + EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, + $ SLAHQR, $ SLANV2, SLARF, SLARFG, SLASET, SORMHR, STREXC * .. * .. Intrinsic Functions .. @@ -332,7 +334,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to SORMHR ==== * - CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * @@ -402,7 +405,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL SLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL SLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) CALL SLAHQR( .true., .true., JW, 1, JW, T, LDT, SR( KWTOP ), @@ -449,7 +453,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . (STREXC can not fail in this case.) ==== * IFST = NS - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 1 END IF @@ -474,7 +479,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . ILST in case of a rare exchange failure. ==== * IFST = NS - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 2 END IF @@ -536,7 +542,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, SORTED = .false. IFST = I ILST = K - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) IF( INFO.EQ.0 ) THEN I = ILST @@ -593,7 +600,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) @@ -618,7 +626,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -632,7 +641,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 70 CONTINUE * * ==== Update horizontal slab in H ==== @@ -652,7 +662,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 90 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL SLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/slaqr3.f b/SRC/slaqr3.f index 81afb2e338..6f8d28444e 100644 --- a/SRC/slaqr3.f +++ b/SRC/slaqr3.f @@ -270,7 +270,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * @@ -308,7 +309,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH, SROUNDUP_LWORK, ILAENV * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, SLANV2, + EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, + $ SLANV2, $ SLAQR4, SLARF, SLARFG, SLASET, SORMHR, STREXC * .. * .. Intrinsic Functions .. @@ -330,13 +332,15 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to SORMHR ==== * - CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL SORMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Workspace query call to SLAQR4 ==== * - CALL SLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, JW, + CALL SLAQR4( .true., .true., JW, 1, JW, T, LDT, SR, SI, 1, + $ JW, $ V, LDV, WORK, -1, INFQR ) LWK3 = INT( WORK( 1 ) ) * @@ -406,7 +410,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL SLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL SCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL SLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) NMIN = ILAENV( 12, 'SLAQR3', 'SV', JW, 1, JW, LWORK ) @@ -459,7 +464,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . (STREXC can not fail in this case.) ==== * IFST = NS - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 1 END IF @@ -484,7 +490,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . ILST in case of a rare exchange failure. ==== * IFST = NS - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) ILST = ILST + 2 END IF @@ -546,7 +553,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, SORTED = .false. IFST = I ILST = K - CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, WORK, + CALL STREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ WORK, $ INFO ) IF( INFO.EQ.0 ) THEN I = ILST @@ -603,7 +611,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) @@ -628,7 +637,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL SORMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -642,7 +652,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL SLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 70 CONTINUE * * ==== Update horizontal slab in H ==== @@ -662,7 +673,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 90 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL SGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL SLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/slaqr4.f b/SRC/slaqr4.f index be02528269..e31d739067 100644 --- a/SRC/slaqr4.f +++ b/SRC/slaqr4.f @@ -324,7 +324,8 @@ SUBROUTINE SLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, REAL ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR2, SLAQR5 + EXTERNAL SLACPY, SLAHQR, SLANV2, SLAQR2, + $ SLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, MAX, MIN, MOD @@ -527,7 +528,8 @@ SUBROUTINE SLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * * ==== Aggressive early deflation ==== * - CALL SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, WR, WI, H( KV, 1 ), LDH, $ NHO, H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, $ WORK, LWORK ) @@ -571,7 +573,8 @@ SUBROUTINE SLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, BB = SS CC = WILK2*SS DD = AA - CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), WI( I-1 ), + CALL SLANV2( AA, BB, CC, DD, WR( I-1 ), + $ WI( I-1 ), $ WR( I ), WI( I ), CS, SN ) 30 CONTINUE IF( KS.EQ.KTOP ) THEN diff --git a/SRC/slaqr5.f b/SRC/slaqr5.f index 32ebb42c08..310e62db96 100644 --- a/SRC/slaqr5.f +++ b/SRC/slaqr5.f @@ -307,7 +307,8 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, REAL VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLAQR1, SLARFG, SLASET, STRMM + EXTERNAL SGEMM, SLACPY, SLAQR1, SLARFG, SLASET, + $ STRMM * .. * .. Executable Statements .. * diff --git a/SRC/slaqsb.f b/SRC/slaqsb.f index 516e445e69..e90596bc36 100644 --- a/SRC/slaqsb.f +++ b/SRC/slaqsb.f @@ -137,7 +137,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/slaqtr.f b/SRC/slaqtr.f index 4dd0600630..9f8367057c 100644 --- a/SRC/slaqtr.f +++ b/SRC/slaqtr.f @@ -161,7 +161,8 @@ *> \ingroup laqtr * * ===================================================================== - SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, + SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, + $ WORK, $ INFO ) * * -- LAPACK auxiliary routine -- @@ -315,7 +316,8 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF IF( J1.GT.1 ) THEN - CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) + CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) K = ISAMAX( J1-1, X, 1 ) XMAX = ABS( X( K ) ) END IF @@ -358,8 +360,10 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, * Update right-hand side * IF( J1.GT.1 ) THEN - CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) - CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 ) + CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) + CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, + $ 1 ) K = ISAMAX( J1-1, X, 1 ) XMAX = ABS( X( K ) ) END IF @@ -403,7 +407,8 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF * - X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, 1 ) + X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, + $ 1 ) * XJ = ABS( X( J1 ) ) TJJ = ABS( T( J1, J1 ) ) @@ -533,7 +538,8 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF * IF( J1.GT.1 ) THEN - CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) + CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) CALL SAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1, $ X( N+1 ), 1 ) * @@ -555,7 +561,8 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, D( 2, 1 ) = X( J2 ) D( 1, 2 ) = X( N+J1 ) D( 2, 2 ) = X( N+J2 ) - CALL SLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, J1 ), + CALL SLALN2( .FALSE., 2, 2, SMINW, ONE, T( J1, + $ J1 ), $ LDT, ONE, ONE, D, 2, ZERO, -W, V, 2, $ SCALOC, XNORM, IERR ) IF( IERR.NE.0 ) @@ -587,8 +594,10 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, * Update the right-hand side. * IF( J1.GT.1 ) THEN - CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, 1 ) - CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, 1 ) + CALL SAXPY( J1-1, -X( J1 ), T( 1, J1 ), 1, X, + $ 1 ) + CALL SAXPY( J1-1, -X( J2 ), T( 1, J2 ), 1, X, + $ 1 ) * CALL SAXPY( J1-1, -X( N+J1 ), T( 1, J1 ), 1, $ X( N+1 ), 1 ) @@ -645,7 +654,8 @@ SUBROUTINE SLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, END IF END IF * - X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, 1 ) + X( J1 ) = X( J1 ) - SDOT( J1-1, T( 1, J1 ), 1, X, + $ 1 ) X( N+J1 ) = X( N+J1 ) - SDOT( J1-1, T( 1, J1 ), 1, $ X( N+1 ), 1 ) IF( J1.GT.1 ) THEN diff --git a/SRC/slaqz0.f b/SRC/slaqz0.f index 80eaa3386a..3e841a5fe0 100644 --- a/SRC/slaqz0.f +++ b/SRC/slaqz0.f @@ -298,7 +298,8 @@ *> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHAR, ALPHAI, BETA, $ Q, LDQ, Z, LDZ, WORK, LWORK, REC, $ INFO ) @@ -437,7 +438,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL SHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) RETURN @@ -449,7 +451,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to slaqz3 NW = MAX( NWR, NMIN ) - CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHAR, $ ALPHAI, BETA, WORK, NW, WORK, NW, WORK, -1, REC, $ AED_INFO ) @@ -474,8 +477,10 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Initialize Q and Z * - IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, LDQ ) - IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, LDZ ) + IF( IWANTQ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Q, + $ LDQ ) + IF( IWANTZ.EQ.3 ) CALL SLASET( 'FULL', N, N, ZERO, ONE, Z, + $ LDZ ) * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) @@ -568,17 +573,20 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL SLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = ZERO CALL SROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL SROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL SROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -588,9 +596,11 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = ZERO - CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL SROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL SROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL SROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -652,7 +662,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL SLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHAR, ALPHAI, BETA, WORK, NW, WORK( NW**2+1 ), $ NW, WORK( 2*NW**2+1 ), LWORK-2*NW**2, REC, @@ -722,7 +733,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL SLAQZ4( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHAR( SHIFTPOS ), ALPHAI( SHIFTPOS ), $ BETA( SHIFTPOS ), A, LDA, B, LDB, Q, LDQ, Z, LDZ, $ WORK, NBLOCK, WORK( NBLOCK**2+1 ), NBLOCK, diff --git a/SRC/slaqz2.f b/SRC/slaqz2.f index af908b813f..58d4d3ff8b 100644 --- a/SRC/slaqz2.f +++ b/SRC/slaqz2.f @@ -169,7 +169,8 @@ *> \ingroup laqz2 *> * ===================================================================== - SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, + SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, + $ B, $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ ) IMPLICIT NONE * @@ -204,16 +205,19 @@ SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, * CALL SROT( IHI-ISTARTM+1, B( ISTARTM, IHI ), 1, B( ISTARTM, $ IHI-1 ), 1, C1, S1 ) - CALL SROT( IHI-ISTARTM+1, B( ISTARTM, IHI-1 ), 1, B( ISTARTM, + CALL SROT( IHI-ISTARTM+1, B( ISTARTM, IHI-1 ), 1, + $ B( ISTARTM, $ IHI-2 ), 1, C2, S2 ) B( IHI-1, IHI-2 ) = ZERO B( IHI, IHI-2 ) = ZERO CALL SROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C1, S1 ) - CALL SROT( IHI-ISTARTM+1, A( ISTARTM, IHI-1 ), 1, A( ISTARTM, + CALL SROT( IHI-ISTARTM+1, A( ISTARTM, IHI-1 ), 1, + $ A( ISTARTM, $ IHI-2 ), 1, C2, S2 ) IF ( ILZ ) THEN - CALL SROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL SROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C1, S1 ) CALL SROT( NZ, Z( 1, IHI-1-ZSTART+1 ), 1, Z( 1, $ IHI-2-ZSTART+1 ), 1, C2, S2 ) @@ -228,7 +232,8 @@ SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL SROT( ISTOPM-IHI+2, B( IHI-1, IHI-1 ), LDB, B( IHI, $ IHI-1 ), LDB, C1, S1 ) IF ( ILQ ) THEN - CALL SROT( NQ, Q( 1, IHI-1-QSTART+1 ), 1, Q( 1, IHI-QSTART+ + CALL SROT( NQ, Q( 1, IHI-1-QSTART+1 ), 1, Q( 1, + $ IHI-QSTART+ $ 1 ), 1, C1, S1 ) END IF * @@ -240,7 +245,8 @@ SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL SROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL SROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL SROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C1, S1 ) END IF * @@ -276,7 +282,8 @@ SUBROUTINE SLAQZ2( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, IF ( ILZ ) THEN CALL SROT( NZ, Z( 1, K+2-ZSTART+1 ), 1, Z( 1, K+1-ZSTART+ $ 1 ), 1, C1, S1 ) - CALL SROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, K-ZSTART+1 ), + CALL SROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, + $ K-ZSTART+1 ), $ 1, C2, S2 ) END IF B( K+1, K ) = ZERO diff --git a/SRC/slaqz3.f b/SRC/slaqz3.f index 825fb846cf..5a28c955cd 100644 --- a/SRC/slaqz3.f +++ b/SRC/slaqz3.f @@ -232,7 +232,8 @@ *> \ingroup laqz3 *> * ===================================================================== - RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHAR, ALPHAI, BETA, QC, LDQC, $ ZC, LDZC, WORK, LWORK, REC, INFO ) @@ -324,7 +325,8 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL SLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL SLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL SLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -339,7 +341,8 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL SLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL SLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL SLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -446,11 +449,14 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = ZERO K2 = MAX( KWTOP, K-1 ) - CALL SROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL SROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL SROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL SROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL SROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL SROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, S1 ) END DO @@ -475,7 +481,8 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, DO K2 = K, KWBOT-2 * Move shift down - CALL SLARTG( B( K2+1, K2+1 ), B( K2+1, K2 ), C1, S1, + CALL SLARTG( B( K2+1, K2+1 ), B( K2+1, K2 ), C1, + $ S1, $ TEMP ) B( K2+1, K2+1 ) = TEMP B( K2+1, K2 ) = ZERO @@ -490,9 +497,11 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ TEMP ) A( K2+1, K2 ) = TEMP A( K2+2, K2 ) = ZERO - CALL SROT( ISTOPM-K2, A( K2+1, K2+1 ), LDA, A( K2+2, + CALL SROT( ISTOPM-K2, A( K2+1, K2+1 ), LDA, + $ A( K2+2, $ K2+1 ), LDA, C1, S1 ) - CALL SROT( ISTOPM-K2, B( K2+1, K2+1 ), LDB, B( K2+2, + CALL SROT( ISTOPM-K2, B( K2+1, K2+1 ), LDB, + $ B( K2+2, $ K2+1 ), LDB, C1, S1 ) CALL SROT( JW, QC( 1, K2+1-KWTOP+1 ), 1, QC( 1, $ K2+2-KWTOP+1 ), 1, C1, S1 ) @@ -500,7 +509,8 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, END DO * Remove the shift - CALL SLARTG( B( KWBOT, KWBOT ), B( KWBOT, KWBOT-1 ), C1, + CALL SLARTG( B( KWBOT, KWBOT ), B( KWBOT, KWBOT-1 ), + $ C1, $ S1, TEMP ) B( KWBOT, KWBOT ) = TEMP B( KWBOT, KWBOT-1 ) = ZERO @@ -537,25 +547,29 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL SGEMM( 'N', 'N', N, JW, JW, ONE, Q( 1, KWTOP ), LDQ, QC, + CALL SGEMM( 'N', 'N', N, JW, JW, ONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, ZERO, WORK, N ) CALL SLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL SGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, A( ISTARTM, + CALL SGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, ZERO, WORK, $ KWTOP-ISTARTM ) CALL SLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL SGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, B( ISTARTM, + CALL SGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, ONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, ZERO, WORK, $ KWTOP-ISTARTM ) CALL SLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL SGEMM( 'N', 'N', N, JW, JW, ONE, Z( 1, KWTOP ), LDZ, ZC, + CALL SGEMM( 'N', 'N', N, JW, JW, ONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, ZERO, WORK, N ) CALL SLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/SRC/slaqz4.f b/SRC/slaqz4.f index a2265b2b5a..7b739d749c 100644 --- a/SRC/slaqz4.f +++ b/SRC/slaqz4.f @@ -317,18 +317,21 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS, 2 * Introduce the shift - CALL SLAQZ1( A( ILO, ILO ), LDA, B( ILO, ILO ), LDB, SR( I ), + CALL SLAQZ1( A( ILO, ILO ), LDA, B( ILO, ILO ), LDB, + $ SR( I ), $ SR( I+1 ), SI( I ), SS( I ), SS( I+1 ), V ) TEMP = V( 2 ) CALL SLARTG( TEMP, V( 3 ), C1, S1, V( 2 ) ) CALL SLARTG( V( 1 ), V( 2 ), C2, S2, TEMP ) - CALL SROT( NS, A( ILO+1, ILO ), LDA, A( ILO+2, ILO ), LDA, C1, + CALL SROT( NS, A( ILO+1, ILO ), LDA, A( ILO+2, ILO ), LDA, + $ C1, $ S1 ) CALL SROT( NS, A( ILO, ILO ), LDA, A( ILO+1, ILO ), LDA, C2, $ S2 ) - CALL SROT( NS, B( ILO+1, ILO ), LDB, B( ILO+2, ILO ), LDB, C1, + CALL SROT( NS, B( ILO+1, ILO ), LDB, B( ILO+2, ILO ), LDB, + $ C1, $ S1 ) CALL SROT( NS, B( ILO, ILO ), LDB, B( ILO+1, ILO ), LDB, C2, $ S2 ) @@ -353,11 +356,13 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS+1 SWIDTH = ISTOPM-( ILO+NS )+1 IF ( SWIDTH > 0 ) THEN - CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ A( ILO, ILO+NS ), LDA, ZERO, WORK, SHEIGHT ) CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ILO, $ ILO+NS ), LDA ) - CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ B( ILO, ILO+NS ), LDB, ZERO, WORK, SHEIGHT ) CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ILO, $ ILO+NS ), LDB ) @@ -373,17 +378,22 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = ILO-1-ISTARTM+1 SWIDTH = NS IF ( SHEIGHT > 0 ) THEN - CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, A( ISTARTM, + CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ A( ISTARTM, $ ILO ), LDA, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ ILO ), LDA ) - CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, B( ISTARTM, + CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ B( ISTARTM, $ ILO ), LDB, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ ILO ), LDB ) END IF IF ( ILZ ) THEN - CALL SGEMM( 'N', 'N', N, SWIDTH, SWIDTH, ONE, Z( 1, ILO ), LDZ, + CALL SGEMM( 'N', 'N', N, SWIDTH, SWIDTH, ONE, Z( 1, ILO ), + $ LDZ, $ ZC, LDZC, ZERO, WORK, N ) CALL SLACPY( 'ALL', N, SWIDTH, WORK, N, Z( 1, ILO ), LDZ ) END IF @@ -428,18 +438,22 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, $ LDQC, A( K+1, K+NS+NP ), LDA, ZERO, WORK, $ SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( K+1, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( K+1, $ K+NS+NP ), LDA ) CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, $ LDQC, B( K+1, K+NS+NP ), LDB, ZERO, WORK, $ SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( K+1, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( K+1, $ K+NS+NP ), LDB ) END IF IF ( ILQ ) THEN - CALL SGEMM( 'N', 'N', N, NBLOCK, NBLOCK, ONE, Q( 1, K+1 ), + CALL SGEMM( 'N', 'N', N, NBLOCK, NBLOCK, ONE, Q( 1, + $ K+1 ), $ LDQ, QC, LDQC, ZERO, WORK, N ) - CALL SLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), LDQ ) + CALL SLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), + $ LDQ ) END IF * Update A(istartm:k,k:k+ns+npos-1) and B(istartm:k,k:k+ns+npos-1) @@ -482,7 +496,8 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS, 2 * Chase the shift down to the bottom right corner DO ISHIFT = IHI-I-1, IHI-2 - CALL SLAQZ2( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, IHI, + CALL SLAQZ2( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NS, IHI-NS+1, QC, LDQC, NS+1, $ IHI-NS, ZC, LDZC ) END DO @@ -496,11 +511,13 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS SWIDTH = ISTOPM-( IHI+1 )+1 IF ( SWIDTH > 0 ) THEN - CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ A( IHI-NS+1, IHI+1 ), LDA, ZERO, WORK, SHEIGHT ) CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ A( IHI-NS+1, IHI+1 ), LDA ) - CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, LDQC, + CALL SGEMM( 'T', 'N', SHEIGHT, SWIDTH, SHEIGHT, ONE, QC, + $ LDQC, $ B( IHI-NS+1, IHI+1 ), LDB, ZERO, WORK, SHEIGHT ) CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ B( IHI-NS+1, IHI+1 ), LDB ) @@ -516,17 +533,22 @@ SUBROUTINE SLAQZ4( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = IHI-NS-ISTARTM+1 SWIDTH = NS+1 IF ( SHEIGHT > 0 ) THEN - CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, A( ISTARTM, + CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ A( ISTARTM, $ IHI-NS ), LDA, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ IHI-NS ), LDA ) - CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, B( ISTARTM, + CALL SGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, ONE, + $ B( ISTARTM, $ IHI-NS ), LDB, ZC, LDZC, ZERO, WORK, SHEIGHT ) - CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL SLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ IHI-NS ), LDB ) END IF IF ( ILZ ) THEN - CALL SGEMM( 'N', 'N', N, NS+1, NS+1, ONE, Z( 1, IHI-NS ), LDZ, ZC, + CALL SGEMM( 'N', 'N', N, NS+1, NS+1, ONE, Z( 1, IHI-NS ), LDZ, + $ ZC, $ LDZC, ZERO, WORK, N ) CALL SLACPY( 'ALL', N, NS+1, WORK, N, Z( 1, IHI-NS ), LDZ ) END IF diff --git a/SRC/slarf.f b/SRC/slarf.f index 8a764a7665..976ce9910c 100644 --- a/SRC/slarf.f +++ b/SRC/slarf.f @@ -195,7 +195,8 @@ SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) * - CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV, + CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, + $ INCV, $ ZERO, WORK, 1 ) * * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T diff --git a/SRC/slarfb.f b/SRC/slarfb.f index 6798095a5d..c3b1d0833f 100644 --- a/SRC/slarfb.f +++ b/SRC/slarfb.f @@ -193,7 +193,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, + SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, + $ LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * * -- LAPACK auxiliary routine -- @@ -262,7 +263,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * @@ -275,7 +277,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**T or W * T * - CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T @@ -291,7 +294,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, + $ K, $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T @@ -316,13 +320,15 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C2 * V2 * - CALL SGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL SGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, $ ONE, WORK, LDWORK ) END IF @@ -345,7 +351,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, + $ K, $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -373,12 +380,14 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**T * DO 70 J = 1, K - CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) 70 CONTINUE * * W := W * V2 * - CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * @@ -390,7 +399,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**T or W * T * - CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T @@ -405,7 +415,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, + $ K, $ ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T @@ -430,13 +441,15 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1 * - CALL SGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL SGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * @@ -457,7 +470,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, + $ K, $ ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W @@ -492,20 +506,23 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, + $ K, $ ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C2**T * V2**T * - CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, + $ ONE, $ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE, $ WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T @@ -514,14 +531,16 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - V2**T * W**T * - CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, + $ -ONE, $ V( 1, K+1 ), LDV, WORK, LDWORK, ONE, $ C( K+1, 1 ), LDC ) END IF * * W := W * V1 * - CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T @@ -546,7 +565,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1**T * - CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, + $ K, $ ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * @@ -568,14 +588,16 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2 * - CALL SGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL SGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, $ C( 1, K+1 ), LDC ) END IF * * W := W * V1 * - CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -603,24 +625,28 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**T * DO 190 J = 1, K - CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL SCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) 190 CONTINUE * * W := W * V2**T * - CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, + $ K, $ ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C1**T * V1**T * - CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + CALL SGEMM( 'Transpose', 'Transpose', N, K, M-K, + $ ONE, $ C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T @@ -629,13 +655,15 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - V1**T * W**T * - CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + CALL SGEMM( 'Transpose', 'Transpose', M-K, N, K, + $ -ONE, $ V, LDV, WORK, LDWORK, ONE, C, LDC ) END IF * * W := W * V2 * - CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T @@ -660,7 +688,8 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2**T * - CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, + $ K, $ ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * @@ -681,13 +710,15 @@ SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1 * - CALL SGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL SGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2 * - CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) * * C1 := C1 - W diff --git a/SRC/slarft.f b/SRC/slarft.f index c65f5e3606..7f28af730c 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -246,7 +246,8 @@ SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) * - CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) IF( I.GT.1 ) THEN @@ -283,7 +284,8 @@ SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) * - CALL SGEMV( 'Transpose', N-K+I-J, K-I, -TAU( I ), + CALL SGEMV( 'Transpose', N-K+I-J, K-I, + $ -TAU( I ), $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, $ T( I+1, I ), 1 ) ELSE @@ -305,7 +307,8 @@ SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) * - CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I, + CALL STRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) IF( I.GT.1 ) THEN PREVLASTV = MIN( PREVLASTV, LASTV ) diff --git a/SRC/slarrd.f b/SRC/slarrd.f index 6b0714e854..1526fed4b8 100644 --- a/SRC/slarrd.f +++ b/SRC/slarrd.f @@ -677,7 +677,8 @@ SUBROUTINE SLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS, * Compute Eigenvalues ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) / $ LOG( TWO ) ) + 2 - CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, + CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, + $ PIVMIN, $ D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ), $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT, $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) diff --git a/SRC/slarre.f b/SRC/slarre.f index 38cfbf7b73..9fe5a019d5 100644 --- a/SRC/slarre.f +++ b/SRC/slarre.f @@ -357,7 +357,8 @@ SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLARNV, SLARRA, SLARRB, SLARRC, SLARRD, + EXTERNAL SCOPY, SLARNV, SLARRA, SLARRB, SLARRC, + $ SLARRD, $ SLASQ2, SLARRK * .. * .. Intrinsic Functions .. diff --git a/SRC/slarrv.f b/SRC/slarrv.f index 2ab86936be..1c67df7c50 100644 --- a/SRC/slarrv.f +++ b/SRC/slarrv.f @@ -338,7 +338,8 @@ SUBROUTINE SLARRV( N, VL, VU, D, L, PIVMIN, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAR1V, SLARRB, SLARRF, SLASET, + EXTERNAL SCOPY, SLAR1V, SLARRB, SLARRF, + $ SLASET, $ SSCAL * .. * .. Intrinsic Functions .. diff --git a/SRC/slarz.f b/SRC/slarz.f index a9ec51236d..79a3489d1d 100644 --- a/SRC/slarz.f +++ b/SRC/slarz.f @@ -184,7 +184,8 @@ SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l ) * - CALL SGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V, + CALL SGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, + $ V, $ INCV, ONE, WORK, 1 ) * * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n ) @@ -210,7 +211,8 @@ SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) * - CALL SGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, + CALL SGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), + $ LDC, $ V, INCV, ONE, WORK, 1 ) * * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) diff --git a/SRC/slarzb.f b/SRC/slarzb.f index 41bab3c849..92a5f893df 100644 --- a/SRC/slarzb.f +++ b/SRC/slarzb.f @@ -257,7 +257,8 @@ SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T * - CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T, + CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T @@ -272,7 +273,8 @@ SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * V( 1:k, 1:l )**T * W( 1:n, 1:k )**T * IF( L.GT.0 ) - $ CALL SGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV, + $ CALL SGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, + $ LDV, $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC ) * ELSE IF( LSAME( SIDE, 'R' ) ) THEN @@ -294,7 +296,8 @@ SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:m, 1:k ) = W( 1:m, 1:k ) * T or W( 1:m, 1:k ) * T**T * - CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T, + CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k ) @@ -309,7 +312,8 @@ SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * W( 1:m, 1:k ) * V( 1:k, 1:l ) * IF( L.GT.0 ) - $ CALL SGEMM( 'No transpose', 'No transpose', M, L, K, -ONE, + $ CALL SGEMM( 'No transpose', 'No transpose', M, L, K, + $ -ONE, $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC ) * END IF diff --git a/SRC/slascl.f b/SRC/slascl.f index e959e97101..08329c4bcd 100644 --- a/SRC/slascl.f +++ b/SRC/slascl.f @@ -140,7 +140,8 @@ *> \ingroup lascl * * ===================================================================== - SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/slasd0.f b/SRC/slasd0.f index b5e77bd470..d2006f9611 100644 --- a/SRC/slasd0.f +++ b/SRC/slasd0.f @@ -148,7 +148,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, + SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, + $ IWORK, $ WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -204,7 +205,8 @@ SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, * If the input matrix is too small, call SLASDQ to find the SVD. * IF( N.LE.SMLSIZ ) THEN - CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, U, + CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDVT, U, LDU, + $ U, $ LDU, WORK, INFO ) RETURN END IF @@ -241,7 +243,8 @@ SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, NLF = IC - NL NRF = IC + 1 SQREI = 1 - CALL SLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), E( NLF ), + CALL SLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), + $ E( NLF ), $ VT( NLF, NLF ), LDVT, U( NLF, NLF ), LDU, $ U( NLF, NLF ), LDU, WORK, INFO ) IF( INFO.NE.0 ) THEN @@ -257,7 +260,8 @@ SUBROUTINE SLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, SQREI = 1 END IF NRP1 = NR + SQREI - CALL SLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), E( NRF ), + CALL SLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), + $ E( NRF ), $ VT( NRF, NRF ), LDVT, U( NRF, NRF ), LDU, $ U( NRF, NRF ), LDU, WORK, INFO ) IF( INFO.NE.0 ) THEN diff --git a/SRC/slasd1.f b/SRC/slasd1.f index 38210be62e..30cd54c265 100644 --- a/SRC/slasd1.f +++ b/SRC/slasd1.f @@ -200,7 +200,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, + SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, + $ LDVT, $ IDXQ, IWORK, WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -229,7 +230,8 @@ SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, REAL ORGNRM * .. * .. External Subroutines .. - EXTERNAL SLAMRG, SLASCL, SLASD2, SLASD3, XERBLA + EXTERNAL SLAMRG, SLASCL, SLASD2, SLASD3, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -288,7 +290,8 @@ SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, * * Deflate singular values. * - CALL SLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, LDU, + CALL SLASD2( NL, NR, SQRE, K, D, WORK( IZ ), ALPHA, BETA, U, + $ LDU, $ VT, LDVT, WORK( ISIGMA ), WORK( IU2 ), LDU2, $ WORK( IVT2 ), LDVT2, IWORK( IDXP ), IWORK( IDX ), $ IWORK( IDXC ), IDXQ, IWORK( COLTYP ), INFO ) @@ -296,7 +299,8 @@ SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, * Solve Secular Equation and update singular vectors. * LDQ = K - CALL SLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, WORK( ISIGMA ), + CALL SLASD3( NL, NR, SQRE, K, D, WORK( IQ ), LDQ, + $ WORK( ISIGMA ), $ U, LDU, WORK( IU2 ), LDU2, VT, LDVT, WORK( IVT2 ), $ LDVT2, IWORK( IDXC ), IWORK( COLTYP ), WORK( IZ ), $ INFO ) diff --git a/SRC/slasd2.f b/SRC/slasd2.f index eb93fd595a..f40eacfd1b 100644 --- a/SRC/slasd2.f +++ b/SRC/slasd2.f @@ -264,7 +264,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, + SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, + $ VT, $ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX, $ IDXC, IDXQ, COLTYP, INFO ) * @@ -304,7 +305,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, EXTERNAL SLAMCH, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SLAMRG, SLASET, SROT, XERBLA + EXTERNAL SCOPY, SLACPY, SLAMRG, SLASET, SROT, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -480,7 +482,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, IDXJ = IDXJ - 1 END IF CALL SROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S ) - CALL SROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C, + CALL SROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, + $ C, $ S ) IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN COLTYP( J ) = 3 @@ -615,7 +618,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, CALL SCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 ) CALL SLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ), $ LDU ) - CALL SLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ), + CALL SLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, + $ 1 ), $ LDVT ) END IF * diff --git a/SRC/slasd3.f b/SRC/slasd3.f index fbc63ace38..aaf3bd6364 100644 --- a/SRC/slasd3.f +++ b/SRC/slasd3.f @@ -212,7 +212,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, + SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, + $ U2, $ LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z, $ INFO ) * @@ -247,7 +248,8 @@ SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, EXTERNAL SNRM2 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SLACPY, SLASCL, SLASD4, XERBLA + EXTERNAL SCOPY, SGEMM, SLACPY, SLASCL, SLASD4, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, SIGN, SQRT @@ -365,16 +367,19 @@ SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, * Update the left singular vector matrix. * IF( K.EQ.2 ) THEN - CALL SGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, U, + CALL SGEMM( 'N', 'N', N, K, K, ONE, U2, LDU2, Q, LDQ, ZERO, + $ U, $ LDU ) GO TO 100 END IF IF( CTOT( 1 ).GT.0 ) THEN - CALL SGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), LDU2, + CALL SGEMM( 'N', 'N', NL, K, CTOT( 1 ), ONE, U2( 1, 2 ), + $ LDU2, $ Q( 2, 1 ), LDQ, ZERO, U( 1, 1 ), LDU ) IF( CTOT( 3 ).GT.0 ) THEN KTEMP = 2 + CTOT( 1 ) + CTOT( 2 ) - CALL SGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, KTEMP ), + CALL SGEMM( 'N', 'N', NL, K, CTOT( 3 ), ONE, U2( 1, + $ KTEMP ), $ LDU2, Q( KTEMP, 1 ), LDQ, ONE, U( 1, 1 ), LDU ) END IF ELSE IF( CTOT( 3 ).GT.0 ) THEN @@ -387,7 +392,8 @@ SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, CALL SCOPY( K, Q( 1, 1 ), LDQ, U( NLP1, 1 ), LDU ) KTEMP = 2 + CTOT( 1 ) CTEMP = CTOT( 2 ) + CTOT( 3 ) - CALL SGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), LDU2, + CALL SGEMM( 'N', 'N', NR, K, CTEMP, ONE, U2( NLP2, KTEMP ), + $ LDU2, $ Q( KTEMP, 1 ), LDQ, ZERO, U( NLP2, 1 ), LDU ) * * Generate the right singular vectors. @@ -405,7 +411,8 @@ SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, * Update the right singular vector matrix. * IF( K.EQ.2 ) THEN - CALL SGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, ZERO, + CALL SGEMM( 'N', 'N', K, M, K, ONE, Q, LDQ, VT2, LDVT2, + $ ZERO, $ VT, LDVT ) RETURN END IF @@ -414,7 +421,8 @@ SUBROUTINE SLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, $ VT2( 1, 1 ), LDVT2, ZERO, VT( 1, 1 ), LDVT ) KTEMP = 2 + CTOT( 1 ) + CTOT( 2 ) IF( KTEMP.LE.LDVT2 ) - $ CALL SGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, KTEMP ), + $ CALL SGEMM( 'N', 'N', K, NLP1, CTOT( 3 ), ONE, Q( 1, + $ KTEMP ), $ LDQ, VT2( KTEMP, 1 ), LDVT2, ONE, VT( 1, 1 ), $ LDVT ) * diff --git a/SRC/slasd6.f b/SRC/slasd6.f index cd4c7e79c8..a0c2e9d950 100644 --- a/SRC/slasd6.f +++ b/SRC/slasd6.f @@ -307,7 +307,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, + SUBROUTINE SLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, + $ BETA, $ IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) @@ -341,7 +342,8 @@ SUBROUTINE SLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, REAL ORGNRM * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAMRG, SLASCL, SLASD7, SLASD8, XERBLA + EXTERNAL SCOPY, SLAMRG, SLASCL, SLASD7, SLASD8, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX diff --git a/SRC/slasd7.f b/SRC/slasd7.f index c1b20edd02..2370536ade 100644 --- a/SRC/slasd7.f +++ b/SRC/slasd7.f @@ -274,7 +274,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL, + SUBROUTINE SLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, + $ VL, $ VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ C, S, INFO ) diff --git a/SRC/slasd8.f b/SRC/slasd8.f index 244e526cbd..313e75f2a5 100644 --- a/SRC/slasd8.f +++ b/SRC/slasd8.f @@ -187,7 +187,8 @@ SUBROUTINE SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLASCL, SLASD4, SLASET, XERBLA + EXTERNAL SCOPY, SLASCL, SLASD4, SLASET, + $ XERBLA * .. * .. External Functions .. REAL SDOT, SLAMC3, SNRM2 @@ -296,11 +297,13 @@ SUBROUTINE SLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, * from doing x+(y+z). * DO 60 I = 1, J - 1 - WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), DSIGJ )-DIFLJ ) + WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), + $ DSIGJ )-DIFLJ ) $ / ( DSIGMA( I )+DJ ) 60 CONTINUE DO 70 I = J + 1, K - WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), DSIGJP )+DIFRJ ) + WORK( I ) = Z( I ) / ( SLAMC3( DSIGMA( I ), + $ DSIGJP )+DIFRJ ) $ / ( DSIGMA( I )+DJ ) 70 CONTINUE TEMP = SNRM2( K, WORK, 1 ) diff --git a/SRC/slasda.f b/SRC/slasda.f index 949d5eaa25..32bdc028e8 100644 --- a/SRC/slasda.f +++ b/SRC/slasda.f @@ -268,7 +268,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, + SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, + $ K, $ DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, $ PERM, GIVNUM, C, S, WORK, IWORK, INFO ) * @@ -302,7 +303,8 @@ SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, REAL ALPHA, BETA * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLASD6, SLASDQ, SLASDT, SLASET, XERBLA + EXTERNAL SCOPY, SLASD6, SLASDQ, SLASDT, SLASET, + $ XERBLA * .. * .. Executable Statements .. * @@ -334,10 +336,12 @@ SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, * IF( N.LE.SMLSIZ ) THEN IF( ICOMPQ.EQ.0 ) THEN - CALL SLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, LDU, + CALL SLASDQ( 'U', SQRE, N, 0, 0, 0, D, E, VT, LDU, U, + $ LDU, $ U, LDU, WORK, INFO ) ELSE - CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, LDU, + CALL SLASDQ( 'U', SQRE, N, M, N, 0, D, E, VT, LDU, U, + $ LDU, $ U, LDU, WORK, INFO ) END IF RETURN @@ -398,7 +402,8 @@ SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, CALL SCOPY( NLP1, WORK( ITEMP ), 1, WORK( VLI ), 1 ) ELSE CALL SLASET( 'A', NL, NL, ZERO, ONE, U( NLF, 1 ), LDU ) - CALL SLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), LDU ) + CALL SLASET( 'A', NLP1, NLP1, ZERO, ONE, VT( NLF, 1 ), + $ LDU ) CALL SLASDQ( 'U', SQREI, NL, NLP1, NL, NCC, D( NLF ), $ E( NLF ), VT( NLF, 1 ), LDU, U( NLF, 1 ), LDU, $ U( NLF, 1 ), LDU, WORK( NWORK1 ), INFO ) @@ -432,7 +437,8 @@ SUBROUTINE SLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, CALL SCOPY( NRP1, WORK( ITEMP ), 1, WORK( VLI ), 1 ) ELSE CALL SLASET( 'A', NR, NR, ZERO, ONE, U( NRF, 1 ), LDU ) - CALL SLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), LDU ) + CALL SLASET( 'A', NRP1, NRP1, ZERO, ONE, VT( NRF, 1 ), + $ LDU ) CALL SLASDQ( 'U', SQREI, NR, NRP1, NR, NCC, D( NRF ), $ E( NRF ), VT( NRF, 1 ), LDU, U( NRF, 1 ), LDU, $ U( NRF, 1 ), LDU, WORK( NWORK1 ), INFO ) diff --git a/SRC/slasdq.f b/SRC/slasdq.f index c38f168571..303153f730 100644 --- a/SRC/slasdq.f +++ b/SRC/slasdq.f @@ -207,7 +207,8 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, + SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, + $ LDVT, $ U, LDU, C, LDC, WORK, INFO ) * * -- LAPACK auxiliary routine -- @@ -235,7 +236,8 @@ SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, REAL CS, R, SMIN, SN * .. * .. External Subroutines .. - EXTERNAL SBDSQR, SLARTG, SLASR, SSWAP, XERBLA + EXTERNAL SBDSQR, SLARTG, SLASR, SSWAP, + $ XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -396,7 +398,8 @@ SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, D( ISUB ) = D( I ) D( I ) = SMIN IF( NCVT.GT.0 ) - $ CALL SSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), LDVT ) + $ CALL SSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( I, 1 ), + $ LDVT ) IF( NRU.GT.0 ) $ CALL SSWAP( NRU, U( 1, ISUB ), 1, U( 1, I ), 1 ) IF( NCC.GT.0 ) diff --git a/SRC/slasq1.f b/SRC/slasq1.f index 84334858a7..55c612655d 100644 --- a/SRC/slasq1.f +++ b/SRC/slasq1.f @@ -129,7 +129,8 @@ SUBROUTINE SLASQ1( N, D, E, WORK, INFO ) REAL EPS, SCALE, SAFMIN, SIGMN, SIGMX * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAS2, SLASCL, SLASQ2, SLASRT, XERBLA + EXTERNAL SCOPY, SLAS2, SLASCL, SLASQ2, SLASRT, + $ XERBLA * .. * .. External Functions .. REAL SLAMCH diff --git a/SRC/slasq2.f b/SRC/slasq2.f index 06a1d5e114..f1b112ab78 100644 --- a/SRC/slasq2.f +++ b/SRC/slasq2.f @@ -468,7 +468,8 @@ SUBROUTINE SLASQ2( N, Z, INFO ) * * While submatrix unfinished take a good dqds step. * - CALL SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, + CALL SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, + $ NFAIL, $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * diff --git a/SRC/slasq3.f b/SRC/slasq3.f index d2be71666d..d2ff537c10 100644 --- a/SRC/slasq3.f +++ b/SRC/slasq3.f @@ -177,7 +177,8 @@ *> \ingroup lasq3 * * ===================================================================== - SUBROUTINE SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, + SUBROUTINE SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, + $ NFAIL, $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * diff --git a/SRC/slasq5.f b/SRC/slasq5.f index a952737cc2..8f0da2ab16 100644 --- a/SRC/slasq5.f +++ b/SRC/slasq5.f @@ -140,7 +140,8 @@ *> \ingroup lasq5 * * ===================================================================== - SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, + SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, + $ DMIN2, $ DN, DNM1, DNM2, IEEE, EPS ) * * -- LAPACK computational routine -- diff --git a/SRC/slasr.f b/SRC/slasr.f index 544bb81281..c3fa5d491b 100644 --- a/SRC/slasr.f +++ b/SRC/slasr.f @@ -235,12 +235,14 @@ SUBROUTINE SLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * Test the input parameters * INFO = 0 - IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN + IF( .NOT.( LSAME( SIDE, 'L' ) .OR. + $ LSAME( SIDE, 'R' ) ) ) THEN INFO = 1 ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN INFO = 2 - ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) + ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. + $ LSAME( DIRECT, 'B' ) ) ) $ THEN INFO = 3 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/slasyf.f b/SRC/slasyf.f index a87f311f76..8636b7d1a0 100644 --- a/SRC/slasyf.f +++ b/SRC/slasyf.f @@ -173,7 +173,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -244,7 +245,8 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * CALL SCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 ) IF( K.LT.N ) - $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), LDA, + $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, ONE, W( 1, KW ), 1 ) * KSTEP = 1 @@ -286,7 +288,8 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL SCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) IF( K.LT.N ) - $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, K+1 ), + $ CALL SGEMV( 'No transpose', K, N-K, -ONE, A( 1, + $ K+1 ), $ LDA, W( IMAX, KW+1 ), LDW, ONE, $ W( 1, KW-1 ), 1 ) * @@ -487,7 +490,8 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Update the rectangular superdiagonal block * - CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, -ONE, + CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, + $ -ONE, $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE, $ A( 1, J ), LDA ) 50 CONTINUE @@ -540,7 +544,8 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * Copy column K of A to column K of W and update it * CALL SCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 ) - CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), LDA, + CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, ONE, W( K, K ), 1 ) * KSTEP = 1 @@ -578,10 +583,13 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) - CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ), + CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), $ 1 ) - CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, 1 ), + CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, + $ K+1 ), + $ 1 ) + CALL SGEMV( 'No transpose', N-K+1, K-1, -ONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, ONE, W( K, K+1 ), 1 ) * * JMAX is the column-index of the largest off-diagonal @@ -639,7 +647,8 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL SCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) IF( KP.LT.N ) - $ CALL SCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL SCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/slasyf_aa.f b/SRC/slasyf_aa.f index d368ec200e..6faf8f8c29 100644 --- a/SRC/slasyf_aa.f +++ b/SRC/slasyf_aa.f @@ -173,7 +173,8 @@ SUBROUTINE SLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, ISAMAX * .. * .. External Subroutines .. - EXTERNAL SAXPY, SGEMV, SSCAL, SCOPY, SSWAP, SLASET, + EXTERNAL SAXPY, SGEMV, SSCAL, SCOPY, SSWAP, + $ SLASET, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/slasyf_rk.f b/SRC/slasyf_rk.f index 38bde7d800..24e4336dd1 100644 --- a/SRC/slasyf_rk.f +++ b/SRC/slasyf_rk.f @@ -406,7 +406,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL SCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -505,7 +506,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * and last N-K+2 columns of W * CALL SSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL SSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL SSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -522,7 +524,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL SSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -729,7 +732,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -749,7 +753,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = ABS( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -771,7 +776,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -797,7 +803,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -832,7 +839,8 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL SCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/slasyf_rook.f b/SRC/slasyf_rook.f index 26949c6700..40c22dd432 100644 --- a/SRC/slasyf_rook.f +++ b/SRC/slasyf_rook.f @@ -318,7 +318,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL SCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL SCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -417,7 +418,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * and last N-K+2 columns of W * CALL SSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL SSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL SSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -434,7 +436,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL SSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL SSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -644,7 +647,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL SCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL SCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -664,7 +668,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + ISAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) STEMP = ABS( W( ITEMP, K+1 ) ) IF( STEMP.GT.ROWMAX ) THEN ROWMAX = STEMP @@ -686,7 +691,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -712,7 +718,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL SCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -747,7 +754,8 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL SCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL SCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/slatbs.f b/SRC/slatbs.f index ca5521823e..6257004308 100644 --- a/SRC/slatbs.f +++ b/SRC/slatbs.f @@ -238,7 +238,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, + SUBROUTINE SLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, + $ X, $ SCALE, CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -703,7 +704,8 @@ SUBROUTINE SLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, ELSE JLEN = MIN( KD, N-J ) IF( JLEN.GT.0 ) - $ SUMJ = SDOT( JLEN, AB( 2, J ), 1, X( J+1 ), 1 ) + $ SUMJ = SDOT( JLEN, AB( 2, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * diff --git a/SRC/slatdf.f b/SRC/slatdf.f index 96865caa0f..4b17964c60 100644 --- a/SRC/slatdf.f +++ b/SRC/slatdf.f @@ -200,7 +200,8 @@ SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, REAL WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGECON, SGESC2, SLASSQ, SLASWP, + EXTERNAL SAXPY, SCOPY, SGECON, SGESC2, SLASSQ, + $ SLASWP, $ SSCAL * .. * .. External Functions .. @@ -230,7 +231,8 @@ SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, * Look-ahead for L-part RHS(1:N-1) = + or -1, SPLUS and * SMIN computed more efficiently than in BSOLVE [1]. * - SPLUS = SPLUS + SDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), 1 ) + SPLUS = SPLUS + SDOT( N-J, Z( J+1, J ), 1, Z( J+1, J ), + $ 1 ) SMINU = SDOT( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) SPLUS = SPLUS*RHS( J ) IF( SPLUS.GT.SMINU ) THEN diff --git a/SRC/slatps.f b/SRC/slatps.f index 462ea920b4..00511bd993 100644 --- a/SRC/slatps.f +++ b/SRC/slatps.f @@ -618,7 +618,8 @@ SUBROUTINE SLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * Compute the update * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) * - CALL SAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X, + CALL SAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, + $ X, $ 1 ) I = ISAMAX( J-1, X, 1 ) XMAX = ABS( X( I ) ) diff --git a/SRC/slatrd.f b/SRC/slatrd.f index cfc2e6b6a5..50d8fe4d30 100644 --- a/SRC/slatrd.f +++ b/SRC/slatrd.f @@ -249,7 +249,8 @@ SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * CALL SGEMV( 'No transpose', I, N-I, -ONE, A( 1, I+1 ), $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 ) - CALL SGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ), + CALL SGEMV( 'No transpose', I, N-I, -ONE, W( 1, + $ IW+1 ), $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 ) END IF IF( I.GT.1 ) THEN @@ -257,7 +258,8 @@ SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * Generate elementary reflector H(i) to annihilate * A(1:i-2,i) * - CALL SLARFG( I-1, A( I-1, I ), A( 1, I ), 1, TAU( I-1 ) ) + CALL SLARFG( I-1, A( I-1, I ), A( 1, I ), 1, + $ TAU( I-1 ) ) E( I-1 ) = A( I-1, I ) A( I-1, I ) = ONE * @@ -266,12 +268,14 @@ SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) CALL SSYMV( 'Upper', I-1, ONE, A, LDA, A( 1, I ), 1, $ ZERO, W( 1, IW ), 1 ) IF( I.LT.N ) THEN - CALL SGEMV( 'Transpose', I-1, N-I, ONE, W( 1, IW+1 ), + CALL SGEMV( 'Transpose', I-1, N-I, ONE, W( 1, + $ IW+1 ), $ LDW, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 ) CALL SGEMV( 'No transpose', I-1, N-I, -ONE, $ A( 1, I+1 ), LDA, W( I+1, IW ), 1, ONE, $ W( 1, IW ), 1 ) - CALL SGEMV( 'Transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL SGEMV( 'Transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( 1, I ), 1, ZERO, W( I+1, IW ), 1 ) CALL SGEMV( 'No transpose', I-1, N-I, -ONE, $ W( 1, IW+1 ), LDW, W( I+1, IW ), 1, ONE, @@ -301,7 +305,8 @@ SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * Generate elementary reflector H(i) to annihilate * A(i+2:n,i) * - CALL SLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, + CALL SLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), + $ 1, $ TAU( I ) ) E( I ) = A( I+1, I ) A( I+1, I ) = ONE @@ -310,18 +315,23 @@ SUBROUTINE SLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) * CALL SSYMV( 'Lower', N-I, ONE, A( I+1, I+1 ), LDA, $ A( I+1, I ), 1, ZERO, W( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), LDW, + CALL SGEMV( 'Transpose', N-I, I-1, ONE, W( I+1, 1 ), + $ LDW, $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ), + CALL SGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) - CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, ZERO, W( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ), + CALL SGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, + $ 1 ), $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL SSCAL( N-I, TAU( I ), W( I+1, I ), 1 ) ALPHA = -HALF*TAU( I )*SDOT( N-I, W( I+1, I ), 1, $ A( I+1, I ), 1 ) - CALL SAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 ) + CALL SAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), + $ 1 ) END IF * 20 CONTINUE diff --git a/SRC/slatrs.f b/SRC/slatrs.f index 7bc8877673..b1f21bd997 100644 --- a/SRC/slatrs.f +++ b/SRC/slatrs.f @@ -234,7 +234,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, + SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, + $ SCALE, $ CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -269,7 +270,8 @@ SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, LOGICAL LSAME INTEGER ISAMAX REAL SASUM, SDOT, SLAMCH, SLANGE - EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH, SLANGE + EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH, + $ SLANGE * .. * .. External Subroutines .. EXTERNAL SAXPY, SSCAL, STRSV, XERBLA @@ -366,8 +368,8 @@ SUBROUTINE SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, * A is upper triangular. * DO J = 2, N - TMAX = MAX( SLANGE( 'M', J-1, 1, A( 1, J ), 1, WORK ), - $ TMAX ) + TMAX = MAX( SLANGE( 'M', J-1, 1, A( 1, J ), 1, + $ WORK ), TMAX ) END DO ELSE * diff --git a/SRC/slatrs3.f b/SRC/slatrs3.f index 8a2ce83ed6..d133ea8f93 100644 --- a/SRC/slatrs3.f +++ b/SRC/slatrs3.f @@ -266,7 +266,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SLARMM - EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE, SLARMM + EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE, + $ SLARMM * .. * .. External Subroutines .. REAL SROUNDUP_LWORK @@ -369,7 +370,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, CALL SLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X( 1, 1), $ SCALE( 1 ), CNORM, INFO ) DO K = 2, NRHS - CALL SLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, K ), + CALL SLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -396,10 +398,12 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute upper bound of A( I1:I2-1, J1:J2-1 ). * IF( NOTRAN ) THEN - ANRM = SLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = SLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + I+(J-1)*NBA ) = ANRM ELSE - ANRM = SLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = SLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + J+(I-1)*NBA ) = ANRM END IF TMAX = MAX( TMAX, ANRM ) @@ -416,7 +420,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * in the computation of the column norms CNORM. * DO K = 1, NRHS - CALL SLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, K ), + CALL SLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -600,7 +605,8 @@ SUBROUTINE SLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute scaling factor to survive the linear update * simulating consistent scaling. * - BNRM = SLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, W ) + BNRM = SLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, + $ W ) BNRM = BNRM*( SCAMIN / WORK( I+KK*LDS ) ) XNRM( KK ) = XNRM( KK )*(SCAMIN / WORK( J+KK*LDS )) ANRM = WORK( AWRK + I+(J-1)*NBA ) diff --git a/SRC/slauu2.f b/SRC/slauu2.f index 548e0614fc..cb836a2f51 100644 --- a/SRC/slauu2.f +++ b/SRC/slauu2.f @@ -165,8 +165,10 @@ SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO ) DO 10 I = 1, N AII = A( I, I ) IF( I.LT.N ) THEN - A( I, I ) = SDOT( N-I+1, A( I, I ), LDA, A( I, I ), LDA ) - CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + A( I, I ) = SDOT( N-I+1, A( I, I ), LDA, A( I, I ), + $ LDA ) + CALL SGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, AII, A( 1, I ), 1 ) ELSE CALL SSCAL( I, AII, A( 1, I ), 1 ) @@ -181,7 +183,8 @@ SUBROUTINE SLAUU2( UPLO, N, A, LDA, INFO ) AII = A( I, I ) IF( I.LT.N ) THEN A( I, I ) = SDOT( N-I+1, A( I, I ), 1, A( I, I ), 1 ) - CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), LDA, + CALL SGEMV( 'Transpose', N-I, I-1, ONE, A( I+1, 1 ), + $ LDA, $ A( I+1, I ), 1, AII, A( I, 1 ), LDA ) ELSE CALL SSCAL( I, AII, A( I, 1 ), LDA ) diff --git a/SRC/slauum.f b/SRC/slauum.f index 5c8cc45080..aa707100c2 100644 --- a/SRC/slauum.f +++ b/SRC/slauum.f @@ -195,14 +195,16 @@ SUBROUTINE SLAUUM( UPLO, N, A, LDA, INFO ) * DO 20 I = 1, N, NB IB = MIN( NB, N-I+1 ) - CALL STRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', IB, + CALL STRMM( 'Left', 'Lower', 'Transpose', 'Non-unit', + $ IB, $ I-1, ONE, A( I, I ), LDA, A( I, 1 ), LDA ) CALL SLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) IF( I+IB.LE.N ) THEN CALL SGEMM( 'Transpose', 'No transpose', IB, I-1, $ N-I-IB+1, ONE, A( I+IB, I ), LDA, $ A( I+IB, 1 ), LDA, ONE, A( I, 1 ), LDA ) - CALL SSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, ONE, + CALL SSYRK( 'Lower', 'Transpose', IB, N-I-IB+1, + $ ONE, $ A( I+IB, I ), LDA, ONE, A( I, I ), LDA ) END IF 20 CONTINUE diff --git a/SRC/sopmtr.f b/SRC/sopmtr.f index df009e0f2e..259ca7d625 100644 --- a/SRC/sopmtr.f +++ b/SRC/sopmtr.f @@ -146,7 +146,8 @@ *> \ingroup upmtr * * ===================================================================== - SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, + SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- @@ -263,7 +264,8 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, * AII = AP( II ) AP( II ) = ONE - CALL SLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, LDC, + CALL SLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, + $ LDC, $ WORK ) AP( II ) = AII * diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index 086bfc4f90..116cbd03a0 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -282,7 +282,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, + $ LDX12, $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1, $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, REAL Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SLARF, SLARFGP, SSCAL, XERBLA + EXTERNAL SAXPY, SLARF, SLARFGP, SSCAL, + $ XERBLA * .. * .. External Functions .. REAL SNRM2 @@ -399,14 +401,16 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL SSCAL( P-I+1, Z1, X11(I,I), 1 ) ELSE CALL SSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), 1 ) - CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I,I-1), + CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I, + $ I-1), $ 1, X11(I,I), 1 ) END IF IF( I .EQ. 1 ) THEN CALL SSCAL( M-P-I+1, Z2, X21(I,I), 1 ) ELSE CALL SSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), 1 ) - CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I,I-1), + CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I, + $ I-1), $ 1, X21(I,I), 1 ) END IF * @@ -414,7 +418,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ SNRM2( P-I+1, X11(I,I), 1 ) ) * IF( P .GT. I ) THEN - CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, + $ TAUP1(I) ) ELSE IF( P .EQ. I ) THEN CALL SLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF @@ -423,7 +428,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) ELSE IF ( M-P .EQ. I ) THEN - CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, TAUP2(I) ) + CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, + $ TAUP2(I) ) END IF X21(I,I) = ONE * @@ -432,7 +438,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X11(I,I+1), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I), + CALL SLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ TAUP1(I), $ X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN @@ -440,18 +447,22 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I), + CALL SLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ TAUP2(I), $ X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN CALL SSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1), $ LDX11 ) - CALL SAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), LDX21, + CALL SAXPY( Q-I, Z2*Z3*COS(THETA(I)), X21(I,I+1), + $ LDX21, $ X11(I,I+1), LDX11 ) END IF - CALL SSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), LDX12 ) - CALL SAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), LDX22, + CALL SSCAL( M-Q-I+1, -Z1*Z4*SIN(THETA(I)), X12(I,I), + $ LDX12 ) + CALL SAXPY( M-Q-I+1, Z2*Z4*COS(THETA(I)), X22(I,I), + $ LDX22, $ X12(I,I), LDX12 ) * IF( I .LT. Q ) @@ -480,13 +491,16 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL SLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL SLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL SLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL SLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN @@ -511,7 +525,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) @@ -534,7 +549,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, END IF X22(Q+I,P+I) = ONE IF ( I .LT. M-P-Q ) THEN - CALL SLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, + CALL SLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + $ LDX22, $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) END IF * @@ -550,21 +566,25 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL SSCAL( P-I+1, Z1, X11(I,I), LDX11 ) ELSE CALL SSCAL( P-I+1, Z1*COS(PHI(I-1)), X11(I,I), LDX11 ) - CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1,I), + CALL SAXPY( P-I+1, -Z1*Z3*Z4*SIN(PHI(I-1)), X12(I-1, + $ I), $ LDX12, X11(I,I), LDX11 ) END IF IF( I .EQ. 1 ) THEN CALL SSCAL( M-P-I+1, Z2, X21(I,I), LDX21 ) ELSE - CALL SSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), LDX21 ) - CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1,I), + CALL SSCAL( M-P-I+1, Z2*COS(PHI(I-1)), X21(I,I), + $ LDX21 ) + CALL SAXPY( M-P-I+1, -Z2*Z3*Z4*SIN(PHI(I-1)), X22(I-1, + $ I), $ LDX22, X21(I,I), LDX21 ) END IF * THETA(I) = ATAN2( SNRM2( M-P-I+1, X21(I,I), LDX21 ), $ SNRM2( P-I+1, X11(I,I), LDX11 ) ) * - CALL SLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) + CALL SLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, + $ TAUP1(I) ) X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, @@ -576,7 +596,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL SLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), + CALL SLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), $ X11(I+1,I), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN @@ -584,7 +605,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ TAUP1(I), X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL SLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), + CALL SLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), $ X21(I+1,I), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN @@ -633,7 +655,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL SLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN - CALL SLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I), + CALL SLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ TAUQ2(I), $ X22(I,I+1), LDX22, WORK ) END IF * @@ -644,7 +667,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, DO I = Q + 1, P * CALL SSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 ) - CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF ( P .GT. I ) THEN @@ -652,7 +676,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL SLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I), + $ CALL SLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ TAUQ2(I), $ X22(I,Q+1), LDX22, WORK ) * END DO @@ -663,11 +688,13 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * CALL SSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 ) IF ( M-P-Q .EQ. I ) THEN - CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), 1, + CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), + $ 1, $ TAUQ2(P+I) ) X22(P+I,Q+I) = ONE ELSE - CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1, + CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), + $ 1, $ TAUQ2(P+I) ) X22(P+I,Q+I) = ONE CALL SLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index e83aee8e15..74acf67ebe 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -199,7 +199,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -228,7 +229,8 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, XERBLA + EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, + $ XERBLA * .. * .. External Functions .. REAL SNRM2 @@ -288,14 +290,17 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, S = SIN( THETA(I) ) X11(I,I) = ONE X21(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN - CALL SROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, S ) - CALL SLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) ) + CALL SROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, + $ S ) + CALL SLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, + $ TAUQ1(I) ) S = X21(I,I+1) X21(I,I+1) = ONE CALL SLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index ecfadf568f..332a9ce6e4 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -197,7 +197,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -226,7 +227,8 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, XERBLA + EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, + $ XERBLA * .. * .. External Functions .. REAL SNRM2 @@ -280,7 +282,8 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = 1, P * IF( I .GT. 1 ) THEN - CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, S ) + CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I-1,I), LDX21, C, + $ S ) END IF CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = X11(I,I) diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index 6f2455a231..d0283f5bec 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -198,7 +198,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, XERBLA + EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, + $ XERBLA * .. * .. External Functions .. REAL SNRM2 @@ -281,7 +283,8 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = 1, M-P * IF( I .GT. 1 ) THEN - CALL SROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, S ) + CALL SROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C, + $ S ) END IF * CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) @@ -300,7 +303,8 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) IF( I .LT. M-P ) THEN - CALL SLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) ) + CALL SLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, + $ TAUP2(I) ) PHI(I) = ATAN2( X21(I+1,I), X11(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) @@ -309,7 +313,8 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF X11(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) * END DO @@ -319,7 +324,8 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = M-P + 1, Q CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) X11(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I,I+1), + CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), $ LDX11, WORK(ILARF) ) END DO * diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index a91d2bdce1..983f254074 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -209,7 +209,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * @@ -239,7 +240,8 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, XERBLA + EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, + $ XERBLA * .. * .. External Functions .. REAL SNRM2 @@ -302,13 +304,15 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ LORBDB5, CHILDINFO ) CALL SSCAL( P, NEGONE, PHANTOM(1), 1 ) CALL SLARFGP( P, PHANTOM(1), PHANTOM(2), 1, TAUP1(1) ) - CALL SLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, TAUP2(1) ) + CALL SLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, + $ TAUP2(1) ) THETA(I) = ATAN2( PHANTOM(1), PHANTOM(P+1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) PHANTOM(1) = ONE PHANTOM(P+1) = ONE - CALL SLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, LDX11, + CALL SLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, + $ LDX11, $ WORK(ILARF) ) CALL SLARF( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, $ LDX21, WORK(ILARF) ) @@ -317,7 +321,8 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), $ LDX21, WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL SSCAL( P-I+1, NEGONE, X11(I,I-1), 1 ) - CALL SLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, TAUP1(I) ) + CALL SLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, + $ TAUP1(I) ) CALL SLARFGP( M-P-I+1, X21(I,I-1), X21(I+1,I-1), 1, $ TAUP2(I) ) THETA(I) = ATAN2( X11(I,I-1), X21(I,I-1) ) @@ -361,10 +366,12 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, * Reduce the bottom-right portion of X21 to [ 0 I ] * DO I = P + 1, Q - CALL SLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), LDX21, + CALL SLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), + $ LDX21, $ TAUQ1(I) ) X21(M-Q+I-P,I) = ONE - CALL SLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, TAUQ1(I), + CALL SLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) END DO * diff --git a/SRC/sorbdb5.f b/SRC/sorbdb5.f index 548e2a8cd0..525189888b 100644 --- a/SRC/sorbdb5.f +++ b/SRC/sorbdb5.f @@ -152,7 +152,8 @@ *> \ingroup unbdb5 * * ===================================================================== - SUBROUTINE SORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE SORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/sorbdb6.f b/SRC/sorbdb6.f index 53fe439578..c58b6342a2 100644 --- a/SRC/sorbdb6.f +++ b/SRC/sorbdb6.f @@ -155,7 +155,8 @@ *> \ingroup unbdb6 * * ===================================================================== - SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -238,11 +239,13 @@ SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL SGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL SGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL SGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL SGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL SGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) @@ -284,11 +287,13 @@ SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL SGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL SGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL SGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL SGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL SGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) diff --git a/SRC/sorcsd.f b/SRC/sorcsd.f index a9e1558bda..b81aeb13e0 100644 --- a/SRC/sorcsd.f +++ b/SRC/sorcsd.f @@ -293,7 +293,8 @@ *> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, @@ -408,7 +409,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL SORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL SORCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, IWORK, INFO ) @@ -441,12 +443,14 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ITAUQ1 = ITAUP2 + MAX( 1, M - P ) ITAUQ2 = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ2 + MAX( 1, M - Q ) - CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1, + CALL SORGQR( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, + $ -1, $ CHILDINFO ) LORGQRWORKOPT = INT( WORK(1) ) LORGQRWORKMIN = MAX( 1, M - Q ) IORGLQ = ITAUQ2 + MAX( 1, M - Q ) - CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, -1, + CALL SORGLQ( M-Q, M-Q, M-Q, DUMMY, MAX(1,M-Q), DUMMY, WORK, + $ -1, $ CHILDINFO ) LORGLQWORKOPT = INT( WORK(1) ) LORGLQWORKMIN = MAX( 1, M - Q ) @@ -498,7 +502,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, WORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -508,7 +513,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -524,7 +530,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -537,7 +544,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL SORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL SORGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -553,7 +561,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL SORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL SORGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -567,7 +576,8 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), WORK(IB22D), diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f index 5a1034de53..e6e65a99b7 100644 --- a/SRC/sorcsd2by1.f +++ b/SRC/sorcsd2by1.f @@ -228,7 +228,8 @@ *> \ingroup uncsd2by1 * * ===================================================================== - SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, + SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, + $ LDX11, $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, IWORK, INFO ) * @@ -267,7 +268,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, REAL DUM1(1), DUM2(1,1) * .. * .. External Subroutines .. - EXTERNAL SBBCSD, SCOPY, SLACPY, SLAPMR, SLAPMT, SORBDB1, + EXTERNAL SBBCSD, SCOPY, SLACPY, SLAPMR, SLAPMT, + $ SORBDB1, $ SORBDB2, SORBDB3, SORBDB4, SORGLQ, SORGQR, $ XERBLA * .. @@ -371,7 +373,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, + CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, + $ THETA, $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, DUM2, $ 1, DUM1, DUM1, DUM1, DUM1, DUM1, $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO @@ -400,7 +403,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, + CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, + $ THETA, $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, U2, $ LDU2, DUM1, DUM1, DUM1, DUM1, DUM1, $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO @@ -504,7 +508,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -520,7 +525,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END DO CALL SLACPY( 'U', Q-1, Q-1, X21(1,2), LDX21, V1T(2,2), $ LDV1T ) - CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL SORGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF * @@ -563,7 +569,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, U1(1,J) = ZERO U1(J,1) = ZERO END DO - CALL SLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), LDU1 ) + CALL SLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), + $ LDU1 ) CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, WORK(ITAUP1), $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF @@ -613,7 +620,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL SLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL SORGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -696,7 +704,8 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL SLACPY( 'U', M-Q, Q, X21, LDX21, V1T, LDV1T ) - CALL SLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), LDX11, + CALL SLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), + $ LDX11, $ V1T(M-Q+1,M-Q+1), LDV1T ) CALL SLACPY( 'U', -P+Q, Q-P, X21(M-Q+1,P+1), LDX21, $ V1T(P+1,P+1), LDV1T ) diff --git a/SRC/sorg2l.f b/SRC/sorg2l.f index c42677c470..0556d4a08e 100644 --- a/SRC/sorg2l.f +++ b/SRC/sorg2l.f @@ -178,7 +178,8 @@ SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL SLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, + CALL SLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, $ LDA, WORK ) CALL SSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) diff --git a/SRC/sorgbr.f b/SRC/sorgbr.f index 28a553e92a..316b8d3f30 100644 --- a/SRC/sorgbr.f +++ b/SRC/sorgbr.f @@ -154,7 +154,8 @@ *> \ingroup ungbr * * ===================================================================== - SUBROUTINE SORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE SORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/sorghr.f b/SRC/sorghr.f index 21678cbb5a..480f1556d1 100644 --- a/SRC/sorghr.f +++ b/SRC/sorghr.f @@ -123,7 +123,8 @@ *> \ingroup unghr * * ===================================================================== - SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/sorglq.f b/SRC/sorglq.f index b5bb9bb1e2..cf5b438bc1 100644 --- a/SRC/sorglq.f +++ b/SRC/sorglq.f @@ -213,7 +213,8 @@ SUBROUTINE SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORGLQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SORGLQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -254,12 +255,14 @@ SUBROUTINE SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL SLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right * - CALL SLARFB( 'Right', 'Transpose', 'Forward', 'Rowwise', + CALL SLARFB( 'Right', 'Transpose', 'Forward', + $ 'Rowwise', $ M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK, $ LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ), $ LDWORK ) @@ -267,7 +270,8 @@ SUBROUTINE SORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**T to columns i:n of current block * - CALL SORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL SORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set columns 1:i-1 of current block to zero diff --git a/SRC/sorgql.f b/SRC/sorgql.f index 982ce81da3..88abfd7c52 100644 --- a/SRC/sorgql.f +++ b/SRC/sorgql.f @@ -223,7 +223,8 @@ SUBROUTINE SORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORGQL', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SORGQL', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF diff --git a/SRC/sorgqr.f b/SRC/sorgqr.f index af4e1e23ee..e4d6d4969d 100644 --- a/SRC/sorgqr.f +++ b/SRC/sorgqr.f @@ -214,7 +214,8 @@ SUBROUTINE SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORGQR', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SORGQR', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -268,7 +269,8 @@ SUBROUTINE SORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H to rows i:m of current block * - CALL SORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL SORG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set rows 1:i-1 of current block to zero diff --git a/SRC/sorgr2.f b/SRC/sorgr2.f index 76170fb3e1..bd3ade3da7 100644 --- a/SRC/sorgr2.f +++ b/SRC/sorgr2.f @@ -182,7 +182,8 @@ SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the right * A( II, N-M+II ) = ONE - CALL SLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, TAU( I ), + CALL SLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + $ TAU( I ), $ A, LDA, WORK ) CALL SSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - TAU( I ) diff --git a/SRC/sorgrq.f b/SRC/sorgrq.f index 0bd5a3fa71..9eaacc4e99 100644 --- a/SRC/sorgrq.f +++ b/SRC/sorgrq.f @@ -223,7 +223,8 @@ SUBROUTINE SORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORGRQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SORGRQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -267,14 +268,16 @@ SUBROUTINE SORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * - CALL SLARFB( 'Right', 'Transpose', 'Backward', 'Rowwise', + CALL SLARFB( 'Right', 'Transpose', 'Backward', + $ 'Rowwise', $ II-1, N-K+I+IB-1, IB, A( II, 1 ), LDA, WORK, $ LDWORK, A, LDA, WORK( IB+1 ), LDWORK ) END IF * * Apply H**T to columns 1:n-k+i+ib-1 of current block * - CALL SORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ), + CALL SORGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) * * Set columns n-k+i+ib:n of current block to zero diff --git a/SRC/sorgtr.f b/SRC/sorgtr.f index a6366b3264..44992646bd 100644 --- a/SRC/sorgtr.f +++ b/SRC/sorgtr.f @@ -218,7 +218,8 @@ SUBROUTINE SORGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Generate Q(1:n-1,1:n-1) * - CALL SORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO ) + CALL SORGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, + $ IINFO ) * ELSE * diff --git a/SRC/sorhr_col.f b/SRC/sorhr_col.f index 4264b3f546..86d69b04f7 100644 --- a/SRC/sorhr_col.f +++ b/SRC/sorhr_col.f @@ -281,7 +281,8 @@ SUBROUTINE SORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) $ NPLUSONE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAORHR_COL_GETRFNP, SSCAL, STRSM, + EXTERNAL SCOPY, SLAORHR_COL_GETRFNP, SSCAL, + $ STRSM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/sorm22.f b/SRC/sorm22.f index 1ed2eda2a7..d9ca2ede78 100644 --- a/SRC/sorm22.f +++ b/SRC/sorm22.f @@ -218,7 +218,8 @@ SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, IF( N1.EQ.0 .OR. N2.EQ.0 ) NW = 1 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN @@ -284,13 +285,15 @@ SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL SLACPY( 'All', N1, LEN, C( N2+1, I ), LDC, WORK, $ LDWORK ) - CALL STRMM( 'Left', 'Lower', 'No Transpose', 'Non-Unit', + CALL STRMM( 'Left', 'Lower', 'No Transpose', + $ 'Non-Unit', $ N1, LEN, ONE, Q( 1, N2+1 ), LDQ, WORK, $ LDWORK ) * * Multiply top part of C by Q11. * - CALL SGEMM( 'No Transpose', 'No Transpose', N1, LEN, N2, + CALL SGEMM( 'No Transpose', 'No Transpose', N1, LEN, + $ N2, $ ONE, Q, LDQ, C( 1, I ), LDC, ONE, WORK, $ LDWORK ) * @@ -298,13 +301,15 @@ SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL SLACPY( 'All', N2, LEN, C( 1, I ), LDC, $ WORK( N1+1 ), LDWORK ) - CALL STRMM( 'Left', 'Upper', 'No Transpose', 'Non-Unit', + CALL STRMM( 'Left', 'Upper', 'No Transpose', + $ 'Non-Unit', $ N2, LEN, ONE, Q( N1+1, 1 ), LDQ, $ WORK( N1+1 ), LDWORK ) * * Multiply bottom part of C by Q22. * - CALL SGEMM( 'No Transpose', 'No Transpose', N2, LEN, N1, + CALL SGEMM( 'No Transpose', 'No Transpose', N2, LEN, + $ N1, $ ONE, Q( N1+1, N2+1 ), LDQ, C( N2+1, I ), LDC, $ ONE, WORK( N1+1 ), LDWORK ) * @@ -362,13 +367,15 @@ SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL SLACPY( 'All', LEN, N2, C( I, N1+1 ), LDC, WORK, $ LDWORK ) - CALL STRMM( 'Right', 'Upper', 'No Transpose', 'Non-Unit', + CALL STRMM( 'Right', 'Upper', 'No Transpose', + $ 'Non-Unit', $ LEN, N2, ONE, Q( N1+1, 1 ), LDQ, WORK, $ LDWORK ) * * Multiply left part of C by Q11. * - CALL SGEMM( 'No Transpose', 'No Transpose', LEN, N2, N1, + CALL SGEMM( 'No Transpose', 'No Transpose', LEN, N2, + $ N1, $ ONE, C( I, 1 ), LDC, Q, LDQ, ONE, WORK, $ LDWORK ) * @@ -376,13 +383,15 @@ SUBROUTINE SORM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL SLACPY( 'All', LEN, N1, C( I, 1 ), LDC, $ WORK( 1 + N2*LDWORK ), LDWORK ) - CALL STRMM( 'Right', 'Lower', 'No Transpose', 'Non-Unit', + CALL STRMM( 'Right', 'Lower', 'No Transpose', + $ 'Non-Unit', $ LEN, N1, ONE, Q( 1, N2+1 ), LDQ, $ WORK( 1 + N2*LDWORK ), LDWORK ) * * Multiply right part of C by Q22. * - CALL SGEMM( 'No Transpose', 'No Transpose', LEN, N1, N2, + CALL SGEMM( 'No Transpose', 'No Transpose', LEN, N1, + $ N2, $ ONE, C( I, N1+1 ), LDC, Q( N1+1, N2+1 ), LDQ, $ ONE, WORK( 1 + N2*LDWORK ), LDWORK ) * diff --git a/SRC/sorm2r.f b/SRC/sorm2r.f index c901f8bff6..3876e56262 100644 --- a/SRC/sorm2r.f +++ b/SRC/sorm2r.f @@ -269,7 +269,8 @@ SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * AII = A( I, I ) A( I, I ) = ONE - CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ), + CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + $ JC ), $ LDC, WORK ) A( I, I ) = AII 10 CONTINUE diff --git a/SRC/sormbr.f b/SRC/sormbr.f index 8041890956..99064dd1f6 100644 --- a/SRC/sormbr.f +++ b/SRC/sormbr.f @@ -328,7 +328,8 @@ SUBROUTINE SORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, I1 = 1 I2 = 2 END IF - CALL SORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + CALL SORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, + $ TAU, $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) END IF ELSE diff --git a/SRC/sormhr.f b/SRC/sormhr.f index e47cc4dfeb..1dc94b64e7 100644 --- a/SRC/sormhr.f +++ b/SRC/sormhr.f @@ -229,7 +229,8 @@ SUBROUTINE SORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/sormlq.f b/SRC/sormlq.f index 5fba349794..9dcd896573 100644 --- a/SRC/sormlq.f +++ b/SRC/sormlq.f @@ -245,7 +245,8 @@ SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'SORMLQ', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'SORMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -270,7 +271,8 @@ SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORMLQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'SORMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -279,7 +281,8 @@ SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -335,7 +338,8 @@ SUBROUTINE SORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL SLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB, + CALL SLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, + $ IB, $ A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/sormql.f b/SRC/sormql.f index c96b815243..3ba68e9c7d 100644 --- a/SRC/sormql.f +++ b/SRC/sormql.f @@ -247,7 +247,8 @@ SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'SORMQL', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'SORMQL', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -272,7 +273,8 @@ SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORMQL', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'SORMQL', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -281,7 +283,8 @@ SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -327,7 +330,8 @@ SUBROUTINE SORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL SLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + CALL SLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, + $ NI, $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, $ WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/sormqr.f b/SRC/sormqr.f index 5d5252951d..a563bef2ea 100644 --- a/SRC/sormqr.f +++ b/SRC/sormqr.f @@ -244,7 +244,8 @@ SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -269,7 +270,8 @@ SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORMQR', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'SORMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -278,7 +280,8 @@ SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -310,7 +313,8 @@ SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL SLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + CALL SLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * @@ -328,7 +332,8 @@ SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**T * - CALL SLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + CALL SLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, + $ NI, $ IB, A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/sormr3.f b/SRC/sormr3.f index a3d5435536..f0cc68428a 100644 --- a/SRC/sormr3.f +++ b/SRC/sormr3.f @@ -174,7 +174,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/sormrq.f b/SRC/sormrq.f index 9edf6e1785..fc266d6324 100644 --- a/SRC/sormrq.f +++ b/SRC/sormrq.f @@ -248,7 +248,8 @@ SUBROUTINE SORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -273,7 +274,8 @@ SUBROUTINE SORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -282,7 +284,8 @@ SUBROUTINE SORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * diff --git a/SRC/sormrz.f b/SRC/sormrz.f index 63069e06cf..b69efd9ada 100644 --- a/SRC/sormrz.f +++ b/SRC/sormrz.f @@ -183,7 +183,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -269,7 +270,8 @@ SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -294,7 +296,8 @@ SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -343,7 +346,8 @@ SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL SLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA, + CALL SLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), + $ LDA, $ TAU( I ), WORK( IWT ), LDT ) * IF( LEFT ) THEN diff --git a/SRC/sormtr.f b/SRC/sormtr.f index a6bd77b600..82bed6cc7e 100644 --- a/SRC/sormtr.f +++ b/SRC/sormtr.f @@ -168,7 +168,8 @@ *> \ingroup unmtr * * ===================================================================== - SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -224,7 +225,8 @@ SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'T' ) ) $ THEN INFO = -3 ELSE IF( M.LT.0 ) THEN @@ -287,7 +289,8 @@ SUBROUTINE SORMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, * * Q was determined by a call to SSYTRD with UPLO = 'U' * - CALL SORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + CALL SORMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, + $ C, $ LDC, WORK, LWORK, IINFO ) ELSE * diff --git a/SRC/spbcon.f b/SRC/spbcon.f index e433702929..3267a6a3df 100644 --- a/SRC/spbcon.f +++ b/SRC/spbcon.f @@ -224,14 +224,16 @@ SUBROUTINE SPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * * Multiply by inv(U). * - CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEU, WORK( 2*N+1 ), $ INFO ) ELSE * * Multiply by inv(L). * - CALL SLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEL, WORK( 2*N+1 ), $ INFO ) NORMIN = 'Y' diff --git a/SRC/spbequ.f b/SRC/spbequ.f index 354e9606bb..db14523cca 100644 --- a/SRC/spbequ.f +++ b/SRC/spbequ.f @@ -126,7 +126,8 @@ *> \ingroup pbequ * * ===================================================================== - SUBROUTINE SPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) + SUBROUTINE SPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/spbrfs.f b/SRC/spbrfs.f index b1514136a8..8f3180fc7d 100644 --- a/SRC/spbrfs.f +++ b/SRC/spbrfs.f @@ -225,7 +225,8 @@ SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SPBTRS, SSBMV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, SPBTRS, SSBMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -398,14 +399,16 @@ SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N, + CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), + $ N, $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( N+I )*WORK( I ) @@ -417,7 +420,8 @@ SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, DO 120 I = 1, N WORK( N+I ) = WORK( N+I )*WORK( I ) 120 CONTINUE - CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), N, + CALL SPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/spbsv.f b/SRC/spbsv.f index 37fb80d131..5bb1574f1d 100644 --- a/SRC/spbsv.f +++ b/SRC/spbsv.f @@ -192,7 +192,8 @@ SUBROUTINE SPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/spbsvx.f b/SRC/spbsvx.f index 4c47f9f6a0..d6a31bdbd1 100644 --- a/SRC/spbsvx.f +++ b/SRC/spbsvx.f @@ -338,7 +338,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, + $ LDAFB, $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, IWORK, INFO ) * @@ -375,7 +376,8 @@ SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EXTERNAL LSAME, SLAMCH, SLANSB * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SLAQSB, SPBCON, SPBEQU, SPBRFS, + EXTERNAL SCOPY, SLACPY, SLAQSB, SPBCON, SPBEQU, + $ SPBRFS, $ SPBTRF, SPBTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -398,7 +400,9 @@ SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN @@ -455,7 +459,8 @@ SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Equilibrate the matrix. * - CALL SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + CALL SLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) RCEQU = LSAME( EQUED, 'Y' ) END IF END IF @@ -503,7 +508,8 @@ SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Compute the reciprocal of the condition number of A. * - CALL SPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, IWORK, + CALL SPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * Compute the solution matrix X. @@ -514,7 +520,8 @@ SUBROUTINE SPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, + CALL SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/spbtrf.f b/SRC/spbtrf.f index 640edcce52..cc1f9ad900 100644 --- a/SRC/spbtrf.f +++ b/SRC/spbtrf.f @@ -173,7 +173,8 @@ SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL SGEMM, SPBTF2, SPOTF2, SSYRK, STRSM, XERBLA + EXTERNAL SGEMM, SPBTF2, SPOTF2, SSYRK, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -300,7 +301,8 @@ SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * Update A23 * IF( I2.GT.0 ) - $ CALL SGEMM( 'Transpose', 'No Transpose', I2, I3, + $ CALL SGEMM( 'Transpose', 'No Transpose', I2, + $ I3, $ IB, -ONE, AB( KD+1-IB, I+IB ), $ LDAB-1, WORK, LDWORK, ONE, $ AB( 1+IB, I+KD ), LDAB-1 ) @@ -376,7 +378,8 @@ SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A22 * - CALL SSYRK( 'Lower', 'No Transpose', I2, IB, -ONE, + CALL SSYRK( 'Lower', 'No Transpose', I2, IB, + $ -ONE, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1, I+IB ), LDAB-1 ) END IF @@ -400,14 +403,16 @@ SUBROUTINE SPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * Update A32 * IF( I2.GT.0 ) - $ CALL SGEMM( 'No transpose', 'Transpose', I3, I2, + $ CALL SGEMM( 'No transpose', 'Transpose', I3, + $ I2, $ IB, -ONE, WORK, LDWORK, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1+KD-IB, I+IB ), LDAB-1 ) * * Update A33 * - CALL SSYRK( 'Lower', 'No Transpose', I3, IB, -ONE, + CALL SSYRK( 'Lower', 'No Transpose', I3, IB, + $ -ONE, $ WORK, LDWORK, ONE, AB( 1, I+KD ), $ LDAB-1 ) * diff --git a/SRC/spbtrs.f b/SRC/spbtrs.f index 7d60c9e759..ca46293aa7 100644 --- a/SRC/spbtrs.f +++ b/SRC/spbtrs.f @@ -190,7 +190,8 @@ SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve U*X = B, overwriting B with X. * - CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB, + CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) 10 CONTINUE ELSE @@ -201,7 +202,8 @@ SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL STBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB, + CALL STBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) * * Solve L**T *X = B, overwriting B with X. diff --git a/SRC/spftrf.f b/SRC/spftrf.f index cab1a24ccd..3ea9c40201 100644 --- a/SRC/spftrf.f +++ b/SRC/spftrf.f @@ -291,7 +291,8 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) CALL SPOTRF( 'L', N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), N, + CALL STRSM( 'R', 'L', 'T', 'N', N2, N1, ONE, A( 0 ), + $ N, $ A( N1 ), N ) CALL SSYRK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE, $ A( N ), N ) @@ -308,7 +309,8 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) CALL SPOTRF( 'L', N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), N, + CALL STRSM( 'L', 'L', 'N', 'N', N1, N2, ONE, A( N2 ), + $ N, $ A( 0 ), N ) CALL SSYRK( 'U', 'T', N2, N1, -ONE, A( 0 ), N, ONE, $ A( N1 ), N ) @@ -331,9 +333,11 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) CALL SPOTRF( 'U', N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), N1, + CALL STRSM( 'L', 'U', 'T', 'N', N1, N2, ONE, A( 0 ), + $ N1, $ A( N1*N1 ), N1 ) - CALL SSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, ONE, + CALL SSYRK( 'L', 'T', N2, N1, -ONE, A( N1*N1 ), N1, + $ ONE, $ A( 1 ), N1 ) CALL SPOTRF( 'L', N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -348,7 +352,8 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) CALL SPOTRF( 'U', N1, A( N2*N2 ), N2, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, A( N2*N2 ), + CALL STRSM( 'R', 'U', 'N', 'N', N2, N1, ONE, + $ A( N2*N2 ), $ N2, A( 0 ), N2 ) CALL SSYRK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE, $ A( N1*N2 ), N2 ) @@ -377,7 +382,8 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) CALL SPOTRF( 'L', K, A( 1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), N+1, + CALL STRSM( 'R', 'L', 'T', 'N', K, K, ONE, A( 1 ), + $ N+1, $ A( K+1 ), N+1 ) CALL SSYRK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE, $ A( 0 ), N+1 ) @@ -419,7 +425,8 @@ SUBROUTINE SPFTRF( TRANSR, UPLO, N, A, INFO ) $ RETURN CALL STRSM( 'L', 'U', 'T', 'N', K, K, ONE, A( K ), N1, $ A( K*( K+1 ) ), K ) - CALL SSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, ONE, + CALL SSYRK( 'L', 'T', K, K, -ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( 0 ), K ) CALL SPOTRF( 'L', K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) diff --git a/SRC/spftri.f b/SRC/spftri.f index c3a12c50dc..245308a14b 100644 --- a/SRC/spftri.f +++ b/SRC/spftri.f @@ -216,7 +216,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, STFTRI, SLAUUM, STRMM, SSYRK + EXTERNAL XERBLA, STFTRI, SLAUUM, STRMM, + $ SSYRK * .. * .. Intrinsic Functions .. INTRINSIC MOD @@ -291,7 +292,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'L', N1, A( 0 ), N, INFO ) CALL SSYRK( 'L', 'T', N1, N2, ONE, A( N1 ), N, ONE, $ A( 0 ), N ) - CALL STRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), N, + CALL STRMM( 'L', 'U', 'N', 'N', N2, N1, ONE, A( N ), + $ N, $ A( N1 ), N ) CALL SLAUUM( 'U', N2, A( N ), N, INFO ) * @@ -304,7 +306,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'L', N1, A( N2 ), N, INFO ) CALL SSYRK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE, $ A( N2 ), N ) - CALL STRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), N, + CALL STRMM( 'R', 'U', 'T', 'N', N1, N2, ONE, A( N1 ), + $ N, $ A( 0 ), N ) CALL SLAUUM( 'U', N2, A( N1 ), N, INFO ) * @@ -320,9 +323,11 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1) * CALL SLAUUM( 'U', N1, A( 0 ), N1, INFO ) - CALL SSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE, + CALL SSYRK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, + $ ONE, $ A( 0 ), N1 ) - CALL STRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), N1, + CALL STRMM( 'R', 'L', 'N', 'N', N1, N2, ONE, A( 1 ), + $ N1, $ A( N1*N1 ), N1 ) CALL SLAUUM( 'L', N2, A( 1 ), N1, INFO ) * @@ -334,7 +339,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'U', N1, A( N2*N2 ), N2, INFO ) CALL SSYRK( 'U', 'T', N1, N2, ONE, A( 0 ), N2, ONE, $ A( N2*N2 ), N2 ) - CALL STRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, A( N1*N2 ), + CALL STRMM( 'L', 'L', 'T', 'N', N2, N1, ONE, + $ A( N1*N2 ), $ N2, A( 0 ), N2 ) CALL SLAUUM( 'L', N2, A( N1*N2 ), N2, INFO ) * @@ -359,7 +365,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'L', K, A( 1 ), N+1, INFO ) CALL SSYRK( 'L', 'T', K, K, ONE, A( K+1 ), N+1, ONE, $ A( 1 ), N+1 ) - CALL STRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), N+1, + CALL STRMM( 'L', 'U', 'N', 'N', K, K, ONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) CALL SLAUUM( 'U', K, A( 0 ), N+1, INFO ) * @@ -372,7 +379,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'L', K, A( K+1 ), N+1, INFO ) CALL SSYRK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE, $ A( K+1 ), N+1 ) - CALL STRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), N+1, + CALL STRMM( 'R', 'U', 'T', 'N', K, K, ONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) CALL SLAUUM( 'U', K, A( K ), N+1, INFO ) * @@ -389,7 +397,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k * CALL SLAUUM( 'U', K, A( K ), K, INFO ) - CALL SSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE, + CALL SSYRK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( K ), K ) CALL STRMM( 'R', 'L', 'N', 'N', K, K, ONE, A( 0 ), K, $ A( K*( K+1 ) ), K ) @@ -404,7 +413,8 @@ SUBROUTINE SPFTRI( TRANSR, UPLO, N, A, INFO ) CALL SLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO ) CALL SSYRK( 'U', 'T', K, K, ONE, A( 0 ), K, ONE, $ A( K*( K+1 ) ), K ) - CALL STRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), K, + CALL STRMM( 'L', 'L', 'T', 'N', K, K, ONE, A( K*K ), + $ K, $ A( 0 ), K ) CALL SLAUUM( 'L', K, A( K*K ), K, INFO ) * diff --git a/SRC/spocon.f b/SRC/spocon.f index 1c471a7228..315de6665a 100644 --- a/SRC/spocon.f +++ b/SRC/spocon.f @@ -204,25 +204,29 @@ SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, * * Multiply by inv(U**T). * - CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * * Multiply by inv(U). * - CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(L). * - CALL SLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * * Multiply by inv(L**T). * - CALL SLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A, + CALL SLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, + $ A, $ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO ) END IF * diff --git a/SRC/sporfs.f b/SRC/sporfs.f index 378aea95a5..825ade7258 100644 --- a/SRC/sporfs.f +++ b/SRC/sporfs.f @@ -219,7 +219,8 @@ SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SPOTRS, SSYMV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, SPOTRS, SSYMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -387,14 +388,16 @@ SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO ) + CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, + $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 110 CONTINUE @@ -405,7 +408,8 @@ SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, INFO ) + CALL SPOTRS( UPLO, N, 1, AF, LDAF, WORK( N+1 ), N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/sporfsx.f b/SRC/sporfsx.f index c3984f8d7e..58c18b7a42 100644 --- a/SRC/sporfsx.f +++ b/SRC/sporfsx.f @@ -388,7 +388,8 @@ *> \ingroup porfsx * * ===================================================================== - SUBROUTINE SPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, + SUBROUTINE SPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, + $ B, $ LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) diff --git a/SRC/sposv.f b/SRC/sposv.f index fd1f9e81bc..931044b5cd 100644 --- a/SRC/sposv.f +++ b/SRC/sposv.f @@ -158,7 +158,8 @@ SUBROUTINE SPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/sposvx.f b/SRC/sposvx.f index 97a31d5b87..2e2a4a3a8a 100644 --- a/SRC/sposvx.f +++ b/SRC/sposvx.f @@ -302,7 +302,8 @@ *> \ingroup posvx * * ===================================================================== - SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, $ IWORK, INFO ) * @@ -339,7 +340,8 @@ SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, EXTERNAL LSAME, SLAMCH, SLANSY * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLAQSY, SPOCON, SPOEQU, SPORFS, SPOTRF, + EXTERNAL SLACPY, SLAQSY, SPOCON, SPOEQU, SPORFS, + $ SPOTRF, $ SPOTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -361,10 +363,13 @@ SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -453,7 +458,8 @@ SUBROUTINE SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Compute the reciprocal of the condition number of A. * - CALL SPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) + CALL SPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/sposvxx.f b/SRC/sposvxx.f index 587bc5b3b2..606ce3ba74 100644 --- a/SRC/sposvxx.f +++ b/SRC/sposvxx.f @@ -491,7 +491,8 @@ *> \ingroup posvxx * * ===================================================================== - SUBROUTINE SPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE SPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, IWORK, INFO ) @@ -541,7 +542,8 @@ SUBROUTINE SPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, REAL SLAMCH, SLA_PORPVGRW * .. * .. External Subroutines .. - EXTERNAL SPOEQUB, SPOTRF, SPOTRS, SLACPY, SLAQSY, + EXTERNAL SPOEQUB, SPOTRF, SPOTRS, SLACPY, + $ SLAQSY, $ XERBLA, SLASCL2, SPORFSX * .. * .. Intrinsic Functions .. @@ -649,7 +651,8 @@ SUBROUTINE SPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * Compute the reciprocal pivot growth factor of the * leading rank-deficient INFO columns of A. * - RPVGRW = SLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, WORK ) + RPVGRW = SLA_PORPVGRW( UPLO, INFO, A, LDA, AF, LDAF, + $ WORK ) RETURN ENDIF END IF diff --git a/SRC/spotf2.f b/SRC/spotf2.f index 635c18fd71..cd837ce75a 100644 --- a/SRC/spotf2.f +++ b/SRC/spotf2.f @@ -209,7 +209,8 @@ SUBROUTINE SPOTF2( UPLO, N, A, LDA, INFO ) * Compute elements J+1:N of column J. * IF( J.LT.N ) THEN - CALL SGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, 1 ), + CALL SGEMV( 'No transpose', N-J, J-1, -ONE, A( J+1, + $ 1 ), $ LDA, A( J, 1 ), LDA, ONE, A( J+1, J ), 1 ) CALL SSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) END IF diff --git a/SRC/spotrf.f b/SRC/spotrf.f index 56cbecd878..e3cd89125e 100644 --- a/SRC/spotrf.f +++ b/SRC/spotrf.f @@ -134,7 +134,8 @@ SUBROUTINE SPOTRF( UPLO, N, A, LDA, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL SGEMM, SPOTRF2, SSYRK, STRSM, XERBLA + EXTERNAL SGEMM, SPOTRF2, SSYRK, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -193,10 +194,12 @@ SUBROUTINE SPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block row. * - CALL SGEMM( 'Transpose', 'No transpose', JB, N-J-JB+1, + CALL SGEMM( 'Transpose', 'No transpose', JB, + $ N-J-JB+1, $ J-1, -ONE, A( 1, J ), LDA, A( 1, J+JB ), $ LDA, ONE, A( J, J+JB ), LDA ) - CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', + CALL STRSM( 'Left', 'Upper', 'Transpose', + $ 'Non-unit', $ JB, N-J-JB+1, ONE, A( J, J ), LDA, $ A( J, J+JB ), LDA ) END IF @@ -221,10 +224,12 @@ SUBROUTINE SPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block column. * - CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, + CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, + $ JB, $ J-1, -ONE, A( J+JB, 1 ), LDA, A( J, 1 ), $ LDA, ONE, A( J+JB, J ), LDA ) - CALL STRSM( 'Right', 'Lower', 'Transpose', 'Non-unit', + CALL STRSM( 'Right', 'Lower', 'Transpose', + $ 'Non-unit', $ N-J-JB+1, JB, ONE, A( J, J ), LDA, $ A( J+JB, J ), LDA ) END IF diff --git a/SRC/spotri.f b/SRC/spotri.f index 6adc26e57f..da14de22ab 100644 --- a/SRC/spotri.f +++ b/SRC/spotri.f @@ -123,7 +123,8 @@ SUBROUTINE SPOTRI( UPLO, N, A, LDA, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/spotrs.f b/SRC/spotrs.f index 5754fdc558..c428e9f4b9 100644 --- a/SRC/spotrs.f +++ b/SRC/spotrs.f @@ -173,7 +173,8 @@ SUBROUTINE SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve U**T *X = B, overwriting B with X. * - CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, + CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -191,7 +192,8 @@ SUBROUTINE SPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve L**T *X = B, overwriting B with X. * - CALL STRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, NRHS, + CALL STRSM( 'Left', 'Lower', 'Transpose', 'Non-unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) END IF * diff --git a/SRC/sppcon.f b/SRC/sppcon.f index 9f1289e117..3cca710882 100644 --- a/SRC/sppcon.f +++ b/SRC/sppcon.f @@ -115,7 +115,8 @@ *> \ingroup ppcon * * ===================================================================== - SUBROUTINE SPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO ) + SUBROUTINE SPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -205,13 +206,15 @@ SUBROUTINE SPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO ) * * Multiply by inv(U). * - CALL SLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEU, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(L). * - CALL SLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL SLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEL, WORK( 2*N+1 ), INFO ) NORMIN = 'Y' * diff --git a/SRC/spprfs.f b/SRC/spprfs.f index d66f3f24c0..218d5b5549 100644 --- a/SRC/spprfs.f +++ b/SRC/spprfs.f @@ -167,7 +167,8 @@ *> \ingroup pprfs * * ===================================================================== - SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -207,7 +208,8 @@ SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SPPTRS, SSPMV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, SPPTRS, SSPMV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -270,7 +272,8 @@ SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * Compute residual R = B - A * X * CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ), + CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, + $ WORK( N+1 ), $ 1 ) * * Compute componentwise relative backward error from formula @@ -378,7 +381,8 @@ SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/sppsv.f b/SRC/sppsv.f index d821f9eaba..27a4f861f6 100644 --- a/SRC/sppsv.f +++ b/SRC/sppsv.f @@ -172,7 +172,8 @@ SUBROUTINE SPPSV( UPLO, N, NRHS, AP, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/sppsvx.f b/SRC/sppsvx.f index 9870332f64..f9407bb761 100644 --- a/SRC/sppsvx.f +++ b/SRC/sppsvx.f @@ -307,7 +307,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, + SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, + $ LDB, $ X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK driver routine -- @@ -342,7 +343,8 @@ SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, EXTERNAL LSAME, SLAMCH, SLANSP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SLAQSP, SPPCON, SPPEQU, SPPRFS, + EXTERNAL SCOPY, SLACPY, SLAQSP, SPPCON, SPPEQU, + $ SPPRFS, $ SPPTRF, SPPTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -364,10 +366,13 @@ SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -462,7 +467,8 @@ SUBROUTINE SPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, + CALL SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + $ BERR, $ WORK, IWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/spstf2.f b/SRC/spstf2.f index 3721569eaa..acb33f1584 100644 --- a/SRC/spstf2.f +++ b/SRC/spstf2.f @@ -138,7 +138,8 @@ *> \ingroup pstf2 * * ===================================================================== - SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -273,7 +274,8 @@ SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) IF( PVT.LT.N ) $ CALL SSWAP( N-PVT, A( J, PVT+1 ), LDA, $ A( PVT, PVT+1 ), LDA ) - CALL SSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), 1 ) + CALL SSWAP( PVT-J-1, A( J, J+1 ), LDA, A( J+1, PVT ), + $ 1 ) * * Swap dot products and PIV * @@ -334,9 +336,11 @@ SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) A( PVT, PVT ) = A( J, J ) CALL SSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) IF( PVT.LT.N ) - $ CALL SSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ), + $ CALL SSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, + $ PVT ), $ 1 ) - CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), LDA ) + CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), + $ LDA ) * * Swap dot products and PIV * @@ -354,7 +358,8 @@ SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Compute elements J+1:N of column J * IF( J.LT.N ) THEN - CALL SGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), LDA, + CALL SGEMV( 'No Trans', N-J, J-1, -ONE, A( J+1, 1 ), + $ LDA, $ A( J, 1 ), LDA, ONE, A( J+1, J ), 1 ) CALL SSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) END IF diff --git a/SRC/spstrf.f b/SRC/spstrf.f index 355e9fcf20..689f1343d3 100644 --- a/SRC/spstrf.f +++ b/SRC/spstrf.f @@ -138,7 +138,8 @@ *> \ingroup pstrf * * ===================================================================== - SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -172,7 +173,8 @@ SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL SLAMCH, ILAENV, LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL SGEMV, SPSTF2, SSCAL, SSWAP, SSYRK, XERBLA + EXTERNAL SGEMV, SPSTF2, SSCAL, SSWAP, SSYRK, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT, MAXLOC @@ -314,7 +316,8 @@ SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Compute elements J+1:N of row J. * IF( J.LT.N ) THEN - CALL SGEMV( 'Trans', J-K, N-J, -ONE, A( K, J+1 ), + CALL SGEMV( 'Trans', J-K, N-J, -ONE, A( K, + $ J+1 ), $ LDA, A( K, J ), 1, ONE, A( J, J+1 ), $ LDA ) CALL SSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA ) @@ -378,11 +381,13 @@ SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Pivot OK, so can now swap pivot rows and columns * A( PVT, PVT ) = A( J, J ) - CALL SSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) + CALL SSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), + $ LDA ) IF( PVT.LT.N ) $ CALL SSWAP( N-PVT, A( PVT+1, J ), 1, $ A( PVT+1, PVT ), 1 ) - CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, J+1 ), + CALL SSWAP( PVT-J-1, A( J+1, J ), 1, A( PVT, + $ J+1 ), $ LDA ) * * Swap dot products and PIV diff --git a/SRC/sptsvx.f b/SRC/sptsvx.f index 31e336a047..f32f69857d 100644 --- a/SRC/sptsvx.f +++ b/SRC/sptsvx.f @@ -258,7 +258,8 @@ SUBROUTINE SPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, EXTERNAL LSAME, SLAMCH, SLANST * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SPTCON, SPTRFS, SPTTRF, SPTTRS, + EXTERNAL SCOPY, SLACPY, SPTCON, SPTRFS, SPTTRF, + $ SPTTRS, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f index ad9ee7ce9e..df58fc7ea6 100644 --- a/SRC/ssb2st_kernels.f +++ b/SRC/ssb2st_kernels.f @@ -289,7 +289,8 @@ SUBROUTINE SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = ( A( DPOS-NB, J1 ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP * CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), diff --git a/SRC/ssbev.f b/SRC/ssbev.f index 05d19f1a71..8a8c03683c 100644 --- a/SRC/ssbev.f +++ b/SRC/ssbev.f @@ -175,7 +175,8 @@ SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, SLAMCH, SLANSB * .. * .. External Subroutines .. - EXTERNAL SLASCL, SSBTRD, SSCAL, SSTEQR, SSTERF, XERBLA + EXTERNAL SLASCL, SSBTRD, SSCAL, SSTEQR, SSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -245,9 +246,11 @@ SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -255,7 +258,8 @@ SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, * INDE = 1 INDWRK = INDE + N - CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, call SSTEQR. @@ -263,7 +267,8 @@ SUBROUTINE SSBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF * diff --git a/SRC/ssbev_2stage.f b/SRC/ssbev_2stage.f index d9440374a9..9fa9409b90 100644 --- a/SRC/ssbev_2stage.f +++ b/SRC/ssbev_2stage.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, INFO ) * IMPLICIT NONE @@ -238,7 +239,8 @@ SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLASCL, SSCAL, SSTEQR, SSTERF, XERBLA, + EXTERNAL SLASCL, SSCAL, SSTEQR, SSTERF, + $ XERBLA, $ SSYTRD_SB2ST * .. * .. Intrinsic Functions .. @@ -331,9 +333,11 @@ SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -353,7 +357,8 @@ SUBROUTINE SSBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF * diff --git a/SRC/ssbevd.f b/SRC/ssbevd.f index 806287b7eb..909832b792 100644 --- a/SRC/ssbevd.f +++ b/SRC/ssbevd.f @@ -183,7 +183,8 @@ *> \ingroup hbevd * * ===================================================================== - SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, + SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -218,7 +219,8 @@ SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, SLAMCH, SLANSB, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASCL, SSBTRD, SSCAL, SSTEDC, + EXTERNAL SGEMM, SLACPY, SLASCL, SSBTRD, SSCAL, + $ SSTEDC, $ SSTERF, XERBLA * .. * .. Intrinsic Functions .. @@ -311,9 +313,11 @@ SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -323,7 +327,8 @@ SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, INDWRK = INDE + N INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 - CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL SSBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, call SSTEDC. @@ -333,7 +338,8 @@ SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, ELSE CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/ssbevd_2stage.f b/SRC/ssbevd_2stage.f index 44fa3ab9a2..65a959b25f 100644 --- a/SRC/ssbevd_2stage.f +++ b/SRC/ssbevd_2stage.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -264,7 +265,8 @@ SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASCL, SSCAL, SSTEDC, + EXTERNAL SGEMM, SLACPY, SLASCL, SSCAL, + $ SSTEDC, $ SSTERF, XERBLA, SSYTRD_SB2ST * .. * .. Intrinsic Functions .. @@ -283,9 +285,12 @@ SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LIWMIN = 1 LWMIN = 1 ELSE - IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', JOBZ, N, KD, IB, + $ -1 ) IF( WANTZ ) THEN LIWMIN = 3 + 5*N LWMIN = 1 + 5*N + 2*N**2 @@ -360,9 +365,11 @@ SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -386,7 +393,8 @@ SUBROUTINE SSBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, ELSE CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/ssbevx.f b/SRC/ssbevx.f index 5ec2ca3210..ce5fb3535b 100644 --- a/SRC/ssbevx.f +++ b/SRC/ssbevx.f @@ -260,7 +260,8 @@ *> \ingroup hbevx * * ===================================================================== - SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, + SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, + $ VL, $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * @@ -300,7 +301,8 @@ SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, EXTERNAL LSAME, SLAMCH, SLANSB * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SSBTRD, SSCAL, + EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SSBTRD, + $ SSCAL, $ SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -408,9 +410,11 @@ SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/ssbevx_2stage.f b/SRC/ssbevx_2stage.f index cd4fa826a3..3362834601 100644 --- a/SRC/ssbevx_2stage.f +++ b/SRC/ssbevx_2stage.f @@ -317,7 +317,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, + SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, + $ Q, $ LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, LWORK, IWORK, IFAIL, INFO ) * @@ -363,7 +364,8 @@ SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, SSCAL, + EXTERNAL SCOPY, SGEMV, SLACPY, SLASCL, + $ SSCAL, $ SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA, $ SSYTRD_SB2ST * .. @@ -494,9 +496,11 @@ SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL SLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA @@ -514,7 +518,8 @@ SUBROUTINE SSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, INDWRK = INDHOUS + LHTRD LLWORK = LWORK - INDWRK + 1 * - CALL SSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, WORK( INDD ), + CALL SSYTRD_SB2ST( "N", JOBZ, UPLO, N, KD, AB, LDAB, + $ WORK( INDD ), $ WORK( INDE ), WORK( INDHOUS ), LHTRD, $ WORK( INDWRK ), LLWORK, IINFO ) * diff --git a/SRC/ssbgst.f b/SRC/ssbgst.f index e203dfa5e7..de4dd0ce88 100644 --- a/SRC/ssbgst.f +++ b/SRC/ssbgst.f @@ -155,7 +155,8 @@ *> \ingroup hbgst * * ===================================================================== - SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, + SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ X, $ LDX, WORK, INFO ) * * -- LAPACK computational routine -- @@ -188,7 +189,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SGER, SLAR2V, SLARGV, SLARTG, SLARTV, SLASET, + EXTERNAL SGER, SLAR2V, SLARGV, SLARTG, SLARTV, + $ SLASET, $ SROT, SSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -428,7 +430,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL SLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1, + $ CALL SLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), + $ KA1, $ WORK( N+J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -652,7 +655,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * * generate rotation to annihilate a(i-k+ka+1,i) * - CALL SLARTG( AB( KA1-K, I ), RA1, WORK( N+I-K+KA-M ), + CALL SLARTG( AB( KA1-K, I ), RA1, + $ WORK( N+I-K+KA-M ), $ WORK( I-K+KA-M ), RA ) * * create nonzero element a(i-k+ka+1,i-k) outside the @@ -688,7 +692,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL SLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ), + $ CALL SLARGV( NRT, AB( KA1, J2T-KA ), INCA, + $ WORK( J2T-M ), $ KA1, WORK( N+J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -703,7 +708,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 1st set from both sides to diagonal * blocks * - CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, WORK( N+J2-M ), WORK( J2-M ), KA1 ) * END IF @@ -784,7 +790,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL SLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1, + CALL SLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), + $ KA1, $ WORK( N+J2 ), KA1 ) * * apply rotations in 2nd set from the left @@ -798,7 +805,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from both sides to diagonal * blocks * - CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL SLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, WORK( N+J2 ), WORK( J2 ), KA1 ) * END IF @@ -937,7 +945,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL SSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, I+1 ), + $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( KB, + $ I+1 ), $ LDBB-1, X( 1, I+1 ), LDX ) END IF * @@ -995,7 +1004,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL SLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1, + $ CALL SLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), + $ KA1, $ WORK( N+J1 ), KA1 ) IF( NR.GT.0 ) THEN * @@ -1095,7 +1105,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL SLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ), + CALL SLARGV( NR, AB( 1, J1+KA ), INCA, + $ WORK( M-KB+J1 ), $ KA1, WORK( N+M-KB+J1 ), KA1 ) * * apply rotations in 2nd set from the left @@ -1201,7 +1212,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL SSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), 1, + $ CALL SGER( NX, KBT, -ONE, X( 1, I ), 1, BB( 2, I ), + $ 1, $ X( 1, I+1 ), LDX ) END IF * @@ -1259,14 +1271,16 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL SLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1, + $ CALL SLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), + $ KA1, $ WORK( N+J1 ), KA1 ) IF( NR.GT.0 ) THEN * * apply rotations in 1st set from the right * DO 810 L = 1, KA - 1 - CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, WORK( N+J1 ), WORK( J1 ), KA1 ) 810 CONTINUE * @@ -1364,7 +1378,8 @@ SUBROUTINE SSBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from the right * DO 890 L = 1, KA - 1 - CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL SLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, WORK( N+M-KB+J1 ), WORK( M-KB+J1 ), $ KA1 ) 890 CONTINUE diff --git a/SRC/ssbgv.f b/SRC/ssbgv.f index 7dbdcaff76..3fb342d031 100644 --- a/SRC/ssbgv.f +++ b/SRC/ssbgv.f @@ -173,7 +173,8 @@ *> \ingroup hbgv * * ===================================================================== - SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, + SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + $ Z, $ LDZ, WORK, INFO ) * * -- LAPACK driver routine -- @@ -201,7 +202,8 @@ SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SPBSTF, SSBGST, SSBTRD, SSTEQR, SSTERF, XERBLA + EXTERNAL SPBSTF, SSBGST, SSBTRD, SSTEQR, SSTERF, + $ XERBLA * .. * .. Executable Statements .. * @@ -260,7 +262,8 @@ SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, ELSE VECT = 'N' END IF - CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, call SSTEQR. @@ -268,7 +271,8 @@ SUBROUTINE SSBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ INFO ) END IF RETURN diff --git a/SRC/ssbgvd.f b/SRC/ssbgvd.f index 9f6e393e62..7c7d974999 100644 --- a/SRC/ssbgvd.f +++ b/SRC/ssbgvd.f @@ -217,7 +217,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -252,7 +253,8 @@ SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SPBSTF, SSBGST, SSBTRD, SSTEDC, + EXTERNAL SGEMM, SLACPY, SPBSTF, SSBGST, SSBTRD, + $ SSTEDC, $ SSTERF, XERBLA * .. * .. Executable Statements .. @@ -340,7 +342,8 @@ SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, ELSE VECT = 'N' END IF - CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, LDZ, + CALL SSBTRD( VECT, UPLO, N, KA, AB, LDAB, W, WORK( INDE ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, call SSTEDC. @@ -350,7 +353,8 @@ SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, ELSE CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, $ WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO ) - CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), N, + CALL SGEMM( 'N', 'N', N, N, N, ONE, Z, LDZ, WORK( INDWRK ), + $ N, $ ZERO, WORK( INDWK2 ), N ) CALL SLACPY( 'A', N, N, WORK( INDWK2 ), N, Z, LDZ ) END IF diff --git a/SRC/ssbgvx.f b/SRC/ssbgvx.f index 717d4d8593..52c0316b3c 100644 --- a/SRC/ssbgvx.f +++ b/SRC/ssbgvx.f @@ -327,7 +327,8 @@ SUBROUTINE SSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SLACPY, SPBSTF, SSBGST, SSBTRD, + EXTERNAL SCOPY, SGEMV, SLACPY, SPBSTF, SSBGST, + $ SSBTRD, $ SSTEBZ, SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/ssbtrd.f b/SRC/ssbtrd.f index c883ca2073..675ab60f60 100644 --- a/SRC/ssbtrd.f +++ b/SRC/ssbtrd.f @@ -189,7 +189,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, REAL TEMP * .. * .. External Subroutines .. - EXTERNAL SLAR2V, SLARGV, SLARTG, SLARTV, SLASET, SROT, + EXTERNAL SLAR2V, SLARGV, SLARTG, SLARTV, SLASET, + $ SROT, $ XERBLA * .. * .. Intrinsic Functions .. @@ -271,7 +272,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * generate plane rotations to annihilate nonzero * elements which have been created outside the band * - CALL SLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ), + CALL SLARGV( NR, AB( 1, J1-1 ), INCA, + $ WORK( J1 ), $ KD1, D( J1 ), KD1 ) * * apply rotations from the right @@ -342,7 +344,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL SLARTV( NRT, AB( KD-L, J1+L ), INCA, + $ CALL SLARTV( NRT, AB( KD-L, J1+L ), + $ INCA, $ AB( KD-L+1, J1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 30 CONTINUE @@ -350,7 +353,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, J1END = J1 + KD1*( NR-2 ) IF( J1END.GE.J1 ) THEN DO 40 JIN = J1, J1END, KD1 - CALL SROT( KD-1, AB( KD-1, JIN+1 ), INCX, + CALL SROT( KD-1, AB( KD-1, JIN+1 ), + $ INCX, $ AB( KD, JIN+1 ), INCX, $ D( JIN ), WORK( JIN ) ) 40 CONTINUE @@ -385,13 +389,15 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 50 CONTINUE ELSE * DO 60 J = J1, J2, KD1 - CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 60 CONTINUE END IF @@ -474,7 +480,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * IF( NR.GT.2*KD-1 ) THEN DO 130 L = 1, KD - 1 - CALL SLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA, + CALL SLARTV( NR, AB( KD1-L, J1-KD1+L ), + $ INCA, $ AB( KD1-L+1, J1-KD1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 130 CONTINUE @@ -532,7 +539,8 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL SLARTV( NRT, AB( L+2, J1-1 ), INCA, + $ CALL SLARTV( NRT, AB( L+2, J1-1 ), + $ INCA, $ AB( L+1, J1 ), INCA, D( J1 ), $ WORK( J1 ), KD1 ) 150 CONTINUE @@ -577,13 +585,15 @@ SUBROUTINE SSBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL SROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 170 CONTINUE ELSE * DO 180 J = J1, J2, KD1 - CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL SROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 180 CONTINUE END IF diff --git a/SRC/ssfrk.f b/SRC/ssfrk.f index 4f0d84a0a0..577d318d8e 100644 --- a/SRC/ssfrk.f +++ b/SRC/ssfrk.f @@ -162,7 +162,8 @@ *> \ingroup hfrk * * ===================================================================== - SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, + $ BETA, $ C ) * * -- LAPACK computational routine -- @@ -282,9 +283,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ), + CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N ) * ELSE @@ -293,9 +296,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ), + CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N ) * END IF @@ -310,7 +315,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA, + CALL SSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL SGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N ) @@ -321,7 +327,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), LDA, + CALL SSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL SGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N ) @@ -344,7 +351,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL SGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( N1+1, 1 ), LDA, BETA, @@ -356,7 +364,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL SGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, N1+1 ), LDA, BETA, @@ -374,9 +383,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL SSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ), + CALL SGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 ) * ELSE @@ -385,9 +396,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL SSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ), + CALL SGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 ) * END IF @@ -414,9 +427,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ), + CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ), $ N+1 ) * @@ -426,9 +441,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ), + CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ), $ N+1 ) * @@ -444,7 +461,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ), @@ -456,7 +474,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ), @@ -480,7 +499,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, BETA, @@ -492,7 +512,8 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, BETA, @@ -510,9 +531,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL SSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ), + CALL SGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK ) * ELSE @@ -521,9 +544,11 @@ SUBROUTINE SSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL SSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL SSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ), + CALL SGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK ) * END IF diff --git a/SRC/sspcon.f b/SRC/sspcon.f index d5c5d74970..0385f99785 100644 --- a/SRC/sspcon.f +++ b/SRC/sspcon.f @@ -121,7 +121,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE SSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, + SUBROUTINE SSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/sspev.f b/SRC/sspev.f index f7532df44a..dc302b45d7 100644 --- a/SRC/sspev.f +++ b/SRC/sspev.f @@ -159,7 +159,8 @@ SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, SLAMCH, SLANSP * .. * .. External Subroutines .. - EXTERNAL SOPGTR, SSCAL, SSPTRD, SSTEQR, SSTERF, XERBLA + EXTERNAL SOPGTR, SSCAL, SSPTRD, SSTEQR, SSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -173,7 +174,8 @@ SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -227,7 +229,8 @@ SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) * INDE = 1 INDTAU = INDE + N - CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO ) + CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), + $ IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, first call * SOPGTR to generate the orthogonal matrix, then call SSTEQR. @@ -238,7 +241,8 @@ SUBROUTINE SSPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO ) INDWRK = INDTAU + N CALL SOPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ, $ WORK( INDWRK ), IINFO ) - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, WORK( INDTAU ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/sspevd.f b/SRC/sspevd.f index 9d685b12ac..0044ec8e5f 100644 --- a/SRC/sspevd.f +++ b/SRC/sspevd.f @@ -203,7 +203,8 @@ SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, EXTERNAL LSAME, SLAMCH, SLANSP, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SOPMTR, SSCAL, SSPTRD, SSTEDC, SSTERF, XERBLA + EXTERNAL SOPMTR, SSCAL, SSPTRD, SSTEDC, SSTERF, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -218,7 +219,8 @@ SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -297,7 +299,8 @@ SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, * INDE = 1 INDTAU = INDE + N - CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), IINFO ) + CALL SSPTRD( UPLO, N, AP, W, WORK( INDE ), WORK( INDTAU ), + $ IINFO ) * * For eigenvalues only, call SSTERF. For eigenvectors, first call * SSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the @@ -309,9 +312,11 @@ SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, ELSE INDWRK = INDTAU + N LLWORK = LWORK - INDWRK + 1 - CALL SSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL SSTEDC( 'I', N, W, WORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ LLWORK, IWORK, LIWORK, INFO ) - CALL SOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ, + CALL SOPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/sspevx.f b/SRC/sspevx.f index 6bb00d096d..c39e17a3d6 100644 --- a/SRC/sspevx.f +++ b/SRC/sspevx.f @@ -268,7 +268,8 @@ SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, EXTERNAL LSAME, SLAMCH, SLANSP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SOPGTR, SOPMTR, SSCAL, SSPTRD, SSTEBZ, + EXTERNAL SCOPY, SOPGTR, SOPMTR, SSCAL, SSPTRD, + $ SSTEBZ, $ SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -288,7 +289,8 @@ SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, INFO = -1 ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN INFO = -2 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -440,7 +442,8 @@ SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, * Apply orthogonal matrix used in reduction to tridiagonal * form to eigenvectors returned by SSTEIN. * - CALL SOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ, + CALL SOPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/sspgst.f b/SRC/sspgst.f index 89d98d8e20..9fd193b53d 100644 --- a/SRC/sspgst.f +++ b/SRC/sspgst.f @@ -136,7 +136,8 @@ SUBROUTINE SSPGST( ITYPE, UPLO, N, AP, BP, INFO ) REAL AJJ, AKK, BJJ, BKK, CT * .. * .. External Subroutines .. - EXTERNAL SAXPY, SSCAL, SSPMV, SSPR2, STPMV, STPSV, + EXTERNAL SAXPY, SSCAL, SSPMV, SSPR2, STPMV, + $ STPSV, $ XERBLA * .. * .. External Functions .. @@ -182,7 +183,8 @@ SUBROUTINE SSPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL SSPMV( UPLO, J-1, -ONE, AP, BP( J1 ), 1, ONE, $ AP( J1 ), 1 ) CALL SSCAL( J-1, ONE / BJJ, AP( J1 ), 1 ) - AP( JJ ) = ( AP( JJ )-SDOT( J-1, AP( J1 ), 1, BP( J1 ), + AP( JJ ) = ( AP( JJ )-SDOT( J-1, AP( J1 ), 1, + $ BP( J1 ), $ 1 ) ) / BJJ 10 CONTINUE ELSE diff --git a/SRC/sspgv.f b/SRC/sspgv.f index ae3b455683..e8023f22be 100644 --- a/SRC/sspgv.f +++ b/SRC/sspgv.f @@ -156,7 +156,8 @@ *> \ingroup hpgv * * ===================================================================== - SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ INFO ) * * -- LAPACK driver routine -- @@ -184,7 +185,8 @@ SUBROUTINE SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SPPTRF, SSPEV, SSPGST, STPMV, STPSV, XERBLA + EXTERNAL SPPTRF, SSPEV, SSPGST, STPMV, STPSV, + $ XERBLA * .. * .. Executable Statements .. * diff --git a/SRC/sspgvd.f b/SRC/sspgvd.f index a902280606..f776b37aa8 100644 --- a/SRC/sspgvd.f +++ b/SRC/sspgvd.f @@ -200,7 +200,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE SSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE SSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -230,7 +231,8 @@ SUBROUTINE SSPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SPPTRF, SSPEVD, SSPGST, STPMV, STPSV, XERBLA + EXTERNAL SPPTRF, SSPEVD, SSPGST, STPMV, STPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL diff --git a/SRC/sspgvx.f b/SRC/sspgvx.f index 0b19c5b789..5039add9f5 100644 --- a/SRC/sspgvx.f +++ b/SRC/sspgvx.f @@ -298,7 +298,8 @@ SUBROUTINE SSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SPPTRF, SSPEVX, SSPGST, STPMV, STPSV, XERBLA + EXTERNAL SPPTRF, SSPEVX, SSPGST, STPMV, STPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -365,7 +366,8 @@ SUBROUTINE SSPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * Transform problem to standard eigenvalue problem and solve. * CALL SSPGST( ITYPE, UPLO, N, AP, BP, INFO ) - CALL SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, + CALL SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, + $ M, $ W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN diff --git a/SRC/ssprfs.f b/SRC/ssprfs.f index 45b8461601..07e5653a65 100644 --- a/SRC/ssprfs.f +++ b/SRC/ssprfs.f @@ -175,7 +175,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -215,7 +216,8 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SSPMV, SSPTRS, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, SSPMV, SSPTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -278,7 +280,8 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * Compute residual R = B - A * X * CALL SCOPY( N, B( 1, J ), 1, WORK( N+1 ), 1 ) - CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, WORK( N+1 ), + CALL SSPMV( UPLO, N, -ONE, AP, X( 1, J ), 1, ONE, + $ WORK( N+1 ), $ 1 ) * * Compute componentwise relative backward error from formula @@ -347,7 +350,8 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * * Update solution and try again. * - CALL SSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, INFO ) + CALL SSPTRS( UPLO, N, 1, AFP, IPIV, WORK( N+1 ), N, + $ INFO ) CALL SAXPY( N, ONE, WORK( N+1 ), 1, X( 1, J ), 1 ) LSTRES = BERR( J ) COUNT = COUNT + 1 @@ -386,7 +390,8 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/sspsv.f b/SRC/sspsv.f index 5c9ef2c945..f4446c26f3 100644 --- a/SRC/sspsv.f +++ b/SRC/sspsv.f @@ -191,7 +191,8 @@ SUBROUTINE SSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/sspsvx.f b/SRC/sspsvx.f index 149a0c006f..61ee2ff222 100644 --- a/SRC/sspsvx.f +++ b/SRC/sspsvx.f @@ -272,7 +272,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK driver routine -- @@ -306,7 +307,8 @@ SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, SLAMCH, SLANSP * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SSPCON, SSPRFS, SSPTRF, SSPTRS, + EXTERNAL SCOPY, SLACPY, SSPCON, SSPRFS, SSPTRF, + $ SSPTRS, $ XERBLA * .. * .. Intrinsic Functions .. @@ -320,7 +322,8 @@ SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -358,7 +361,8 @@ SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * * Compute the reciprocal of the condition number of A. * - CALL SSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, INFO ) + CALL SSPCON( UPLO, N, AFP, IPIV, ANORM, RCOND, WORK, IWORK, + $ INFO ) * * Compute the solution vectors X. * @@ -368,7 +372,8 @@ SUBROUTINE SSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, IWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/ssptrd.f b/SRC/ssptrd.f index 9b388f8df1..176db4b884 100644 --- a/SRC/ssptrd.f +++ b/SRC/ssptrd.f @@ -266,7 +266,8 @@ SUBROUTINE SSPTRD( UPLO, N, AP, D, E, TAU, INFO ) * * Compute y := tau * A * v storing y in TAU(i:n-1) * - CALL SSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, + CALL SSPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), + $ 1, $ ZERO, TAU( I ), 1 ) * * Compute w := y - 1/2 * tau * (y**T *v) * v @@ -278,7 +279,8 @@ SUBROUTINE SSPTRD( UPLO, N, AP, D, E, TAU, INFO ) * Apply the transformation as a rank-2 update: * A := A - v * w**T - w * v**T * - CALL SSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, + CALL SSPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), + $ 1, $ AP( I1I1 ) ) * AP( II+1 ) = E( I ) diff --git a/SRC/ssptrf.f b/SRC/ssptrf.f index d6114aa57d..29785243c3 100644 --- a/SRC/ssptrf.f +++ b/SRC/ssptrf.f @@ -499,7 +499,8 @@ SUBROUTINE SSPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL SSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL SSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/ssptri.f b/SRC/ssptri.f index c5dfd64051..888c62ea38 100644 --- a/SRC/ssptri.f +++ b/SRC/ssptri.f @@ -218,7 +218,8 @@ SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL SCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ SDOT( K-1, WORK, 1, AP( KC ), 1 ) @@ -243,12 +244,14 @@ SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL SCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ SDOT( K-1, WORK, 1, AP( KC ), 1 ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ SDOT( K-1, AP( KC ), 1, AP( KCNEXT ), + $ SDOT( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL SCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL SSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, @@ -322,7 +325,8 @@ SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL SCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) CALL SSPMV( UPLO, N-K, -ONE, AP( KC+N-K+1 ), WORK, 1, $ ZERO, AP( KC+1 ), 1 ) - AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), 1 ) + AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), + $ 1 ) END IF KSTEP = 1 ELSE @@ -344,14 +348,17 @@ SUBROUTINE SSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL SCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KC+1 ), 1 ) - AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), 1 ) + AP( KC ) = AP( KC ) - SDOT( N-K, WORK, 1, AP( KC+1 ), + $ 1 ) AP( KCNEXT+1 ) = AP( KCNEXT+1 ) - $ SDOT( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL SCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL SSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - $ SDOT( N-K, WORK, 1, AP( KCNEXT+2 ), 1 ) diff --git a/SRC/ssptrs.f b/SRC/ssptrs.f index b80c6560d2..5694dfc8b4 100644 --- a/SRC/ssptrs.f +++ b/SRC/ssptrs.f @@ -268,7 +268,8 @@ SUBROUTINE SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -285,7 +286,8 @@ SUBROUTINE SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB ) @@ -356,7 +358,8 @@ SUBROUTINE SSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL SGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL SGER( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL SGER( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/sstebz.f b/SRC/sstebz.f index 1c88830760..3f79b5b713 100644 --- a/SRC/sstebz.f +++ b/SRC/sstebz.f @@ -268,7 +268,8 @@ *> \ingroup stebz * * ===================================================================== - SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, + SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, + $ E, $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * @@ -481,7 +482,8 @@ SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, IWORK( 5 ) = IL - 1 IWORK( 6 ) = IU * - CALL SLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E, + CALL SLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, + $ E, $ WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT, $ IWORK, W, IBLOCK, IINFO ) * @@ -623,7 +625,8 @@ SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, * ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) / $ LOG( TWO ) ) + 2 - CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN, + CALL SLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, + $ PIVMIN, $ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ), $ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT, $ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO ) diff --git a/SRC/sstedc.f b/SRC/sstedc.f index 5e3afaca7c..0f854e9e1f 100644 --- a/SRC/sstedc.f +++ b/SRC/sstedc.f @@ -213,7 +213,8 @@ SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLAED0, SLASCL, SLASET, SLASRT, + EXTERNAL SGEMM, SLACPY, SLAED0, SLASCL, SLASET, + $ SLASRT, $ SSTEQR, SSTERF, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -378,9 +379,11 @@ SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * Scale. * ORGNRM = SLANST( 'M', M, D( START ), E( START ) ) - CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), + $ M, $ INFO ) - CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + CALL SLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, + $ E( START ), $ M-1, INFO ) * IF( ICOMPZ.EQ.1 ) THEN @@ -399,7 +402,8 @@ SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * * Scale back. * - CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + CALL SLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), + $ M, $ INFO ) * ELSE @@ -409,7 +413,8 @@ SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * the length of D, we must solve the sub-problem in a * workspace and then multiply back into Z. * - CALL SSTEQR( 'I', M, D( START ), E( START ), WORK, M, + CALL SSTEQR( 'I', M, D( START ), E( START ), WORK, + $ M, $ WORK( M*M+1 ), INFO ) CALL SLACPY( 'A', N, M, Z( 1, START ), LDZ, $ WORK( STOREZ ), N ) diff --git a/SRC/sstein.f b/SRC/sstein.f index e66a1bedd5..5e861ac652 100644 --- a/SRC/sstein.f +++ b/SRC/sstein.f @@ -211,7 +211,8 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, EXTERNAL ISAMAX, SDOT, SLAMCH, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLAGTF, SLAGTS, SLARNV, SSCAL, + EXTERNAL SAXPY, SCOPY, SLAGTF, SLAGTS, SLARNV, + $ SSCAL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -355,7 +356,8 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Compute LU factors with partial pivoting ( PT = LU ) * TOL = ZERO - CALL SLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ), + CALL SLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK, $ IINFO ) * @@ -376,7 +378,8 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * * Solve the system LU = Pb. * - CALL SLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ), + CALL SLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK, $ WORK( INDRV1+1 ), TOL, IINFO ) * @@ -389,7 +392,8 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, $ GPIND = J IF( GPIND.NE.J ) THEN DO 80 I = GPIND, J - 1 - CTR = -SDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, I ), + CTR = -SDOT( BLKSIZ, WORK( INDRV1+1 ), 1, Z( B1, + $ I ), $ 1 ) CALL SAXPY( BLKSIZ, CTR, Z( B1, I ), 1, $ WORK( INDRV1+1 ), 1 ) diff --git a/SRC/sstemr.f b/SRC/sstemr.f index 973fd83723..eb310d9354 100644 --- a/SRC/sstemr.f +++ b/SRC/sstemr.f @@ -364,7 +364,8 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, EXTERNAL LSAME, SLAMCH, SLANST, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAE2, SLAEV2, SLARRC, SLARRE, SLARRJ, + EXTERNAL SCOPY, SLAE2, SLAEV2, SLARRC, SLARRE, + $ SLARRJ, $ SLARRR, SLARRV, SLASRT, SSCAL, SSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/ssteqr.f b/SRC/ssteqr.f index 21f80e940c..3616213ebd 100644 --- a/SRC/ssteqr.f +++ b/SRC/ssteqr.f @@ -164,7 +164,8 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, SLAMCH, SLANST, SLAPY2 * .. * .. External Subroutines .. - EXTERNAL SLAE2, SLAEV2, SLARTG, SLASCL, SLASET, SLASR, + EXTERNAL SLAE2, SLAEV2, SLARTG, SLASCL, SLASET, + $ SLASR, $ SLASRT, SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -270,13 +271,15 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) $ GO TO 10 IF( ANORM.GT.SSFMAX ) THEN ISCALE = 1 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) @@ -319,7 +322,8 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L+1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S ) + CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, + $ S ) WORK( L ) = C WORK( N-1+L ) = S CALL SLASR( 'R', 'V', 'B', N, 2, WORK( L ), @@ -378,7 +382,8 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = M - L + 1 - CALL SLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ), + CALL SLASR( 'R', 'V', 'B', N, MM, WORK( L ), + $ WORK( N-1+L ), $ Z( 1, L ), LDZ ) END IF * @@ -426,7 +431,8 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L-1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S ) + CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, + $ S ) WORK( M ) = C WORK( N-1+M ) = S CALL SLASR( 'R', 'V', 'F', N, 2, WORK( M ), @@ -485,7 +491,8 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = L - M + 1 - CALL SLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ), + CALL SLASR( 'R', 'V', 'F', N, MM, WORK( M ), + $ WORK( N-1+M ), $ Z( 1, M ), LDZ ) END IF * @@ -511,12 +518,14 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) IF( ISCALE.EQ.1 ) THEN CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL SLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) ELSE IF( ISCALE.EQ.2 ) THEN CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL SLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) END IF * diff --git a/SRC/ssterf.f b/SRC/ssterf.f index 8b02cd4140..5e6d1e68cc 100644 --- a/SRC/ssterf.f +++ b/SRC/ssterf.f @@ -190,13 +190,15 @@ SUBROUTINE SSTERF( N, D, E, INFO ) $ GO TO 10 IF( ANORM.GT.SSFMAX ) THEN ISCALE = 1 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL SLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) diff --git a/SRC/sstevd.f b/SRC/sstevd.f index 1201829cdd..676f44120b 100644 --- a/SRC/sstevd.f +++ b/SRC/sstevd.f @@ -275,7 +275,8 @@ SUBROUTINE SSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, D, E, INFO ) ELSE - CALL SSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, + CALL SSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, + $ LIWORK, $ INFO ) END IF * diff --git a/SRC/sstevr.f b/SRC/sstevr.f index de99212897..0eff542cdb 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -301,7 +301,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, + SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * @@ -341,7 +342,8 @@ SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, EXTERNAL LSAME, ILAENV, SLAMCH, SLANST, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEMR, SSTEIN, SSTERF, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEMR, SSTEIN, + $ SSTERF, $ SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -523,12 +525,14 @@ SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, ORDER = 'E' END IF - CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, + CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + $ M, $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), WORK, $ IWORK( INDIWO ), INFO ) * IF( WANTZ ) THEN - CALL SSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ), + CALL SSTEIN( N, D, E, M, W, IWORK( INDIBL ), + $ IWORK( INDISP ), $ Z, LDZ, WORK, IWORK( INDIWO ), IWORK( INDIFL ), $ INFO ) END IF diff --git a/SRC/sstevx.f b/SRC/sstevx.f index b492a91515..37bf92a8a2 100644 --- a/SRC/sstevx.f +++ b/SRC/sstevx.f @@ -223,7 +223,8 @@ *> \ingroup stevx * * ===================================================================== - SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, + SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * * -- LAPACK driver routine -- @@ -260,7 +261,8 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, EXTERNAL LSAME, SLAMCH, SLANST * .. * .. External Subroutines .. - EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEIN, SSTEQR, SSTERF, + EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEIN, SSTEQR, + $ SSTERF, $ SSWAP, XERBLA * .. * .. Intrinsic Functions .. @@ -378,7 +380,8 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK, INFO ) ELSE - CALL SSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), INFO ) + CALL SSTEQR( 'I', N, W, WORK, Z, LDZ, WORK( INDWRK ), + $ INFO ) IF( INFO.EQ.0 ) THEN DO 10 I = 1, N IFAIL( I ) = 0 @@ -402,7 +405,8 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, INDWRK = 1 INDISP = 1 + N INDIWO = INDISP + N - CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, + CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, + $ M, $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ), $ WORK( INDWRK ), IWORK( INDIWO ), INFO ) * diff --git a/SRC/ssycon_rook.f b/SRC/ssycon_rook.f index e1380b469a..c7925e770b 100644 --- a/SRC/ssycon_rook.f +++ b/SRC/ssycon_rook.f @@ -140,7 +140,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE SSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ IWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/ssyequb.f b/SRC/ssyequb.f index 81f1ffec42..6f24b3ae93 100644 --- a/SRC/ssyequb.f +++ b/SRC/ssyequb.f @@ -128,7 +128,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -173,7 +174,8 @@ SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/ssyev.f b/SRC/ssyev.f index e6af75587e..b23d3ad94d 100644 --- a/SRC/ssyev.f +++ b/SRC/ssyev.f @@ -163,7 +163,8 @@ SUBROUTINE SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF, SSYTRD, + EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF, + $ SSYTRD, $ XERBLA * .. * .. Intrinsic Functions .. @@ -256,9 +257,11 @@ SUBROUTINE SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE - CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/ssyev_2stage.f b/SRC/ssyev_2stage.f index aaadc82666..f2dd5ee7b1 100644 --- a/SRC/ssyev_2stage.f +++ b/SRC/ssyev_2stage.f @@ -217,7 +217,8 @@ SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF, + EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, + $ SSTERF, $ XERBLA, SSYTRD_2STAGE * .. * .. Intrinsic Functions .. @@ -243,10 +244,14 @@ SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = 2*N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -319,9 +324,11 @@ SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, * Not available in this release, and argument checking should not * let it getting here RETURN - CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) - CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, WORK( INDTAU ), + CALL SSTEQR( JOBZ, N, W, WORK( INDE ), A, LDA, + $ WORK( INDTAU ), $ INFO ) END IF * diff --git a/SRC/ssyevd.f b/SRC/ssyevd.f index 8bb05b62c7..5b511d9513 100644 --- a/SRC/ssyevd.f +++ b/SRC/ssyevd.f @@ -171,7 +171,8 @@ *> Modified description of INFO. Sven, 16 Feb 05. \n *> * ===================================================================== - SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, + SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ IWORK, $ LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -208,7 +209,8 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, SSTERF, + EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, + $ SSTERF, $ SSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -248,7 +250,8 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LWMIN = 2*N + 1 END IF LOPT = MAX( LWMIN, 2*N + - $ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) ) + $ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, + $ -1 ) ) LIOPT = LIWMIN END IF WORK( 1 ) = SROUNDUP_LWORK( LOPT ) diff --git a/SRC/ssyevd_2stage.f b/SRC/ssyevd_2stage.f index eb50dc0a13..9dc0f85927 100644 --- a/SRC/ssyevd_2stage.f +++ b/SRC/ssyevd_2stage.f @@ -217,7 +217,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, + $ LWORK, $ IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -257,7 +258,8 @@ SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, SLAMCH, SLANSY, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, SSTERF, + EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, + $ SSTERF, $ SSYTRD_2STAGE, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index f55268cd82..65df90a01f 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -333,7 +333,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * @@ -375,7 +376,8 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, SSTEIN, + EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, + $ SSTEIN, $ SSTERF, SSWAP, SSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -642,7 +644,8 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index dcae905380..2f08184803 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -424,7 +424,8 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, SSTEIN, + EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, + $ SSTEIN, $ SSTERF, SSWAP, SSYTRD_2STAGE, XERBLA * .. * .. Intrinsic Functions .. @@ -699,7 +700,8 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index 1bea52dbb0..35ffb1366d 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -248,7 +248,8 @@ *> \ingroup heevx * * ===================================================================== - SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * @@ -290,7 +291,8 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, SSTEBZ, + EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, + $ SSTEBZ, $ SSTEIN, SSTEQR, SSTERF, SSWAP, SSYTRD, XERBLA * .. * .. Intrinsic Functions .. @@ -343,7 +345,8 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ELSE LWKMIN = 8*N NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) - NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, -1 ) ) + NB = MAX( NB, ILAENV( 1, 'SORMTR', UPLO, N, -1, -1, + $ -1 ) ) LWKOPT = MAX( LWKMIN, ( NB + 3 )*N ) END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) @@ -495,7 +498,8 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/ssyevx_2stage.f b/SRC/ssyevx_2stage.f index 72ef53fb2f..7638962249 100644 --- a/SRC/ssyevx_2stage.f +++ b/SRC/ssyevx_2stage.f @@ -340,7 +340,8 @@ SUBROUTINE SSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, SSTEBZ, + EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, + $ SSTEBZ, $ SSTEIN, SSTEQR, SSTERF, SSWAP, XERBLA, $ SSYTRD_2STAGE * .. @@ -554,7 +555,8 @@ SUBROUTINE SSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDE LLWRKN = LWORK - INDWKN + 1 - CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL SORMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/ssygs2.f b/SRC/ssygs2.f index 63243bbe23..b3b85dd3df 100644 --- a/SRC/ssygs2.f +++ b/SRC/ssygs2.f @@ -150,7 +150,8 @@ SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) REAL AKK, BKK, CT * .. * .. External Subroutines .. - EXTERNAL SAXPY, SSCAL, SSYR2, STRMV, STRSV, XERBLA + EXTERNAL SAXPY, SSCAL, SSYR2, STRMV, STRSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -222,10 +223,12 @@ SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) IF( K.LT.N ) THEN CALL SSCAL( N-K, ONE / BKK, A( K+1, K ), 1 ) CT = -HALF*AKK - CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL SSYR2( UPLO, N-K, -ONE, A( K+1, K ), 1, $ B( K+1, K ), 1, A( K+1, K+1 ), LDA ) - CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL SAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL STRSV( UPLO, 'No transpose', 'Non-unit', N-K, $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 ) END IF @@ -246,7 +249,8 @@ SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDB, A( 1, K ), 1 ) CT = HALF*AKK CALL SAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) - CALL SSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), 1, + CALL SSYR2( UPLO, K-1, ONE, A( 1, K ), 1, B( 1, K ), + $ 1, $ A, LDA ) CALL SAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) CALL SSCAL( K-1, BKK, A( 1, K ), 1 ) @@ -262,7 +266,8 @@ SUBROUTINE SSYGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * AKK = A( K, K ) BKK = B( K, K ) - CALL STRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, LDB, + CALL STRMV( UPLO, 'Transpose', 'Non-unit', K-1, B, + $ LDB, $ A( K, 1 ), LDA ) CT = HALF*AKK CALL SAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) diff --git a/SRC/ssygst.f b/SRC/ssygst.f index 90cff39d9f..973711e197 100644 --- a/SRC/ssygst.f +++ b/SRC/ssygst.f @@ -149,7 +149,8 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) INTEGER K, KB, NB * .. * .. External Subroutines .. - EXTERNAL SSYGS2, SSYMM, SSYR2K, STRMM, STRSM, XERBLA + EXTERNAL SSYGS2, SSYMM, SSYR2K, STRMM, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -212,13 +213,15 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL STRSM( 'Left', UPLO, 'Transpose', 'Non-unit', + CALL STRSM( 'Left', UPLO, 'Transpose', + $ 'Non-unit', $ KB, N-K-KB+1, ONE, B( K, K ), LDB, $ A( K, K+KB ), LDA ) CALL SSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, $ A( K, K ), LDA, B( K, K+KB ), LDB, ONE, $ A( K, K+KB ), LDA ) - CALL SSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, -ONE, + CALL SSYR2K( UPLO, 'Transpose', N-K-KB+1, KB, + $ -ONE, $ A( K, K+KB ), LDA, B( K, K+KB ), LDB, $ ONE, A( K+KB, K+KB ), LDA ) CALL SSYMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, @@ -242,7 +245,8 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL STRSM( 'Right', UPLO, 'Transpose', 'Non-unit', + CALL STRSM( 'Right', UPLO, 'Transpose', + $ 'Non-unit', $ N-K-KB+1, KB, ONE, B( K, K ), LDB, $ A( K+KB, K ), LDA ) CALL SSYMM( 'Right', UPLO, N-K-KB+1, KB, -HALF, @@ -271,14 +275,17 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the upper triangle of A(1:k+kb-1,1:k+kb-1) * - CALL STRMM( 'Left', UPLO, 'No transpose', 'Non-unit', + CALL STRMM( 'Left', UPLO, 'No transpose', + $ 'Non-unit', $ K-1, KB, ONE, B, LDB, A( 1, K ), LDA ) - CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA ) CALL SSYR2K( UPLO, 'No transpose', K-1, KB, ONE, $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A, $ LDA ) - CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL SSYMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, ONE, A( 1, K ), LDA ) CALL STRMM( 'Right', UPLO, 'Transpose', 'Non-unit', $ K-1, KB, ONE, B( K, K ), LDB, A( 1, K ), @@ -295,7 +302,8 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the lower triangle of A(1:k+kb-1,1:k+kb-1) * - CALL STRMM( 'Right', UPLO, 'No transpose', 'Non-unit', + CALL STRMM( 'Right', UPLO, 'No transpose', + $ 'Non-unit', $ KB, K-1, ONE, B, LDB, A( K, 1 ), LDA ) CALL SSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA ) @@ -304,7 +312,8 @@ SUBROUTINE SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDA ) CALL SSYMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, ONE, A( K, 1 ), LDA ) - CALL STRMM( 'Left', UPLO, 'Transpose', 'Non-unit', KB, + CALL STRMM( 'Left', UPLO, 'Transpose', 'Non-unit', + $ KB, $ K-1, ONE, B( K, K ), LDB, A( K, 1 ), LDA ) CALL SSYGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) diff --git a/SRC/ssygv.f b/SRC/ssygv.f index cd6c5b10a7..0dfabbb2c1 100644 --- a/SRC/ssygv.f +++ b/SRC/ssygv.f @@ -171,7 +171,8 @@ *> \ingroup hegv * * ===================================================================== - SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -204,7 +205,8 @@ SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SPOTRF, SSYEV, SSYGST, STRMM, STRSM, XERBLA + EXTERNAL SPOTRF, SSYEV, SSYGST, STRMM, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -286,7 +288,8 @@ SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'T' END IF * - CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -300,7 +303,8 @@ SUBROUTINE SSYGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'N' END IF * - CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/ssygv_2stage.f b/SRC/ssygv_2stage.f index fdea246d74..79c4dd4dc5 100644 --- a/SRC/ssygv_2stage.f +++ b/SRC/ssygv_2stage.f @@ -222,7 +222,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, + $ W, $ WORK, LWORK, INFO ) * IMPLICIT NONE @@ -257,7 +258,8 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, EXTERNAL LSAME, ILAENV2STAGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SPOTRF, SSYGST, STRMM, STRSM, XERBLA, + EXTERNAL SPOTRF, SSYGST, STRMM, STRSM, + $ XERBLA, $ SSYEV_2STAGE * .. * .. Intrinsic Functions .. @@ -287,10 +289,14 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = 2*N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -322,7 +328,8 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, * Transform problem to standard eigenvalue problem and solve. * CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) + CALL SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ INFO ) * IF( WANTZ ) THEN * @@ -342,7 +349,8 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'T' END IF * - CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -356,7 +364,8 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'N' END IF * - CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/ssygvd.f b/SRC/ssygvd.f index 85b817eed0..3f70819d52 100644 --- a/SRC/ssygvd.f +++ b/SRC/ssygvd.f @@ -217,7 +217,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA *> * ===================================================================== - SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -250,7 +251,8 @@ SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SPOTRF, SSYEVD, SSYGST, STRMM, STRSM, XERBLA + EXTERNAL SPOTRF, SSYEVD, SSYGST, STRMM, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL @@ -324,7 +326,8 @@ SUBROUTINE SSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, + CALL SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, + $ LIWORK, $ INFO ) LOPT = INT( MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) ) LIOPT = INT( MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) ) diff --git a/SRC/ssygvx.f b/SRC/ssygvx.f index be45b22382..4c5ea41cea 100644 --- a/SRC/ssygvx.f +++ b/SRC/ssygvx.f @@ -329,7 +329,8 @@ SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, EXTERNAL ILAENV, LSAME, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SPOTRF, SSYEVX, SSYGST, STRMM, STRSM, XERBLA + EXTERNAL SPOTRF, SSYEVX, SSYGST, STRMM, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -414,7 +415,8 @@ SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, * Transform problem to standard eigenvalue problem and solve. * CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, + CALL SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN @@ -434,7 +436,8 @@ SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'T' END IF * - CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B, + CALL STRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, + $ B, $ LDB, Z, LDZ ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -448,7 +451,8 @@ SUBROUTINE SSYGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'N' END IF * - CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, B, + CALL STRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, ONE, + $ B, $ LDB, Z, LDZ ) END IF END IF diff --git a/SRC/ssyrfs.f b/SRC/ssyrfs.f index aa4b9717f4..9a960b0572 100644 --- a/SRC/ssyrfs.f +++ b/SRC/ssyrfs.f @@ -187,7 +187,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, SSYMV, SSYTRS, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, SSYMV, SSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -396,14 +398,16 @@ SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * KASE = 0 100 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(A**T). * - CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) DO 110 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) @@ -415,7 +419,8 @@ SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 120 CONTINUE - CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), N, + CALL SSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK( N+1 ), + $ N, $ INFO ) END IF GO TO 100 diff --git a/SRC/ssyrfsx.f b/SRC/ssyrfsx.f index a4e8eee98c..7416573f23 100644 --- a/SRC/ssyrfsx.f +++ b/SRC/ssyrfsx.f @@ -396,7 +396,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE SSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE SSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, IWORK, INFO ) @@ -518,7 +519,8 @@ SUBROUTINE SSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF ( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF ( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -657,7 +659,8 @@ SUBROUTINE SSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, DO J = 1, NRHS IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG ) $ THEN - RCOND_TMP = SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = SLA_SYRCOND( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ 1, X(1,J), INFO, WORK, IWORK ) ELSE RCOND_TMP = 0.0 diff --git a/SRC/ssysv.f b/SRC/ssysv.f index a0742346b6..f0aa0fee7f 100644 --- a/SRC/ssysv.f +++ b/SRC/ssysv.f @@ -206,7 +206,8 @@ SUBROUTINE SSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/ssysv_rk.f b/SRC/ssysv_rk.f index e3165c1d94..c0ca14eb7a 100644 --- a/SRC/ssysv_rk.f +++ b/SRC/ssysv_rk.f @@ -263,7 +263,8 @@ SUBROUTINE SSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -281,7 +282,8 @@ SUBROUTINE SSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) @@ -303,7 +305,8 @@ SUBROUTINE SSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/ssysv_rook.f b/SRC/ssysv_rook.f index 0da9cfab94..b48ae14024 100644 --- a/SRC/ssysv_rook.f +++ b/SRC/ssysv_rook.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE SSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -239,7 +240,8 @@ SUBROUTINE SSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -279,7 +281,8 @@ SUBROUTINE SSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS_ROOK ( Use Level 2 BLAS) * - CALL SSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL SSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/ssysvx.f b/SRC/ssysvx.f index 8d2754f0b2..e809e9101d 100644 --- a/SRC/ssysvx.f +++ b/SRC/ssysvx.f @@ -279,7 +279,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ IWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLACPY, SSYCON, SSYRFS, SSYTRF, SSYTRS, XERBLA + EXTERNAL SLACPY, SSYCON, SSYRFS, SSYTRF, SSYTRS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -331,7 +333,8 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LWKMIN = MAX( 1, 3*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -387,7 +390,8 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL SSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, IWORK, + CALL SSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ IWORK, $ INFO ) * * Compute the solution vectors X. diff --git a/SRC/ssysvxx.f b/SRC/ssysvxx.f index 03b16863d4..a7f062f59e 100644 --- a/SRC/ssysvxx.f +++ b/SRC/ssysvxx.f @@ -502,7 +502,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE SSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE SSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, IWORK, INFO ) @@ -630,7 +631,8 @@ SUBROUTINE SSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -649,7 +651,8 @@ SUBROUTINE SSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^T or UDU^T factorization of A. * CALL SLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL SSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL SSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * diff --git a/SRC/ssytd2.f b/SRC/ssytd2.f index f63252ed49..2769d09764 100644 --- a/SRC/ssytd2.f +++ b/SRC/ssytd2.f @@ -249,7 +249,8 @@ SUBROUTINE SSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute x := tau * A * v storing x in TAU(1:i) * - CALL SSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, + CALL SSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, + $ ZERO, $ TAU, 1 ) * * Compute w := x - 1/2 * tau * (x**T * v) * v @@ -295,14 +296,16 @@ SUBROUTINE SSYTD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute w := x - 1/2 * tau * (x**T * v) * v * - ALPHA = -HALF*TAUI*SDOT( N-I, TAU( I ), 1, A( I+1, I ), + ALPHA = -HALF*TAUI*SDOT( N-I, TAU( I ), 1, A( I+1, + $ I ), $ 1 ) CALL SAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**T - w * v**T * - CALL SSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, + CALL SSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), + $ 1, $ A( I+1, I+1 ), LDA ) * A( I+1, I ) = E( I ) diff --git a/SRC/ssytf2.f b/SRC/ssytf2.f index d4b8e5e011..886e556b21 100644 --- a/SRC/ssytf2.f +++ b/SRC/ssytf2.f @@ -286,7 +286,8 @@ SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ SISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -456,7 +457,8 @@ SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. SISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ SISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -478,7 +480,8 @@ SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, ABS( A( JMAX, IMAX ) ) ) END IF * @@ -510,7 +513,8 @@ SUBROUTINE SSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) T = A( KK, KK ) diff --git a/SRC/ssytf2_rk.f b/SRC/ssytf2_rk.f index ceccd36f16..d67bd7d1c7 100644 --- a/SRC/ssytf2_rk.f +++ b/SRC/ssytf2_rk.f @@ -461,7 +461,8 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL SSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL SSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -476,7 +477,8 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.GT.1 ) $ CALL SSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -518,7 +520,8 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / A( K, K ) - CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -537,7 +540,8 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -695,14 +699,16 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ISAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = ABS( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -761,7 +767,8 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( P.LT.N ) $ CALL SSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL SSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL SSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -783,9 +790,11 @@ SUBROUTINE SSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/ssytf2_rook.f b/SRC/ssytf2_rook.f index 6d0f958f67..45bd45c5a8 100644 --- a/SRC/ssytf2_rook.f +++ b/SRC/ssytf2_rook.f @@ -411,7 +411,8 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.GT.1 ) $ CALL SSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL SSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -445,7 +446,8 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / A( K, K ) - CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -464,7 +466,8 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL SSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -594,14 +597,16 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + ISAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = ABS( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + ISAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + ISAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) STEMP = ABS( A( ITEMP, IMAX ) ) IF( STEMP.GT.ROWMAX ) THEN @@ -660,7 +665,8 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( P.LT.N ) $ CALL SSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL SSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL SSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -675,9 +681,11 @@ SUBROUTINE SSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL SSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL SSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/ssytrd.f b/SRC/ssytrd.f index d9bd7e02f5..184cc9165d 100644 --- a/SRC/ssytrd.f +++ b/SRC/ssytrd.f @@ -189,7 +189,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) + SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -317,7 +318,8 @@ SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) * Update the unreduced submatrix A(1:i-1,1:i-1), using an * update of the form: A := A - V*W**T - W*V**T * - CALL SSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, I ), + CALL SSYR2K( UPLO, 'No transpose', I-1, NB, -ONE, A( 1, + $ I ), $ LDA, WORK, LDWORK, ONE, A, LDA ) * * Copy superdiagonal elements back into A, and diagonal diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index 47f885e83f..c6cb196d30 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -277,7 +277,8 @@ SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, $ TPOS, WPOS, S2POS, S1POS * .. * .. External Subroutines .. - EXTERNAL XERBLA, SSYR2K, SSYMM, SGEMM, SCOPY, + EXTERNAL XERBLA, SSYR2K, SSYMM, SGEMM, + $ SCOPY, $ SLARFT, SGELQF, SGEQRF, SLASET * .. * .. Intrinsic Functions .. @@ -386,7 +387,8 @@ SUBROUTINE SSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, * DO 20 J = I, I+PK-1 LK = MIN( KD, N-J ) + 1 - CALL SCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 ) + CALL SCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), + $ LDAB-1 ) 20 CONTINUE * CALL SLASET( 'Lower', PK, PK, ZERO, ONE, diff --git a/SRC/ssytrf.f b/SRC/ssytrf.f index a6e8af3f30..b66eb37f26 100644 --- a/SRC/ssytrf.f +++ b/SRC/ssytrf.f @@ -251,7 +251,8 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'SSYTRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'SSYTRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -321,13 +322,15 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL SLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL SLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, LDWORK, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL SSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL SSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index 4ffaadde50..3fc35d7c1c 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -166,7 +166,8 @@ SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLASYF_AA, SGEMV, SSCAL, SCOPY, SSWAP, SGEMM, + EXTERNAL SLASYF_AA, SGEMV, SSCAL, SCOPY, SSWAP, + $ SGEMM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/ssytrf_rk.f b/SRC/ssytrf_rk.f index d80e685676..b063d63e46 100644 --- a/SRC/ssytrf_rk.f +++ b/SRC/ssytrf_rk.f @@ -285,7 +285,8 @@ SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLASYF_RK, SSYTF2_RK, SSWAP, XERBLA + EXTERNAL SLASYF_RK, SSYTF2_RK, SSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -427,7 +428,8 @@ SUBROUTINE SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL SLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL SLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/ssytrf_rook.f b/SRC/ssytrf_rook.f index 06a94d0fd0..dbf98be353 100644 --- a/SRC/ssytrf_rook.f +++ b/SRC/ssytrf_rook.f @@ -205,7 +205,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/ssytri.f b/SRC/ssytri.f index 6fe4445e14..9f11e15c7e 100644 --- a/SRC/ssytri.f +++ b/SRC/ssytri.f @@ -249,7 +249,8 @@ SUBROUTINE SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) A( K, K ) = A( K, K ) - SDOT( K-1, WORK, 1, A( 1, K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ SDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ SDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL SCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL SSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -308,9 +309,11 @@ SUBROUTINE SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -333,15 +336,19 @@ SUBROUTINE SSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ SDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ SDOT( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL SCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - $ SDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 ) diff --git a/SRC/ssytri2x.f b/SRC/ssytri2x.f index 3c49240cea..add882bb57 100644 --- a/SRC/ssytri2x.f +++ b/SRC/ssytri2x.f @@ -382,8 +382,10 @@ SUBROUTINE SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -568,12 +570,16 @@ SUBROUTINE SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF ( I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/ssytri_3x.f b/SRC/ssytri_3x.f index 60a631a6e4..d0fd016c03 100644 --- a/SRC/ssytri_3x.f +++ b/SRC/ssytri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -188,7 +189,8 @@ SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SGEMM, SSYSWAPR, STRTRI, STRMM, XERBLA + EXTERNAL SGEMM, SSYSWAPR, STRTRI, STRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MOD @@ -432,8 +434,10 @@ SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -628,8 +632,10 @@ SUBROUTINE SSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL SSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/ssytri_rook.f b/SRC/ssytri_rook.f index cbe9e4dd6b..efbee73e0a 100644 --- a/SRC/ssytri_rook.f +++ b/SRC/ssytri_rook.f @@ -264,7 +264,8 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) A( K, K ) = A( K, K ) - SDOT( K-1, WORK, 1, A( 1, K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ SDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ SDOT( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL SCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL SSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -283,7 +284,8 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL SSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -297,7 +299,8 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL SSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -312,7 +315,8 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL SSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL SSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -350,9 +354,11 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -375,15 +381,19 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL SCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - SDOT( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ SDOT( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ SDOT( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL SCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL SSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - $ SDOT( N-K, WORK, 1, A( K+1, K-1 ), 1 ) @@ -399,8 +409,10 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -413,8 +425,10 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -428,8 +442,10 @@ SUBROUTINE SSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL SSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL SSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP diff --git a/SRC/ssytrs.f b/SRC/ssytrs.f index baa23c8009..4cb2fcdca1 100644 --- a/SRC/ssytrs.f +++ b/SRC/ssytrs.f @@ -271,7 +271,8 @@ SUBROUTINE SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -287,7 +288,8 @@ SUBROUTINE SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) CALL SGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB ) @@ -355,7 +357,8 @@ SUBROUTINE SSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/ssytrs2.f b/SRC/ssytrs2.f index 9e99aa065d..dd8a39fef8 100644 --- a/SRC/ssytrs2.f +++ b/SRC/ssytrs2.f @@ -160,7 +160,8 @@ SUBROUTINE SSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SSCAL, SSYCONV, SSWAP, STRSM, XERBLA + EXTERNAL SSCAL, SSYCONV, SSWAP, STRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX diff --git a/SRC/ssytrs_3.f b/SRC/ssytrs_3.f index 3cf3e6c48c..b6ee69761d 100644 --- a/SRC/ssytrs_3.f +++ b/SRC/ssytrs_3.f @@ -247,7 +247,8 @@ SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL STRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -273,7 +274,8 @@ SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ] * - CALL STRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**T \ (D \ (U \P**T * B) )) ] * @@ -314,7 +316,8 @@ SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL STRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -340,7 +343,8 @@ SUBROUTINE SSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ] * - CALL STRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**T \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/ssytrs_aa.f b/SRC/ssytrs_aa.f index d7def08060..f9231b9943 100644 --- a/SRC/ssytrs_aa.f +++ b/SRC/ssytrs_aa.f @@ -223,13 +223,15 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, DO WHILE ( K.LE.N ) KP = IPIV( K ) IF( KP.NE.K ) - $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), + $ LDB ) K = K + 1 END DO * * Compute U**T \ B -> B [ (U**T \P**T * B) ] * - CALL STRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL STRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -252,7 +254,8 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL STRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL STRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B(2, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -308,7 +311,8 @@ SUBROUTINE SSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L**T \ B -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL STRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL STRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/ssytrs_aa_2stage.f b/SRC/ssytrs_aa_2stage.f index fc2296628b..11aed3adba 100644 --- a/SRC/ssytrs_aa_2stage.f +++ b/SRC/ssytrs_aa_2stage.f @@ -216,7 +216,8 @@ SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * - CALL STRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL STRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -229,7 +230,8 @@ SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL STRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL STRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -250,7 +252,8 @@ SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \ B) -> B [ (L \P**T * B) ] * - CALL STRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL STRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -263,7 +266,8 @@ SUBROUTINE SSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL STRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL STRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/ssytrs_rook.f b/SRC/ssytrs_rook.f index e1b1a684d7..e60ba9dda1 100644 --- a/SRC/ssytrs_rook.f +++ b/SRC/ssytrs_rook.f @@ -251,7 +251,8 @@ SUBROUTINE SSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, IF( K.GT.2 ) THEN CALL SGER( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), $ LDB, B( 1, 1 ), LDB ) - CALL SGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), + CALL SGER( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, + $ 1 ), $ LDB, B( 1, 1 ), LDB ) END IF * @@ -389,7 +390,8 @@ SUBROUTINE SSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL SGER( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/stbcon.f b/SRC/stbcon.f index 3530a9b295..48a70913f0 100644 --- a/SRC/stbcon.f +++ b/SRC/stbcon.f @@ -139,7 +139,8 @@ *> \ingroup tbcon * * ===================================================================== - SUBROUTINE STBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, + SUBROUTINE STBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, + $ WORK, $ IWORK, INFO ) * * -- LAPACK computational routine -- @@ -239,19 +240,22 @@ SUBROUTINE STBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, END IF KASE = 0 10 CONTINUE - CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * * Multiply by inv(A). * - CALL SLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD, + CALL SLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ KD, $ AB, LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO ) ELSE * * Multiply by inv(A**T). * - CALL SLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, AB, + CALL SLATBS( UPLO, 'Transpose', DIAG, NORMIN, N, KD, + $ AB, $ LDAB, WORK, SCALE, WORK( 2*N+1 ), INFO ) END IF NORMIN = 'Y' diff --git a/SRC/stbrfs.f b/SRC/stbrfs.f index ac34a39e11..9c2a274de3 100644 --- a/SRC/stbrfs.f +++ b/SRC/stbrfs.f @@ -219,7 +219,8 @@ SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, STBMV, STBSV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, STBMV, STBSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -440,7 +441,8 @@ SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * KASE = 0 210 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/stbtrs.f b/SRC/stbtrs.f index c0d8b8a866..72332967ab 100644 --- a/SRC/stbtrs.f +++ b/SRC/stbtrs.f @@ -187,7 +187,8 @@ SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 @@ -232,7 +233,8 @@ SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * Solve A * X = B or A**T * X = B. * DO 30 J = 1, NRHS - CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) + CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), + $ 1 ) 30 CONTINUE * RETURN diff --git a/SRC/stfsm.f b/SRC/stfsm.f index a91580e9c0..84c9e48675 100644 --- a/SRC/stfsm.f +++ b/SRC/stfsm.f @@ -273,7 +273,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, + SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, + $ A, $ B, LDB ) * * -- LAPACK computational routine -- @@ -328,7 +329,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, INFO = -3 ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN INFO = -4 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -5 ELSE IF( M.LT.0 ) THEN @@ -399,12 +401,15 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A, M, B, LDB ) ELSE - CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) - CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), + CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, + $ A( M1 ), $ M, B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, $ A( M ), M, B( M1, 0 ), LDB ) @@ -416,12 +421,15 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'T' * IF( M.EQ.1 ) THEN - CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) ELSE - CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, + $ ALPHA, $ A( M ), M, B( M1, 0 ), LDB ) - CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), + CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, + $ A( M1 ), $ M, B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, $ A( 0 ), M, B, LDB ) @@ -440,7 +448,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, $ A( M2 ), M, B, LDB ) - CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), M, + CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, A( 0 ), + $ M, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, $ A( M1 ), M, B( M1, 0 ), LDB ) @@ -452,7 +461,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, $ A( M1 ), M, B( M1, 0 ), LDB ) - CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), M, + CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, A( 0 ), + $ M, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, $ A( M2 ), M, B, LDB ) @@ -475,10 +485,12 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, $ A( M1*M1 ), M1, B, LDB, ALPHA, @@ -493,10 +505,12 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'T' * IF( M.EQ.1 ) THEN - CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, + CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, + $ ALPHA, $ A( 1 ), M1, B( M1, 0 ), LDB ) CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, $ A( M1*M1 ), M1, B( M1, 0 ), LDB, @@ -518,7 +532,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, $ A( M2*M2 ), M2, B, LDB ) - CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), M2, + CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( 0 ), + $ M2, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL STRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) @@ -530,7 +545,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) - CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), M2, + CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( 0 ), + $ M2, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, $ A( M2*M2 ), M2, B, LDB ) @@ -590,7 +606,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, $ A( K+1 ), M+1, B, LDB ) - CALL SGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), M+1, + CALL SGEMM( 'T', 'N', K, N, K, -ONE, A( 0 ), + $ M+1, $ B, LDB, ALPHA, B( K, 0 ), LDB ) CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ONE, $ A( K ), M+1, B( K, 0 ), LDB ) @@ -601,7 +618,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * and TRANS = 'T' CALL STRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, $ A( K ), M+1, B( K, 0 ), LDB ) - CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), M+1, + CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), + $ M+1, $ B( K, 0 ), LDB, ALPHA, B, LDB ) CALL STRSM( 'L', 'L', 'T', DIAG, K, N, ONE, $ A( K+1 ), M+1, B, LDB ) @@ -657,7 +675,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'L', 'U', 'T', DIAG, K, N, ALPHA, $ A( K*( K+1 ) ), K, B, LDB ) - CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, B, + CALL SGEMM( 'N', 'N', K, N, K, -ONE, A( 0 ), K, + $ B, $ LDB, ALPHA, B( K, 0 ), LDB ) CALL STRSM( 'L', 'L', 'N', DIAG, K, N, ONE, $ A( K*K ), K, B( K, 0 ), LDB ) @@ -723,7 +742,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA, $ A( N ), N, B( 0, N1 ), LDB ) - CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ), + CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ), $ LDB ) CALL STRSM( 'R', 'L', 'N', DIAG, M, N1, ONE, @@ -736,7 +756,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA, $ A( 0 ), N, B( 0, 0 ), LDB ) - CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ), + CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL STRSM( 'R', 'U', 'N', DIAG, M, N2, ONE, @@ -755,7 +776,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'L', 'T', DIAG, M, N1, ALPHA, $ A( N2 ), N, B( 0, 0 ), LDB ) - CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ), + CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL STRSM( 'R', 'U', 'N', DIAG, M, N2, ONE, @@ -768,7 +790,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'U', 'T', DIAG, M, N2, ALPHA, $ A( N1 ), N, B( 0, N1 ), LDB ) - CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ), + CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB ) CALL STRSM( 'R', 'L', 'N', DIAG, M, N1, ONE, $ A( N2 ), N, B( 0, 0 ), LDB ) @@ -792,7 +815,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( 1 ), N1, B( 0, N1 ), LDB ) - CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, N1 ), + CALL SGEMM( 'N', 'T', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ), $ LDB ) CALL STRSM( 'R', 'U', 'T', DIAG, M, N1, ONE, @@ -805,7 +829,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( 0 ), N1, B( 0, 0 ), LDB ) - CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, 0 ), + CALL SGEMM( 'N', 'N', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ), $ LDB ) CALL STRSM( 'R', 'L', 'T', DIAG, M, N2, ONE, @@ -824,7 +849,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) - CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, 0 ), + CALL SGEMM( 'N', 'T', M, N2, N1, -ONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ), $ LDB ) CALL STRSM( 'R', 'L', 'T', DIAG, M, N2, ONE, @@ -837,7 +863,8 @@ SUBROUTINE STFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL STRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) - CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, N1 ), + CALL SGEMM( 'N', 'N', M, N1, N2, -ONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ), $ LDB ) CALL STRSM( 'R', 'U', 'T', DIAG, M, N1, ONE, diff --git a/SRC/stftri.f b/SRC/stftri.f index 249d4b8ec3..0ba26f9df1 100644 --- a/SRC/stftri.f +++ b/SRC/stftri.f @@ -243,7 +243,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) INFO = -1 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -306,7 +307,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), N, + CALL STRMM( 'L', 'U', 'T', DIAG, N2, N1, ONE, A( N ), + $ N, $ A( N1 ), N ) * ELSE @@ -318,7 +320,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL STRTRI( 'L', DIAG, N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, A( N2 ), + CALL STRMM( 'L', 'L', 'T', DIAG, N1, N2, -ONE, + $ A( N2 ), $ N, A( 0 ), N ) CALL STRTRI( 'U', DIAG, N2, A( N1 ), N, INFO ) IF( INFO.GT.0 ) @@ -397,7 +400,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), N+1, + CALL STRMM( 'L', 'U', 'T', DIAG, K, K, ONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) * ELSE @@ -416,7 +420,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), N+1, + CALL STRMM( 'R', 'U', 'N', DIAG, K, K, ONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) END IF ELSE @@ -432,7 +437,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL STRTRI( 'U', DIAG, K, A( K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), K, + CALL STRMM( 'L', 'U', 'N', DIAG, K, K, -ONE, A( K ), + $ K, $ A( K*( K+1 ) ), K ) CALL STRTRI( 'L', DIAG, K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) @@ -457,7 +463,8 @@ SUBROUTINE STFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL STRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), K, + CALL STRMM( 'L', 'L', 'N', DIAG, K, K, ONE, A( K*K ), + $ K, $ A( 0 ), K ) END IF END IF diff --git a/SRC/stgevc.f b/SRC/stgevc.f index 7fbbe4fa5d..4db97ca9a7 100644 --- a/SRC/stgevc.f +++ b/SRC/stgevc.f @@ -338,7 +338,8 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGEMV, SLACPY, SLAG2, SLALN2, XERBLA + EXTERNAL SGEMV, SLACPY, SLAG2, SLALN2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -765,7 +766,8 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * Solve ( a A - b B ) y = SUM(,) * with scaling and perturbation of the denominator * - CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), LDS, + CALL SLALN2( .TRUE., NA, NW, DMIN, ACOEF, S( J, J ), + $ LDS, $ BDIAG( 1 ), BDIAG( 2 ), SUM, 2, BCOEFR, $ BCOEFI, WORK( 2*N+J ), N, SCALE, TEMP, $ IINFO ) @@ -791,11 +793,13 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, $ WORK( ( JW+2 )*N+JE ), 1, ZERO, $ WORK( ( JW+4 )*N+1 ), 1 ) 170 CONTINUE - CALL SLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, JE ), + CALL SLACPY( ' ', N, NW, WORK( 4*N+1 ), N, VL( 1, + $ JE ), $ LDVL ) IBEG = 1 ELSE - CALL SLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, IEIG ), + CALL SLACPY( ' ', N, NW, WORK( 2*N+1 ), N, VL( 1, + $ IEIG ), $ LDVL ) IBEG = JE END IF @@ -954,7 +958,8 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * * Complex eigenvalue * - CALL SLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), LDP, + CALL SLAG2( S( JE-1, JE-1 ), LDS, P( JE-1, JE-1 ), + $ LDP, $ SAFMIN*SAFETY, ACOEF, TEMP, BCOEFR, TEMP2, $ BCOEFI ) IF( BCOEFI.EQ.ZERO ) THEN diff --git a/SRC/stgex2.f b/SRC/stgex2.f index a59053a64d..836067974d 100644 --- a/SRC/stgex2.f +++ b/SRC/stgex2.f @@ -268,7 +268,8 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGEMM, SGEQR2, SGERQ2, SLACPY, SLAGV2, SLARTG, + EXTERNAL SGEMM, SGEQR2, SGERQ2, SLACPY, SLAGV2, + $ SLARTG, $ SLASET, SLASSQ, SORG2R, SORGR2, SORM2R, SORMR2, $ SROT, SSCAL, STGSY2 * .. @@ -347,10 +348,12 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL SROT( 2, T( 1, 1 ), 1, T( 1, 2 ), 1, IR( 1, 1 ), $ IR( 2, 1 ) ) IF( SA.GE.SB ) THEN - CALL SLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ), + CALL SLARTG( S( 1, 1 ), S( 2, 1 ), LI( 1, 1 ), LI( 2, + $ 1 ), $ DDUM ) ELSE - CALL SLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, 1 ), + CALL SLARTG( T( 1, 1 ), T( 2, 1 ), LI( 1, 1 ), LI( 2, + $ 1 ), $ DDUM ) END IF CALL SROT( 2, S( 1, 1 ), LDST, S( 2, 1 ), LDST, LI( 1, 1 ), @@ -375,22 +378,28 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * and * F-norm((B-QL**H*T*QR)) <= O(EPS*F-norm((B))) * - CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ), + CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, + $ WORK( M*M+1 ), $ M ) - CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, + CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, + $ ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM ) SA = DSCALE*SQRT( DSUM ) * - CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ), + CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, + $ WORK( M*M+1 ), $ M ) - CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, + CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, + $ ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL SGEMM( 'N', 'T', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE @@ -490,11 +499,13 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * CALL SGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, S, + CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, + $ S, $ LDST ) CALL SGEMM( 'T', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, T, + CALL SGEMM( 'N', 'T', M, M, M, ONE, WORK, M, IR, LDST, ZERO, + $ T, $ LDST ) CALL SLACPY( 'F', M, M, S, LDST, SCPY, LDST ) CALL SLACPY( 'F', M, M, T, LDST, TCPY, LDST ) @@ -507,11 +518,13 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL SGERQ2( M, M, T, LDST, TAUR, WORK, LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL SORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, WORK, + CALL SORMR2( 'R', 'T', M, M, M, T, LDST, TAUR, S, LDST, + $ WORK, $ LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL SORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, WORK, + CALL SORMR2( 'L', 'N', M, M, M, T, LDST, TAUR, IR, LDST, + $ WORK, $ LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 @@ -531,9 +544,11 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL SGEQR2( M, M, TCPY, LDST, TAUL, WORK, LINFO ) IF( LINFO.NE.0 ) $ GO TO 70 - CALL SORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, LDST, + CALL SORM2R( 'L', 'T', M, M, M, TCPY, LDST, TAUL, SCPY, + $ LDST, $ WORK, INFO ) - CALL SORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, LDST, + CALL SORM2R( 'R', 'N', M, M, M, TCPY, LDST, TAUL, LICOP, + $ LDST, $ WORK, INFO ) IF( LINFO.NE.0 ) $ GO TO 70 @@ -571,22 +586,28 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * and * F-norm((B-QL**H*T*QR)) <= O(EPS*F-norm((B))) * - CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, WORK( M*M+1 ), + CALL SLACPY( 'Full', M, M, A( J1, J1 ), LDA, + $ WORK( M*M+1 ), $ M ) - CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, ZERO, + CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, S, LDST, + $ ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE CALL SLASSQ( M*M, WORK( M*M+1 ), 1, DSCALE, DSUM ) SA = DSCALE*SQRT( DSUM ) * - CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, WORK( M*M+1 ), + CALL SLACPY( 'Full', M, M, B( J1, J1 ), LDB, + $ WORK( M*M+1 ), $ M ) - CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, ZERO, + CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, T, LDST, + $ ZERO, $ WORK, M ) - CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, ONE, + CALL SGEMM( 'N', 'N', M, M, M, -ONE, WORK, M, IR, LDST, + $ ONE, $ WORK( M*M+1 ), M ) DSCALE = ZERO DSUM = ONE @@ -616,7 +637,8 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( 1, 1 ) = ONE IDUM = LWORK - M*M - 2 IF( N2.GT.1 ) THEN - CALL SLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, BE, + CALL SLAGV2( A( J1, J1 ), LDA, B( J1, J1 ), LDB, AR, AI, + $ BE, $ WORK( 1 ), WORK( 2 ), T( 1, 1 ), T( 2, 1 ) ) WORK( M+1 ) = -WORK( 2 ) WORK( M+2 ) = WORK( 1 ) @@ -627,7 +649,8 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( M, M ) = ONE * IF( N1.GT.1 ) THEN - CALL SLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), LDB, + CALL SLAGV2( A( J1+N2, J1+N2 ), LDA, B( J1+N2, J1+N2 ), + $ LDB, $ TAUR, TAUL, WORK( M*M+1 ), WORK( N2*M+N2+1 ), $ WORK( N2*M+N2+2 ), T( N2+1, N2+1 ), $ T( M, M-1 ) ) @@ -636,13 +659,17 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, T( M, M ) = T( N2+1, N2+1 ) T( M-1, M ) = -T( M, M-1 ) END IF - CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, J1+N2 ), + CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, A( J1, + $ J1+N2 ), $ LDA, ZERO, WORK( M*M+1 ), N2 ) - CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, J1+N2 ), + CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, A( J1, + $ J1+N2 ), $ LDA ) - CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, J1+N2 ), + CALL SGEMM( 'T', 'N', N2, N1, N2, ONE, WORK, M, B( J1, + $ J1+N2 ), $ LDB, ZERO, WORK( M*M+1 ), N2 ) - CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, J1+N2 ), + CALL SLACPY( 'Full', N2, N1, WORK( M*M+1 ), N2, B( J1, + $ J1+N2 ), $ LDB ) CALL SGEMM( 'N', 'N', M, M, M, ONE, LI, LDST, WORK, M, ZERO, $ WORK( M*M+1 ), M ) diff --git a/SRC/stgexc.f b/SRC/stgexc.f index 3d31fb811e..682d03d753 100644 --- a/SRC/stgexc.f +++ b/SRC/stgexc.f @@ -386,7 +386,8 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap two 1-by-1 blocks. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -404,7 +405,8 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did not split. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK, $ INFO ) IF( INFO.NE.0 ) THEN @@ -416,14 +418,16 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did split. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE RETURN END IF HERE = HERE + 1 - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -489,7 +493,8 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap two 1-by-1 blocks. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -506,7 +511,8 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did not split. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE-1, 2, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -517,14 +523,16 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * 2-by-2 block did split. * - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE RETURN END IF HERE = HERE - 1 - CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + CALL STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE diff --git a/SRC/stgsen.f b/SRC/stgsen.f index cb4996c189..673b480d3f 100644 --- a/SRC/stgsen.f +++ b/SRC/stgsen.f @@ -446,7 +446,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -487,7 +488,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SLACN2, SLACPY, SLAG2, SLASSQ, STGEXC, STGSYL, + EXTERNAL SLACN2, SLACPY, SLAG2, SLASSQ, STGEXC, + $ STGSYL, $ XERBLA * .. * .. External Functions .. @@ -635,7 +637,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * KK = K IF( K.NE.KS ) - $ CALL STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ CALL STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, KK, KS, WORK, LWORK, IERR ) * IF( IERR.GT.0 ) THEN @@ -669,7 +672,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, I = N1 + 1 IJB = 0 CALL SLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL SLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL SLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1, @@ -711,14 +715,16 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu-estimate. * - CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl-estimate. * - CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -747,7 +753,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -756,7 +763,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL STGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL STGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -776,7 +784,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -785,7 +794,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL STGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL STGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -827,7 +837,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, WORK( 6 ) = B( K+1, K ) WORK( 7 ) = B( K, K+1 ) WORK( 8 ) = B( K+1, K+1 ) - CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ), + CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, + $ BETA( K ), $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ), $ ALPHAI( K ) ) ALPHAI( K+1 ) = -ALPHAI( K ) diff --git a/SRC/stgsja.f b/SRC/stgsja.f index cd20877f16..95ec1fd56c 100644 --- a/SRC/stgsja.f +++ b/SRC/stgsja.f @@ -413,7 +413,8 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAGS2, SLAPLL, SLARTG, SLASET, SROT, + EXTERNAL SCOPY, SLAGS2, SLAPLL, SLARTG, SLASET, + $ SROT, $ SSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -436,9 +437,13 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, INFO = 0 IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITV .OR. + $ WANTV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITQ .OR. + $ WANTQ .OR. + $ LSAME( JOBQ, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -508,7 +513,8 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, * Update (K+I)-th and (K+J)-th rows of matrix A: U**T *A * IF( K+J.LE.M ) - $ CALL SROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ), + $ CALL SROT( L, A( K+J, N-L+1 ), LDA, A( K+I, + $ N-L+1 ), $ LDA, CSU, SNU ) * * Update I-th and J-th rows of matrix B: V**T *B @@ -542,10 +548,12 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ SNU ) * IF( WANTV ) - $ CALL SROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV ) + $ CALL SROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, + $ SNV ) * IF( WANTQ ) - $ CALL SROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ, + $ CALL SROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, + $ CSQ, $ SNQ ) * 10 CONTINUE @@ -562,7 +570,8 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, ERROR = ZERO DO 30 I = 1, MIN( L, M-K ) CALL SCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 ) - CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 ) + CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), + $ 1 ) CALL SLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN ) ERROR = MAX( ERROR, SSMIN ) 30 CONTINUE @@ -607,16 +616,19 @@ SUBROUTINE STGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ CALL SSCAL( P, -ONE, V( 1, I ), 1 ) END IF * - CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ), + CALL SLARTG( ABS( GAMMA ), ONE, BETA( K+I ), + $ ALPHA( K+I ), $ RWK ) * IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN - CALL SSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ), + CALL SSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, + $ N-L+I ), $ LDA ) ELSE CALL SSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ), $ LDB ) - CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ), + CALL SCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, + $ N-L+I ), $ LDA ) END IF * diff --git a/SRC/stgsna.f b/SRC/stgsna.f index d9dcac1f85..d8580bbf4b 100644 --- a/SRC/stgsna.f +++ b/SRC/stgsna.f @@ -422,7 +422,8 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMV, SLACPY, SLAG2, STGEXC, STGSYL, XERBLA + EXTERNAL SGEMV, SLACPY, SLAG2, STGEXC, STGSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT @@ -560,7 +561,8 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, $ SNRM2( N, VR( 1, KS+1 ), 1 ) ) LNRM = SLAPY2( SNRM2( N, VL( 1, KS ), 1 ), $ SNRM2( N, VL( 1, KS+1 ), 1 ) ) - CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO, + CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) TMPRR = SDOT( N, WORK, 1, VL( 1, KS ), 1 ) TMPRI = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 ) @@ -570,7 +572,8 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, TMPIR = SDOT( N, WORK, 1, VL( 1, KS ), 1 ) UHAV = TMPRR + TMPII UHAVI = TMPIR - TMPRI - CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO, + CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) TMPRR = SDOT( N, WORK, 1, VL( 1, KS ), 1 ) TMPRI = SDOT( N, WORK, 1, VL( 1, KS+1 ), 1 ) @@ -592,10 +595,12 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * RNRM = SNRM2( N, VR( 1, KS ), 1 ) LNRM = SNRM2( N, VL( 1, KS ), 1 ) - CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, ZERO, + CALL SGEMV( 'N', N, N, ONE, A, LDA, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) UHAV = SDOT( N, WORK, 1, VL( 1, KS ), 1 ) - CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, ZERO, + CALL SGEMV( 'N', N, N, ONE, B, LDB, VR( 1, KS ), 1, + $ ZERO, $ WORK, 1 ) UHBV = SDOT( N, WORK, 1, VL( 1, KS ), 1 ) COND = SLAPY2( UHAV, UHBV ) @@ -647,7 +652,8 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, IFST = K ILST = 1 * - CALL STGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), N, + CALL STGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), + $ N, $ DUMMY, 1, DUMMY1, 1, IFST, ILST, $ WORK( N*N*2+1 ), LWORK-2*N*N, IERR ) * @@ -673,7 +679,8 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, ELSE I = N*N + 1 IZ = 2*N*N + 1 - CALL STGSYL( 'N', DIFDRI, N2, N1, WORK( N*N1+N1+1 ), + CALL STGSYL( 'N', DIFDRI, N2, N1, + $ WORK( N*N1+N1+1 ), $ N, WORK, N, WORK( N1+1 ), N, $ WORK( N*N1+N1+I ), N, WORK( I ), N, $ WORK( N1+I ), N, SCALE, DIF( KS ), diff --git a/SRC/stgsy2.f b/SRC/stgsy2.f index 2d3c49c4ba..f730ff193a 100644 --- a/SRC/stgsy2.f +++ b/SRC/stgsy2.f @@ -269,7 +269,8 @@ *> Umea University, S-901 87 Umea, Sweden. * * ===================================================================== - SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, $ IWORK, PQ, INFO ) * @@ -314,7 +315,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMM, SGEMV, SGER, SGESC2, + EXTERNAL SAXPY, SCOPY, SGEMM, SGEMV, SGER, + $ SGESC2, $ SGETC2, SSCAL, SLASET, SLATDF, XERBLA * .. * .. Intrinsic Functions .. @@ -467,9 +469,11 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( I.GT.1 ) THEN ALPHA = -RHS( 1 ) - CALL SAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, JS ), + CALL SAXPY( IS-1, ALPHA, A( 1, IS ), 1, C( 1, + $ JS ), $ 1 ) - CALL SAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, JS ), + CALL SAXPY( IS-1, ALPHA, D( 1, IS ), 1, F( 1, + $ JS ), $ 1 ) END IF IF( J.LT.Q ) THEN @@ -542,9 +546,11 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( I.GT.1 ) THEN - CALL SGER( IS-1, NB, -ONE, A( 1, IS ), 1, RHS( 1 ), + CALL SGER( IS-1, NB, -ONE, A( 1, IS ), 1, + $ RHS( 1 ), $ 1, C( 1, JS ), LDC ) - CALL SGER( IS-1, NB, -ONE, D( 1, IS ), 1, RHS( 1 ), + CALL SGER( IS-1, NB, -ONE, D( 1, IS ), 1, + $ RHS( 1 ), $ 1, F( 1, JS ), LDF ) END IF IF( J.LT.Q ) THEN @@ -552,9 +558,11 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ C( IS, JE+1 ), LDC ) CALL SAXPY( N-JE, RHS( 3 ), E( JS, JE+1 ), LDE, $ F( IS, JE+1 ), LDF ) - CALL SAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), LDB, + CALL SAXPY( N-JE, RHS( 4 ), B( JSP1, JE+1 ), + $ LDB, $ C( IS, JE+1 ), LDC ) - CALL SAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), LDE, + CALL SAXPY( N-JE, RHS( 4 ), E( JSP1, JE+1 ), + $ LDE, $ F( IS, JE+1 ), LDF ) END IF * @@ -620,9 +628,11 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( I.GT.1 ) THEN - CALL SGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), LDA, + CALL SGEMV( 'N', IS-1, MB, -ONE, A( 1, IS ), + $ LDA, $ RHS( 1 ), 1, ONE, C( 1, JS ), 1 ) - CALL SGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), LDD, + CALL SGEMV( 'N', IS-1, MB, -ONE, D( 1, IS ), + $ LDD, $ RHS( 1 ), 1, ONE, F( 1, JS ), 1 ) END IF IF( J.LT.Q ) THEN @@ -680,7 +690,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 80 JJ = 0, NB - 1 CALL SCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 ) - CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 ) + CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), + $ 1 ) K = K + MB II = II + MB 80 CONTINUE @@ -711,7 +722,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 100 JJ = 0, NB - 1 CALL SCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 ) - CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 ) + CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), + $ 1 ) K = K + MB II = II + MB 100 CONTINUE @@ -729,10 +741,12 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, END IF IF( J.LT.Q ) THEN K = MB*NB + 1 - CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ), + CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, + $ RHS( K ), $ MB, B( JS, JE+1 ), LDB, ONE, $ C( IS, JE+1 ), LDC ) - CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, RHS( K ), + CALL SGEMM( 'N', 'N', MB, N-JE, NB, ONE, + $ RHS( K ), $ MB, E( JS, JE+1 ), LDE, ONE, $ F( IS, JE+1 ), LDF ) END IF @@ -783,7 +797,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 130 K = 1, N CALL SSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -802,10 +817,12 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( J.GT.P+2 ) THEN ALPHA = RHS( 1 ) - CALL SAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, 1 ), + CALL SAXPY( JS-1, ALPHA, B( 1, JS ), 1, F( IS, + $ 1 ), $ LDF ) ALPHA = RHS( 2 ) - CALL SAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, 1 ), + CALL SAXPY( JS-1, ALPHA, E( 1, JS ), 1, F( IS, + $ 1 ), $ LDF ) END IF IF( I.LT.P ) THEN @@ -853,7 +870,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, CALL SGETC2( ZDIM, Z, LDZ, IPIV, JPIV, IERR ) IF( IERR.GT.0 ) $ INFO = IERR - CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 140 K = 1, N CALL SSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -926,7 +944,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 150 K = 1, N CALL SSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -946,9 +965,11 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * equation. * IF( J.GT.P+2 ) THEN - CALL SGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, JS ), + CALL SGER( MB, JS-1, ONE, RHS( 1 ), 1, B( 1, + $ JS ), $ 1, F( IS, 1 ), LDF ) - CALL SGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, JS ), + CALL SGER( MB, JS-1, ONE, RHS( 3 ), 1, E( 1, + $ JS ), $ 1, F( IS, 1 ), LDF ) END IF IF( I.LT.P ) THEN @@ -1008,7 +1029,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 160 JJ = 0, NB - 1 CALL SCOPY( MB, C( IS, JS+JJ ), 1, RHS( K ), 1 ) - CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), 1 ) + CALL SCOPY( MB, F( IS, JS+JJ ), 1, RHS( II ), + $ 1 ) K = K + MB II = II + MB 160 CONTINUE @@ -1020,7 +1042,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IF( IERR.GT.0 ) $ INFO = IERR * - CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) + CALL SGESC2( ZDIM, Z, LDZ, RHS, IPIV, JPIV, + $ SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 170 K = 1, N CALL SSCAL( M, SCALOC, C( 1, K ), 1 ) @@ -1035,7 +1058,8 @@ SUBROUTINE STGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, II = MB*NB + 1 DO 180 JJ = 0, NB - 1 CALL SCOPY( MB, RHS( K ), 1, C( IS, JS+JJ ), 1 ) - CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), 1 ) + CALL SCOPY( MB, RHS( II ), 1, F( IS, JS+JJ ), + $ 1 ) K = K + MB II = II + MB 180 CONTINUE diff --git a/SRC/stgsyl.f b/SRC/stgsyl.f index 486b42ffb1..e9cd6981d6 100644 --- a/SRC/stgsyl.f +++ b/SRC/stgsyl.f @@ -294,7 +294,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, $ IWORK, INFO ) * @@ -336,7 +337,8 @@ SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLACPY, SLASET, SSCAL, STGSY2, XERBLA + EXTERNAL SGEMM, SLACPY, SLASET, SSCAL, STGSY2, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL, SQRT @@ -439,7 +441,8 @@ SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, DSCALE = ZERO DSUM = ONE PQ = 0 - CALL STGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D, + CALL STGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE, $ IWORK, PQ, INFO ) IF( DSCALE.NE.ZERO ) THEN @@ -533,7 +536,8 @@ SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IE = IWORK( I+1 ) - 1 MB = IE - IS + 1 PPQQ = 0 - CALL STGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA, + CALL STGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), + $ LDA, $ B( JS, JS ), LDB, C( IS, JS ), LDC, $ D( IS, IS ), LDD, E( JS, JS ), LDE, $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE, @@ -652,10 +656,12 @@ SUBROUTINE STGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * Substitute R(I, J) and L(I, J) into remaining equation. * IF( J.GT.P+2 ) THEN - CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, JS ), + CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, C( IS, + $ JS ), $ LDC, B( 1, JS ), LDB, ONE, F( IS, 1 ), $ LDF ) - CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, JS ), + CALL SGEMM( 'N', 'T', MB, JS-1, NB, ONE, F( IS, + $ JS ), $ LDF, E( 1, JS ), LDE, ONE, F( IS, 1 ), $ LDF ) END IF diff --git a/SRC/stpcon.f b/SRC/stpcon.f index 9a6ed3d4b5..8c11b4a04b 100644 --- a/SRC/stpcon.f +++ b/SRC/stpcon.f @@ -222,13 +222,15 @@ SUBROUTINE STPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK, END IF KASE = 0 10 CONTINUE - CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * * Multiply by inv(A). * - CALL SLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP, + CALL SLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ AP, $ WORK, SCALE, WORK( 2*N+1 ), INFO ) ELSE * diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f index 99046c021e..278a7c309f 100644 --- a/SRC/stpmlqt.f +++ b/SRC/stpmlqt.f @@ -210,7 +210,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, + SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/stpmqrt.f b/SRC/stpmqrt.f index f6140921a7..a31df38c71 100644 --- a/SRC/stpmqrt.f +++ b/SRC/stpmqrt.f @@ -212,7 +212,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, + SUBROUTINE STPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/stprfb.f b/SRC/stprfb.f index bc5fa8f058..23f4446ed0 100644 --- a/SRC/stprfb.f +++ b/SRC/stprfb.f @@ -430,7 +430,8 @@ SUBROUTINE STPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL SGEMM( 'N', 'T', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL SGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL SGEMM( 'N', 'T', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB ) CALL STRMM( 'R', 'U', 'T', 'N', M, L, ONE, V( NP, 1 ), LDV, $ WORK, LDWORK ) @@ -671,7 +672,8 @@ SUBROUTINE STPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL SGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL SGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL SGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) CALL STRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV, $ WORK, LDWORK ) diff --git a/SRC/stprfs.f b/SRC/stprfs.f index 6c9787ec07..7ff59c6714 100644 --- a/SRC/stprfs.f +++ b/SRC/stprfs.f @@ -171,7 +171,8 @@ *> \ingroup tprfs * * ===================================================================== - SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, + SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -206,7 +207,8 @@ SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, STPMV, STPSV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, STPMV, STPSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -430,14 +432,16 @@ SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, * KASE = 0 210 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL STPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), 1 ) + CALL STPSV( UPLO, TRANST, DIAG, N, AP, WORK( N+1 ), + $ 1 ) DO 220 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) 220 CONTINUE diff --git a/SRC/stptrs.f b/SRC/stptrs.f index 2edae4671e..d060ec5d90 100644 --- a/SRC/stptrs.f +++ b/SRC/stptrs.f @@ -127,7 +127,8 @@ *> \ingroup tptrs * * ===================================================================== - SUBROUTINE STPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) + SUBROUTINE STPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ SUBROUTINE STPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/strcon.f b/SRC/strcon.f index 714913ba84..dd835c77af 100644 --- a/SRC/strcon.f +++ b/SRC/strcon.f @@ -231,7 +231,8 @@ SUBROUTINE STRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, END IF KASE = 0 10 CONTINUE - CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE ) + CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.KASE1 ) THEN * @@ -243,7 +244,8 @@ SUBROUTINE STRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, * * Multiply by inv(A**T). * - CALL SLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, LDA, + CALL SLATRS( UPLO, 'Transpose', DIAG, NORMIN, N, A, + $ LDA, $ WORK, SCALE, WORK( 2*N+1 ), INFO ) END IF NORMIN = 'Y' diff --git a/SRC/strevc.f b/SRC/strevc.f index 36a1a7b77b..519ec82ed0 100644 --- a/SRC/strevc.f +++ b/SRC/strevc.f @@ -218,7 +218,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, INFO ) * * -- LAPACK computational routine -- @@ -255,7 +256,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA + EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -432,7 +434,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * 1-by-1 diagonal block * - CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ ZERO, X, 2, SCALE, XNORM, IERR ) * @@ -563,7 +566,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * 1-by-1 diagonal block * - CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, WI, $ X, 2, SCALE, XNORM, IERR ) * @@ -673,7 +677,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( 1+N2 ), 1, WORK( KI+N2 ), $ VR( 1, KI ), 1 ) ELSE - CALL SSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), 1 ) + CALL SSCAL( N, WORK( KI-1+N ), VR( 1, KI-1 ), + $ 1 ) CALL SSCAL( N, WORK( KI+N2 ), VR( 1, KI ), 1 ) END IF * @@ -782,7 +787,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Solve (T(J,J)-WR)**T*X = WORK * - CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ ZERO, X, 2, SCALE, XNORM, IERR ) * @@ -842,7 +848,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Copy the vector x or Q*x to VL and normalize. * IF( .NOT.OVER ) THEN - CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) + CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), + $ 1 ) * II = ISAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 REMAX = ONE / ABS( VL( II, IS ) ) @@ -855,7 +862,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, ELSE * IF( KI.LT.N ) - $ CALL SGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), LDVL, + $ CALL SGEMV( 'N', N, N-KI, ONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1+N ), 1, WORK( KI+N ), $ VL( 1, KI ), 1 ) * @@ -934,7 +942,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 * - CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, + $ J ), $ LDT, ONE, ONE, WORK( J+N ), N, WR, $ -WI, X, 2, SCALE, XNORM, IERR ) * @@ -979,7 +988,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( KI+2+N ), 1 ) * WORK( J+1+N2 ) = WORK( J+1+N2 ) - - $ SDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ SDOT( J-KI-2, T( KI+2, J+1 ), + $ 1, $ WORK( KI+2+N2 ), 1 ) * * Solve 2-by-2 complex linear equation @@ -1010,8 +1020,10 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Copy the vector x or Q*x to VL and normalize. * IF( .NOT.OVER ) THEN - CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), 1 ) - CALL SCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, IS+1 ), + CALL SCOPY( N-KI+1, WORK( KI+N ), 1, VL( KI, IS ), + $ 1 ) + CALL SCOPY( N-KI+1, WORK( KI+N2 ), 1, VL( KI, + $ IS+1 ), $ 1 ) * EMAX = ZERO @@ -1037,7 +1049,8 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, $ WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) ELSE CALL SSCAL( N, WORK( KI+N ), VL( 1, KI ), 1 ) - CALL SSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), 1 ) + CALL SSCAL( N, WORK( KI+1+N2 ), VL( 1, KI+1 ), + $ 1 ) END IF * EMAX = ZERO diff --git a/SRC/strevc3.f b/SRC/strevc3.f index 49dec0950d..a58e2c64c6 100644 --- a/SRC/strevc3.f +++ b/SRC/strevc3.f @@ -275,7 +275,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, EXTERNAL LSAME, ISAMAX, ILAENV, SDOT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA, + EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, + $ XERBLA, $ SLACPY, SGEMM, SLASET * .. * .. Intrinsic Functions .. @@ -490,7 +491,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * 1-by-1 diagonal block * - CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + 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 ) * @@ -557,7 +559,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 ) ) @@ -636,7 +639,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * 1-by-1 diagonal block * - CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + 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 ) * @@ -654,8 +658,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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 ) @@ -694,8 +700,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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 ) @@ -720,8 +728,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 @@ -748,8 +758,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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) + 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 @@ -928,14 +940,16 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * * Solve [ T(J,J) - WR ]**T * X = WORK * - CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + 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 ) + $ 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 @@ -960,7 +974,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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, + $ SDOT( J-KI-1, T( KI+1, J+1 ), + $ 1, $ WORK( KI+1+IV*N ), 1 ) * * Solve @@ -974,7 +989,8 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * Scale if necessary * IF( SCALE.NE.ONE ) - $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + $ 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 ) * @@ -1080,30 +1096,37 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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 ) + 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, + $ 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, + $ 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 ), + 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) + 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 ) @@ -1121,8 +1144,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, 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 ) + 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 @@ -1136,11 +1161,13 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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, + $ 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, + $ SDOT( J-KI-2, T( KI+2, J+1 ), + $ 1, $ WORK( KI+2+(IV+1)*N ), 1 ) * * Solve 2-by-2 complex linear equation @@ -1154,8 +1181,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * 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) + 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 ) @@ -1208,8 +1237,10 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, $ 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) + 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 diff --git a/SRC/strexc.f b/SRC/strexc.f index eb5303060d..db5951360a 100644 --- a/SRC/strexc.f +++ b/SRC/strexc.f @@ -296,7 +296,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * Swap two 1 by 1 blocks, no problems possible * - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, + $ NBNEXT, $ WORK, INFO ) HERE = HERE + 1 ELSE @@ -322,7 +323,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1, $ WORK, INFO ) - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, + $ 1, $ WORK, INFO ) HERE = HERE + 2 END IF @@ -347,7 +349,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, IF( T( HERE-1, HERE-2 ).NE.ZERO ) $ NBNEXT = 2 END IF - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, + $ NBNEXT, $ NBF, WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -372,7 +375,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, IF( T( HERE-1, HERE-2 ).NE.ZERO ) $ NBNEXT = 2 END IF - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, + $ NBNEXT, $ 1, WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -382,7 +386,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * Swap two 1 by 1 blocks, no problems possible * - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, + $ 1, $ WORK, INFO ) HERE = HERE - 1 ELSE @@ -395,7 +400,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * * 2 by 2 Block did not split * - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, + $ 1, $ WORK, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -408,7 +414,8 @@ SUBROUTINE STREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, * CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1, $ WORK, INFO ) - CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1, + CALL SLAEXC( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, + $ 1, $ WORK, INFO ) HERE = HERE - 2 END IF diff --git a/SRC/strrfs.f b/SRC/strrfs.f index 9c14a63b6b..b1914ce922 100644 --- a/SRC/strrfs.f +++ b/SRC/strrfs.f @@ -178,7 +178,8 @@ *> \ingroup trrfs * * ===================================================================== - SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, + SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, IWORK, INFO ) * * -- LAPACK computational routine -- @@ -213,7 +214,8 @@ SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLACN2, STRMV, STRSV, XERBLA + EXTERNAL SAXPY, SCOPY, SLACN2, STRMV, STRSV, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX @@ -427,14 +429,16 @@ SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, * KASE = 0 210 CONTINUE - CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, FERR( J ), + CALL SLACN2( N, WORK( 2*N+1 ), WORK( N+1 ), IWORK, + $ FERR( J ), $ KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * * Multiply by diag(W)*inv(op(A)**T). * - CALL STRSV( UPLO, TRANST, DIAG, N, A, LDA, WORK( N+1 ), + CALL STRSV( UPLO, TRANST, DIAG, N, A, LDA, + $ WORK( N+1 ), $ 1 ) DO 220 I = 1, N WORK( N+I ) = WORK( I )*WORK( N+I ) diff --git a/SRC/strsen.f b/SRC/strsen.f index 5e3de5c6db..5ffcc920df 100644 --- a/SRC/strsen.f +++ b/SRC/strsen.f @@ -310,7 +310,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, + SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, + $ WI, $ M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO ) * * -- LAPACK computational routine -- @@ -351,7 +352,8 @@ SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, EXTERNAL LSAME, SLANGE, SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SLACN2, SLACPY, STREXC, STRSYL, XERBLA + EXTERNAL SLACN2, SLACPY, STREXC, STRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -472,7 +474,8 @@ SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, IERR = 0 KK = K IF( K.NE.KS ) - $ CALL STREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, WORK, + $ CALL STREXC( COMPQ, N, T, LDT, Q, LDQ, KK, KS, + $ WORK, $ IERR ) IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN * @@ -520,7 +523,8 @@ SUBROUTINE STRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, EST = ZERO KASE = 0 30 CONTINUE - CALL SLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, ISAVE ) + CALL SLACN2( NN, WORK( NN+1 ), WORK, IWORK, EST, KASE, + $ ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN * diff --git a/SRC/strsna.f b/SRC/strsna.f index f494ba7047..fc2601a8a1 100644 --- a/SRC/strsna.f +++ b/SRC/strsna.f @@ -260,7 +260,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, $ INFO ) * @@ -301,7 +302,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, SDOT, SLAMCH, SLAPY2, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SLACN2, SLACPY, SLAQTR, STREXC, XERBLA + EXTERNAL SLACN2, SLACPY, SLAQTR, STREXC, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -441,10 +443,12 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Complex eigenvalue. * PROD1 = SDOT( N, VR( 1, KS ), 1, VL( 1, KS ), 1 ) - PROD1 = PROD1 + SDOT( N, VR( 1, KS+1 ), 1, VL( 1, KS+1 ), + PROD1 = PROD1 + SDOT( N, VR( 1, KS+1 ), 1, VL( 1, + $ KS+1 ), $ 1 ) PROD2 = SDOT( N, VL( 1, KS ), 1, VR( 1, KS+1 ), 1 ) - PROD2 = PROD2 - SDOT( N, VL( 1, KS+1 ), 1, VR( 1, KS ), + PROD2 = PROD2 - SDOT( N, VL( 1, KS+1 ), 1, VR( 1, + $ KS ), $ 1 ) RNRM = SLAPY2( SNRM2( N, VR( 1, KS ), 1 ), $ SNRM2( N, VR( 1, KS+1 ), 1 ) ) @@ -467,7 +471,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, CALL SLACPY( 'Full', N, N, T, LDT, WORK, LDWORK ) IFST = K ILST = 1 - CALL STREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, ILST, + CALL STREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, IFST, + $ ILST, $ WORK( 1, N+1 ), IERR ) * IF( IERR.EQ.1 .OR. IERR.EQ.2 ) THEN @@ -535,7 +540,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EST = ZERO KASE = 0 50 CONTINUE - CALL SLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), IWORK, + CALL SLACN2( NN, WORK( 1, N+2 ), WORK( 1, N+4 ), + $ IWORK, $ EST, KASE, ISAVE ) IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN @@ -543,7 +549,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Real eigenvalue: solve C**T*x = scale*c. * - CALL SLAQTR( .TRUE., .TRUE., N-1, WORK( 2, 2 ), + CALL SLAQTR( .TRUE., .TRUE., N-1, WORK( 2, + $ 2 ), $ LDWORK, DUMMY, DUMM, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) @@ -552,7 +559,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * Complex eigenvalue: solve * C**T*(p+iq) = scale*(c+id) in real arithmetic. * - CALL SLAQTR( .TRUE., .FALSE., N-1, WORK( 2, 2 ), + CALL SLAQTR( .TRUE., .FALSE., N-1, WORK( 2, + $ 2 ), $ LDWORK, WORK( 1, N+1 ), MU, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) @@ -562,7 +570,8 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * * Real eigenvalue: solve C*x = scale*c. * - CALL SLAQTR( .FALSE., .TRUE., N-1, WORK( 2, 2 ), + CALL SLAQTR( .FALSE., .TRUE., N-1, WORK( 2, + $ 2 ), $ LDWORK, DUMMY, DUMM, SCALE, $ WORK( 1, N+4 ), WORK( 1, N+6 ), $ IERR ) diff --git a/SRC/strsyl.f b/SRC/strsyl.f index d8483b266f..b0fdfe3a38 100644 --- a/SRC/strsyl.f +++ b/SRC/strsyl.f @@ -592,7 +592,8 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL SLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ), + CALL SLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) @@ -776,7 +777,8 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, $ B( L2, MIN(L2+1, N ) ), LDB ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL SLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ), + CALL SLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) @@ -969,7 +971,8 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, $ B( L2, MIN( L2+1, N ) ), LDB ) VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR ) * - CALL SLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ), + CALL SLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, + $ K1 ), $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X, $ 2, XNORM, IERR ) IF( IERR.NE.0 ) diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index eac21821e7..3899ba6299 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -176,7 +176,8 @@ * Angelika Schwarz, Umea University, Sweden. * * ===================================================================== - SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, + SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, + $ C, $ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK, $ INFO ) IMPLICIT NONE @@ -210,10 +211,12 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME INTEGER ILAENV REAL SLANGE, SLAMCH, SLARMM - EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV, LSAME + EXTERNAL SLANGE, SLAMCH, SLARMM, ILAENV, + $ LSAME * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL, XERBLA + EXTERNAL SGEMM, SLASCL, SSCAL, STRSYL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXPONENT, MAX, MIN, REAL diff --git a/SRC/strtri.f b/SRC/strtri.f index 21981d73a0..7c09134c78 100644 --- a/SRC/strtri.f +++ b/SRC/strtri.f @@ -198,9 +198,11 @@ SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO ) * * Compute rows 1:j-1 of current block column * - CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, + CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, + CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) * * Compute inverse of current diagonal block diff --git a/SRC/strtrs.f b/SRC/strtrs.f index af82956fa4..c546cae843 100644 --- a/SRC/strtrs.f +++ b/SRC/strtrs.f @@ -176,10 +176,12 @@ SUBROUTINE STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * INFO = 0 NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/stzrzf.f b/SRC/stzrzf.f index 69a1d11a33..987e0aa3a1 100644 --- a/SRC/stzrzf.f +++ b/SRC/stzrzf.f @@ -282,7 +282,8 @@ SUBROUTINE STZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL SLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ), + CALL SLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, + $ M1 ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:i-1,i:n) from the right diff --git a/SRC/zbbcsd.f b/SRC/zbbcsd.f index a343e2c0b4..5b8af32720 100644 --- a/SRC/zbbcsd.f +++ b/SRC/zbbcsd.f @@ -326,7 +326,8 @@ *> \ingroup bbcsd * * ===================================================================== - SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, + $ Q, $ THETA, PHI, U1, LDU1, U2, LDU2, V1T, LDV1T, $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) @@ -372,7 +373,8 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, $ TEMP, THETAMAX, THETAMIN, THRESH, TOL, TOLMUL, $ UNFL, X1, X2, Y1, Y2 * - EXTERNAL DLARTGP, DLARTGS, DLAS2, XERBLA, ZLASR, ZSCAL, + EXTERNAL DLARTGP, DLARTGS, DLAS2, XERBLA, ZLASR, + $ ZSCAL, $ ZSWAP * .. * .. External Functions .. @@ -559,9 +561,11 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * * Compute shifts for B11 and B21 and use the lesser * - CALL DLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), SIGMA11, + CALL DLAS2( B11D(IMAX-1), B11E(IMAX-1), B11D(IMAX), + $ SIGMA11, $ DUMMY ) - CALL DLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), SIGMA21, + CALL DLAS2( B21D(IMAX-1), B21E(IMAX-1), B21D(IMAX), + $ SIGMA21, $ DUMMY ) * IF( SIGMA11 .LE. SIGMA21 ) THEN @@ -718,10 +722,12 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL DLARTGP( Y2, Y1, RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( .NOT. RESTART12 .AND. RESTART22 ) THEN - CALL DLARTGP( B12BULGE, B12D(I-1), RWORK(IV2TSN+I-1-1), + CALL DLARTGP( B12BULGE, B12D(I-1), + $ RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( RESTART12 .AND. .NOT. RESTART22 ) THEN - CALL DLARTGP( B22BULGE, B22D(I-1), RWORK(IV2TSN+I-1-1), + CALL DLARTGP( B22BULGE, B22D(I-1), + $ RWORK(IV2TSN+I-1-1), $ RWORK(IV2TCS+I-1-1), R ) ELSE IF( NU .LT. MU ) THEN CALL DLARTGS( B12E(I-1), B12D(I), NU, @@ -780,7 +786,8 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, * chasing by applying the original shift again. * IF( .NOT. RESTART11 .AND. .NOT. RESTART12 ) THEN - CALL DLARTGP( X2, X1, RWORK(IU1SN+I-1), RWORK(IU1CS+I-1), + CALL DLARTGP( X2, X1, RWORK(IU1SN+I-1), + $ RWORK(IU1CS+I-1), $ R ) ELSE IF( .NOT. RESTART11 .AND. RESTART12 ) THEN CALL DLARTGP( B11BULGE, B11D(I), RWORK(IU1SN+I-1), @@ -789,14 +796,16 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL DLARTGP( B12BULGE, B12E(I-1), RWORK(IU1SN+I-1), $ RWORK(IU1CS+I-1), R ) ELSE IF( MU .LE. NU ) THEN - CALL DLARTGS( B11E(I), B11D(I+1), MU, RWORK(IU1CS+I-1), + CALL DLARTGS( B11E(I), B11D(I+1), MU, + $ RWORK(IU1CS+I-1), $ RWORK(IU1SN+I-1) ) ELSE CALL DLARTGS( B12D(I), B12E(I), NU, RWORK(IU1CS+I-1), $ RWORK(IU1SN+I-1) ) END IF IF( .NOT. RESTART21 .AND. .NOT. RESTART22 ) THEN - CALL DLARTGP( Y2, Y1, RWORK(IU2SN+I-1), RWORK(IU2CS+I-1), + CALL DLARTGP( Y2, Y1, RWORK(IU2SN+I-1), + $ RWORK(IU2CS+I-1), $ R ) ELSE IF( .NOT. RESTART21 .AND. RESTART22 ) THEN CALL DLARTGP( B21BULGE, B21D(I), RWORK(IU2SN+I-1), @@ -805,7 +814,8 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, CALL DLARTGP( B22BULGE, B22E(I-1), RWORK(IU2SN+I-1), $ RWORK(IU2CS+I-1), R ) ELSE IF( NU .LT. MU ) THEN - CALL DLARTGS( B21E(I), B21E(I+1), NU, RWORK(IU2CS+I-1), + CALL DLARTGS( B21E(I), B21E(I+1), NU, + $ RWORK(IU2CS+I-1), $ RWORK(IU2SN+I-1) ) ELSE CALL DLARTGS( B22D(I), B22E(I), MU, RWORK(IU2CS+I-1), @@ -991,7 +1001,8 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( B12D(IMAX)+B22D(IMAX) .LT. 0 ) THEN IF( WANTV2T ) THEN IF( COLMAJOR ) THEN - CALL ZSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), LDV2T ) + CALL ZSCAL( M-Q, NEGONECOMPLEX, V2T(IMAX,1), + $ LDV2T ) ELSE CALL ZSCAL( M-Q, NEGONECOMPLEX, V2T(1,IMAX), 1 ) END IF @@ -1058,7 +1069,8 @@ SUBROUTINE ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, IF( WANTU2 ) $ CALL ZSWAP( M-P, U2(1,I), 1, U2(1,MINI), 1 ) IF( WANTV1T ) - $ CALL ZSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), LDV1T ) + $ CALL ZSWAP( Q, V1T(I,1), LDV1T, V1T(MINI,1), + $ LDV1T ) IF( WANTV2T ) $ CALL ZSWAP( M-Q, V2T(I,1), LDV2T, V2T(MINI,1), $ LDV2T ) diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index 17d3e9ba17..0561c7faa2 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -280,7 +280,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, EXTERNAL LSAME, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLARTG, DLAS2, DLASQ1, DLASV2, XERBLA, ZDROT, + EXTERNAL DLARTG, DLAS2, DLASQ1, DLASV2, XERBLA, + $ ZDROT, $ ZDSCAL, ZLASR, ZSWAP * .. * .. Intrinsic Functions .. @@ -361,10 +362,12 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NRU.GT.0 ) - $ CALL ZLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), RWORK( N ), + $ CALL ZLASR( 'R', 'V', 'F', NRU, N, RWORK( 1 ), + $ RWORK( N ), $ U, LDU ) IF( NCC.GT.0 ) - $ CALL ZLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), RWORK( N ), + $ CALL ZLASR( 'L', 'V', 'F', N, NCC, RWORK( 1 ), + $ RWORK( N ), $ C, LDC ) END IF * @@ -488,7 +491,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL ZDROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, $ COSR, SINR ) IF( NRU.GT.0 ) - $ CALL ZDROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL ) + $ CALL ZDROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, + $ SINL ) IF( NCC.GT.0 ) $ CALL ZDROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL, $ SINL ) @@ -621,7 +625,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL DLARTG( D( I )*CS, E( I ), CS, SN, R ) IF( I.GT.LL ) $ E( I-1 ) = OLDSN*R - CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, + $ D( I ) ) RWORK( I-LL+1 ) = CS RWORK( I-LL+1+NM1 ) = SN RWORK( I-LL+1+NM12 ) = OLDCS @@ -637,10 +642,12 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ), $ RWORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ), + $ CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ), + $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -659,7 +666,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R ) IF( I.LT.M ) $ E( I ) = OLDSN*R - CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) ) + CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, + $ D( I ) ) RWORK( I-LL ) = CS RWORK( I-LL+NM1 ) = -SN RWORK( I-LL+NM12 ) = OLDCS @@ -672,7 +680,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors * IF( NCVT.GT.0 ) - $ CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ), + $ CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ), @@ -727,10 +736,12 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCVT, RWORK( 1 ), $ RWORK( N ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) - $ CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, RWORK( NM12+1 ), + $ CALL ZLASR( 'R', 'V', 'F', NRU, M-LL+1, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), U( 1, LL ), LDU ) IF( NCC.GT.0 ) - $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, RWORK( NM12+1 ), + $ CALL ZLASR( 'L', 'V', 'F', M-LL+1, NCC, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), C( LL, 1 ), LDC ) * * Test convergence @@ -777,7 +788,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Update singular vectors if desired * IF( NCVT.GT.0 ) - $ CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, RWORK( NM12+1 ), + $ CALL ZLASR( 'L', 'V', 'B', M-LL+1, NCVT, + $ RWORK( NM12+1 ), $ RWORK( NM13+1 ), VT( LL, 1 ), LDVT ) IF( NRU.GT.0 ) $ CALL ZLASR( 'R', 'V', 'B', NRU, M-LL+1, RWORK( 1 ), @@ -833,7 +845,8 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, IF( NRU.GT.0 ) $ CALL ZSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 ) IF( NCC.GT.0 ) - $ CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC ) + $ CALL ZSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), + $ LDC ) END IF 190 CONTINUE GO TO 220 diff --git a/SRC/zcgesv.f b/SRC/zcgesv.f index 2be757824d..5d859fab36 100644 --- a/SRC/zcgesv.f +++ b/SRC/zcgesv.f @@ -237,7 +237,8 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, COMPLEX*16 ZDUM * * .. External Subroutines .. - EXTERNAL CGETRS, CGETRF, CLAG2Z, XERBLA, ZAXPY, ZGEMM, + EXTERNAL CGETRS, CGETRF, CLAG2Z, XERBLA, ZAXPY, + $ ZGEMM, $ ZLACPY, ZLAG2C, ZGETRF, ZGETRS * .. * .. External Functions .. @@ -343,7 +344,8 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) * - CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, A, + CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, + $ A, $ LDA, X, LDX, ONE, WORK, N ) * * Check whether the NRHS normwise backward errors satisfy the @@ -378,7 +380,8 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * * Solve the system SA*SX = SR. * - CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, IPIV, + CALL CGETRS( 'No transpose', N, NRHS, SWORK( PTSA ), N, + $ IPIV, $ SWORK( PTSX ), N, INFO ) * * Convert SX back to double precision and update the current @@ -394,7 +397,8 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, * CALL ZLACPY( 'All', N, NRHS, B, LDB, WORK, N ) * - CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, NEGONE, + CALL ZGEMM( 'No Transpose', 'No Transpose', N, NRHS, N, + $ NEGONE, $ A, LDA, X, LDX, ONE, WORK, N ) * * Check whether the NRHS normwise backward errors satisfy the diff --git a/SRC/zcposv.f b/SRC/zcposv.f index 5ac9dfba65..40ea8bb4fa 100644 --- a/SRC/zcposv.f +++ b/SRC/zcposv.f @@ -245,7 +245,8 @@ SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, COMPLEX*16 ZDUM * * .. External Subroutines .. - EXTERNAL ZAXPY, ZHEMM, ZLACPY, ZLAT2C, ZLAG2C, CLAG2Z, + EXTERNAL ZAXPY, ZHEMM, ZLACPY, ZLAT2C, ZLAG2C, + $ CLAG2Z, $ CPOTRF, CPOTRS, XERBLA, ZPOTRF, ZPOTRS * .. * .. External Functions .. @@ -269,7 +270,8 @@ SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, * * Test the input parameters. * - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -388,7 +390,8 @@ SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, * * Solve the system SA*SX = SR. * - CALL CPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), N, + CALL CPOTRS( UPLO, N, NRHS, SWORK( PTSA ), N, SWORK( PTSX ), + $ N, $ INFO ) * * Convert SX back to double precision and update the current diff --git a/SRC/zgbbrd.f b/SRC/zgbbrd.f index bdf736bcf7..e77b15237c 100644 --- a/SRC/zgbbrd.f +++ b/SRC/zgbbrd.f @@ -223,7 +223,8 @@ SUBROUTINE ZGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, COMPLEX*16 RA, RB, RS, T * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARGV, ZLARTG, ZLARTV, ZLASET, ZROT, + EXTERNAL XERBLA, ZLARGV, ZLARTG, ZLARTV, ZLASET, + $ ZROT, $ ZSCAL * .. * .. Intrinsic Functions .. @@ -243,7 +244,9 @@ SUBROUTINE ZGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, WANTC = NCC.GT.0 KLU1 = KL + KU + 1 INFO = 0 - IF( .NOT.WANTQ .AND. .NOT.WANTPT .AND. .NOT.LSAME( VECT, 'N' ) ) + IF( .NOT.WANTQ .AND. + $ .NOT.WANTPT .AND. + $ .NOT.LSAME( VECT, 'N' ) ) $ THEN INFO = -1 ELSE IF( M.LT.0 ) THEN @@ -339,7 +342,8 @@ SUBROUTINE ZGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL ZLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), INCA, + $ CALL ZLARTV( NRT, AB( KLU1-L, J1-KLM+L-1 ), + $ INCA, $ AB( KLU1-L+1, J1-KLM+L-1 ), INCA, $ RWORK( J1 ), WORK( J1 ), KB1 ) 10 CONTINUE @@ -378,7 +382,8 @@ SUBROUTINE ZGBBRD( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q, * apply plane rotations to C * DO 30 J = J1, J2, KB1 - CALL ZROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), LDC, + CALL ZROT( NCC, C( J-1, 1 ), LDC, C( J, 1 ), + $ LDC, $ RWORK( J ), WORK( J ) ) 30 CONTINUE END IF diff --git a/SRC/zgbcon.f b/SRC/zgbcon.f index 1aec7e1538..fb7b49b0a3 100644 --- a/SRC/zgbcon.f +++ b/SRC/zgbcon.f @@ -143,7 +143,8 @@ *> \ingroup gbcon * * ===================================================================== - SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, + SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, + $ RCOND, $ WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -185,7 +186,8 @@ SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, EXTERNAL LSAME, IZAMAX, DLAMCH, ZDOTC * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZDRSCL, ZLACN2, ZLATBS + EXTERNAL XERBLA, ZAXPY, ZDRSCL, ZLACN2, + $ ZLATBS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MIN @@ -260,13 +262,15 @@ SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK( JP ) = WORK( J ) WORK( J ) = T END IF - CALL ZAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), 1 ) + CALL ZAXPY( LM, -T, AB( KD+1, J ), 1, WORK( J+1 ), + $ 1 ) 20 CONTINUE END IF * * Multiply by inv(U). * - CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KL+KU, AB, LDAB, WORK, SCALE, RWORK, INFO ) ELSE * @@ -281,7 +285,8 @@ SUBROUTINE ZGBCON( NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, IF( LNOTI ) THEN DO 30 J = N - 1, 1, -1 LM = MIN( KL, N-J ) - WORK( J ) = WORK( J ) - ZDOTC( LM, AB( KD+1, J ), 1, + WORK( J ) = WORK( J ) - ZDOTC( LM, AB( KD+1, J ), + $ 1, $ WORK( J+1 ), 1 ) JP = IPIV( J ) IF( JP.NE.J ) THEN diff --git a/SRC/zgbequ.f b/SRC/zgbequ.f index ba5ff7b4e2..3b7a18e87e 100644 --- a/SRC/zgbequ.f +++ b/SRC/zgbequ.f @@ -150,7 +150,8 @@ *> \ingroup gbequ * * ===================================================================== - SUBROUTINE ZGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE ZGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zgbequb.f b/SRC/zgbequb.f index ae16a74bb2..3065b59d43 100644 --- a/SRC/zgbequb.f +++ b/SRC/zgbequb.f @@ -157,7 +157,8 @@ *> \ingroup gbequb * * ===================================================================== - SUBROUTINE ZGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE ZGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zgbrfs.f b/SRC/zgbrfs.f index 6976cd1095..e1af6dc863 100644 --- a/SRC/zgbrfs.f +++ b/SRC/zgbrfs.f @@ -201,7 +201,8 @@ *> \ingroup gbrfs * * ===================================================================== - SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, $ INFO ) * @@ -245,7 +246,8 @@ SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGBMV, ZGBTRS, ZLACN2 + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGBMV, ZGBTRS, + $ ZLACN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN @@ -332,7 +334,8 @@ SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ), 1, + CALL ZGBMV( TRANS, N, N, KL, KU, -CONE, AB, LDAB, X( 1, J ), + $ 1, $ CONE, WORK, 1 ) * * Compute componentwise relative backward error from formula @@ -390,7 +393,8 @@ SUBROUTINE ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, * * Update solution and try again. * - CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK, N, + CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, WORK, + $ N, $ INFO ) CALL ZAXPY( N, CONE, WORK, 1, X( 1, J ), 1 ) LSTRES = BERR( J ) diff --git a/SRC/zgbrfsx.f b/SRC/zgbrfsx.f index fa91f96aae..7492fb41ea 100644 --- a/SRC/zgbrfsx.f +++ b/SRC/zgbrfsx.f @@ -433,7 +433,8 @@ *> \ingroup gbrfsx * * ===================================================================== - SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, @@ -497,7 +498,8 @@ SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL DLAMCH, ZLANGB, ZLA_GBRCOND_X, ZLA_GBRCOND_C + EXTERNAL DLAMCH, ZLANGB, ZLA_GBRCOND_X, + $ ZLA_GBRCOND_C DOUBLE PRECISION DLAMCH, ZLANGB, ZLA_GBRCOND_X, ZLA_GBRCOND_C LOGICAL LSAME INTEGER ILATRANS, ILAPREC @@ -644,7 +646,8 @@ SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, PREC_TYPE = ILAPREC( 'E' ) IF ( NOTRAN ) THEN - CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1), @@ -652,7 +655,8 @@ SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, $ RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE, $ INFO ) ELSE - CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + CALL ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B, $ LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, WORK, RWORK, WORK(N+1), @@ -662,19 +666,23 @@ SUBROUTINE ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, END IF END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF (N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1) THEN * * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, C, .TRUE., INFO, WORK, RWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, R, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB, + RCOND_TMP = ZLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, + $ AFB, $ LDAFB, IPIV, C, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/zgbsv.f b/SRC/zgbsv.f index 7908bb0b8e..b626fddc0e 100644 --- a/SRC/zgbsv.f +++ b/SRC/zgbsv.f @@ -159,7 +159,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) + SUBROUTINE ZGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE ZGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO ) * * Solve the system A*X = B, overwriting B with X. * - CALL ZGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV, + CALL ZGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, + $ IPIV, $ B, LDB, INFO ) END IF RETURN diff --git a/SRC/zgbsvx.f b/SRC/zgbsvx.f index c1fce0b3aa..86d82c0229 100644 --- a/SRC/zgbsvx.f +++ b/SRC/zgbsvx.f @@ -408,7 +408,8 @@ SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, EXTERNAL LSAME, DLAMCH, ZLANGB, ZLANTB * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGBCON, ZGBEQU, ZGBRFS, ZGBTRF, + EXTERNAL XERBLA, ZCOPY, ZGBCON, ZGBEQU, ZGBRFS, + $ ZGBTRF, $ ZGBTRS, ZLACPY, ZLAQGB * .. * .. Intrinsic Functions .. @@ -433,7 +434,9 @@ SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -509,7 +512,8 @@ SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -560,7 +564,8 @@ SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) 80 CONTINUE 90 CONTINUE - RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), + RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, + $ KL+KU ), $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, $ RWORK ) IF( RPVGRW.EQ.ZERO ) THEN @@ -604,7 +609,8 @@ SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, + CALL ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/zgbsvxx.f b/SRC/zgbsvxx.f index b7e8a9d917..128bf3bb34 100644 --- a/SRC/zgbsvxx.f +++ b/SRC/zgbsvxx.f @@ -553,7 +553,8 @@ *> \ingroup gbsvxx * * ===================================================================== - SUBROUTINE ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, + SUBROUTINE ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, + $ AFB, $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, $ RCOND, RPVGRW, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, @@ -604,7 +605,8 @@ SUBROUTINE ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, DOUBLE PRECISION DLAMCH, ZLA_GBRPVGRW * .. * .. External Subroutines .. - EXTERNAL ZGBEQUB, ZGBTRF, ZGBTRS, ZLACPY, ZLAQGB, + EXTERNAL ZGBEQUB, ZGBTRF, ZGBTRS, ZLACPY, + $ ZLAQGB, $ XERBLA, ZLASCL2, ZGBRFSX * .. * .. Intrinsic Functions .. @@ -711,7 +713,8 @@ SUBROUTINE ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * * Equilibrate the matrix. * - CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) @@ -777,7 +780,8 @@ SUBROUTINE ZGBSVXX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, + CALL ZGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, + $ LDAFB, $ IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) diff --git a/SRC/zgbtf2.f b/SRC/zgbtf2.f index 2e602db364..294450670d 100644 --- a/SRC/zgbtf2.f +++ b/SRC/zgbtf2.f @@ -250,7 +250,8 @@ SUBROUTINE ZGBTF2( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers. * - CALL ZSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), 1 ) + CALL ZSCAL( KM, ONE / AB( KV+1, J ), AB( KV+2, J ), + $ 1 ) * * Update trailing submatrix within the band. * diff --git a/SRC/zgbtrf.f b/SRC/zgbtrf.f index 306863299d..33e5c605f8 100644 --- a/SRC/zgbtrf.f +++ b/SRC/zgbtrf.f @@ -178,7 +178,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) EXTERNAL ILAENV, IZAMAX * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGBTF2, ZGEMM, ZGERU, ZLASWP, + EXTERNAL XERBLA, ZCOPY, ZGBTF2, ZGEMM, ZGERU, + $ ZLASWP, $ ZSCAL, ZSWAP, ZTRSM * .. * .. Intrinsic Functions .. @@ -326,7 +327,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Compute multipliers * - CALL ZSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, JJ ), + CALL ZSCAL( KM, ONE / AB( KV+1, JJ ), AB( KV+2, + $ JJ ), $ 1 ) * * Update trailing submatrix within the band and within @@ -395,7 +397,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A12 * - CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL ZTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J2, ONE, AB( KV+1, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1 ) * @@ -403,7 +406,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A22 * - CALL ZGEMM( 'No transpose', 'No transpose', I2, J2, + CALL ZGEMM( 'No transpose', 'No transpose', I2, + $ J2, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+1, J+JB ), LDAB-1 ) @@ -413,7 +417,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A32 * - CALL ZGEMM( 'No transpose', 'No transpose', I3, J2, + CALL ZGEMM( 'No transpose', 'No transpose', I3, + $ J2, $ JB, -ONE, WORK31, LDWORK, $ AB( KV+1-JB, J+JB ), LDAB-1, ONE, $ AB( KV+KL+1-JB, J+JB ), LDAB-1 ) @@ -433,7 +438,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A13 in the work array * - CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + CALL ZTRSM( 'Left', 'Lower', 'No transpose', + $ 'Unit', $ JB, J3, ONE, AB( KV+1, J ), LDAB-1, $ WORK13, LDWORK ) * @@ -441,7 +447,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A23 * - CALL ZGEMM( 'No transpose', 'No transpose', I2, J3, + CALL ZGEMM( 'No transpose', 'No transpose', I2, + $ J3, $ JB, -ONE, AB( KV+1+JB, J ), LDAB-1, $ WORK13, LDWORK, ONE, AB( 1+JB, J+KV ), $ LDAB-1 ) @@ -451,7 +458,8 @@ SUBROUTINE ZGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO ) * * Update A33 * - CALL ZGEMM( 'No transpose', 'No transpose', I3, J3, + CALL ZGEMM( 'No transpose', 'No transpose', I3, + $ J3, $ JB, -ONE, WORK31, LDWORK, WORK13, $ LDWORK, ONE, AB( 1+KL, J+KV ), LDAB-1 ) END IF diff --git a/SRC/zgbtrs.f b/SRC/zgbtrs.f index 79e1d305cd..20c4eaf9d2 100644 --- a/SRC/zgbtrs.f +++ b/SRC/zgbtrs.f @@ -134,7 +134,8 @@ *> \ingroup gbtrs * * ===================================================================== - SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, + SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -165,7 +166,8 @@ SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMV, ZGERU, ZLACGV, ZSWAP, ZTBSV + EXTERNAL XERBLA, ZGEMV, ZGERU, ZLACGV, ZSWAP, + $ ZTBSV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -222,7 +224,8 @@ SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, L = IPIV( J ) IF( L.NE.J ) $ CALL ZSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB ) - CALL ZGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ), + CALL ZGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, + $ 1 ), $ LDB, B( J+1, 1 ), LDB ) 10 CONTINUE END IF @@ -231,7 +234,8 @@ SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U*X = B, overwriting B with X. * - CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU, + CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, + $ KL+KU, $ AB, LDAB, B( 1, I ), 1 ) 20 CONTINUE * @@ -243,7 +247,8 @@ SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**T * X = B, overwriting B with X. * - CALL ZTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB, + CALL ZTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, + $ AB, $ LDAB, B( 1, I ), 1 ) 30 CONTINUE * @@ -268,7 +273,8 @@ SUBROUTINE ZGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, * * Solve U**H * X = B, overwriting B with X. * - CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ KL+KU, AB, LDAB, B( 1, I ), 1 ) 50 CONTINUE * diff --git a/SRC/zgebak.f b/SRC/zgebak.f index 897f66d19d..553daad07e 100644 --- a/SRC/zgebak.f +++ b/SRC/zgebak.f @@ -172,8 +172,10 @@ SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/zgebal.f b/SRC/zgebal.f index 356394a744..f29f0dae7f 100644 --- a/SRC/zgebal.f +++ b/SRC/zgebal.f @@ -197,7 +197,8 @@ SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) LOGICAL DISNAN, LSAME INTEGER IZAMAX DOUBLE PRECISION DLAMCH, DZNRM2 - EXTERNAL DISNAN, LSAME, IZAMAX, DLAMCH, DZNRM2 + EXTERNAL DISNAN, LSAME, IZAMAX, DLAMCH, + $ DZNRM2 * .. * .. External Subroutines .. EXTERNAL XERBLA, ZDSCAL, ZSWAP @@ -208,8 +209,10 @@ SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -267,7 +270,8 @@ SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( L ) = I IF( I.NE.L ) THEN CALL ZSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) - CALL ZSWAP( N-K+1, A( I, K ), LDA, A( L, K ), LDA ) + CALL ZSWAP( N-K+1, A( I, K ), LDA, A( L, K ), + $ LDA ) END IF NOCONV = .TRUE. * @@ -303,7 +307,8 @@ SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) SCALE( K ) = J IF( J.NE.K ) THEN CALL ZSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) - CALL ZSWAP( N-K+1, A( J, K ), LDA, A( K, K ), LDA ) + CALL ZSWAP( N-K+1, A( J, K ), LDA, A( K, K ), + $ LDA ) END IF NOCONV = .TRUE. * diff --git a/SRC/zgebrd.f b/SRC/zgebrd.f index 1cd6e014bd..1d05082bf5 100644 --- a/SRC/zgebrd.f +++ b/SRC/zgebrd.f @@ -316,7 +316,8 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, * the matrices X and Y which are needed to update the unreduced * part of the matrix * - CALL ZLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ), + CALL ZLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), + $ E( I ), $ TAUQ( I ), TAUP( I ), WORK, LDWRKX, $ WORK( LDWRKX*NB+1 ), LDWRKY ) * @@ -327,7 +328,8 @@ SUBROUTINE ZGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, $ N-I-NB+1, NB, -ONE, A( I+NB, I ), LDA, $ WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE, $ A( I+NB, I+NB ), LDA ) - CALL ZGEMM( 'No transpose', 'No transpose', M-I-NB+1, N-I-NB+1, + CALL ZGEMM( 'No transpose', 'No transpose', M-I-NB+1, + $ N-I-NB+1, $ NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA, $ ONE, A( I+NB, I+NB ), LDA ) * diff --git a/SRC/zgecon.f b/SRC/zgecon.f index 98120bb645..f8b8a2ad6f 100644 --- a/SRC/zgecon.f +++ b/SRC/zgecon.f @@ -237,12 +237,14 @@ SUBROUTINE ZGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(L). * - CALL ZLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, A, + CALL ZLATRS( 'Lower', 'No transpose', 'Unit', NORMIN, N, + $ A, $ LDA, WORK, SL, RWORK, INFO ) * * Multiply by inv(U). * - CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SU, RWORK( N+1 ), INFO ) ELSE * @@ -254,7 +256,8 @@ SUBROUTINE ZGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(L**H). * - CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Unit', NORMIN, + CALL ZLATRS( 'Lower', 'Conjugate transpose', 'Unit', + $ NORMIN, $ N, A, LDA, WORK, SL, RWORK, INFO ) END IF * diff --git a/SRC/zgees.f b/SRC/zgees.f index c7001bd782..ee8081bcd4 100644 --- a/SRC/zgees.f +++ b/SRC/zgees.f @@ -230,7 +230,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, + EXTERNAL XERBLA, ZCOPY, ZGEBAK, ZGEBAL, + $ ZGEHRD, $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR * .. * .. External Functions .. @@ -252,7 +253,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, WANTST = LSAME( SORT, 'S' ) IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -4 @@ -288,7 +290,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) ELSE - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) MAXWRK = MAX( MAXWRK, HSWORK ) END IF @@ -362,7 +365,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -391,7 +395,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: none) * (RWorkspace: none) * - CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM, + CALL ZTRSEN( 'N', JOBVS, BWORK, N, A, LDA, VS, LDVS, W, + $ SDIM, $ S, SEP, WORK( IWRK ), LWORK-IWRK+1, ICOND ) END IF * @@ -401,7 +406,8 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * (CWorkspace: none) * (RWorkspace: need N) * - CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS, + CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f index dd6cdbe60e..a3595d9bb9 100644 --- a/SRC/zgeesx.f +++ b/SRC/zgeesx.f @@ -234,7 +234,8 @@ *> \ingroup geesx * * ===================================================================== - SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, + SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, + $ W, $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * @@ -274,7 +275,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, + EXTERNAL DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, + $ ZGEHRD, $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR * .. * .. External Functions .. @@ -301,7 +303,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * IF( ( .NOT.WANTVS ) .AND. ( .NOT.LSAME( JOBVS, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -2 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -343,7 +346,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) ELSE - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) MAXWRK = MAX( MAXWRK, HSWORK ) END IF @@ -421,7 +425,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) END IF * @@ -452,7 +457,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * otherwise, need none ) * (RWorkspace: none) * - CALL ZTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, W, SDIM, + CALL ZTRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, W, + $ SDIM, $ RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1, $ ICOND ) IF( .NOT.WANTSN ) @@ -471,7 +477,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * (CWorkspace: none) * (RWorkspace: need N) * - CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, LDVS, + CALL ZGEBAK( 'P', 'R', N, ILO, IHI, RWORK( IBAL ), N, VS, + $ LDVS, $ IERR ) END IF * @@ -483,7 +490,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, CALL ZCOPY( N, A, LDA+1, W, 1 ) IF( ( WANTSV .OR. WANTSB ) .AND. INFO.EQ.0 ) THEN DUM( 1 ) = RCONDV - CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR ) + CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, + $ IERR ) RCONDV = DUM( 1 ) END IF END IF diff --git a/SRC/zgeev.f b/SRC/zgeev.f index 5007e12c20..9fc2e7d0fb 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -176,7 +176,8 @@ *> \ingroup geev * * ===================================================================== - SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, + SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, + $ LDVR, $ WORK, LWORK, RWORK, INFO ) implicit none * @@ -213,14 +214,16 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR, + EXTERNAL XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, + $ ZHSEQR, $ ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR * .. * .. External Functions .. LOGICAL LSAME INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE - EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE + EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, + $ ZLANGE * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT @@ -235,7 +238,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WANTVR = LSAME( JOBVR, 'V' ) IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -1 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 @@ -266,7 +270,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 ) MINWRK = 2*N IF( WANTVL ) THEN - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', + 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, @@ -276,7 +281,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', + 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, @@ -361,7 +367,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL @@ -393,7 +400,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR @@ -427,7 +435,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + 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 @@ -438,7 +447,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: none) * (RWorkspace: need N) * - CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, LDVL, + CALL ZGEBAK( 'B', 'L', N, ILO, IHI, RWORK( IBAL ), N, VL, + $ LDVL, $ IERR ) * * Normalize left eigenvectors and make largest component real @@ -463,7 +473,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * (CWorkspace: none) * (RWorkspace: need N) * - CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, LDVR, + CALL ZGEBAK( 'B', 'R', N, ILO, IHI, RWORK( IBAL ), N, VR, + $ LDVR, $ IERR ) * * Normalize right eigenvectors and make largest component real @@ -486,10 +497,12 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, * 50 CONTINUE IF( SCALEA ) THEN - CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ), + CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ W( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.GT.0 ) THEN - CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR ) + CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, + $ IERR ) END IF END IF * diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index 1e4343cffa..83eb0693bb 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -283,7 +283,8 @@ *> \ingroup geevx * * ===================================================================== - SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, + 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 @@ -324,7 +325,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, + EXTERNAL DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, + $ ZGEHRD, $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZTRSNA, $ ZUNGHR * .. @@ -332,7 +334,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, LOGICAL LSAME INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE - EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE + EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, + $ ZLANGE * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT @@ -349,12 +352,15 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR. + 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 + ELSE IF( ( .NOT.WANTVL ) .AND. + $ ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTVR ) .AND. + $ ( .NOT.LSAME( JOBVR, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR. $ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND. @@ -406,10 +412,12 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ WORK, -1, INFO ) ELSE IF( WNTSNN ) THEN - CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, + CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, + $ LDVR, $ WORK, -1, INFO ) ELSE - CALL ZHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, LDVR, + CALL ZHSEQR( 'S', 'N', N, 1, N, A, LDA, W, VR, + $ LDVR, $ WORK, -1, INFO ) END IF END IF @@ -427,7 +435,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, IF( .NOT.( WNTSNN .OR. WNTSNE ) ) $ MINWRK = MAX( MINWRK, N*N + 2*N ) MAXWRK = MAX( MAXWRK, HSWORK ) - MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', + MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, + $ 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) IF( .NOT.( WNTSNN .OR. WNTSNE ) ) $ MAXWRK = MAX( MAXWRK, N*N + 2*N ) @@ -508,7 +517,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VL, LDVL, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VL @@ -540,7 +550,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) * (RWorkspace: none) * - CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), WORK( IWRK ), + CALL ZUNGHR( N, ILO, IHI, VR, LDVR, WORK( ITAU ), + $ WORK( IWRK ), $ LWORK-IWRK+1, IERR ) * * Perform QR iteration, accumulating Schur vectors in VR @@ -581,7 +592,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, $ RWORK, N, IERR ) END IF @@ -591,7 +603,8 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * (RWorkspace: need 2*N unless SENSE = 'E') * IF( .NOT.WNTSNN ) THEN - CALL ZTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + CALL ZTRSNA( SENSE, 'A', SELECT, N, A, LDA, VL, LDVL, VR, + $ LDVR, $ RCONDE, RCONDV, N, NOUT, WORK( IWRK ), N, RWORK, $ ICOND ) END IF @@ -646,14 +659,16 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, * 50 CONTINUE IF( SCALEA ) THEN - CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, W( INFO+1 ), + CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, N-INFO, 1, + $ W( INFO+1 ), $ MAX( N-INFO, 1 ), IERR ) IF( INFO.EQ.0 ) THEN IF( ( WNTSNV .OR. WNTSNB ) .AND. ICOND.EQ.0 ) $ CALL DLASCL( 'G', 0, 0, CSCALE, ANRM, N, 1, RCONDV, N, $ IERR ) ELSE - CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, IERR ) + CALL ZLASCL( 'G', 0, 0, CSCALE, ANRM, ILO-1, 1, W, N, + $ IERR ) END IF END IF * diff --git a/SRC/zgehd2.f b/SRC/zgehd2.f index 1cd124deaa..5700361499 100644 --- a/SRC/zgehd2.f +++ b/SRC/zgehd2.f @@ -199,7 +199,8 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) * ALPHA = A( I+1, I ) - CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) ) + CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, + $ TAU( I ) ) A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 01687ff3b6..9731bf87f0 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -164,7 +164,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -194,7 +195,8 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) COMPLEX*16 EI * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, ZTRMM, + EXTERNAL ZAXPY, ZGEHD2, ZGEMM, ZLAHR2, ZLARFB, + $ ZTRMM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/zgejsv.f b/SRC/zgejsv.f index c4bf3cb0a2..85578f2d95 100644 --- a/SRC/zgejsv.f +++ b/SRC/zgejsv.f @@ -624,10 +624,10 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2 * .. * .. External Subroutines .. - EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLAPMR, - $ ZLASCL, DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, - $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, ZLACGV, - $ XERBLA + EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, + $ ZLAPMR, ZLASCL, DLASCL, ZLASET, ZLASSQ, ZLASWP, + $ ZUNGQR, ZUNMLQ, ZUNMQR, ZPOCON, DSCAL, ZDSCAL, + $ ZSWAP, ZTRSM, ZLACGV, XERBLA * EXTERNAL ZGESVJ * .. @@ -659,7 +659,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, INFO = - 3 ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN INFO = - 4 - ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN + ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. + $ LSAME(JOBT,'N') ) ) THEN INFO = - 5 ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN INFO = - 6 @@ -726,7 +727,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ ) END IF IF ( LQUERY ) THEN - CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, + CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, + $ V, $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) LWRK_ZGESVJ = INT( CDUMMY(1) ) IF ( ERREST ) THEN @@ -870,7 +872,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, $ LDU, CDUMMY, -1, IERR ) LWRK_ZUNMQR = INT( CDUMMY(1) ) IF ( .NOT. JRACC ) THEN - CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, + CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, + $ -1, $ RDUMMY, IERR ) LWRK_ZGEQP3N = INT( CDUMMY(1) ) CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, @@ -914,10 +917,12 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) LWRK_ZGESVJV = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, + CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, + $ CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) LWRK_ZUNMQR = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, + CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, + $ U, $ LDU, CDUMMY, -1, IERR ) LWRK_ZUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN @@ -1065,8 +1070,10 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL ZLACPY( 'A', M, 1, A, LDA, U, LDU ) * computing all M left singular vectors of the M x 1 matrix IF ( N1 .NE. N ) THEN - CALL ZGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR ) - CALL ZUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR ) + CALL ZGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N, + $ IERR ) + CALL ZUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N, + $ IERR ) CALL ZCOPY( M, A(1,1), 1, U(1,1), 1 ) END IF END IF @@ -1496,7 +1503,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * * .. second preconditioning using the QR factorization * - CALL ZGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR ) + CALL ZGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, + $ IERR ) * * .. and transpose upper to lower triangular DO 1948 p = 1, NR - 1 @@ -1523,7 +1531,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 1949 CONTINUE 1947 CONTINUE ELSE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA ) + CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), + $ LDA ) END IF * * .. and one-sided Jacobi rotations are started on a lower @@ -1563,7 +1572,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * accumulated product of Jacobi rotations, three are perfect ) * CALL ZLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA ) - CALL ZGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR) + CALL ZGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, + $ IERR) CALL ZLACPY( 'L', NR, NR, A, LDA, V, LDV ) CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) CALL ZGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), @@ -1579,9 +1589,12 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, SCALEM = RWORK(1) NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - 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 ) + 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 ZUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK, @@ -1636,10 +1649,13 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, NUMRANK = NINT(RWORK(2)) * IF ( NR .LT. M ) THEN - CALL ZLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU ) + CALL ZLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN - CALL ZLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU ) - CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU ) + CALL ZLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1), + $ LDU ) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1), + $ LDU ) END IF END IF * @@ -1703,7 +1719,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 2968 CONTINUE 2969 CONTINUE ELSE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) + CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), + $ LDV ) END IF * * Estimate the row scaled condition number of R1 @@ -1812,7 +1829,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL ZLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR ) DO 4950 p = 1, NR TEMP1 = DZNRM2( p, CWORK(2*N+N*NR+NR+p), NR ) - CALL ZDSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR ) + CALL ZDSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), + $ NR ) 4950 CONTINUE CALL ZPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1, $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR ) @@ -1841,7 +1859,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 4969 CONTINUE 4968 CONTINUE ELSE - CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) END IF * * Second preconditioning finished; continue with Jacobi SVD @@ -1869,7 +1888,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * equation is Q2*V2 = the product of the Jacobi rotations * used in ZGESVJ, premultiplied with the orthogonal matrix * from the second QR factorization. - CALL ZTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV) + CALL ZTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V, + $ LDV) ELSE * .. R1 is well conditioned, but non-square. Adjoint of R2 * is inverted to get the product of the Jacobi rotations @@ -1880,9 +1900,11 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, IF ( NR .LT. N ) THEN 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) + 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), + 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) END IF * @@ -1892,7 +1914,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * is Q3^* * V3 = the product of the Jacobi rotations (applied to * the lower triangular L3 from the LQ factorization of * R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL ZGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, + CALL ZGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, $ RWORK, LRWORK, INFO ) SCALEM = RWORK(1) @@ -1913,9 +1936,12 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, 874 CONTINUE 873 CONTINUE IF ( NR .LT. N ) THEN - 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) + 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 ) @@ -1931,15 +1957,19 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * defense ensures that ZGEJSV completes the task. * Compute the full SVD of L3 using ZGESVJ with explicit * accumulation of Jacobi rotations. - CALL ZGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, + CALL ZGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, + $ U, $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, $ RWORK, LRWORK, INFO ) SCALEM = RWORK(1) NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - 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) + 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 ) @@ -1977,7 +2007,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * At this moment, V contains the right singular vectors of A. * Next, assemble the left singular vector matrix U (M x N). IF ( NR .LT. M ) THEN - CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) + CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) CALL ZLASET('A',M-NR,N1-NR,CZERO,CONE, @@ -2051,10 +2082,13 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Assemble the left singular vector matrix U (M x N). * IF ( N .LT. M ) THEN - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU ) + CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), + $ LDU ) IF ( N .LT. N1 ) THEN - CALL ZLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU) - CALL ZLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU) + CALL ZLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1), + $ LDU) + CALL ZLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1), + $ LDU) END IF END IF CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, @@ -2166,10 +2200,13 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Next, assemble the left singular vector matrix U (M x N). * IF ( NR .LT. M ) THEN - CALL ZLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU ) + CALL ZLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), + $ LDU ) IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU) - CALL ZLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU) + CALL ZLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1), + $ LDU) + CALL ZLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1), + $ LDU) END IF END IF * @@ -2194,7 +2231,8 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL DLASCL( '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/SRC/zgelq2.f b/SRC/zgelq2.f index c83499f55d..471a2c590f 100644 --- a/SRC/zgelq2.f +++ b/SRC/zgelq2.f @@ -187,7 +187,8 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i+1:m,i:n) from the right * A( I, I ) = ONE - CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ), + CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), $ A( I+1, I ), LDA, WORK ) END IF A( I, I ) = ALPHA diff --git a/SRC/zgelqf.f b/SRC/zgelqf.f index cc238b1fe0..cbd13c74dd 100644 --- a/SRC/zgelqf.f +++ b/SRC/zgelqf.f @@ -252,7 +252,8 @@ SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/zgels.f b/SRC/zgels.f index 9296547979..99e8035da1 100644 --- a/SRC/zgels.f +++ b/SRC/zgels.f @@ -178,7 +178,8 @@ *> \ingroup gels * * ===================================================================== - SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -216,7 +217,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGELQF, ZGEQRF, ZLASCL, ZLASET, + EXTERNAL XERBLA, ZGELQF, ZGEQRF, ZLASCL, + $ ZLASET, $ ZTRTRS, ZUNMLQ, ZUNMQR * .. * .. Intrinsic Functions .. @@ -229,7 +231,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'C' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'C' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -289,7 +292,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * Quick return if possible * IF( MIN( M, N, NRHS ).EQ.0 ) THEN - CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, + $ LDB ) RETURN END IF * @@ -347,7 +351,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * compute QR factorization of A * - CALL ZGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL ZGEQRF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least N, optimally N*NB @@ -358,7 +363,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, A, + CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, N, + $ A, $ LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN, $ INFO ) * @@ -366,7 +372,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -412,7 +419,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Compute LQ factorization of A * - CALL ZGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN, + CALL ZGELQF( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), + $ LWORK-MN, $ INFO ) * * workspace at least M, optimally M*NB. @@ -423,7 +431,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -440,7 +449,8 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * B(1:N,1:NRHS) := Q(1:N,:)**H * B(1:M,1:NRHS) * - CALL ZUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, A, + CALL ZUNMLQ( 'Left', 'Conjugate transpose', N, NRHS, M, + $ A, $ LDA, WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN, $ INFO ) * diff --git a/SRC/zgelsd.f b/SRC/zgelsd.f index 0a274f94ca..b703515ec2 100644 --- a/SRC/zgelsd.f +++ b/SRC/zgelsd.f @@ -248,7 +248,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF, ZGEQRF, + EXTERNAL DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF, + $ ZGEQRF, $ ZLACPY, ZLALSD, ZLASCL, ZLASET, ZUNMBR, ZUNMLQ, $ ZUNMQR * .. @@ -305,9 +306,11 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * columns. * MM = N - MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'ZGEQRF', ' ', M, N, + MAXWRK = MAX( MAXWRK, N*ILAENV( 1, 'ZGEQRF', ' ', M, + $ N, $ -1, -1 ) ) - MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'ZUNMQR', 'LC', M, + MAXWRK = MAX( MAXWRK, NRHS*ILAENV( 1, 'ZUNMQR', 'LC', + $ M, $ NRHS, N, -1 ) ) END IF IF( M.GE.N ) THEN @@ -339,7 +342,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ 'ZGEBRD', ' ', M, M, -1, -1 ) ) MAXWRK = MAX( MAXWRK, M*M + 4*M + NRHS*ILAENV( 1, $ 'ZUNMBR', 'QLC', M, NRHS, M, -1 ) ) - MAXWRK = MAX( MAXWRK, M*M + 4*M + ( M - 1 )*ILAENV( 1, + MAXWRK = MAX( MAXWRK, + $ M*M + 4*M + ( M - 1 )*ILAENV( 1, $ 'ZUNMLQ', 'LC', N, NRHS, M, -1 ) ) IF( NRHS.GT.1 ) THEN MAXWRK = MAX( MAXWRK, M*M + M + M*NRHS ) @@ -355,9 +359,11 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Path 2 - underdetermined. * - MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'ZGEBRD', ' ', M, + MAXWRK = 2*M + ( N + M )*ILAENV( 1, 'ZGEBRD', ' ', + $ M, $ N, -1, -1 ) - MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1, 'ZUNMBR', + MAXWRK = MAX( MAXWRK, 2*M + NRHS*ILAENV( 1, + $ 'ZUNMBR', $ 'QLC', M, NRHS, M, -1 ) ) MAXWRK = MAX( MAXWRK, 2*M + M*ILAENV( 1, 'ZUNMBR', $ 'PLN', N, NRHS, M, -1 ) ) @@ -431,20 +437,23 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM. * - CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM. * - CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * If M < N make sure B(M+1:N,:) = 0 * IF( M.LT.N ) - $ CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + $ CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) * * Overdetermined case. * @@ -472,7 +481,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (RWorkspace: need N) * (CWorkspace: need NRHS, prefer NRHS*NB) * - CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Zero out below R. @@ -500,7 +510,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors of R. * (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB) * - CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -514,7 +525,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of R. * - CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, WORK( ITAUP ), + CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, N, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * ELSE IF( N.GE.MNTHR .AND. LWORK.GE.4*M+M*M+ @@ -579,7 +591,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Zero out below first M rows of B. * - CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) NWORK = ITAU + M * * Multiply transpose(Q) by B. @@ -609,7 +622,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Multiply B by transpose of left bidiagonalizing vectors. * (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB) * - CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * * Solve the bidiagonal least squares problem. @@ -623,7 +637,8 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Multiply B by right bidiagonalizing vectors of A. * - CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, WORK( ITAUP ), + CALL ZUNMBR( 'P', 'L', 'N', N, NRHS, M, A, LDA, + $ WORK( ITAUP ), $ B, LDB, WORK( NWORK ), LWORK-NWORK+1, INFO ) * END IF @@ -631,18 +646,22 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling. * IF( IASCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 10 CONTINUE diff --git a/SRC/zgelss.f b/SRC/zgelss.f index b38dae114c..bf1483cff1 100644 --- a/SRC/zgelss.f +++ b/SRC/zgelss.f @@ -213,7 +213,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, COMPLEX*16 DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, ZDRSCL, + EXTERNAL DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, + $ ZDRSCL, $ ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF, ZLACPY, $ ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ * .. @@ -272,9 +273,11 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ LDB, DUM(1), -1, INFO ) LWORK_ZUNMQR = INT( DUM(1) ) MM = N - MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'ZGEQRF', ' ', M, + MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'ZGEQRF', ' ', + $ M, $ N, -1, -1 ) ) - MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'ZUNMQR', 'LC', + MAXWRK = MAX( MAXWRK, N + NRHS*ILAENV( 1, 'ZUNMQR', + $ 'LC', $ M, NRHS, N, -1 ) ) END IF IF( M.GE.N ) THEN @@ -282,11 +285,13 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Path 1 - overdetermined or exactly determined * * Compute space needed for ZGEBRD - CALL ZGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + CALL ZGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), $ -1, INFO ) LWORK_ZGEBRD = INT( DUM(1) ) * Compute space needed for ZUNMBR - CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), + CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ DUM(1), $ B, LDB, DUM(1), -1, INFO ) LWORK_ZUNMBR = INT( DUM(1) ) * Compute space needed for ZUNGBR @@ -423,13 +428,15 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -459,7 +466,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need N+NRHS, prefer N+NRHS*NB) * (RWorkspace: none) * - CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), B, + CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAU ), + $ B, $ LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Zero out below R @@ -486,7 +494,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need 2*N+NRHS, prefer 2*N+NRHS*NB) * (RWorkspace: none) * - CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors of R in A @@ -503,7 +512,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: none) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, N, 0, NRHS, S, RWORK( IE ), A, LDA, DUM, + CALL ZBDSQR( 'U', N, N, 0, NRHS, S, RWORK( IE ), A, LDA, + $ DUM, $ 1, B, LDB, RWORK( IRWORK ), INFO ) IF( INFO.NE.0 ) $ GO TO 70 @@ -519,7 +529,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL ZDRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 10 CONTINUE * @@ -535,12 +546,14 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CHUNK = LWORK / N DO 20 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL ZGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B( 1, I ), + CALL ZGEMM( 'C', 'N', N, BL, N, CONE, A, LDA, B( 1, + $ I ), $ LDB, CZERO, WORK, N ) CALL ZLACPY( 'G', N, BL, WORK, N, B( 1, I ), LDB ) 20 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL ZGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 ) + CALL ZGEMV( 'C', N, N, CONE, A, LDA, B, 1, CZERO, WORK, + $ 1 ) CALL ZCOPY( N, WORK, 1, B, 1 ) END IF * @@ -596,7 +609,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) * (RWorkspace: none) * - CALL ZUNGBR( 'P', M, M, M, WORK( IL ), LDWORK, WORK( ITAUP ), + CALL ZUNGBR( 'P', M, M, M, WORK( IL ), LDWORK, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, INFO ) IRWORK = IE + M * @@ -622,7 +636,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL ZDRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 30 CONTINUE IWORK = IL + M*LDWORK @@ -632,27 +647,30 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (RWorkspace: none) * IF( LWORK.GE.LDB*NRHS+IWORK-1 .AND. NRHS.GT.1 ) THEN - CALL ZGEMM( 'C', 'N', M, NRHS, M, CONE, WORK( IL ), LDWORK, + CALL ZGEMM( 'C', 'N', M, NRHS, M, CONE, WORK( IL ), + $ LDWORK, $ B, LDB, CZERO, WORK( IWORK ), LDB ) CALL ZLACPY( 'G', M, NRHS, WORK( IWORK ), LDB, B, LDB ) ELSE IF( NRHS.GT.1 ) THEN CHUNK = ( LWORK-IWORK+1 ) / M DO 40 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL ZGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), LDWORK, + CALL ZGEMM( 'C', 'N', M, BL, M, CONE, WORK( IL ), + $ LDWORK, $ B( 1, I ), LDB, CZERO, WORK( IWORK ), M ) CALL ZLACPY( 'G', M, BL, WORK( IWORK ), M, B( 1, I ), $ LDB ) 40 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL ZGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, 1 ), - $ 1, CZERO, WORK( IWORK ), 1 ) + CALL ZGEMV( 'C', M, M, CONE, WORK( IL ), LDWORK, B( 1, + $ 1 ), 1, CZERO, WORK( IWORK ), 1 ) CALL ZCOPY( M, WORK( IWORK ), 1, B( 1, 1 ), 1 ) END IF * * Zero out below first M rows of B * - CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), LDB ) + CALL ZLASET( 'F', N-M, NRHS, CZERO, CZERO, B( M+1, 1 ), + $ LDB ) IWORK = ITAU + M * * Multiply transpose(Q) by B @@ -683,7 +701,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: need 2*M+NRHS, prefer 2*M+NRHS*NB) * (RWorkspace: none) * - CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, WORK( ITAUQ ), + CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, + $ WORK( ITAUQ ), $ B, LDB, WORK( IWORK ), LWORK-IWORK+1, INFO ) * * Generate right bidiagonalizing vectors in A @@ -700,7 +719,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * (CWorkspace: none) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'L', M, N, 0, NRHS, S, RWORK( IE ), A, LDA, DUM, + CALL ZBDSQR( 'L', M, N, 0, NRHS, S, RWORK( IE ), A, LDA, + $ DUM, $ 1, B, LDB, RWORK( IRWORK ), INFO ) IF( INFO.NE.0 ) $ GO TO 70 @@ -716,7 +736,8 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CALL ZDRSCL( NRHS, S( I ), B( I, 1 ), LDB ) RANK = RANK + 1 ELSE - CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL ZLASET( 'F', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) END IF 50 CONTINUE * @@ -732,12 +753,14 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, CHUNK = LWORK / N DO 60 I = 1, NRHS, CHUNK BL = MIN( NRHS-I+1, CHUNK ) - CALL ZGEMM( 'C', 'N', N, BL, M, CONE, A, LDA, B( 1, I ), + CALL ZGEMM( 'C', 'N', N, BL, M, CONE, A, LDA, B( 1, + $ I ), $ LDB, CZERO, WORK, N ) CALL ZLACPY( 'F', N, BL, WORK, N, B( 1, I ), LDB ) 60 CONTINUE ELSE IF( NRHS.EQ.1 ) THEN - CALL ZGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, 1 ) + CALL ZGEMV( 'C', M, N, CONE, A, LDA, B, 1, CZERO, WORK, + $ 1 ) CALL ZCOPY( N, WORK, 1, B, 1 ) END IF END IF @@ -745,18 +768,22 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF 70 CONTINUE WORK( 1 ) = MAXWRK diff --git a/SRC/zgelst.f b/SRC/zgelst.f index f265213d22..13fbbef813 100644 --- a/SRC/zgelst.f +++ b/SRC/zgelst.f @@ -190,7 +190,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, + SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -229,7 +230,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL ZGELQT, ZGEQRT, ZGEMLQT, ZGEMQRT, ZLASCL, + EXTERNAL ZGELQT, ZGEQRT, ZGEMLQT, ZGEMQRT, + $ ZLASCL, $ ZLASET, ZTRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -242,7 +244,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO = 0 MN = MIN( M, N ) LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.( LSAME( TRANS, 'N' ) .OR. LSAME( TRANS, 'C' ) ) ) THEN + IF( .NOT.( LSAME( TRANS, 'N' ) .OR. + $ LSAME( TRANS, 'C' ) ) ) THEN INFO = -1 ELSE IF( M.LT.0 ) THEN INFO = -2 @@ -285,7 +288,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * Quick return if possible * IF( MIN( M, N, NRHS ).EQ.0 ) THEN - CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, + $ LDB ) WORK( 1 ) = DBLE( LWOPT ) RETURN END IF @@ -333,7 +337,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Matrix all zero. Return zero solution. * - CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL ZLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, + $ LDB ) WORK( 1 ) = DBLE( LWOPT ) RETURN END IF @@ -379,13 +384,15 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL ZGEMQRT( 'Left', 'Conjugate transpose', M, NRHS, N, NB, + CALL ZGEMQRT( 'Left', 'Conjugate transpose', M, NRHS, N, + $ NB, $ A, LDA, WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * * Compute B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) * - CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N, NRHS, + CALL ZTRTRS( 'Upper', 'No transpose', 'Non-unit', N, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -452,7 +459,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * * Block 1: B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) * - CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M, NRHS, + CALL ZTRTRS( 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, $ A, LDA, B, LDB, INFO ) * IF( INFO.GT.0 ) THEN @@ -472,7 +480,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * using the compact WY representation of Q, * workspace at least NRHS, optimally NRHS*NB. * - CALL ZGEMLQT( 'Left', 'Conjugate transpose', N, NRHS, M, NB, + CALL ZGEMLQT( 'Left', 'Conjugate transpose', N, NRHS, M, + $ NB, $ A, LDA, WORK( 1 ), NB, B, LDB, $ WORK( MN*NB+1 ), INFO ) * diff --git a/SRC/zgelsy.f b/SRC/zgelsy.f index 664e8b49a2..94db5185b8 100644 --- a/SRC/zgelsy.f +++ b/SRC/zgelsy.f @@ -208,7 +208,8 @@ *> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n *> * ===================================================================== - SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, + SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, $ WORK, LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -245,7 +246,8 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, COMPLEX*16 C1, C2, S1, S2 * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGEQP3, ZLAIC1, ZLASCL, + EXTERNAL XERBLA, ZCOPY, ZGEQP3, ZLAIC1, + $ ZLASCL, $ ZLASET, ZTRSM, ZTZRZF, ZUNMQR, ZUNMRZ * .. * .. External Functions .. @@ -338,13 +340,15 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -411,7 +415,8 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA, + CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, + $ LDA, $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) WSIZE = MAX( WSIZE, 2*MN+DBLE( WORK( 2*MN+1 ) ) ) * @@ -452,18 +457,22 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 70 CONTINUE diff --git a/SRC/zgeqlf.f b/SRC/zgeqlf.f index fdb70aeb1f..77c63140a1 100644 --- a/SRC/zgeqlf.f +++ b/SRC/zgeqlf.f @@ -249,7 +249,8 @@ SUBROUTINE ZGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the QL factorization of the current block * A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1) * - CALL ZGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, TAU( I ), + CALL ZGEQL2( M-K+I+IB-1, IB, A( 1, N-K+I ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( N-K+I.GT.1 ) THEN * @@ -261,7 +262,8 @@ SUBROUTINE ZGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * - CALL ZLARFB( 'Left', 'Conjugate transpose', 'Backward', + CALL ZLARFB( 'Left', 'Conjugate transpose', + $ 'Backward', $ 'Columnwise', M-K+I+IB-1, N-K+I-1, IB, $ A( 1, N-K+I ), LDA, WORK, LDWORK, A, LDA, $ WORK( IB+1 ), LDWORK ) diff --git a/SRC/zgeqp3.f b/SRC/zgeqp3.f index c6e896f957..48ff85d9eb 100644 --- a/SRC/zgeqp3.f +++ b/SRC/zgeqp3.f @@ -183,7 +183,8 @@ SUBROUTINE ZGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, $ NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZLAQP2, ZLAQPS, ZSWAP, ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZLAQP2, ZLAQPS, ZSWAP, + $ ZUNMQR * .. * .. External Functions .. INTEGER ILAENV @@ -266,7 +267,8 @@ SUBROUTINE ZGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, *CC CALL ZUNM2R( 'Left', 'Conjugate Transpose', M, N-NA, *CC $ NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK, *CC $ INFO ) - CALL ZUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, A, + CALL ZUNMQR( 'Left', 'Conjugate Transpose', M, N-NA, NA, + $ A, $ LDA, TAU, A( 1, NA+1 ), LDA, WORK, LWORK, $ INFO ) IWS = MAX( IWS, INT( WORK( 1 ) ) ) @@ -308,7 +310,8 @@ SUBROUTINE ZGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, RWORK, * determine the minimum value of NB. * NB = LWORK / ( SN+1 ) - NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQRF', ' ', SM, SN, + NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQRF', ' ', SM, + $ SN, $ -1, -1 ) ) * * diff --git a/SRC/zgeqrt.f b/SRC/zgeqrt.f index 8425895db8..2539059123 100644 --- a/SRC/zgeqrt.f +++ b/SRC/zgeqrt.f @@ -196,9 +196,11 @@ SUBROUTINE ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO ) * Compute the QR factorization of the current block A(I:M,I:I+IB-1) * IF( USE_RECURSIVE_QR ) THEN - CALL ZGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL ZGEQRT3( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) ELSE - CALL ZGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, IINFO ) + CALL ZGEQRT2( M-I+1, IB, A(I,I), LDA, T(1,I), LDT, + $ IINFO ) END IF IF( I+IB.LE.N ) THEN * diff --git a/SRC/zgerfs.f b/SRC/zgerfs.f index b22d1871d0..144dac488e 100644 --- a/SRC/zgerfs.f +++ b/SRC/zgerfs.f @@ -182,7 +182,8 @@ *> \ingroup gerfs * * ===================================================================== - SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, EXTERNAL LSAME, DLAMCH * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGETRS, ZLACN2 + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGETRS, + $ ZLACN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -308,7 +310,8 @@ SUBROUTINE ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + CALL ZGEMV( TRANS, N, N, -ONE, A, LDA, X( 1, J ), 1, ONE, + $ WORK, $ 1 ) * * Compute componentwise relative backward error from formula diff --git a/SRC/zgerfsx.f b/SRC/zgerfsx.f index 43b03f9974..b9bfdc732d 100644 --- a/SRC/zgerfsx.f +++ b/SRC/zgerfsx.f @@ -408,7 +408,8 @@ *> \ingroup gerfsx * * ===================================================================== - SUBROUTINE ZGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -474,7 +475,8 @@ SUBROUTINE ZGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILATRANS, ILAPREC - EXTERNAL DLAMCH, ZLANGE, ZLA_GERCOND_X, ZLA_GERCOND_C + EXTERNAL DLAMCH, ZLANGE, ZLA_GERCOND_X, + $ ZLA_GERCOND_C DOUBLE PRECISION DLAMCH, ZLANGE, ZLA_GERCOND_X, ZLA_GERCOND_C LOGICAL LSAME INTEGER ILATRANS, ILAPREC @@ -607,7 +609,8 @@ SUBROUTINE ZGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, NORM = '1' END IF ANORM = ZLANGE( NORM, N, N, A, LDA, RWORK ) - CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Perform refinement on each right-hand side * @@ -634,19 +637,23 @@ SUBROUTINE ZGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, END IF END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). * IF ( COLEQU .AND. NOTRAN ) THEN - RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ C, .TRUE., INFO, WORK, RWORK ) ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN - RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ R, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, + $ IPIV, $ C, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/zgerqf.f b/SRC/zgerqf.f index feb95dc78f..54f2d639e9 100644 --- a/SRC/zgerqf.f +++ b/SRC/zgerqf.f @@ -249,7 +249,8 @@ SUBROUTINE ZGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Compute the RQ factorization of the current block * A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1) * - CALL ZGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, TAU( I ), + CALL ZGERQ2( IB, N-K+I+IB-1, A( M-K+I, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) IF( M-K+I.GT.1 ) THEN * diff --git a/SRC/zgesdd.f b/SRC/zgesdd.f index bccbeda77e..0ad38714ad 100644 --- a/SRC/zgesdd.f +++ b/SRC/zgesdd.f @@ -269,7 +269,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, COMPLEX*16 CDUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM, + EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, + $ ZGEMM, $ ZGEQRF, ZLACP2, ZLACPY, ZLACRM, ZLARCM, ZLASCL, $ ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR * .. @@ -344,7 +345,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ 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 ) + 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), @@ -485,7 +487,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ 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 ) + 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), @@ -675,7 +678,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Zero out below R @@ -692,7 +696,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NRWORK = IE + N @@ -732,13 +737,15 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy R to WORK( IR ), zeroing out below it * CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ), + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -771,7 +778,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + N IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -783,7 +791,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) - CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, + CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * @@ -794,7 +803,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) - CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, + CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -832,13 +842,15 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, WORK( IR+1 ), + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ WORK( IR+1 ), $ LDWRKR ) * * Generate Q in A @@ -871,7 +883,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + N IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -882,7 +895,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) - CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, + CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -893,7 +907,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) - CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, + CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), + $ LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -903,7 +918,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA, + $ WORK( IR ), $ LDWRKR, CZERO, U, LDU ) * ELSE IF( WNTQA ) THEN @@ -925,7 +941,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] * RWorkspace: need 0 * - CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) * @@ -951,7 +968,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IRU = IE + N @@ -964,7 +982,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -996,7 +1015,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need N*N [U] * RWorkspace: need 0 * - CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), + CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU, + $ WORK( IU ), $ LDWRKU, CZERO, A, LDA ) * * Copy left singular vectors of A from A to U @@ -1034,7 +1054,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 @@ -1079,7 +1100,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1102,7 +1124,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRVT DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL ZLACRM( CHUNK, N, A( I, 1 ), LDA, RWORK( IRU ), + CALL ZLACRM( CHUNK, N, A( I, 1 ), LDA, + $ RWORK( IRU ), $ N, WORK( IU ), LDWRKU, RWORK( NRWORK ) ) CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, $ A( I, 1 ), LDA ) @@ -1138,7 +1161,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1190,7 +1214,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1270,7 +1295,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1297,12 +1323,14 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL ZLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) - CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), + CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, + $ WORK( IU ), $ LDWRKU ) CALL ZUNMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) - CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) + CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, + $ LDA ) ELSE * * Path 6o-slow @@ -1344,7 +1372,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1382,7 +1411,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), + $ RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1440,7 +1470,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Zero out above L @@ -1457,7 +1488,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) NRWORK = IE + M @@ -1502,7 +1534,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy L to WORK(IL), zeroing about above it @@ -1541,7 +1574,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1552,7 +1586,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) - CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, + CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1564,7 +1599,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) - CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, + CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * @@ -1576,7 +1612,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ), M, + CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IVT ), + $ M, $ A( 1, I ), LDA, CZERO, WORK( IL ), $ LDWRKL ) CALL ZLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1602,7 +1639,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * * Copy L to WORK(IL), zeroing out above it @@ -1641,7 +1679,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1652,7 +1691,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) - CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, + CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1663,7 +1703,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) - CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, + CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), + $ LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * @@ -1673,7 +1714,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * RWorkspace: need 0 * CALL ZLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) - CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, + CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), + $ LDWRKL, $ A, LDA, CZERO, VT, LDVT ) * ELSE IF( WNTQA ) THEN @@ -1695,7 +1737,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] * RWorkspace: need 0 * - CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), + CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) * @@ -1721,7 +1764,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) * @@ -1734,7 +1778,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IE + M IRVT = IRU + M*M NRWORK = IRVT + M*M - CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'U', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1766,7 +1811,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need M*M [VT] * RWorkspace: need 0 * - CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, + CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), + $ LDWKVT, $ VT, LDVT, CZERO, A, LDA ) * * Copy right singular vectors of A from A to VT @@ -1852,7 +1898,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * CWorkspace: need 0 * RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1861,7 +1908,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, + $ WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) CALL ZLACPY( 'F', M, M, WORK( IVT ), LDWKVT, U, LDU ) * @@ -1875,7 +1923,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRU DO 50 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), LDA, + CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), + $ LDA, $ WORK( IVT ), LDWKVT, RWORK( NRWORK ) ) CALL ZLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT, $ A( 1, I ), LDA ) @@ -1910,7 +1959,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -1962,7 +2012,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2045,7 +2096,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2070,12 +2122,14 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * 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 ), + CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, + $ WORK( IVT ), $ LDWKVT ) CALL ZUNMBR( 'P', 'R', 'C', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, $ WORK( NWORK ), LWORK-NWORK+1, IERR ) - CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) + CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, + $ LDA ) ELSE * * Path 6to-slow @@ -2097,7 +2151,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, NRWORK = IRU DO 60 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, I ), + CALL ZLARCM( M, BLK, RWORK( IRVT ), M, A( 1, + $ I ), $ LDA, WORK( IVT ), LDWKVT, $ RWORK( NRWORK ) ) CALL ZLACPY( 'F', M, BLK, WORK( IVT ), LDWKVT, @@ -2116,7 +2171,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRVT = NRWORK IRU = IRVT + M*M NRWORK = IRU + M*M - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * @@ -2155,7 +2211,8 @@ SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, IRU = IRVT + M*M NRWORK = IRU + M*M * - CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), + CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), + $ RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, $ RWORK( NRWORK ), IWORK, INFO ) * diff --git a/SRC/zgesvd.f b/SRC/zgesvd.f index a6253b796a..53cf124b4d 100644 --- a/SRC/zgesvd.f +++ b/SRC/zgesvd.f @@ -253,7 +253,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, COMPLEX*16 CDUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF, ZGEMM, + EXTERNAL DLASCL, XERBLA, ZBDSQR, ZGEBRD, ZGELQF, + $ ZGEMM, $ ZGEQRF, ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNGLQ, $ ZUNGQR, ZUNMBR * .. @@ -322,9 +323,11 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL ZGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) LWORK_ZGEQRF = INT( CDUM(1) ) * Compute space needed for ZUNGQR - CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_ZUNGQR_N = INT( CDUM(1) ) - CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_ZUNGQR_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), @@ -474,7 +477,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) LWORK_ZUNGLQ_N = INT( CDUM(1) ) - CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) + CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, + $ IERR ) LWORK_ZUNGLQ_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), @@ -673,13 +677,15 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 2*N, prefer N+N*NB) * (RWorkspace: need 0) * - CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R * IF( N .GT. 1 ) THEN - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, + $ 1 ), $ LDA ) END IF IE = 1 @@ -691,7 +697,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) * (RWorkspace: need N) * - CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), + CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) NCVT = 0 @@ -712,7 +719,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, LDA, + CALL ZBDSQR( 'U', N, NCVT, 0, 0, S, RWORK( IE ), A, + $ LDA, $ CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO ) * * If right singular vectors desired in VT, copy them there @@ -762,7 +770,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Copy R to WORK(IR) and zero out below it * - CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) + CALL ZLACPY( 'U', N, N, A, LDA, WORK( IR ), + $ LDWRKR ) CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, $ WORK( IR+1 ), LDWRKR ) * @@ -781,7 +790,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) * (RWorkspace: need N) * - CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), + CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, + $ RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -799,7 +809,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, 1, + CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + $ 1, $ WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) IU = ITAUQ @@ -811,7 +822,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ), + CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, CZERO, $ WORK( IU ), LDWRKU ) CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -848,7 +860,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, 1, + CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + $ 1, $ A, LDA, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -918,7 +931,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL ZGEBRD( N, N, VT, LDVT, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL ZLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) + CALL ZLACPY( 'L', N, N, VT, LDVT, WORK( IR ), + $ LDWRKR ) * * Generate left vectors bidiagonalizing R in WORK(IR) * (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) @@ -954,7 +968,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) - CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, 1 ), + CALL ZGEMM( 'N', 'N', CHUNK, N, N, CONE, A( I, + $ 1 ), $ LDA, WORK( IR ), LDWRKR, CZERO, $ WORK( IU ), LDWRKU ) CALL ZLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU, @@ -1104,7 +1119,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), + $ CDUM, $ 1, WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1171,7 +1187,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), + $ CDUM, $ 1, U, LDU, CDUM, 1, RWORK( IRWORK ), $ INFO ) * @@ -1348,7 +1365,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1439,7 +1457,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * prefer N*N+2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1449,7 +1468,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), + $ VT, $ LDVT, WORK( IU ), LDWRKU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1515,7 +1535,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1525,7 +1546,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1609,7 +1631,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), CDUM, + CALL ZBDSQR( 'U', N, 0, N, 0, S, RWORK( IE ), + $ CDUM, $ 1, WORK( IR ), LDWRKR, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -1681,7 +1704,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), CDUM, + CALL ZBDSQR( 'U', N, 0, M, 0, S, RWORK( IE ), + $ CDUM, $ 1, U, LDU, CDUM, 1, RWORK( IRWORK ), $ INFO ) * @@ -1862,7 +1886,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, A, LDA, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1954,7 +1979,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * prefer N*N+2*N+(N-1)*NB) * (RWorkspace: need 0) * - CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -1964,7 +1990,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need N*N) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', N, N, N, 0, S, RWORK( IE ), + $ VT, $ LDVT, WORK( IU ), LDWRKU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2034,7 +2061,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), + CALL ZUNGBR( 'P', N, N, N, VT, LDVT, + $ WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + N * @@ -2044,7 +2072,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', N, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2185,7 +2214,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 2*M, prefer M+M*NB) * (RWorkspace: 0) * - CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), + CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), + $ WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out above L @@ -2201,7 +2231,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*M, prefer 2*M+2*M*NB) * (RWorkspace: need M) * - CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), + CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), + $ WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, $ IERR ) IF( WNTUO .OR. WNTUAS ) THEN @@ -2223,7 +2254,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, 1, + CALL ZBDSQR( 'U', M, 0, NRU, 0, S, RWORK( IE ), CDUM, + $ 1, $ A, LDA, CDUM, 1, RWORK( IRWORK ), INFO ) * * If left singular vectors desired in U, copy them there @@ -2276,7 +2308,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * * Copy L to WORK(IR) and zero out above it * - CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR ) + CALL ZLACPY( 'L', M, M, A, LDA, WORK( IR ), + $ LDWRKR ) CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, $ WORK( IR+LDWRKR ), LDWRKR ) * @@ -2295,7 +2328,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) * (RWorkspace: need M) * - CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S, RWORK( IE ), + CALL ZGEBRD( M, M, WORK( IR ), LDWRKR, S, + $ RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * @@ -2325,7 +2359,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ), + CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, CZERO, $ WORK( IU ), LDWRKU ) CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2362,7 +2397,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, LDA, + CALL ZBDSQR( 'L', M, N, 0, 0, S, RWORK( IE ), A, + $ LDA, $ CDUM, 1, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -2413,7 +2449,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Copy L to U, zeroing about above it * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ), + CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, + $ 2 ), $ LDU ) * * Generate Q in A @@ -2434,7 +2471,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, CALL ZGEBRD( M, M, U, LDU, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) - CALL ZLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) + CALL ZLACPY( 'U', M, M, U, LDU, WORK( IR ), + $ LDWRKR ) * * Generate right vectors bidiagonalizing L in WORK(IR) * (CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB) @@ -2470,7 +2508,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) - CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, WORK( IR ), + CALL ZGEMM( 'N', 'N', M, BLK, M, CONE, + $ WORK( IR ), $ LDWRKR, A( 1, I ), LDA, CZERO, $ WORK( IU ), LDWRKU ) CALL ZLACPY( 'F', M, BLK, WORK( IU ), LDWRKU, @@ -2494,7 +2533,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * Copy L to U, zeroing out above it * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) - CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, 2 ), + CALL ZLASET( 'U', M-1, M-1, CZERO, CZERO, U( 1, + $ 2 ), $ LDU ) * * Generate Q in A @@ -2538,7 +2578,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, LDA, + CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), A, + $ LDA, $ U, LDU, CDUM, 1, RWORK( IRWORK ), INFO ) * END IF @@ -2687,7 +2728,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), + $ VT, $ LDVT, CDUM, 1, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2862,7 +2904,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -2872,7 +2915,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, A, LDA, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -2953,7 +2997,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3028,7 +3073,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3038,7 +3084,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3193,7 +3240,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, 0, 0, S, RWORK( IE ), + $ VT, $ LDVT, CDUM, 1, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3372,7 +3420,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, A, LDA, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3382,7 +3431,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, A, LDA, CDUM, 1, $ RWORK( IRWORK ), INFO ) * @@ -3463,7 +3513,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3542,7 +3593,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: need 3*M, prefer 2*M+M*NB) * (RWorkspace: 0) * - CALL ZUNGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), + CALL ZUNGBR( 'Q', M, M, M, U, LDU, + $ WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) IRWORK = IE + M * @@ -3552,7 +3604,8 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, * (CWorkspace: 0) * (RWorkspace: need BDSPAC) * - CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), VT, + CALL ZBDSQR( 'U', M, N, M, 0, S, RWORK( IE ), + $ VT, $ LDVT, U, LDU, CDUM, 1, $ RWORK( IRWORK ), INFO ) * diff --git a/SRC/zgesvdq.f b/SRC/zgesvdq.f index c3b359396f..3fcf4ca66d 100644 --- a/SRC/zgesvdq.f +++ b/SRC/zgesvdq.f @@ -448,7 +448,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, DOUBLE PRECISION RDUMMY(1) * .. * .. External Subroutines (BLAS, LAPACK) - EXTERNAL ZGELQF, ZGEQP3, ZGEQRF, ZGESVD, ZLACPY, ZLAPMT, + EXTERNAL ZGELQF, ZGEQP3, ZGEQRF, ZGESVD, ZLACPY, + $ ZLAPMT, $ ZLASCL, ZLASET, ZLASWP, ZDSCAL, DLASET, DLASCL, $ ZPOCON, ZUNMLQ, ZUNMQR, XERBLA * .. @@ -673,10 +674,12 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL ZGEQRF(N,N/2,U,LDU,CDUMMY,CDUMMY,-1,IERR) LWRK_ZGEQRF = INT( CDUMMY(1) ) - CALL ZGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + CALL ZGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U, + $ LDU, $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) LWRK_ZGESVD2 = INT( CDUMMY(1) ) - CALL ZUNMQR( 'R', 'C', N, N, N/2, U, LDU, CDUMMY, + CALL ZUNMQR( 'R', 'C', N, N, N/2, U, LDU, + $ CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) LWRK_ZUNMQR2 = INT( CDUMMY(1) ) OPTWRK2 = MAX( LWRK_ZGEQP3, N/2+LWRK_ZGEQRF, @@ -695,10 +698,12 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( WNTVA ) THEN CALL ZGELQF(N/2,N,U,LDU,CDUMMY,CDUMMY,-1,IERR) LWRK_ZGELQF = INT( CDUMMY(1) ) - CALL ZGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + CALL ZGESVD( 'S','O', N/2,N/2, V, LDV, S, U, + $ LDU, $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) LWRK_ZGESVD2 = INT( CDUMMY(1) ) - CALL ZUNMLQ( 'R', 'N', N, N, N/2, U, LDU, CDUMMY, + CALL ZUNMLQ( 'R', 'N', N, N, N/2, U, LDU, + $ CDUMMY, $ V, LDV, CDUMMY,-1,IERR ) LWRK_ZUNMLQ = INT( CDUMMY(1) ) OPTWRK2 = MAX( LWRK_ZGEQP3, N/2+LWRK_ZGELQF, @@ -773,9 +778,12 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * Quick return: A is the M x N zero matrix. NUMRANK = 0 CALL DLASET( 'G', N, 1, ZERO, ZERO, S, N ) - IF ( WNTUS ) CALL ZLASET('G', M, N, CZERO, CONE, U, LDU) - IF ( WNTUA ) CALL ZLASET('G', M, M, CZERO, CONE, U, LDU) - IF ( WNTVA ) CALL ZLASET('G', N, N, CZERO, CONE, V, LDV) + IF ( WNTUS ) CALL ZLASET('G', M, N, CZERO, CONE, U, + $ LDU) + IF ( WNTUA ) CALL ZLASET('G', M, M, CZERO, CONE, U, + $ LDU) + IF ( WNTVA ) CALL ZLASET('G', N, N, CZERO, CONE, V, + $ LDV) IF ( WNTUF ) THEN CALL ZLASET( 'G', N, 1, CZERO, CZERO, CWORK, N ) CALL ZLASET( 'G', M, N, CZERO, CONE, U, LDU ) @@ -796,7 +804,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RWORK(1) .GT. BIG / SQRT(DBLE(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL ZLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + CALL ZLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF CALL ZLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) @@ -818,7 +827,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( RTMP .GT. BIG / SQRT(DBLE(M)) ) THEN * .. to prevent overflow in the QR factorization, scale the * matrix by 1/sqrt(M) if too large entry detected - CALL ZLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + CALL ZLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, + $ IERR) ASCALED = .TRUE. END IF END IF @@ -947,7 +957,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. compute the singular values of R = [A](1:NR,1:N) * IF ( NR .GT. 1 ) - $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), LDA ) + $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), + $ LDA ) CALL ZGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, $ V, LDV, CWORK, LCWORK, RWORK, INFO ) * @@ -967,7 +978,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1193 CONTINUE 1192 CONTINUE IF ( NR .GT. 1 ) - $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), LDU ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), + $ LDU ) * .. the left singular vectors not computed, the NR right singular * vectors overwrite [U](1:NR,1:NR) as conjugate transposed. These * will be pre-multiplied by Q to build the left singular vectors of A. @@ -988,7 +1000,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [U] and overwrite [U] with the left singular vectors CALL ZLACPY( 'U', NR, N, A, LDA, U, LDU ) IF ( NR .GT. 1 ) - $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), LDU ) + $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), + $ LDU ) * .. the right singular vectors not computed, the NR left singular * vectors overwrite [U](1:NR,1:NR) CALL ZGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, @@ -1003,7 +1016,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) IF ( NR .LT. N1 ) THEN - CALL ZLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), LDU ) + CALL ZLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU ) CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1031,7 +1045,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1166 CONTINUE 1165 CONTINUE IF ( NR .GT. 1 ) - $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) * .. the left singular vectors of R**H overwrite V, the right singular * vectors not computed IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1061,7 +1076,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * by padding a zero block. In the case NR << N, a more efficient * way is to first use the QR factorization. For more details * how to implement this, see the " FULL SVD " branch. - CALL ZLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), LDV) + CALL ZLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), + $ LDV) CALL ZGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) * @@ -1081,7 +1097,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into V and overwrite V with the right singular vectors CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), LDV ) + $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), + $ LDV ) * .. the right singular vectors overwrite V, the NR left singular * vectors stored in U(1:NR,1:NR) IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN @@ -1095,7 +1112,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * by padding a zero block. In the case NR << N, a more efficient * way is to first use the LQ factorization. For more details * how to implement this, see the " FULL SVD " branch. - CALL ZLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), LDV) + CALL ZLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), + $ LDV) CALL ZGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1121,7 +1139,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1169 CONTINUE 1168 CONTINUE IF ( NR .GT. 1 ) - $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV ) * * .. the left singular vectors of R**H overwrite [V], the NR right * singular vectors of R**H stored in [U](1:NR,1:NR) as conjugate @@ -1156,9 +1175,11 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1117 CONTINUE * IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1181,7 +1202,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1199 CONTINUE 1198 CONTINUE IF ( NR .GT. 1 ) - $ CALL ZLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2),LDV) + $ CALL ZLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2), + $ LDV) * CALL ZLASET('A',N,N-NR,CZERO,CZERO,V(1,NR+1),LDV) CALL ZGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, @@ -1211,7 +1233,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL ZLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1), + $ LDU) CALL ZLASET('A',M-N,N1-N,CZERO,CONE, $ U(N+1,N+1), LDU ) END IF @@ -1225,7 +1248,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, 1197 CONTINUE 1196 CONTINUE IF ( NR .GT. 1 ) - $ CALL ZLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2),LDU) + $ CALL ZLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2), + $ LDU) CALL ZGEQRF( N, NR, U(1,NR+1), LDU, CWORK(N+1), $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) DO 1143 p = 1, NR @@ -1238,16 +1262,19 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V,LDV, CWORK(N+NR+1),LCWORK-N-NR,RWORK, INFO ) 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) + CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1), + $ LDV) CALL ZUNMQR('R','C', N, N, NR, U(1,NR+1), LDU, $ CWORK(N+1),V,LDV,CWORK(N+NR+1),LCWORK-N-NR,IERR) CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1),LDU) END IF @@ -1263,7 +1290,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. copy R into [V] and overwrite V with the right singular vectors CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), LDV ) + $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), + $ LDV ) * .. the right singular vectors of R overwrite [V], the NR left * singular vectors of R stored in [U](1:NR,1:NR) CALL ZGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, @@ -1273,9 +1301,11 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1294,10 +1324,12 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( OPTRATIO * NR .GT. N ) THEN CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) IF ( NR .GT. 1 ) - $ CALL ZLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1),LDV) + $ CALL ZLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1), + $ LDV) * .. the right singular vectors of R overwrite [V], the NR left * singular vectors of R stored in [U](1:NR,1:NR) - CALL ZLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1),LDV) + CALL ZLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1), + $ LDV) CALL ZGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) @@ -1309,7 +1341,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN CALL ZLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) IF ( N .LT. N1 ) THEN - CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1), + $ LDU) CALL ZLASET( 'A',M-N,N1-N,CZERO,CONE, $ U(N+1,N+1), LDU ) END IF @@ -1317,7 +1350,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, ELSE CALL ZLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) IF ( NR .GT. 1 ) - $ CALL ZLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1),LDU) + $ CALL ZLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1), + $ LDU) CALL ZGELQF( NR, N, U(NR+1,1), LDU, CWORK(N+1), $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) CALL ZLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) @@ -1327,16 +1361,20 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, $ V, LDV, CWORK(N+NR+1), LCWORK-N-NR, RWORK, INFO ) 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) - CALL ZUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU,CWORK(N+1), + CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1), + $ LDV) + CALL ZUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU, + $ CWORK(N+1), $ V, LDV, CWORK(N+NR+1),LCWORK-N-NR,IERR) CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) * .. assemble the left singular vector matrix U of dimensions * (M x NR) or (M x N) or (M x M). IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN - CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1), + $ LDU) IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), + $ LDU) CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, $ U(NR+1,NR+1), LDU ) END IF @@ -1369,7 +1407,8 @@ SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * * .. if numerical rank deficiency is detected, the truncated * singular values are set to zero. - IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) + IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), + $ N ) * .. undo scaling; this may cause overflow in the largest singular * values. IF ( ASCALED ) diff --git a/SRC/zgesvdx.f b/SRC/zgesvdx.f index 5668812da3..77d48b0f64 100644 --- a/SRC/zgesvdx.f +++ b/SRC/zgesvdx.f @@ -306,7 +306,8 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL ZGEBRD, ZGELQF, ZGEQRF, ZLASCL, ZLASET, ZLACPY, + EXTERNAL ZGEBRD, ZGELQF, ZGEQRF, ZLASCL, ZLASET, + $ ZLACPY, $ ZUNMLQ, ZUNMBR, ZUNMQR, DBDSVDX, DLASCL, XERBLA * .. * .. External Functions .. @@ -395,7 +396,8 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, MAXWRK = 1 IF( MINMN.GT.0 ) THEN IF( M.GE.N ) THEN - MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) + MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( M.GE.MNTHR ) THEN * * Path 1 (M much larger than N) @@ -403,24 +405,28 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, 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)) + $ 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)) + $ 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) * MINWRK = 3*N + M - MAXWRK = 2*N + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + 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 ) + MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, + $ 0 ) IF( N.GE.MNTHR ) THEN * * Path 1t (N much larger than M) @@ -428,10 +434,12 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, 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)) + $ 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)) + $ M*M+2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M, + $ -1)) END IF ELSE * @@ -439,7 +447,8 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * * MINWRK = 3*M + N - MAXWRK = 2*M + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + 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)) @@ -560,7 +569,8 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, END DO K = K + N END DO - CALL ZLASET( 'A', M-N, NS, 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) @@ -636,7 +646,8 @@ SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, END DO K = K + N END DO - CALL ZLASET( 'A', M-N, NS, 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) diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index 696178aa57..eceaf2b9b3 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -415,7 +415,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * from BLAS EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP, ZAXPY * from LAPACK - EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA + EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, + $ XERBLA EXTERNAL ZGSVJ0, ZGSVJ1 * .. * .. Executable Statements .. @@ -441,9 +442,13 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LQUERY = ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) IF( .NOT.( UPPER .OR. LOWER .OR. LSAME( JOBA, 'G' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSVEC .OR. UCTOL .OR. LSAME( JOBU, 'N' ) ) ) THEN + ELSE IF( .NOT.( LSVEC .OR. + $ UCTOL .OR. + $ LSAME( JOBU, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( RSVEC .OR. APPLV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( RSVEC .OR. + $ APPLV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -786,7 +791,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ V( N4*q+1, N4+1 ), LDV, EPSLN, SFMIN, TOL, 1, $ CWORK( N+1 ), LWORK-N, IERR ) * - CALL ZGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL ZGSVJ0( JOBV, M, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * @@ -798,16 +804,19 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE IF( UPPER ) THEN * * - CALL ZGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, LDV, + CALL ZGSVJ0( JOBV, N4, N4, A, LDA, CWORK, SVA, MVL, V, + $ LDV, $ EPSLN, SFMIN, TOL, 2, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL ZGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, CWORK( N4+1 ), + CALL ZGSVJ0( JOBV, N2, N4, A( 1, N4+1 ), LDA, + $ CWORK( N4+1 ), $ SVA( N4+1 ), MVL, V( N4*q+1, N4+1 ), LDV, $ EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), LWORK-N, $ IERR ) * - CALL ZGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, V, + CALL ZGSVJ1( JOBV, N2, N2, N4, A, LDA, CWORK, SVA, MVL, + $ V, $ LDV, EPSLN, SFMIN, TOL, 1, CWORK( N+1 ), $ LWORK-N, IERR ) * @@ -961,7 +970,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -990,7 +1000,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1003,14 +1014,17 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, * .. have to use modified Gram-Schmidt like transformation CALL ZCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, CWORK(N+1), LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) CALL ZAXPY( M, -AAPQ, CWORK(N+1), 1, $ A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ1*AAPQ1 ) ) @@ -1025,7 +1039,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1 ) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1 ) ELSE T = ZERO AAQQ = ONE @@ -1178,7 +1193,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1205,7 +1221,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -1219,15 +1236,18 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( AAPP.GT.AAQQ ) THEN CALL ZCOPY( M, A( 1, p ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL ZAXPY( M, -AAPQ, CWORK(N+1), $ 1, A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -1236,15 +1256,18 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, ELSE CALL ZCOPY( M, A( 1, q ), 1, $ CWORK(N+1), 1 ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, CWORK(N+1),LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL ZAXPY( M, -CONJG(AAPQ), $ CWORK(N+1), 1, A( 1, p ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAPP, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -1260,7 +1283,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE @@ -1402,7 +1426,8 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, IF( LSVEC .OR. UCTOL ) THEN DO 1998 p = 1, N4 * CALL ZDSCAL( M, ONE / SVA( p ), A( 1, p ), 1 ) - CALL ZLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, IERR ) + CALL ZLASCL( 'G',0,0, SVA(p), ONE, M, 1, A(1,p), M, + $ IERR ) 1998 CONTINUE END IF * diff --git a/SRC/zgesvx.f b/SRC/zgesvx.f index acb21005a4..91fd15c513 100644 --- a/SRC/zgesvx.f +++ b/SRC/zgesvx.f @@ -345,7 +345,8 @@ *> \ingroup gesvx * * ===================================================================== - SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -385,7 +386,8 @@ SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EXTERNAL LSAME, DLAMCH, ZLANGE, ZLANTR * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGECON, ZGEEQU, ZGERFS, ZGETRF, ZGETRS, + EXTERNAL XERBLA, ZGECON, ZGEEQU, ZGERFS, ZGETRF, + $ ZGETRS, $ ZLACPY, ZLAQGE * .. * .. Intrinsic Functions .. @@ -410,7 +412,9 @@ SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. @@ -476,7 +480,8 @@ SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL ZGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) + CALL ZGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -552,7 +557,8 @@ SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute the reciprocal of the condition number of A. * - CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/zgesvxx.f b/SRC/zgesvxx.f index 1372234850..03dd482cad 100644 --- a/SRC/zgesvxx.f +++ b/SRC/zgesvxx.f @@ -533,7 +533,8 @@ *> \ingroup gesvxx * * ===================================================================== - SUBROUTINE ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, $ BERR, N_ERR_BNDS, ERR_BNDS_NORM, $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, @@ -584,7 +585,8 @@ SUBROUTINE ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, DOUBLE PRECISION DLAMCH, ZLA_GERPVGRW * .. * .. External Subroutines .. - EXTERNAL ZGEEQUB, ZGETRF, ZGETRS, ZLACPY, ZLAQGE, + EXTERNAL ZGEEQUB, ZGETRF, ZGETRS, ZLACPY, + $ ZLAQGE, $ XERBLA, ZLASCL2, ZGERFSX * .. * .. Intrinsic Functions .. diff --git a/SRC/zgetrf.f b/SRC/zgetrf.f index 73f7cb0318..7c8cae27aa 100644 --- a/SRC/zgetrf.f +++ b/SRC/zgetrf.f @@ -129,7 +129,8 @@ SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO ) INTEGER I, IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZGETRF2, ZLASWP, ZTRSM + EXTERNAL XERBLA, ZGEMM, ZGETRF2, ZLASWP, + $ ZTRSM * .. * .. External Functions .. INTEGER ILAENV @@ -178,7 +179,8 @@ SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO ) * Factor diagonal and subdiagonal blocks and test for exact * singularity. * - CALL ZGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) + CALL ZGETRF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), + $ IINFO ) * * Adjust INFO and the pivot indices. * @@ -201,14 +203,16 @@ SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO ) * * Compute block row of U. * - CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL ZGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/zgetri.f b/SRC/zgetri.f index 7af365a363..ab9c43a853 100644 --- a/SRC/zgetri.f +++ b/SRC/zgetri.f @@ -142,7 +142,8 @@ SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM, ZTRTRI + EXTERNAL XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM, + $ ZTRTRI * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -188,7 +189,8 @@ SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = MAX( LDWORK*NB, 1 ) IF( LWORK.LT.IWS ) THEN NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1, + $ -1 ) ) END IF ELSE IWS = N @@ -239,7 +241,8 @@ SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) $ CALL ZGEMM( 'No transpose', 'No transpose', N, JB, $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) - CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB, + CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ JB, $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 50 CONTINUE END IF diff --git a/SRC/zgetrs.f b/SRC/zgetrs.f index 31fd537427..1e6ec8946d 100644 --- a/SRC/zgetrs.f +++ b/SRC/zgetrs.f @@ -190,7 +190,8 @@ SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, + CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, + $ NRHS, $ ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -203,7 +204,8 @@ SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * * Solve U**T *X = B or U**H *X = B, overwriting B with X. * - CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE, + CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, + $ ONE, $ A, LDA, B, LDB ) * * Solve L**T *X = B, or L**H *X = B overwriting B with X. diff --git a/SRC/zgetsqrhrt.f b/SRC/zgetsqrhrt.f index fc982199f0..35ee2dace9 100644 --- a/SRC/zgetsqrhrt.f +++ b/SRC/zgetsqrhrt.f @@ -177,7 +177,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, + SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, + $ WORK, $ LWORK, INFO ) IMPLICIT NONE * @@ -204,7 +205,8 @@ SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, $ NB1LOCAL, NB2LOCAL, NUM_ALL_ROW_BLOCKS * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZLATSQR, ZUNGTSQR_ROW, ZUNHR_COL, + EXTERNAL ZCOPY, ZLATSQR, ZUNGTSQR_ROW, + $ ZUNHR_COL, $ XERBLA * .. * .. Intrinsic Functions .. @@ -341,7 +343,8 @@ SUBROUTINE ZGETSQRHRT( M, N, MB1, NB1, NB2, A, LDA, T, LDT, WORK, A( I, J ) = -CONE * WORK( LWT+N*(J-1)+I ) END DO ELSE - CALL ZCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), LDA ) + CALL ZCOPY( N-I+1, WORK(LWT+N*(I-1)+I), N, A( I, I ), + $ LDA ) END IF END DO * diff --git a/SRC/zggbak.f b/SRC/zggbak.f index d181858b7d..129842f3fe 100644 --- a/SRC/zggbak.f +++ b/SRC/zggbak.f @@ -144,7 +144,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, + SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, + $ V, $ LDV, INFO ) * * -- LAPACK computational routine -- @@ -184,8 +185,10 @@ SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LEFTV = LSAME( SIDE, 'L' ) * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -2 diff --git a/SRC/zggbal.f b/SRC/zggbal.f index 0cb35c358d..89e736e375 100644 --- a/SRC/zggbal.f +++ b/SRC/zggbal.f @@ -231,8 +231,10 @@ SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Test the input parameters * INFO = 0 - IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. - $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN + IF( .NOT.LSAME( JOB, 'N' ) .AND. + $ .NOT.LSAME( JOB, 'P' ) .AND. + $ .NOT.LSAME( JOB, 'S' ) .AND. + $ .NOT.LSAME( JOB, 'B' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -515,8 +517,10 @@ SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, IF( CMAX.LT.HALF ) $ GO TO 350 * - CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), 1 ) - CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), 1 ) + CALL DAXPY( NR, -ALPHA, WORK( ILO+2*N ), 1, WORK( ILO+4*N ), + $ 1 ) + CALL DAXPY( NR, -ALPHA, WORK( ILO+3*N ), 1, WORK( ILO+5*N ), + $ 1 ) * PGAMMA = GAMMA IT = IT + 1 diff --git a/SRC/zgges.f b/SRC/zgges.f index cb13022767..673f38ba5f 100644 --- a/SRC/zgges.f +++ b/SRC/zgges.f @@ -265,7 +265,8 @@ *> \ingroup gges * * ===================================================================== - SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, + SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, + $ LDB, $ SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, $ LWORK, RWORK, BWORK, INFO ) * @@ -312,7 +313,8 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, + $ ZHGEQZ, $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. @@ -360,7 +362,8 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -383,7 +386,8 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * IF( INFO.EQ.0 ) THEN LWKMIN = MAX( 1, 2*N ) - LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) ) + LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, + $ 0 ) ) LWKOPT = MAX( LWKOPT, N + $ N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, -1 ) ) IF( ILVSL ) THEN @@ -527,9 +531,11 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * Undo scaling on eigenvalues before selecting * IF( ILASCL ) - $ CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * @@ -537,7 +543,8 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) ) 10 CONTINUE * - CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA, + CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHA, $ BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR, $ DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR ) IF( IERR.EQ.1 ) diff --git a/SRC/zgges3.f b/SRC/zgges3.f index cd9f4cbea4..bfabead6e6 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -312,7 +312,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0, + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, + $ ZLAQZ0, $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. @@ -361,7 +362,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -5 @@ -532,9 +534,11 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * Undo scaling on eigenvalues before selecting * IF( ILASCL ) - $ CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, ANRM, ANRMTO, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, BNRM, BNRMTO, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * @@ -542,7 +546,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, BWORK( I ) = SELCTG( ALPHA( I ), BETA( I ) ) 10 CONTINUE * - CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, ALPHA, + CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, + $ ALPHA, $ BETA, VSL, LDVSL, VSR, LDVSR, SDIM, PVSL, PVSR, $ DIF, WORK( IWRK ), LWORK-IWRK+1, IDUM, 1, IERR ) IF( IERR.EQ.1 ) diff --git a/SRC/zggesx.f b/SRC/zggesx.f index 4e24451173..5f334c5b10 100644 --- a/SRC/zggesx.f +++ b/SRC/zggesx.f @@ -324,7 +324,8 @@ *> \ingroup ggesx * * ===================================================================== - SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, + SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, + $ LDA, $ B, LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, $ LDVSR, RCONDE, RCONDV, WORK, LWORK, RWORK, $ IWORK, LIWORK, BWORK, INFO ) @@ -373,7 +374,8 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, + $ ZHGEQZ, $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. @@ -434,7 +436,8 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, INFO = -1 ELSE IF( IJOBVR.LE.0 ) THEN INFO = -2 - ELSE IF( ( .NOT.WANTST ) .AND. ( .NOT.LSAME( SORT, 'N' ) ) ) THEN + ELSE IF( ( .NOT.WANTST ) .AND. + $ ( .NOT.LSAME( SORT, 'N' ) ) ) THEN INFO = -3 ELSE IF( .NOT.( WANTSN .OR. WANTSE .OR. WANTSV .OR. WANTSB ) .OR. $ ( .NOT.WANTST .AND. .NOT.WANTSN ) ) THEN @@ -466,7 +469,8 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, $ ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, -1 ) ) ) IF( ILVSL ) THEN MAXWRK = MAX( MAXWRK, N*( 1 + - $ ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) ) ) + $ ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, + $ -1 ) ) ) END IF LWRK = MAXWRK IF( IJOB.GE.1 ) @@ -620,9 +624,11 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, * Undo scaling on eigenvalues before SELCTGing * IF( ILASCL ) - $ CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IERR ) IF( ILBSCL ) - $ CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, IERR ) + $ CALL ZLASCL( 'G', 0, 0, BNRMTO, BNRM, N, 1, BETA, N, + $ IERR ) * * Select eigenvalues * diff --git a/SRC/zggev.f b/SRC/zggev.f index 76ac26ac01..fe182fd66c 100644 --- a/SRC/zggev.f +++ b/SRC/zggev.f @@ -254,7 +254,8 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, + $ ZHGEQZ, $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR * .. * .. External Functions .. @@ -329,7 +330,8 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * IF( INFO.EQ.0 ) THEN LWKMIN = MAX( 1, 2*N ) - LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) ) + LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, + $ 0 ) ) LWKOPT = MAX( LWKOPT, N + $ N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) ) IF( ILVL ) THEN @@ -491,7 +493,8 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHTEMP = 'R' END IF * - CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ), $ IERR ) IF( IERR.NE.0 ) THEN diff --git a/SRC/zggev3.f b/SRC/zggev3.f index 9929fbd904..b68184fe09 100644 --- a/SRC/zggev3.f +++ b/SRC/zggev3.f @@ -213,7 +213,8 @@ *> \ingroup ggev3 * * ===================================================================== - SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, + SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, + $ BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -254,7 +255,8 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0, + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, + $ ZLAQZ0, $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR * .. * .. External Functions .. @@ -499,7 +501,8 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, CHTEMP = 'R' END IF * - CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, LDVL, + CALL ZTGEVC( CHTEMP, 'B', LDUMMA, N, A, LDA, B, LDB, VL, + $ LDVL, $ VR, LDVR, N, IN, WORK( IWRK ), RWORK( IRWRK ), $ IERR ) IF( IERR.NE.0 ) THEN diff --git a/SRC/zggevx.f b/SRC/zggevx.f index 1ff2ae146b..53d6b38fae 100644 --- a/SRC/zggevx.f +++ b/SRC/zggevx.f @@ -368,7 +368,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, + SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, VL, LDVL, VR, LDVR, ILO, IHI, $ LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, $ WORK, LWORK, RWORK, IWORK, BWORK, INFO ) @@ -415,7 +416,8 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, + EXTERNAL DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, + $ ZGGHRD, $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZTGSNA, $ ZUNGQR, ZUNMQR * .. @@ -514,12 +516,15 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF MAXWRK = MINWRK MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, + $ 0 ) ) MAXWRK = MAX( MAXWRK, - $ N + N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) ) + $ N + N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, + $ 0 ) ) IF( ILVL ) THEN MAXWRK = MAX( MAXWRK, N + - $ N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, 0 ) ) + $ N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, + $ 0 ) ) END IF END IF WORK( 1 ) = MAXWRK @@ -580,7 +585,8 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * Permute and/or balance the matrix pair (A,B) * (Real Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) * - CALL ZGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, + CALL ZGGBAL( BALANC, N, A, LDA, B, LDB, ILO, IHI, LSCALE, + $ RSCALE, $ RWORK, IERR ) * * Compute ABNRM and BBNRM @@ -749,7 +755,8 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * (Workspace: none needed) * IF( ILVL ) THEN - CALL ZGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, VL, + CALL ZGGBAK( BALANC, 'L', N, ILO, IHI, LSCALE, RSCALE, N, + $ VL, $ LDVL, IERR ) * DO 50 JC = 1, N @@ -767,7 +774,8 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, END IF * IF( ILVR ) THEN - CALL ZGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, VR, + CALL ZGGBAK( BALANC, 'R', N, ILO, IHI, LSCALE, RSCALE, N, + $ VR, $ LDVR, IERR ) DO 80 JC = 1, N TEMP = ZERO diff --git a/SRC/zggglm.f b/SRC/zggglm.f index cb975bc622..f4184eab13 100644 --- a/SRC/zggglm.f +++ b/SRC/zggglm.f @@ -181,7 +181,8 @@ *> \ingroup ggglm * * ===================================================================== - SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, + SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -209,7 +210,8 @@ SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, $ NB4, NP * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGEMV, ZGGQRF, ZTRTRS, ZUNMQR, + EXTERNAL XERBLA, ZCOPY, ZGEMV, ZGGQRF, ZTRTRS, + $ ZUNMQR, $ ZUNMRQ * .. * .. External Functions .. @@ -295,7 +297,8 @@ SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * Update left-hand-side vector d = Q**H*d = ( d1 ) M * ( d2 ) N-M * - CALL ZUNMQR( 'Left', 'Conjugate transpose', N, 1, M, A, LDA, WORK, + CALL ZUNMQR( 'Left', 'Conjugate transpose', N, 1, M, A, LDA, + $ WORK, $ D, MAX( 1, N ), WORK( M+NP+1 ), LWORK-M-NP, INFO ) LOPT = MAX( LOPT, INT( WORK( M+NP+1 ) ) ) * @@ -321,13 +324,15 @@ SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, * * Update d1 = d1 - T12*y2 * - CALL ZGEMV( 'No transpose', M, N-M, -CONE, B( 1, M+P-N+1 ), LDB, + CALL ZGEMV( 'No transpose', M, N-M, -CONE, B( 1, M+P-N+1 ), + $ LDB, $ Y( M+P-N+1 ), 1, CONE, D, 1 ) * * Solve triangular system: R11*x = d1 * IF( M.GT.0 ) THEN - CALL ZTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, LDA, + CALL ZTRTRS( 'Upper', 'No Transpose', 'Non unit', M, 1, A, + $ LDA, $ D, M, INFO ) * IF( INFO.GT.0 ) THEN diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index c7002cee3e..d4f34087d9 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -223,7 +223,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -264,7 +265,8 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. - EXTERNAL ZGGHRD, ZLARTG, ZLASET, ZUNM22, ZROT, ZGEMM, + EXTERNAL ZGGHRD, ZLARTG, ZLASET, ZUNM22, ZROT, + $ ZGEMM, $ ZGEMV, ZTRMV, ZLACPY, XERBLA * .. * .. Intrinsic Functions .. @@ -388,7 +390,8 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * N2NB = ( IHI-JCOL-1 ) / NNB - 1 NBLST = IHI - JCOL - N2NB*NNB - CALL ZLASET( 'All', NBLST, NBLST, CZERO, CONE, WORK, NBLST ) + CALL ZLASET( 'All', NBLST, NBLST, CZERO, CONE, WORK, + $ NBLST ) PW = NBLST * NBLST + 1 DO I = 1, N2NB CALL ZLASET( 'All', 2*NNB, 2*NNB, CZERO, CONE, @@ -581,10 +584,12 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, WORK( PPW ) = A( I, J+1 ) PPW = PPW + 1 END DO - CALL ZTRMV( 'Upper', 'Conjugate', 'Non-unit', LEN, + CALL ZTRMV( 'Upper', 'Conjugate', 'Non-unit', + $ LEN, $ WORK( PPWO + NNB ), 2*NNB, WORK( PW ), $ 1 ) - CALL ZTRMV( 'Lower', 'Conjugate', 'Non-unit', NNB, + CALL ZTRMV( 'Lower', 'Conjugate', 'Non-unit', + $ NNB, $ WORK( PPWO + 2*LEN*NNB ), $ 2*NNB, WORK( PW + LEN ), 1 ) CALL ZGEMV( 'Conjugate', NNB, LEN, CONE, @@ -753,9 +758,11 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END DO ELSE * - CALL ZLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, CZERO, + CALL ZLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, + $ CZERO, $ A( JCOL + 2, JCOL ), LDA ) - CALL ZLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, CZERO, + CALL ZLASET( 'Lower', IHI - JCOL - 1, NNB, CZERO, + $ CZERO, $ B( JCOL + 2, JCOL ), LDB ) END IF * @@ -775,7 +782,8 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL ZUNM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL ZUNM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ A( 1, J ), LDA, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -806,7 +814,8 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, * * Exploit the structure of U. * - CALL ZUNM22( 'Right', 'No Transpose', TOP, 2*NNB, + CALL ZUNM22( 'Right', 'No Transpose', TOP, + $ 2*NNB, $ NNB, NNB, WORK( PPWO ), 2*NNB, $ B( 1, J ), LDB, WORK( PW ), $ LWORK-PW+1, IERR ) @@ -886,7 +895,8 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, END IF * IF ( JCOL.LT.IHI ) - $ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q, + $ CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, IERR ) * WORK( 1 ) = DCMPLX( LWKOPT ) diff --git a/SRC/zgghrd.f b/SRC/zgghrd.f index 5bc5aa25e6..4a6c7d321c 100644 --- a/SRC/zgghrd.f +++ b/SRC/zgghrd.f @@ -200,7 +200,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, + SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, + $ Q, $ LDQ, Z, LDZ, INFO ) * * -- LAPACK computational routine -- @@ -344,11 +345,13 @@ SUBROUTINE ZGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, CALL ZLARTG( CTEMP, B( JROW, JROW-1 ), C, S, $ B( JROW, JROW ) ) B( JROW, JROW-1 ) = CZERO - CALL ZROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S ) + CALL ZROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, + $ S ) CALL ZROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C, $ S ) IF( ILZ ) - $ CALL ZROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S ) + $ CALL ZROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, + $ S ) 30 CONTINUE 40 CONTINUE * diff --git a/SRC/zgglse.f b/SRC/zgglse.f index 511e47d50c..aca2b6ff63 100644 --- a/SRC/zgglse.f +++ b/SRC/zgglse.f @@ -176,7 +176,8 @@ *> \ingroup gglse * * ===================================================================== - SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, + SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, + $ LWORK, $ INFO ) * * -- LAPACK driver routine -- @@ -203,7 +204,8 @@ SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, $ NB4, NR * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGGRQF, ZTRMV, + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGEMV, ZGGRQF, + $ ZTRMV, $ ZTRTRS, ZUNMQR, ZUNMRQ * .. * .. External Functions .. @@ -304,7 +306,8 @@ SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, * * Update c1 * - CALL ZGEMV( 'No transpose', N-P, P, -CONE, A( 1, N-P+1 ), LDA, + CALL ZGEMV( 'No transpose', N-P, P, -CONE, A( 1, N-P+1 ), + $ LDA, $ D, 1, CONE, C, 1 ) END IF * @@ -329,7 +332,8 @@ SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, IF( M.LT.N ) THEN NR = M + P - N IF( NR.GT.0 ) - $ CALL ZGEMV( 'No transpose', NR, N-M, -CONE, A( N-P+1, M+1 ), + $ CALL ZGEMV( 'No transpose', NR, N-M, -CONE, A( N-P+1, + $ M+1 ), $ LDA, D( NR+1 ), 1, CONE, C( N-P+1 ), 1 ) ELSE NR = P diff --git a/SRC/zggqrf.f b/SRC/zggqrf.f index 516d1641e7..0506fcf414 100644 --- a/SRC/zggqrf.f +++ b/SRC/zggqrf.f @@ -281,7 +281,8 @@ SUBROUTINE ZGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, * * Update B := Q**H*B. * - CALL ZUNMQR( 'Left', 'Conjugate Transpose', N, P, MIN( N, M ), A, + CALL ZUNMQR( 'Left', 'Conjugate Transpose', N, P, MIN( N, M ), + $ A, $ LDA, TAUA, B, LDB, WORK, LWORK, INFO ) LOPT = MAX( LOPT, INT( WORK( 1 ) ) ) * diff --git a/SRC/zggsvd3.f b/SRC/zggsvd3.f index 3b8ac4c973..73a8f01358 100644 --- a/SRC/zggsvd3.f +++ b/SRC/zggsvd3.f @@ -428,7 +428,8 @@ SUBROUTINE ZGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, + CALL ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, + $ TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, $ WORK, WORK, -1, INFO ) LWKOPT = N + INT( WORK( 1 ) ) diff --git a/SRC/zggsvp3.f b/SRC/zggsvp3.f index 2c194b9d1d..4ec1446633 100644 --- a/SRC/zggsvp3.f +++ b/SRC/zggsvp3.f @@ -312,7 +312,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEQP3, ZGEQR2, ZGERQ2, ZLACPY, ZLAPMT, + EXTERNAL XERBLA, ZGEQP3, ZGEQR2, ZGERQ2, ZLACPY, + $ ZLAPMT, $ ZLASET, ZUNG2R, ZUNM2R, ZUNMR2 * .. * .. Intrinsic Functions .. @@ -361,7 +362,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * Compute workspace * IF( INFO.EQ.0 ) THEN - CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, -1, RWORK, INFO ) + CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, -1, RWORK, + $ INFO ) LWKOPT = INT( WORK ( 1 ) ) IF( WANTV ) THEN LWKOPT = MAX( LWKOPT, P ) @@ -371,7 +373,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, IF( WANTQ ) THEN LWKOPT = MAX( LWKOPT, N ) END IF - CALL ZGEQP3( M, N, A, LDA, IWORK, TAU, WORK, -1, RWORK, INFO ) + CALL ZGEQP3( M, N, A, LDA, IWORK, TAU, WORK, -1, RWORK, + $ INFO ) LWKOPT = MAX( LWKOPT, INT( WORK ( 1 ) ) ) LWKOPT = MAX( 1, LWKOPT ) WORK( 1 ) = DCMPLX( LWKOPT ) @@ -391,7 +394,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, DO 10 I = 1, N IWORK( I ) = 0 10 CONTINUE - CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, LWORK, RWORK, INFO ) + CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, LWORK, RWORK, + $ INFO ) * * Update A := A*P * @@ -424,7 +428,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -442,7 +447,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, + CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, $ TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * @@ -487,7 +493,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), + CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, + $ N-L ), $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) * IF( WANTU ) THEN @@ -496,7 +503,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL ZLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), + $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, + $ 1 ), $ LDU ) CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF @@ -517,7 +525,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -529,7 +538,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, + CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, $ LDA, TAU, Q, LDQ, WORK, INFO ) END IF * @@ -554,7 +564,8 @@ SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL ZUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), + CALL ZUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, + $ L ), $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, $ WORK, INFO ) END IF diff --git a/SRC/zgsvj0.f b/SRC/zgsvj0.f index 15b90d9411..a5ddadbd69 100644 --- a/SRC/zgsvj0.f +++ b/SRC/zgsvj0.f @@ -500,7 +500,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -529,7 +530,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF ( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -542,14 +544,17 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, * .. have to use modified Gram-Schmidt like transformation CALL ZCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + $ M, $ 1, WORK, LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, M, + CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + $ M, $ 1, A( 1, q ), LDA, IERR ) CALL ZAXPY( M, -AAPQ, WORK, 1, $ A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, M, + CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + $ M, $ 1, A( 1, q ), LDA, IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ1*AAPQ1 ) ) @@ -564,7 +569,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1 ) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1 ) ELSE T = ZERO AAQQ = ONE @@ -716,7 +722,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -743,7 +750,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -757,15 +765,18 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, IF( AAPP.GT.AAQQ ) THEN CALL ZCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL ZAXPY( M, -AAPQ, WORK, $ 1, A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -774,15 +785,18 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, ELSE CALL ZCOPY( M, A( 1, q ), 1, $ WORK, 1 ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL ZAXPY( M, -CONJG(AAPQ), $ WORK, 1, A( 1, p ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAPP, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -798,7 +812,8 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE diff --git a/SRC/zgsvj1.f b/SRC/zgsvj1.f index a47dd8c72e..f47bf9331d 100644 --- a/SRC/zgsvj1.f +++ b/SRC/zgsvj1.f @@ -486,7 +486,8 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, IF( ABS( THETA ).GT.BIGTHETA ) THEN T = HALF / THETA CS = ONE - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*T ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -513,7 +514,8 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ1 ) ) * - CALL ZROT( M, A(1,p), 1, A(1,q), 1, + CALL ZROT( M, A(1,p), 1, A(1,q), + $ 1, $ CS, CONJG(OMPQ)*SN ) IF( RSVEC ) THEN CALL ZROT( MVL, V(1,p), 1, @@ -527,15 +529,18 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, IF( AAPP.GT.AAQQ ) THEN CALL ZCOPY( M, A( 1, p ), 1, $ WORK, 1 ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, A( 1, q ), LDA, $ IERR ) CALL ZAXPY( M, -AAPQ, WORK, $ 1, A( 1, q ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) SVA( q ) = AAQQ*SQRT( MAX( ZERO, @@ -544,15 +549,18 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, ELSE CALL ZCOPY( M, A( 1, q ), 1, $ WORK, 1 ) - CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, + CALL ZLASCL( 'G', 0, 0, AAQQ, + $ ONE, $ M, 1, WORK,LDA, $ IERR ) - CALL ZLASCL( 'G', 0, 0, AAPP, ONE, + CALL ZLASCL( 'G', 0, 0, AAPP, + $ ONE, $ M, 1, A( 1, p ), LDA, $ IERR ) CALL ZAXPY( M, -CONJG(AAPQ), $ WORK, 1, A( 1, p ), 1 ) - CALL ZLASCL( 'G', 0, 0, ONE, AAPP, + CALL ZLASCL( 'G', 0, 0, ONE, + $ AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) SVA( p ) = AAPP*SQRT( MAX( ZERO, @@ -568,7 +576,8 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ THEN IF( ( AAQQ.LT.ROOTBIG ) .AND. $ ( AAQQ.GT.ROOTSFMIN ) ) THEN - SVA( q ) = DZNRM2( M, A( 1, q ), 1) + SVA( q ) = DZNRM2( M, A( 1, q ), + $ 1) ELSE T = ZERO AAQQ = ONE diff --git a/SRC/zgtrfs.f b/SRC/zgtrfs.f index e371ad881e..b61010a5c6 100644 --- a/SRC/zgtrfs.f +++ b/SRC/zgtrfs.f @@ -205,7 +205,8 @@ *> \ingroup gtrfs * * ===================================================================== - SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + $ DU2, $ IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, $ INFO ) * @@ -248,7 +249,8 @@ SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGTTRS, ZLACN2, ZLAGTM + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZGTTRS, ZLACN2, + $ ZLAGTM * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DIMAG, MAX @@ -327,7 +329,8 @@ SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * where op(A) = A, A**T, or A**H, depending on TRANS. * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, ONE, + CALL ZLAGTM( TRANS, N, 1, -ONE, DL, D, DU, X( 1, J ), LDX, + $ ONE, $ WORK, N ) * * Compute abs(op(A))*abs(x) + abs(b) for use in the backward @@ -402,7 +405,8 @@ SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * * Update solution and try again. * - CALL ZGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, N, + CALL ZGTTRS( TRANS, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + $ N, $ INFO ) CALL ZAXPY( N, DCMPLX( ONE ), WORK, 1, X( 1, J ), 1 ) LSTRES = BERR( J ) @@ -449,7 +453,8 @@ SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, * * Multiply by diag(W)*inv(op(A)**H). * - CALL ZGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + CALL ZGTTRS( TRANST, N, 1, DLF, DF, DUF, DU2, IPIV, + $ WORK, $ N, INFO ) DO 80 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) @@ -461,7 +466,8 @@ SUBROUTINE ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, DO 90 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 90 CONTINUE - CALL ZGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV, WORK, + CALL ZGTTRS( TRANSN, N, 1, DLF, DF, DUF, DU2, IPIV, + $ WORK, $ N, INFO ) END IF GO TO 70 diff --git a/SRC/zgtsvx.f b/SRC/zgtsvx.f index 0c25085931..2a9dc11161 100644 --- a/SRC/zgtsvx.f +++ b/SRC/zgtsvx.f @@ -289,7 +289,8 @@ *> \ingroup gtsvx * * ===================================================================== - SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, + SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, + $ DUF, $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -327,7 +328,8 @@ SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, EXTERNAL LSAME, DLAMCH, ZLANGT * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS, + EXTERNAL XERBLA, ZCOPY, ZGTCON, ZGTRFS, ZGTTRF, + $ ZGTTRS, $ ZLACPY * .. * .. Intrinsic Functions .. @@ -387,7 +389,8 @@ SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * * Compute the reciprocal of the condition number of A. * - CALL ZGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, WORK, + CALL ZGTCON( NORM, N, DLF, DF, DUF, DU2, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * Compute the solution vectors X. @@ -399,7 +402,8 @@ SUBROUTINE ZGTSVX( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, + CALL ZGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, + $ IPIV, $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/zgttrs.f b/SRC/zgttrs.f index 64910b1570..ca50380732 100644 --- a/SRC/zgttrs.f +++ b/SRC/zgttrs.f @@ -134,7 +134,8 @@ *> \ingroup gttrs * * ===================================================================== - SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, + SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB, $ INFO ) * * -- LAPACK computational routine -- @@ -213,7 +214,8 @@ SUBROUTINE ZGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, ELSE DO 10 J = 1, NRHS, NB JB = MIN( NRHS-J+1, NB ) - CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), + CALL ZGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, + $ J ), $ LDB ) 10 CONTINUE END IF diff --git a/SRC/zgtts2.f b/SRC/zgtts2.f index a22a94e7e3..c5a6aa84a2 100644 --- a/SRC/zgtts2.f +++ b/SRC/zgtts2.f @@ -125,7 +125,8 @@ *> \ingroup gtts2 * * ===================================================================== - SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) + SUBROUTINE ZGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, + $ LDB ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f index 2405900b42..e890425f83 100644 --- a/SRC/zhb2st_kernels.f +++ b/SRC/zhb2st_kernels.f @@ -288,7 +288,8 @@ SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = DCONJG( A( DPOS-NB, J1 ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP * CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), diff --git a/SRC/zhbev.f b/SRC/zhbev.f index 037d57b06e..0ae3cd55d9 100644 --- a/SRC/zhbev.f +++ b/SRC/zhbev.f @@ -182,7 +182,8 @@ SUBROUTINE ZHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, DLAMCH, ZLANHB * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZHBTRD, ZLASCL, ZSTEQR + EXTERNAL DSCAL, DSTERF, XERBLA, ZHBTRD, ZLASCL, + $ ZSTEQR * .. * .. Intrinsic Functions .. INTRINSIC SQRT @@ -252,9 +253,11 @@ SUBROUTINE ZHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * diff --git a/SRC/zhbev_2stage.f b/SRC/zhbev_2stage.f index 6a424d9734..f8dc61fbf3 100644 --- a/SRC/zhbev_2stage.f +++ b/SRC/zhbev_2stage.f @@ -207,7 +207,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, RWORK, INFO ) * IMPLICIT NONE @@ -245,7 +246,8 @@ SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR, + EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, + $ ZSTEQR, $ ZHETRD_2STAGE, ZHETRD_HB2ST * .. * .. Intrinsic Functions .. @@ -338,9 +340,11 @@ SUBROUTINE ZHBEV_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * diff --git a/SRC/zhbevd.f b/SRC/zhbevd.f index 3c948d8089..74e8cf8925 100644 --- a/SRC/zhbevd.f +++ b/SRC/zhbevd.f @@ -205,7 +205,8 @@ *> \ingroup hbevd * * ===================================================================== - SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, + SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -244,7 +245,8 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, EXTERNAL LSAME, DLAMCH, ZLANHB * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZHBTRD, ZLACPY, + EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZHBTRD, + $ ZLACPY, $ ZLASCL, ZSTEDC * .. * .. Intrinsic Functions .. @@ -343,9 +345,11 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -364,7 +368,8 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/zhbevd_2stage.f b/SRC/zhbevd_2stage.f index d568f10b03..3201c41f19 100644 --- a/SRC/zhbevd_2stage.f +++ b/SRC/zhbevd_2stage.f @@ -249,7 +249,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, + SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, + $ LDZ, $ WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * @@ -293,7 +294,8 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, ZLACPY, + EXTERNAL DSCAL, DSTERF, XERBLA, ZGEMM, + $ ZLACPY, $ ZLASCL, ZSTEDC, ZHETRD_HB2ST * .. * .. Intrinsic Functions .. @@ -313,9 +315,12 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, LRWMIN = 1 LIWMIN = 1 ELSE - IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', JOBZ, N, KD, IB, + $ -1 ) IF( WANTZ ) THEN LWMIN = 2*N**2 LRWMIN = 1 + 5*N + 2*N**2 @@ -395,9 +400,11 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF END IF * @@ -421,7 +428,8 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/zhbevx.f b/SRC/zhbevx.f index 0c541407b7..9996ecd279 100644 --- a/SRC/zhbevx.f +++ b/SRC/zhbevx.f @@ -262,7 +262,8 @@ *> \ingroup hbevx * * ===================================================================== - SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, + SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, + $ VL, $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * @@ -307,7 +308,8 @@ SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, EXTERNAL LSAME, DLAMCH, ZLANHB * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZCOPY, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZCOPY, $ ZGEMV, ZHBTRD, ZLACPY, ZLASCL, ZSTEIN, ZSTEQR, $ ZSWAP * .. @@ -417,9 +419,11 @@ SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/zhbevx_2stage.f b/SRC/zhbevx_2stage.f index 679ad46f1b..101129e3b4 100644 --- a/SRC/zhbevx_2stage.f +++ b/SRC/zhbevx_2stage.f @@ -372,7 +372,8 @@ SUBROUTINE ZHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, EXTERNAL LSAME, DLAMCH, ZLANHB, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZCOPY, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZCOPY, $ ZGEMV, ZLACPY, ZLASCL, ZSTEIN, ZSTEQR, $ ZSWAP, ZHETRD_HB2ST * .. @@ -504,9 +505,11 @@ SUBROUTINE ZHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, END IF IF( ISCALE.EQ.1 ) THEN IF( LOWER ) THEN - CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) ELSE - CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO ) + CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, + $ INFO ) END IF IF( ABSTOL.GT.0 ) $ ABSTLL = ABSTOL*SIGMA diff --git a/SRC/zhbgst.f b/SRC/zhbgst.f index a74ee30fcf..6e09d0ea5f 100644 --- a/SRC/zhbgst.f +++ b/SRC/zhbgst.f @@ -161,7 +161,8 @@ *> \ingroup hbgst * * ===================================================================== - SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, + SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ X, $ LDX, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -198,7 +199,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGERC, ZGERU, ZLACGV, ZLAR2V, + EXTERNAL XERBLA, ZDSCAL, ZGERC, ZGERU, ZLACGV, + $ ZLAR2V, $ ZLARGV, ZLARTG, ZLARTV, ZLASET, ZROT * .. * .. Intrinsic Functions .. @@ -442,7 +444,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL ZLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), KA1, + $ CALL ZLARGV( NRT, AB( 1, J2T ), INCA, WORK( J2T-M ), + $ KA1, $ RWORK( J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -671,7 +674,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * * generate rotation to annihilate a(i-k+ka+1,i) * - CALL ZLARTG( AB( KA1-K, I ), RA1, RWORK( I-K+KA-M ), + CALL ZLARTG( AB( KA1-K, I ), RA1, + $ RWORK( I-K+KA-M ), $ WORK( I-K+KA-M ), RA ) * * create nonzero element a(i-k+ka+1,i-k) outside the @@ -708,7 +712,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL ZLARGV( NRT, AB( KA1, J2T-KA ), INCA, WORK( J2T-M ), + $ CALL ZLARGV( NRT, AB( KA1, J2T-KA ), INCA, + $ WORK( J2T-M ), $ KA1, RWORK( J2T-M ), KA1 ) IF( NR.GT.0 ) THEN * @@ -723,7 +728,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 1st set from both sides to diagonal * blocks * - CALL ZLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL ZLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, RWORK( J2-M ), WORK( J2-M ), KA1 ) * CALL ZLACGV( NR, WORK( J2-M ), KA1 ) @@ -805,7 +811,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL ZLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), KA1, + CALL ZLARGV( NR, AB( KA1, J2-KA ), INCA, WORK( J2 ), + $ KA1, $ RWORK( J2 ), KA1 ) * * apply rotations in 2nd set from the left @@ -819,7 +826,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from both sides to diagonal * blocks * - CALL ZLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, J2 ), + CALL ZLAR2V( NR, AB( 1, J2 ), AB( 1, J2+1 ), AB( 2, + $ J2 ), $ INCA, RWORK( J2 ), WORK( J2 ), KA1 ) * CALL ZLACGV( NR, WORK( J2 ), KA1 ) @@ -1023,7 +1031,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL ZLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), KA1, + $ CALL ZLARGV( NRT, AB( 1, J1+KA ), INCA, WORK( J1 ), + $ KA1, $ RWORK( J1 ), KA1 ) IF( NR.GT.0 ) THEN * @@ -1124,7 +1133,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * generate rotations in 2nd set to annihilate elements * which have been created outside the band * - CALL ZLARGV( NR, AB( 1, J1+KA ), INCA, WORK( M-KB+J1 ), + CALL ZLARGV( NR, AB( 1, J1+KA ), INCA, + $ WORK( M-KB+J1 ), $ KA1, RWORK( M-KB+J1 ), KA1 ) * * apply rotations in 2nd set from the left @@ -1234,7 +1244,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * CALL ZDSCAL( NX, ONE / BII, X( 1, I ), 1 ) IF( KBT.GT.0 ) - $ CALL ZGERC( NX, KBT, -CONE, X( 1, I ), 1, BB( 2, I ), + $ CALL ZGERC( NX, KBT, -CONE, X( 1, I ), 1, BB( 2, + $ I ), $ 1, X( 1, I+1 ), LDX ) END IF * @@ -1293,14 +1304,16 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * have been created outside the band * IF( NRT.GT.0 ) - $ CALL ZLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), KA1, + $ CALL ZLARGV( NRT, AB( KA1, J1 ), INCA, WORK( J1 ), + $ KA1, $ RWORK( J1 ), KA1 ) IF( NR.GT.0 ) THEN * * apply rotations in 1st set from the right * DO 810 L = 1, KA - 1 - CALL ZLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL ZLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, RWORK( J1 ), WORK( J1 ), KA1 ) 810 CONTINUE * @@ -1399,7 +1412,8 @@ SUBROUTINE ZHBGST( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, * apply rotations in 2nd set from the right * DO 890 L = 1, KA - 1 - CALL ZLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, J1-1 ), + CALL ZLARTV( NR, AB( L+1, J1 ), INCA, AB( L+2, + $ J1-1 ), $ INCA, RWORK( M-KB+J1 ), WORK( M-KB+J1 ), $ KA1 ) 890 CONTINUE diff --git a/SRC/zhbgv.f b/SRC/zhbgv.f index c74c0e4a83..e84e249b90 100644 --- a/SRC/zhbgv.f +++ b/SRC/zhbgv.f @@ -179,7 +179,8 @@ *> \ingroup hbgv * * ===================================================================== - SUBROUTINE ZHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, + SUBROUTINE ZHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + $ Z, $ LDZ, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -208,7 +209,8 @@ SUBROUTINE ZHBGV( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DSTERF, XERBLA, ZHBGST, ZHBTRD, ZPBSTF, ZSTEQR + EXTERNAL DSTERF, XERBLA, ZHBGST, ZHBTRD, ZPBSTF, + $ ZSTEQR * .. * .. Executable Statements .. * diff --git a/SRC/zhbgvd.f b/SRC/zhbgvd.f index adeadecf89..781850d83b 100644 --- a/SRC/zhbgvd.f +++ b/SRC/zhbgvd.f @@ -241,7 +241,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, + SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, + $ W, $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * @@ -279,7 +280,8 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DSTERF, XERBLA, ZGEMM, ZHBGST, ZHBTRD, ZLACPY, + EXTERNAL DSTERF, XERBLA, ZGEMM, ZHBGST, ZHBTRD, + $ ZLACPY, $ ZPBSTF, ZSTEDC * .. * .. Executable Statements .. @@ -381,7 +383,8 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, WORK( INDWK2 ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), WORK, N, + $ WORK( INDWK2 ), $ LLWK2, RWORK( INDWRK ), LLRWK, IWORK, LIWORK, $ INFO ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, Z, LDZ, WORK, N, CZERO, diff --git a/SRC/zhbgvx.f b/SRC/zhbgvx.f index a62f001fb0..094f754e11 100644 --- a/SRC/zhbgvx.f +++ b/SRC/zhbgvx.f @@ -337,7 +337,8 @@ SUBROUTINE ZHBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSTEBZ, DSTERF, XERBLA, ZCOPY, ZGEMV, + EXTERNAL DCOPY, DSTEBZ, DSTERF, XERBLA, ZCOPY, + $ ZGEMV, $ ZHBGST, ZHBTRD, ZLACPY, ZPBSTF, ZSTEIN, ZSTEQR, $ ZSWAP * .. diff --git a/SRC/zhbtrd.f b/SRC/zhbtrd.f index 15e409c76f..424531eccd 100644 --- a/SRC/zhbtrd.f +++ b/SRC/zhbtrd.f @@ -193,7 +193,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, COMPLEX*16 T, TEMP * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLAR2V, ZLARGV, ZLARTG, ZLARTV, + EXTERNAL XERBLA, ZLACGV, ZLAR2V, ZLARGV, ZLARTG, + $ ZLARTV, $ ZLASET, ZROT, ZSCAL * .. * .. Intrinsic Functions .. @@ -277,7 +278,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * generate plane rotations to annihilate nonzero * elements which have been created outside the band * - CALL ZLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ), + CALL ZLARGV( NR, AB( 1, J1-1 ), INCA, + $ WORK( J1 ), $ KD1, D( J1 ), KD1 ) * * apply rotations from the right @@ -349,7 +351,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL ZLARTV( NRT, AB( KD-L, J1+L ), INCA, + $ CALL ZLARTV( NRT, AB( KD-L, J1+L ), + $ INCA, $ AB( KD-L+1, J1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 30 CONTINUE @@ -357,7 +360,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, J1END = J1 + KD1*( NR-2 ) IF( J1END.GE.J1 ) THEN DO 40 JIN = J1, J1END, KD1 - CALL ZROT( KD-1, AB( KD-1, JIN+1 ), INCX, + CALL ZROT( KD-1, AB( KD-1, JIN+1 ), + $ INCX, $ AB( KD, JIN+1 ), INCX, $ D( JIN ), WORK( JIN ) ) 40 CONTINUE @@ -392,13 +396,15 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), DCONJG( WORK( J ) ) ) 50 CONTINUE ELSE * DO 60 J = J1, J2, KD1 - CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), DCONJG( WORK( J ) ) ) 60 CONTINUE END IF @@ -496,7 +502,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, * IF( NR.GT.2*KD-1 ) THEN DO 130 L = 1, KD - 1 - CALL ZLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA, + CALL ZLARTV( NR, AB( KD1-L, J1-KD1+L ), + $ INCA, $ AB( KD1-L+1, J1-KD1+L ), INCA, $ D( J1 ), WORK( J1 ), KD1 ) 130 CONTINUE @@ -555,7 +562,8 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, NRT = NR END IF IF( NRT.GT.0 ) - $ CALL ZLARTV( NRT, AB( L+2, J1-1 ), INCA, + $ CALL ZLARTV( NRT, AB( L+2, J1-1 ), + $ INCA, $ AB( L+1, J1 ), INCA, D( J1 ), $ WORK( J1 ), KD1 ) 150 CONTINUE @@ -600,13 +608,15 @@ SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, IQB = MAX( 1, J-IBL ) NQ = 1 + IQAEND - IQB IQAEND = MIN( IQAEND+KD, IQEND ) - CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ), + CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, + $ J ), $ 1, D( J ), WORK( J ) ) 170 CONTINUE ELSE * DO 180 J = J1, J2, KD1 - CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1, + CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), + $ 1, $ D( J ), WORK( J ) ) 180 CONTINUE END IF diff --git a/SRC/zhecon_rook.f b/SRC/zhecon_rook.f index 099f72ef0e..fc253c7cfc 100644 --- a/SRC/zhecon_rook.f +++ b/SRC/zhecon_rook.f @@ -135,7 +135,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE ZHECON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zheequb.f b/SRC/zheequb.f index d1c8032f6e..8e93544927 100644 --- a/SRC/zheequb.f +++ b/SRC/zheequb.f @@ -129,7 +129,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -182,7 +183,8 @@ SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/zheev.f b/SRC/zheev.f index 4d357f2e79..156636defb 100644 --- a/SRC/zheev.f +++ b/SRC/zheev.f @@ -174,7 +174,8 @@ SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, ZSTEQR, + EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLASCL, + $ ZSTEQR, $ ZUNGTR * .. * .. Intrinsic Functions .. @@ -267,7 +268,8 @@ SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) INDWRK = INDE + N CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA, diff --git a/SRC/zheev_2stage.f b/SRC/zheev_2stage.f index bc5f9fccc0..ba0f6408ee 100644 --- a/SRC/zheev_2stage.f +++ b/SRC/zheev_2stage.f @@ -225,7 +225,8 @@ SUBROUTINE ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, ZSTEQR, + EXTERNAL DSCAL, DSTERF, XERBLA, ZLASCL, + $ ZSTEQR, $ ZUNGTR, ZHETRD_2STAGE * .. * .. Intrinsic Functions .. @@ -251,10 +252,14 @@ SUBROUTINE ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -324,7 +329,8 @@ SUBROUTINE ZHEEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), + CALL ZUNGTR( UPLO, N, A, LDA, WORK( INDTAU ), + $ WORK( INDWRK ), $ LLWORK, IINFO ) INDWRK = INDE + N CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), A, LDA, diff --git a/SRC/zheevd.f b/SRC/zheevd.f index f0960190a6..2a6a4c8e41 100644 --- a/SRC/zheevd.f +++ b/SRC/zheevd.f @@ -194,7 +194,8 @@ *> at Berkeley, USA *> * ===================================================================== - SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + $ RWORK, $ LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -234,7 +235,8 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, ZLASCL, + EXTERNAL DSCAL, DSTERF, XERBLA, ZHETRD, ZLACPY, + $ ZLASCL, $ ZSTEDC, ZUNMTR * .. * .. Intrinsic Functions .. @@ -278,7 +280,8 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LIWMIN = 1 END IF LOPT = MAX( LWMIN, N + - $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) + $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, + $ -1 ) ) LROPT = LRWMIN LIOPT = LIWMIN END IF diff --git a/SRC/zheevd_2stage.f b/SRC/zheevd_2stage.f index 661e07efa2..094babbf73 100644 --- a/SRC/zheevd_2stage.f +++ b/SRC/zheevd_2stage.f @@ -243,7 +243,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, + SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, + $ LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * IMPLICIT NONE @@ -288,7 +289,8 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZLACPY, ZLASCL, + EXTERNAL DSCAL, DSTERF, XERBLA, ZLACPY, + $ ZLASCL, $ ZSTEDC, ZUNMTR, ZHETRD_2STAGE * .. * .. Intrinsic Functions .. diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 22d269c221..8d9fc10dac 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -355,7 +355,8 @@ *> California at Berkeley, USA \n *> * ===================================================================== - SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * @@ -400,7 +401,8 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANSY * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHETRD, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR * .. * .. Intrinsic Functions .. @@ -677,7 +679,8 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index a86c447ed2..09b8c58999 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -448,10 +448,12 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV, ILAENV2STAGE DOUBLE PRECISION DLAMCH, ZLANSY - EXTERNAL LSAME, DLAMCH, ZLANSY, ILAENV, ILAENV2STAGE + EXTERNAL LSAME, DLAMCH, ZLANSY, ILAENV, + $ ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHETRD_2STAGE, ZSTEMR, ZSTEIN, ZSWAP, ZUNMTR * .. * .. Intrinsic Functions .. @@ -733,7 +735,8 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * INDWKN = INDWK LLWRKN = LWORK - INDWKN + 1 - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWKN ), LLWRKN, IINFO ) END IF * diff --git a/SRC/zheevx.f b/SRC/zheevx.f index 8556ecbfde..6b9b58a347 100644 --- a/SRC/zheevx.f +++ b/SRC/zheevx.f @@ -254,7 +254,8 @@ *> \ingroup heevx * * ===================================================================== - SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, + $ IU, $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * @@ -299,7 +300,8 @@ SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHETRD, ZLACPY, ZSTEIN, ZSTEQR, ZSWAP, ZUNGTR, $ ZUNMTR * .. @@ -353,7 +355,8 @@ SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ELSE LWKMIN = 2*N NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) - NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) ) + NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, + $ -1 ) ) LWKOPT = MAX( 1, ( NB + 1 )*N ) WORK( 1 ) = LWKOPT END IF @@ -505,7 +508,8 @@ SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, * Apply unitary matrix used in reduction to tridiagonal * form to eigenvectors returned by ZSTEIN. * - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWRK ), LLWORK, IINFO ) END IF * diff --git a/SRC/zheevx_2stage.f b/SRC/zheevx_2stage.f index 09a15b5df7..db582a0c43 100644 --- a/SRC/zheevx_2stage.f +++ b/SRC/zheevx_2stage.f @@ -348,7 +348,8 @@ SUBROUTINE ZHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, EXTERNAL LSAME, DLAMCH, ZLANHE, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZLACPY, ZSTEIN, ZSTEQR, ZSWAP, ZUNGTR, ZUNMTR, $ ZHETRD_2STAGE * .. @@ -563,7 +564,8 @@ SUBROUTINE ZHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * Apply unitary matrix used in reduction to tridiagonal * form to eigenvectors returned by ZSTEIN. * - CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), Z, + CALL ZUNMTR( 'L', UPLO, 'N', N, M, A, LDA, WORK( INDTAU ), + $ Z, $ LDZ, WORK( INDWRK ), LLWORK, IINFO ) END IF * diff --git a/SRC/zhegs2.f b/SRC/zhegs2.f index c84aa0d041..1463dccc68 100644 --- a/SRC/zhegs2.f +++ b/SRC/zhegs2.f @@ -154,7 +154,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) COMPLEX*16 CT * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZDSCAL, ZHER2, ZLACGV, ZTRMV, + EXTERNAL XERBLA, ZAXPY, ZDSCAL, ZHER2, ZLACGV, + $ ZTRMV, $ ZTRSV * .. * .. Intrinsic Functions .. @@ -211,7 +212,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL ZAXPY( N-K, CT, B( K, K+1 ), LDB, A( K, K+1 ), $ LDA ) CALL ZLACGV( N-K, B( K, K+1 ), LDB ) - CALL ZTRSV( UPLO, 'Conjugate transpose', 'Non-unit', + CALL ZTRSV( UPLO, 'Conjugate transpose', + $ 'Non-unit', $ N-K, B( K+1, K+1 ), LDB, A( K, K+1 ), $ LDA ) CALL ZLACGV( N-K, A( K, K+1 ), LDA ) @@ -232,10 +234,12 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) IF( K.LT.N ) THEN CALL ZDSCAL( N-K, ONE / BKK, A( K+1, K ), 1 ) CT = -HALF*AKK - CALL ZAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL ZAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL ZHER2( UPLO, N-K, -CONE, A( K+1, K ), 1, $ B( K+1, K ), 1, A( K+1, K+1 ), LDA ) - CALL ZAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), 1 ) + CALL ZAXPY( N-K, CT, B( K+1, K ), 1, A( K+1, K ), + $ 1 ) CALL ZTRSV( UPLO, 'No transpose', 'Non-unit', N-K, $ B( K+1, K+1 ), LDB, A( K+1, K ), 1 ) END IF @@ -256,7 +260,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) $ LDB, A( 1, K ), 1 ) CT = HALF*AKK CALL ZAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) - CALL ZHER2( UPLO, K-1, CONE, A( 1, K ), 1, B( 1, K ), 1, + CALL ZHER2( UPLO, K-1, CONE, A( 1, K ), 1, B( 1, K ), + $ 1, $ A, LDA ) CALL ZAXPY( K-1, CT, B( 1, K ), 1, A( 1, K ), 1 ) CALL ZDSCAL( K-1, BKK, A( 1, K ), 1 ) @@ -273,12 +278,14 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) AKK = DBLE( A( K, K ) ) BKK = DBLE( B( K, K ) ) CALL ZLACGV( K-1, A( K, 1 ), LDA ) - CALL ZTRMV( UPLO, 'Conjugate transpose', 'Non-unit', K-1, + CALL ZTRMV( UPLO, 'Conjugate transpose', 'Non-unit', + $ K-1, $ B, LDB, A( K, 1 ), LDA ) CT = HALF*AKK CALL ZLACGV( K-1, B( K, 1 ), LDB ) CALL ZAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) - CALL ZHER2( UPLO, K-1, CONE, A( K, 1 ), LDA, B( K, 1 ), + CALL ZHER2( UPLO, K-1, CONE, A( K, 1 ), LDA, B( K, + $ 1 ), $ LDB, A, LDA ) CALL ZAXPY( K-1, CT, B( K, 1 ), LDB, A( K, 1 ), LDA ) CALL ZLACGV( K-1, B( K, 1 ), LDB ) diff --git a/SRC/zhegst.f b/SRC/zhegst.f index d8f9b25523..ad2f6481c6 100644 --- a/SRC/zhegst.f +++ b/SRC/zhegst.f @@ -153,7 +153,8 @@ SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) INTEGER K, KB, NB * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHEGS2, ZHEMM, ZHER2K, ZTRMM, ZTRSM + EXTERNAL XERBLA, ZHEGS2, ZHEMM, ZHER2K, ZTRMM, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -222,7 +223,8 @@ SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL ZHEMM( 'Left', UPLO, KB, N-K-KB+1, -HALF, $ A( K, K ), LDA, B( K, K+KB ), LDB, $ CONE, A( K, K+KB ), LDA ) - CALL ZHER2K( UPLO, 'Conjugate transpose', N-K-KB+1, + CALL ZHER2K( UPLO, 'Conjugate transpose', + $ N-K-KB+1, $ KB, -CONE, A( K, K+KB ), LDA, $ B( K, K+KB ), LDB, ONE, $ A( K+KB, K+KB ), LDA ) @@ -247,7 +249,8 @@ SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL ZHEGS2( ITYPE, UPLO, KB, A( K, K ), LDA, $ B( K, K ), LDB, INFO ) IF( K+KB.LE.N ) THEN - CALL ZTRSM( 'Right', UPLO, 'Conjugate transpose', + CALL ZTRSM( 'Right', UPLO, + $ 'Conjugate transpose', $ 'Non-unit', N-K-KB+1, KB, CONE, $ B( K, K ), LDB, A( K+KB, K ), LDA ) CALL ZHEMM( 'Right', UPLO, N-K-KB+1, KB, -HALF, @@ -277,15 +280,18 @@ SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the upper triangle of A(1:k+kb-1,1:k+kb-1) * - CALL ZTRMM( 'Left', UPLO, 'No transpose', 'Non-unit', + CALL ZTRMM( 'Left', UPLO, 'No transpose', + $ 'Non-unit', $ K-1, KB, CONE, B, LDB, A( 1, K ), LDA ) - CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, CONE, A( 1, K ), $ LDA ) CALL ZHER2K( UPLO, 'No transpose', K-1, KB, CONE, $ A( 1, K ), LDA, B( 1, K ), LDB, ONE, A, $ LDA ) - CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, K ), + CALL ZHEMM( 'Right', UPLO, K-1, KB, HALF, A( K, + $ K ), $ LDA, B( 1, K ), LDB, CONE, A( 1, K ), $ LDA ) CALL ZTRMM( 'Right', UPLO, 'Conjugate transpose', @@ -303,7 +309,8 @@ SUBROUTINE ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) * * Update the lower triangle of A(1:k+kb-1,1:k+kb-1) * - CALL ZTRMM( 'Right', UPLO, 'No transpose', 'Non-unit', + CALL ZTRMM( 'Right', UPLO, 'No transpose', + $ 'Non-unit', $ KB, K-1, CONE, B, LDB, A( K, 1 ), LDA ) CALL ZHEMM( 'Left', UPLO, KB, K-1, HALF, A( K, K ), $ LDA, B( K, 1 ), LDB, CONE, A( K, 1 ), diff --git a/SRC/zhegv.f b/SRC/zhegv.f index 528b15b024..35f0d1a757 100644 --- a/SRC/zhegv.f +++ b/SRC/zhegv.f @@ -177,7 +177,8 @@ *> \ingroup hegv * * ===================================================================== - SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -210,7 +211,8 @@ SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHEEV, ZHEGST, ZPOTRF, ZTRMM, ZTRSM + EXTERNAL XERBLA, ZHEEV, ZHEGST, ZPOTRF, ZTRMM, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -271,7 +273,8 @@ SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, INFO ) + CALL ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ INFO ) * IF( WANTZ ) THEN * @@ -291,7 +294,8 @@ SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'C' END IF * - CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -305,7 +309,8 @@ SUBROUTINE ZHEGV( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, TRANS = 'N' END IF * - CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/zhegv_2stage.f b/SRC/zhegv_2stage.f index 2fe72d4c99..1dfcbaf3d0 100644 --- a/SRC/zhegv_2stage.f +++ b/SRC/zhegv_2stage.f @@ -228,7 +228,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, + $ W, $ WORK, LWORK, RWORK, INFO ) * IMPLICIT NONE @@ -263,7 +264,8 @@ SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, EXTERNAL LSAME, ILAENV2STAGE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHEGST, ZPOTRF, ZTRMM, ZTRSM, + EXTERNAL XERBLA, ZHEGST, ZPOTRF, ZTRMM, + $ ZTRSM, $ ZHEEV_2STAGE * .. * .. Intrinsic Functions .. @@ -293,10 +295,14 @@ SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * IF( INFO.EQ.0 ) THEN - KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) LWMIN = N + LHTRD + LWTRD WORK( 1 ) = LWMIN * @@ -349,7 +355,8 @@ SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'C' END IF * - CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -363,7 +370,8 @@ SUBROUTINE ZHEGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, TRANS = 'N' END IF * - CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, ONE, + CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG, + $ ONE, $ B, LDB, A, LDA ) END IF END IF diff --git a/SRC/zhegvd.f b/SRC/zhegvd.f index 9bc226019e..34767c36a1 100644 --- a/SRC/zhegvd.f +++ b/SRC/zhegvd.f @@ -239,7 +239,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA *> * ===================================================================== - SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, + SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -272,7 +273,8 @@ SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHEEVD, ZHEGST, ZPOTRF, ZTRMM, ZTRSM + EXTERNAL XERBLA, ZHEEVD, ZHEGST, ZPOTRF, ZTRMM, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX @@ -353,7 +355,8 @@ SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, * Transform problem to standard eigenvalue problem and solve. * CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, + CALL ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, + $ LRWORK, $ IWORK, LIWORK, INFO ) LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) ) LROPT = INT( MAX( DBLE( LROPT ), DBLE( RWORK( 1 ) ) ) ) diff --git a/SRC/zhegvx.f b/SRC/zhegvx.f index 232726e8fa..a6a0550f58 100644 --- a/SRC/zhegvx.f +++ b/SRC/zhegvx.f @@ -339,7 +339,8 @@ SUBROUTINE ZHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHEEVX, ZHEGST, ZPOTRF, ZTRMM, ZTRSM + EXTERNAL XERBLA, ZHEEVX, ZHEGST, ZPOTRF, ZTRMM, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -423,7 +424,8 @@ SUBROUTINE ZHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, * Transform problem to standard eigenvalue problem and solve. * CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) - CALL ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, + CALL ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, + $ ABSTOL, $ M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, $ INFO ) * @@ -444,7 +446,8 @@ SUBROUTINE ZHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'C' END IF * - CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B, + CALL ZTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, + $ B, $ LDB, Z, LDZ ) * ELSE IF( ITYPE.EQ.3 ) THEN @@ -458,7 +461,8 @@ SUBROUTINE ZHEGVX( ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, TRANS = 'N' END IF * - CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, B, + CALL ZTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, M, CONE, + $ B, $ LDB, Z, LDZ ) END IF END IF diff --git a/SRC/zherfs.f b/SRC/zherfs.f index 08061edafa..0390a35411 100644 --- a/SRC/zherfs.f +++ b/SRC/zherfs.f @@ -188,7 +188,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHEMV, ZHETRS, ZLACN2 + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHEMV, ZHETRS, + $ ZLACN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -303,7 +305,8 @@ SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * Compute residual R = B - A * X * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * @@ -410,7 +413,8 @@ SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * * Multiply by diag(W)*inv(A**H). * - CALL ZHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL ZHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -421,7 +425,8 @@ SUBROUTINE ZHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL ZHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL ZHETRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/zherfsx.f b/SRC/zherfsx.f index babde2f8d5..8b429285bb 100644 --- a/SRC/zherfsx.f +++ b/SRC/zherfsx.f @@ -395,7 +395,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE ZHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -460,7 +461,8 @@ SUBROUTINE ZHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL DLAMCH, ZLANHE, ZLA_HERCOND_X, ZLA_HERCOND_C + EXTERNAL DLAMCH, ZLANHE, ZLA_HERCOND_X, + $ ZLA_HERCOND_C DOUBLE PRECISION DLAMCH, ZLANHE, ZLA_HERCOND_X, ZLA_HERCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -517,7 +519,8 @@ SUBROUTINE ZHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF (.NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF (.NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -603,16 +606,19 @@ SUBROUTINE ZHERFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, $ INFO ) END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). * IF ( RCEQU ) THEN - RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_HERCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/zhesv.f b/SRC/zhesv.f index 3d69ca48a0..d5fa6dd19c 100644 --- a/SRC/zhesv.f +++ b/SRC/zhesv.f @@ -206,7 +206,8 @@ SUBROUTINE ZHESV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zhesv_aa_2stage.f b/SRC/zhesv_aa_2stage.f index c3ffe9693d..47d06416a7 100644 --- a/SRC/zhesv_aa_2stage.f +++ b/SRC/zhesv_aa_2stage.f @@ -218,7 +218,8 @@ SUBROUTINE ZHESV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHETRF_AA_2STAGE, ZHETRS_AA_2STAGE + EXTERNAL XERBLA, ZHETRF_AA_2STAGE, + $ ZHETRS_AA_2STAGE * .. * .. Intrinsic Functions .. INTRINSIC MAX diff --git a/SRC/zhesv_rk.f b/SRC/zhesv_rk.f index 8bbc539c65..3687a34f94 100644 --- a/SRC/zhesv_rk.f +++ b/SRC/zhesv_rk.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, + SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -262,7 +263,8 @@ SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -280,7 +282,8 @@ SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT @@ -302,7 +305,8 @@ SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/zhesv_rook.f b/SRC/zhesv_rook.f index d510f48489..225e6d1c2c 100644 --- a/SRC/zhesv_rook.f +++ b/SRC/zhesv_rook.f @@ -201,7 +201,8 @@ * * * ===================================================================== - SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -240,7 +241,8 @@ SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -280,7 +282,8 @@ SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS ( Use Level BLAS 2) * - CALL ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/zhesvx.f b/SRC/zhesvx.f index 464be28afd..ae6844c4cb 100644 --- a/SRC/zhesvx.f +++ b/SRC/zhesvx.f @@ -280,7 +280,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ RWORK, INFO ) * @@ -318,7 +319,8 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHECON, ZHERFS, ZHETRF, ZHETRS, ZLACPY + EXTERNAL XERBLA, ZHECON, ZHERFS, ZHETRF, ZHETRS, + $ ZLACPY * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -333,7 +335,8 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LWKMIN = MAX( 1, 2*N ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -389,7 +392,8 @@ SUBROUTINE ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL ZHECON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, INFO ) + CALL ZHECON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * Compute the solution vectors X. * diff --git a/SRC/zhesvxx.f b/SRC/zhesvxx.f index 17aa580f09..e590a020c7 100644 --- a/SRC/zhesvxx.f +++ b/SRC/zhesvxx.f @@ -500,7 +500,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) @@ -628,7 +629,8 @@ SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -647,7 +649,8 @@ SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^H or UDU^H factorization of A. * CALL ZLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL ZHETRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL ZHETRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * @@ -658,7 +661,8 @@ SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * leading rank-deficient INFO columns of A. * IF( N.GT.0 ) - $ RPVGRW = ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ RPVGRW = ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, + $ LDAF, $ IPIV, RWORK ) RETURN END IF @@ -667,7 +671,8 @@ SUBROUTINE ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the reciprocal pivot growth factor RPVGRW. * IF( N.GT.0 ) - $ RPVGRW = ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, + $ RPVGRW = ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, + $ IPIV, $ RWORK ) * * Compute the solution matrix X. diff --git a/SRC/zhetd2.f b/SRC/zhetd2.f index 3558b49450..47b98c3915 100644 --- a/SRC/zhetd2.f +++ b/SRC/zhetd2.f @@ -256,7 +256,8 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute x := tau * A * v storing x in TAU(1:i) * - CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, + CALL ZHEMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, + $ ZERO, $ TAU, 1 ) * * Compute w := x - 1/2 * tau * (x**H * v) * v @@ -305,14 +306,16 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO ) * * Compute w := x - 1/2 * tau * (x**H * v) * v * - ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1, I ), + ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, A( I+1, + $ I ), $ 1 ) CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**H - w * v**H * - CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, + CALL ZHER2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), + $ 1, $ A( I+1, I+1 ), LDA ) * ELSE diff --git a/SRC/zhetf2.f b/SRC/zhetf2.f index 97811d3363..9baf9f992a 100644 --- a/SRC/zhetf2.f +++ b/SRC/zhetf2.f @@ -290,7 +290,8 @@ SUBROUTINE ZHETF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ DISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -485,7 +486,8 @@ SUBROUTINE ZHETF2( UPLO, N, A, LDA, IPIV, INFO ) COLMAX = ZERO END IF * - IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN + IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. + $ DISNAN(ABSAKK) ) THEN * * Column K is zero or underflow, or contains a NaN: * set INFO and continue @@ -514,7 +516,8 @@ SUBROUTINE ZHETF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) ) END IF * @@ -551,7 +554,8 @@ SUBROUTINE ZHETF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) DO 60 J = KK + 1, KP - 1 T = DCONJG( A( J, KK ) ) A( J, KK ) = DCONJG( A( KP, J ) ) diff --git a/SRC/zhetf2_rk.f b/SRC/zhetf2_rk.f index f91a36e901..fa027f0cbf 100644 --- a/SRC/zhetf2_rk.f +++ b/SRC/zhetf2_rk.f @@ -492,7 +492,8 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -561,7 +562,8 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / DBLE( A( K, K ) ) - CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -580,7 +582,8 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -753,14 +756,16 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = CABS1( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -856,7 +861,8 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.NE.KK ) THEN * (1) Swap columnar parts IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * (2) Swap and conjugate middle parts DO 45 J = KK + 1, KP - 1 T = DCONJG( A( J, KK ) ) diff --git a/SRC/zhetf2_rook.f b/SRC/zhetf2_rook.f index 00e7f48bb3..f7d372d5ad 100644 --- a/SRC/zhetf2_rook.f +++ b/SRC/zhetf2_rook.f @@ -486,7 +486,8 @@ SUBROUTINE ZHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = ONE / DBLE( A( K, K ) ) - CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -505,7 +506,8 @@ SUBROUTINE ZHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZHER( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -652,14 +654,16 @@ SUBROUTINE ZHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = CABS1( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -748,7 +752,8 @@ SUBROUTINE ZHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.NE.KK ) THEN * (1) Swap columnar parts IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * (2) Swap and conjugate middle parts DO 45 J = KK + 1, KP - 1 T = DCONJG( A( J, KK ) ) diff --git a/SRC/zhetrd.f b/SRC/zhetrd.f index e26a79e1ca..58c230f9bd 100644 --- a/SRC/zhetrd.f +++ b/SRC/zhetrd.f @@ -189,7 +189,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO ) + SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index 75ca612fe8..4d86b8434d 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -277,7 +277,8 @@ SUBROUTINE ZHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, $ TPOS, WPOS, S2POS, S1POS * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHER2K, ZHEMM, ZGEMM, ZCOPY, + EXTERNAL XERBLA, ZHER2K, ZHEMM, ZGEMM, + $ ZCOPY, $ ZLARFT, ZGELQF, ZGEQRF, ZLASET * .. * .. Intrinsic Functions .. @@ -385,7 +386,8 @@ SUBROUTINE ZHETRD_HE2HB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, * DO 20 J = I, I+PK-1 LK = MIN( KD, N-J ) + 1 - CALL ZCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), LDAB-1 ) + CALL ZCOPY( LK, A( J, J ), LDA, AB( KD+1, J ), + $ LDAB-1 ) 20 CONTINUE * CALL ZLASET( 'Lower', PK, PK, ZERO, ONE, diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f index 258c42f384..d02a0ccdaa 100644 --- a/SRC/zhetrf.f +++ b/SRC/zhetrf.f @@ -245,7 +245,8 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'ZHETRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZHETRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -274,7 +275,8 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k-kb+1:k of A and use blocked code to * update columns 1:k-kb * - CALL ZLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO ) + CALL ZLAHEF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, + $ IINFO ) ELSE * * Use unblocked code to factorize columns 1:k of A @@ -314,13 +316,15 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL ZLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL ZLAHEF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, N, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL ZHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL ZHETF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index 47462a581b..e27908afa1 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -165,7 +165,8 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL ZLAHEF_AA, ZGEMM, ZGEMV, ZCOPY, ZSCAL, ZSWAP, XERBLA + EXTERNAL ZLAHEF_AA, ZGEMM, ZGEMV, ZCOPY, ZSCAL, ZSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX @@ -439,7 +440,8 @@ SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * J3 = J2 DO MJ = NJ-1, 1, -1 - CALL ZGEMM( 'No transpose', 'Conjugate transpose', + CALL ZGEMM( 'No transpose', + $ 'Conjugate transpose', $ MJ, 1, JB+1, $ -ONE, WORK( (J3-J1+1)+K1*N ), N, $ A( J3, J1-K2 ), LDA, diff --git a/SRC/zhetrf_aa_2stage.f b/SRC/zhetrf_aa_2stage.f index ac4d23c8b2..fe229d0c54 100644 --- a/SRC/zhetrf_aa_2stage.f +++ b/SRC/zhetrf_aa_2stage.f @@ -560,13 +560,15 @@ SUBROUTINE ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * Compute H(J,J) * IF( J.EQ.1 ) THEN - CALL ZGEMM( 'NoTranspose', 'Conjugate transpose', + CALL ZGEMM( 'NoTranspose', + $ 'Conjugate transpose', $ KB, KB, KB, $ ONE, TB( TD+1 + (J*NB)*LDTB ), LDTB-1, $ A( J*NB+1, (J-1)*NB+1 ), LDA, $ ZERO, WORK( J*NB+1 ), N ) ELSE - CALL ZGEMM( 'NoTranspose', 'Conjugate transpose', + CALL ZGEMM( 'NoTranspose', + $ 'Conjugate transpose', $ KB, KB, NB+KB, $ ONE, TB( TD+NB+1 + ((J-1)*NB)*LDTB ), $ LDTB-1, diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f index e87b743ab1..f99aa3eb2c 100644 --- a/SRC/zhetrf_rk.f +++ b/SRC/zhetrf_rk.f @@ -426,7 +426,8 @@ SUBROUTINE ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL ZLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL ZLAHEF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/zhetrf_rook.f b/SRC/zhetrf_rook.f index 5d72e0d613..4f4578024b 100644 --- a/SRC/zhetrf_rook.f +++ b/SRC/zhetrf_rook.f @@ -209,7 +209,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zhetri.f b/SRC/zhetri.f index 09bfb50054..3633c034c6 100644 --- a/SRC/zhetri.f +++ b/SRC/zhetri.f @@ -224,7 +224,8 @@ SUBROUTINE ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) END IF KSTEP = 1 @@ -249,15 +250,18 @@ SUBROUTINE ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) A( K, K+1 ) = A( K, K+1 ) - - $ ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) A( K+1, K+1 ) = A( K+1, K+1 ) - - $ DBLE( ZDOTC( K-1, WORK, 1, A( 1, K+1 ), + $ DBLE( ZDOTC( K-1, WORK, 1, A( 1, + $ K+1 ), $ 1 ) ) END IF KSTEP = 2 @@ -317,7 +321,8 @@ SUBROUTINE ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) @@ -342,18 +347,22 @@ SUBROUTINE ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) A( K, K-1 ) = A( K, K-1 ) - - $ ZDOTC( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ ZDOTC( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ DBLE( ZDOTC( N-K, WORK, 1, A( K+1, K-1 ), + $ DBLE( ZDOTC( N-K, WORK, 1, A( K+1, + $ K-1 ), $ 1 ) ) END IF KSTEP = 2 diff --git a/SRC/zhetri2x.f b/SRC/zhetri2x.f index 0a2a128720..04cbb2d039 100644 --- a/SRC/zhetri2x.f +++ b/SRC/zhetri2x.f @@ -385,8 +385,10 @@ SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -568,12 +570,16 @@ SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF ( I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP , + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/zhetri_3x.f b/SRC/zhetri_3x.f index 60c83c74cb..89e2c6d641 100644 --- a/SRC/zhetri_3x.f +++ b/SRC/zhetri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -192,7 +193,8 @@ SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZGEMM, ZHESWAPR, ZTRTRI, ZTRMM, XERBLA + EXTERNAL ZGEMM, ZHESWAPR, ZTRTRI, ZTRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCONJG, DBLE, MAX @@ -437,8 +439,10 @@ SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -633,8 +637,10 @@ SUBROUTINE ZHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZHESWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/zhetri_rook.f b/SRC/zhetri_rook.f index 4401a3a889..7714557a58 100644 --- a/SRC/zhetri_rook.f +++ b/SRC/zhetri_rook.f @@ -238,7 +238,8 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) END IF KSTEP = 1 @@ -263,15 +264,18 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, A( 1, + A( K, K ) = A( K, K ) - DBLE( ZDOTC( K-1, WORK, 1, + $ A( 1, $ K ), 1 ) ) A( K, K+1 ) = A( K, K+1 ) - - $ ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ ZDOTC( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL ZHEMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K+1 ), 1 ) A( K+1, K+1 ) = A( K+1, K+1 ) - - $ DBLE( ZDOTC( K-1, WORK, 1, A( 1, K+1 ), + $ DBLE( ZDOTC( K-1, WORK, 1, A( 1, + $ K+1 ), $ 1 ) ) END IF KSTEP = 2 @@ -384,7 +388,8 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) @@ -409,18 +414,22 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K ), 1 ) A( K, K ) = A( K, K ) - DBLE( ZDOTC( N-K, WORK, 1, $ A( K+1, K ), 1 ) ) A( K, K-1 ) = A( K, K-1 ) - - $ ZDOTC( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ ZDOTC( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, WORK, + CALL ZHEMV( UPLO, N-K, -CONE, A( K+1, K+1 ), LDA, + $ WORK, $ 1, CZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ DBLE( ZDOTC( N-K, WORK, 1, A( K+1, K-1 ), + $ DBLE( ZDOTC( N-K, WORK, 1, A( K+1, + $ K-1 ), $ 1 ) ) END IF KSTEP = 2 @@ -435,7 +444,8 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 90 J = K + 1, KP - 1 TEMP = DCONJG( A( J, K ) ) @@ -460,7 +470,8 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 100 J = K + 1, KP - 1 TEMP = DCONJG( A( J, K ) ) @@ -486,7 +497,8 @@ SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) * DO 110 J = K + 1, KP - 1 TEMP = DCONJG( A( J, K ) ) diff --git a/SRC/zhetrs.f b/SRC/zhetrs.f index 6eee3f245a..e5f7f208a0 100644 --- a/SRC/zhetrs.f +++ b/SRC/zhetrs.f @@ -149,7 +149,8 @@ SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, ZSWAP + EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX @@ -209,7 +210,8 @@ SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -230,7 +232,8 @@ SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -347,7 +350,8 @@ SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in column K of A. * IF( K.LT.N ) - $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -369,7 +373,8 @@ SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/zhetrs2.f b/SRC/zhetrs2.f index b7c0613622..36c0a23beb 100644 --- a/SRC/zhetrs2.f +++ b/SRC/zhetrs2.f @@ -156,7 +156,8 @@ SUBROUTINE ZHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZDSCAL, ZSYCONV, ZSWAP, ZTRSM, XERBLA + EXTERNAL ZDSCAL, ZSYCONV, ZSWAP, ZTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX diff --git a/SRC/zhetrs_3.f b/SRC/zhetrs_3.f index b8e7542427..7bf61b3416 100644 --- a/SRC/zhetrs_3.f +++ b/SRC/zhetrs_3.f @@ -248,7 +248,8 @@ SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -275,7 +276,8 @@ SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**H \ B) -> B [ U**H \ (D \ (U \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'U', 'C', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**H \ (D \ (U \P**T * B) )) ] * @@ -316,7 +318,8 @@ SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -343,7 +346,8 @@ SUBROUTINE ZHETRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**H \ B) -> B [ L**H \ (D \ (L \P**T * B) ) ] * - CALL ZTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM('L', 'L', 'C', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**H \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f index 84045ac617..da540f8725 100644 --- a/SRC/zhetrs_aa.f +++ b/SRC/zhetrs_aa.f @@ -166,7 +166,8 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, XERBLA + EXTERNAL ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX @@ -226,7 +227,8 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U**H \ B -> B [ (U**H \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL ZTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB ) END IF * @@ -236,8 +238,10 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1 ) IF( N.GT.1 ) THEN - CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1) - CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 ) + CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), + $ 1) + CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), + $ 1 ) CALL ZLACGV( N-1, WORK( 1 ), 1 ) END IF CALL ZGTSV( N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, @@ -249,7 +253,8 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**H \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B(2, 1), LDB) * * Pivot, P * B [ P * (U**H \ (T \ (U \P**T * B) )) ] @@ -279,7 +284,8 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L \ B -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B(2, 1), LDB) END IF * @@ -289,8 +295,10 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1) - CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1) + CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), + $ 1) + CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), + $ 1) CALL ZLACGV( N-1, WORK( 2*N ), 1 ) END IF CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, @@ -302,7 +310,8 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L**H \ B -> B [ L**H \ (T \ (L \P**T * B) ) ] * - CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B [ P * (L**H \ (T \ (L \P**T * B) )) ] diff --git a/SRC/zhetrs_aa_2stage.f b/SRC/zhetrs_aa_2stage.f index 3a1a6203d2..f26df2959e 100644 --- a/SRC/zhetrs_aa_2stage.f +++ b/SRC/zhetrs_aa_2stage.f @@ -218,7 +218,8 @@ SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**H \ B) -> B [ (U**H \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL ZTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -231,7 +232,8 @@ SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**H \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**H \P**T * B) )) ] @@ -252,7 +254,8 @@ SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \ B) -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -265,7 +268,8 @@ SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ] * - CALL ZTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL ZTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ] diff --git a/SRC/zhetrs_rook.f b/SRC/zhetrs_rook.f index 91514608ec..84b430624e 100644 --- a/SRC/zhetrs_rook.f +++ b/SRC/zhetrs_rook.f @@ -165,7 +165,8 @@ SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZGEMV, ZGERU, ZLACGV, ZDSCAL, ZSWAP, XERBLA + EXTERNAL ZGEMV, ZGERU, ZLACGV, ZDSCAL, ZSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, DBLE @@ -225,7 +226,8 @@ SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -250,7 +252,8 @@ SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -372,7 +375,8 @@ SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -398,7 +402,8 @@ SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/zhfrk.f b/SRC/zhfrk.f index ede0c78cf3..c085656566 100644 --- a/SRC/zhfrk.f +++ b/SRC/zhfrk.f @@ -164,7 +164,8 @@ *> \ingroup hfrk * * ===================================================================== - SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, + $ BETA, $ C ) * * -- LAPACK computational routine -- @@ -291,9 +292,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ), + CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N ) * ELSE @@ -302,9 +305,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N ) - CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N+1 ), N ) - CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ), + CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N ) * END IF @@ -319,7 +324,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA, + CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N ) @@ -330,7 +336,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2+1 ), N ) - CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA, + CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), + $ LDA, $ BETA, C( N1+1 ), N ) CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N ) @@ -353,7 +360,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( N1+1, 1 ), LDA, CBETA, @@ -365,7 +373,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 1 ), N1 ) - CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( 2 ), N1 ) CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, N1+1 ), LDA, CBETA, @@ -383,9 +392,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA, + CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ), + CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 ) * ELSE @@ -394,9 +405,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( N2*N2+1 ), N2 ) - CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA, + CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), + $ LDA, $ BETA, C( N1*N2+1 ), N2 ) - CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ), + CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, + $ N1+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 ) * END IF @@ -423,9 +436,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ), + CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ), $ N+1 ) * @@ -435,9 +450,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( 2 ), N+1 ) - CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), N+1 ) - CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ), + CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ), $ N+1 ) * @@ -453,7 +470,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ), @@ -465,7 +483,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+2 ), N+1 ) - CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK+1 ), N+1 ) CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ), @@ -489,7 +508,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( NK+1, 1 ), LDA, CBETA, @@ -501,7 +521,8 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK+1 ), NK ) - CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( 1 ), NK ) CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ), $ LDA, A( 1, NK+1 ), LDA, CBETA, @@ -519,9 +540,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA, + CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ), + CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, + $ 1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK ) * ELSE @@ -530,9 +553,11 @@ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, * CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA, $ BETA, C( NK*( NK+1 )+1 ), NK ) - CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA, + CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), + $ LDA, $ BETA, C( NK*NK+1 ), NK ) - CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ), + CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, + $ NK+1 ), $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK ) * END IF diff --git a/SRC/zhgeqz.f b/SRC/zhgeqz.f index 2ebb49abd1..e2c8aed1ca 100644 --- a/SRC/zhgeqz.f +++ b/SRC/zhgeqz.f @@ -279,7 +279,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, + SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, + $ LDT, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * @@ -580,7 +581,8 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL ZROT( ILASTM-JCH, T( JCH, JCH+1 ), LDT, $ T( JCH+1, JCH+1 ), LDT, C, S ) IF( ILQ ) - $ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, DCONJG( S ) ) IF( ILAZR2 ) $ H( JCH, JCH-1 ) = H( JCH, JCH-1 )*C @@ -607,12 +609,14 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, $ T( JCH, JCH+1 ) ) T( JCH+1, JCH+1 ) = CZERO IF( JCH.LT.ILASTM-1 ) - $ CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), LDT, + $ CALL ZROT( ILASTM-JCH-1, T( JCH, JCH+2 ), + $ LDT, $ T( JCH+1, JCH+2 ), LDT, C, S ) CALL ZROT( ILASTM-JCH+2, H( JCH, JCH-1 ), LDH, $ H( JCH+1, JCH-1 ), LDH, C, S ) IF( ILQ ) - $ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), 1, + $ CALL ZROT( N, Q( 1, JCH ), 1, Q( 1, JCH+1 ), + $ 1, $ C, DCONJG( S ) ) CTEMP = H( JCH+1, JCH ) CALL ZLARTG( CTEMP, H( JCH+1, JCH-1 ), C, S, @@ -623,7 +627,8 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL ZROT( JCH-IFRSTM, T( IFRSTM, JCH ), 1, $ T( IFRSTM, JCH-1 ), 1, C, S ) IF( ILZ ) - $ CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), 1, + $ CALL ZROT( N, Z( 1, JCH ), 1, Z( 1, JCH-1 ), + $ 1, $ C, S ) 30 CONTINUE GO TO 50 @@ -658,7 +663,8 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, CALL ZROT( ILAST-IFRSTM, T( IFRSTM, ILAST ), 1, $ T( IFRSTM, ILAST-1 ), 1, C, S ) IF( ILZ ) - $ CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, S ) + $ CALL ZROT( N, Z( 1, ILAST ), 1, Z( 1, ILAST-1 ), 1, C, + $ S ) * * H(ILAST,ILAST-1)=0 -- Standardize B, set ALPHA and BETA * @@ -668,8 +674,10 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, SIGNBC = DCONJG( T( ILAST, ILAST ) / ABSB ) T( ILAST, ILAST ) = ABSB IF( ILSCHR ) THEN - CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), 1 ) - CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, ILAST ), + CALL ZSCAL( ILAST-IFRSTM, SIGNBC, T( IFRSTM, ILAST ), + $ 1 ) + CALL ZSCAL( ILAST+1-IFRSTM, SIGNBC, H( IFRSTM, + $ ILAST ), $ 1 ) ELSE CALL ZSCAL( 1, SIGNBC, H( ILAST, ILAST ), 1 ) diff --git a/SRC/zhpcon.f b/SRC/zhpcon.f index 3f0994205f..a65a63cebb 100644 --- a/SRC/zhpcon.f +++ b/SRC/zhpcon.f @@ -115,7 +115,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE ZHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO ) + SUBROUTINE ZHPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zhpev.f b/SRC/zhpev.f index 3d9fd6a342..24315b835c 100644 --- a/SRC/zhpev.f +++ b/SRC/zhpev.f @@ -169,7 +169,8 @@ SUBROUTINE ZHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, ZSTEQR, + EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, + $ ZSTEQR, $ ZUPGTR * .. * .. Intrinsic Functions .. @@ -184,7 +185,8 @@ SUBROUTINE ZHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN diff --git a/SRC/zhpevd.f b/SRC/zhpevd.f index 3edd21f6e5..4e47b3dd27 100644 --- a/SRC/zhpevd.f +++ b/SRC/zhpevd.f @@ -228,7 +228,8 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, ZSTEDC, + EXTERNAL DSCAL, DSTERF, XERBLA, ZDSCAL, ZHPTRD, + $ ZSTEDC, $ ZUPMTR * .. * .. Intrinsic Functions .. @@ -244,7 +245,8 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, INFO = 0 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -342,10 +344,12 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, RWORK( INDE ), INFO ) ELSE - CALL ZSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, WORK( INDWRK ), + CALL ZSTEDC( 'I', N, W, RWORK( INDE ), Z, LDZ, + $ WORK( INDWRK ), $ LLWRK, RWORK( INDRWK ), LLRWK, IWORK, LIWORK, $ INFO ) - CALL ZUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, LDZ, + CALL ZUPMTR( 'L', UPLO, 'N', N, N, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/zhpevx.f b/SRC/zhpevx.f index 76e50e4fab..bb91ac63e5 100644 --- a/SRC/zhpevx.f +++ b/SRC/zhpevx.f @@ -277,7 +277,8 @@ SUBROUTINE ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, ZDSCAL, + EXTERNAL DCOPY, DSCAL, DSTEBZ, DSTERF, XERBLA, + $ ZDSCAL, $ ZHPTRD, ZSTEIN, ZSTEQR, ZSWAP, ZUPGTR, ZUPMTR * .. * .. Intrinsic Functions .. @@ -297,7 +298,8 @@ SUBROUTINE ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, INFO = -1 ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN INFO = -2 - ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) ) + ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. + $ LSAME( UPLO, 'U' ) ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -451,7 +453,8 @@ SUBROUTINE ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, * form to eigenvectors returned by ZSTEIN. * INDWRK = INDTAU + N - CALL ZUPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, LDZ, + CALL ZUPMTR( 'L', UPLO, 'N', N, M, AP, WORK( INDTAU ), Z, + $ LDZ, $ WORK( INDWRK ), IINFO ) END IF * diff --git a/SRC/zhpgst.f b/SRC/zhpgst.f index 8fecb637c6..9469d106fe 100644 --- a/SRC/zhpgst.f +++ b/SRC/zhpgst.f @@ -139,7 +139,8 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) COMPLEX*16 CT * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZDSCAL, ZHPMV, ZHPR2, ZTPMV, + EXTERNAL XERBLA, ZAXPY, ZDSCAL, ZHPMV, ZHPR2, + $ ZTPMV, $ ZTPSV * .. * .. Intrinsic Functions .. @@ -184,12 +185,14 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) * AP( JJ ) = DBLE( AP( JJ ) ) BJJ = DBLE( BP( JJ ) ) - CALL ZTPSV( UPLO, 'Conjugate transpose', 'Non-unit', J, + CALL ZTPSV( UPLO, 'Conjugate transpose', 'Non-unit', + $ J, $ BP, AP( J1 ), 1 ) CALL ZHPMV( UPLO, J-1, -CONE, AP, BP( J1 ), 1, CONE, $ AP( J1 ), 1 ) CALL ZDSCAL( J-1, ONE / BJJ, AP( J1 ), 1 ) - AP( JJ ) = ( AP( JJ )-ZDOTC( J-1, AP( J1 ), 1, BP( J1 ), + AP( JJ ) = ( AP( JJ )-ZDOTC( J-1, AP( J1 ), 1, + $ BP( J1 ), $ 1 ) ) / BJJ 10 CONTINUE ELSE @@ -264,7 +267,8 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) AP( JJ ) = AJJ*BJJ + ZDOTC( N-J, AP( JJ+1 ), 1, $ BP( JJ+1 ), 1 ) CALL ZDSCAL( N-J, BJJ, AP( JJ+1 ), 1 ) - CALL ZHPMV( UPLO, N-J, CONE, AP( J1J1 ), BP( JJ+1 ), 1, + CALL ZHPMV( UPLO, N-J, CONE, AP( J1J1 ), BP( JJ+1 ), + $ 1, $ CONE, AP( JJ+1 ), 1 ) CALL ZTPMV( UPLO, 'Conjugate transpose', 'Non-unit', $ N-J+1, BP( JJ ), AP( JJ ), 1 ) diff --git a/SRC/zhpgv.f b/SRC/zhpgv.f index 745b5dc6cd..fb308ebe53 100644 --- a/SRC/zhpgv.f +++ b/SRC/zhpgv.f @@ -161,7 +161,8 @@ *> \ingroup hpgv * * ===================================================================== - SUBROUTINE ZHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE ZHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ RWORK, INFO ) * * -- LAPACK driver routine -- @@ -189,7 +190,8 @@ SUBROUTINE ZHPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHPEV, ZHPGST, ZPPTRF, ZTPMV, ZTPSV + EXTERNAL XERBLA, ZHPEV, ZHPGST, ZPPTRF, ZTPMV, + $ ZTPSV * .. * .. Executable Statements .. * diff --git a/SRC/zhpgvd.f b/SRC/zhpgvd.f index 0382bf7533..b73cdda1ef 100644 --- a/SRC/zhpgvd.f +++ b/SRC/zhpgvd.f @@ -221,7 +221,8 @@ *> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA * * ===================================================================== - SUBROUTINE ZHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, + SUBROUTINE ZHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, + $ WORK, $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO ) * * -- LAPACK driver routine -- @@ -250,7 +251,8 @@ SUBROUTINE ZHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHPEVD, ZHPGST, ZPPTRF, ZTPMV, ZTPSV + EXTERNAL XERBLA, ZHPEVD, ZHPGST, ZPPTRF, ZTPMV, + $ ZTPSV * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX diff --git a/SRC/zhpgvx.f b/SRC/zhpgvx.f index 3955446357..226037a2d4 100644 --- a/SRC/zhpgvx.f +++ b/SRC/zhpgvx.f @@ -303,7 +303,8 @@ SUBROUTINE ZHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZHPEVX, ZHPGST, ZPPTRF, ZTPMV, ZTPSV + EXTERNAL XERBLA, ZHPEVX, ZHPGST, ZPPTRF, ZTPMV, + $ ZTPSV * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -369,7 +370,8 @@ SUBROUTINE ZHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * Transform problem to standard eigenvalue problem and solve. * CALL ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) - CALL ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, + CALL ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, + $ M, $ W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * IF( WANTZ ) THEN diff --git a/SRC/zhprfs.f b/SRC/zhprfs.f index 928e6b5db8..63b221f61d 100644 --- a/SRC/zhprfs.f +++ b/SRC/zhprfs.f @@ -176,7 +176,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE ZHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE ZHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -218,7 +219,8 @@ SUBROUTINE ZHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHPMV, ZHPTRS, ZLACN2 + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHPMV, ZHPTRS, + $ ZLACN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX diff --git a/SRC/zhpsv.f b/SRC/zhpsv.f index 652f3370d8..9173b162fd 100644 --- a/SRC/zhpsv.f +++ b/SRC/zhpsv.f @@ -191,7 +191,8 @@ SUBROUTINE ZHPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zhpsvx.f b/SRC/zhpsvx.f index b8cea58439..d526e49ba3 100644 --- a/SRC/zhpsvx.f +++ b/SRC/zhpsvx.f @@ -273,7 +273,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE ZHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -308,7 +309,8 @@ SUBROUTINE ZHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZHPCON, ZHPRFS, ZHPTRF, ZHPTRS, + EXTERNAL XERBLA, ZCOPY, ZHPCON, ZHPRFS, ZHPTRF, + $ ZHPTRS, $ ZLACPY * .. * .. Intrinsic Functions .. @@ -322,7 +324,8 @@ SUBROUTINE ZHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -370,7 +373,8 @@ SUBROUTINE ZHPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL ZHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL ZHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/zhptrd.f b/SRC/zhptrd.f index 9b0c68af66..7d335e0495 100644 --- a/SRC/zhptrd.f +++ b/SRC/zhptrd.f @@ -277,19 +277,22 @@ SUBROUTINE ZHPTRD( UPLO, N, AP, D, E, TAU, INFO ) * * Compute y := tau * A * v storing y in TAU(i:n-1) * - CALL ZHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), 1, + CALL ZHPMV( UPLO, N-I, TAUI, AP( I1I1 ), AP( II+1 ), + $ 1, $ ZERO, TAU( I ), 1 ) * * Compute w := y - 1/2 * tau * (y**H *v) * v * - ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, AP( II+1 ), + ALPHA = -HALF*TAUI*ZDOTC( N-I, TAU( I ), 1, + $ AP( II+1 ), $ 1 ) CALL ZAXPY( N-I, ALPHA, AP( II+1 ), 1, TAU( I ), 1 ) * * Apply the transformation as a rank-2 update: * A := A - v * w**H - w * v**H * - CALL ZHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), 1, + CALL ZHPR2( UPLO, N-I, -ONE, AP( II+1 ), 1, TAU( I ), + $ 1, $ AP( I1I1 ) ) * END IF diff --git a/SRC/zhptrf.f b/SRC/zhptrf.f index 6abb174fcb..ce843c81db 100644 --- a/SRC/zhptrf.f +++ b/SRC/zhptrf.f @@ -525,7 +525,8 @@ SUBROUTINE ZHPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/zhptri.f b/SRC/zhptri.f index 51e5c8b55b..1ef2a9bda0 100644 --- a/SRC/zhptri.f +++ b/SRC/zhptri.f @@ -224,7 +224,8 @@ SUBROUTINE ZHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KC ), 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - - $ DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), 1 ) ) + $ DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), + $ 1 ) ) END IF KSTEP = 1 ELSE @@ -249,15 +250,18 @@ SUBROUTINE ZHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KC ), 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - - $ DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), 1 ) ) + $ DBLE( ZDOTC( K-1, WORK, 1, AP( KC ), + $ 1 ) ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ ZDOTC( K-1, AP( KC ), 1, AP( KCNEXT ), + $ ZDOTC( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL ZCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL ZHPMV( UPLO, K-1, -CONE, AP, WORK, 1, ZERO, $ AP( KCNEXT ), 1 ) AP( KCNEXT+K ) = AP( KCNEXT+K ) - - $ DBLE( ZDOTC( K-1, WORK, 1, AP( KCNEXT ), + $ DBLE( ZDOTC( K-1, WORK, 1, + $ AP( KCNEXT ), $ 1 ) ) END IF KSTEP = 2 @@ -350,7 +354,8 @@ SUBROUTINE ZHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK, + CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), + $ WORK, $ 1, ZERO, AP( KC+1 ), 1 ) AP( KC ) = AP( KC ) - DBLE( ZDOTC( N-K, WORK, 1, $ AP( KC+1 ), 1 ) ) @@ -358,10 +363,12 @@ SUBROUTINE ZHPTRI( UPLO, N, AP, IPIV, WORK, INFO ) $ ZDOTC( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL ZCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), WORK, + CALL ZHPMV( UPLO, N-K, -CONE, AP( KC+( N-K+1 ) ), + $ WORK, $ 1, ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - - $ DBLE( ZDOTC( N-K, WORK, 1, AP( KCNEXT+2 ), + $ DBLE( ZDOTC( N-K, WORK, 1, + $ AP( KCNEXT+2 ), $ 1 ) ) END IF KSTEP = 2 diff --git a/SRC/zhptrs.f b/SRC/zhptrs.f index 0e060bf4dd..b1459fb960 100644 --- a/SRC/zhptrs.f +++ b/SRC/zhptrs.f @@ -144,7 +144,8 @@ SUBROUTINE ZHPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, ZSWAP + EXTERNAL XERBLA, ZDSCAL, ZGEMV, ZGERU, ZLACGV, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX @@ -370,7 +371,8 @@ SUBROUTINE ZHPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/zhsein.f b/SRC/zhsein.f index f2fb26e93f..5cf4055bf4 100644 --- a/SRC/zhsein.f +++ b/SRC/zhsein.f @@ -240,7 +240,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, + SUBROUTINE ZHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, + $ VL, $ LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, $ IFAILR, INFO ) * @@ -397,7 +398,8 @@ SUBROUTINE ZHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * Compute infinity-norm of submatrix H(KL:KR,KL:KR) if it * has not ben computed before. * - HNORM = ZLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, RWORK ) + HNORM = ZLANHS( 'I', KR-KL+1, H( KL, KL ), LDH, + $ RWORK ) IF( DISNAN( HNORM ) ) THEN INFO = -6 RETURN @@ -426,7 +428,8 @@ SUBROUTINE ZHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * * Compute left eigenvector. * - CALL ZLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), LDH, + CALL ZLAEIN( .FALSE., NOINIT, N-KL+1, H( KL, KL ), + $ LDH, $ WK, VL( KL, KS ), WORK, LDWORK, RWORK, EPS3, $ SMLNUM, IINFO ) IF( IINFO.GT.0 ) THEN @@ -443,7 +446,8 @@ SUBROUTINE ZHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, * * Compute right eigenvector. * - CALL ZLAEIN( .TRUE., NOINIT, KR, H, LDH, WK, VR( 1, KS ), + CALL ZLAEIN( .TRUE., NOINIT, KR, H, LDH, WK, VR( 1, + $ KS ), $ WORK, LDWORK, RWORK, EPS3, SMLNUM, IINFO ) IF( IINFO.GT.0 ) THEN INFO = INFO + 1 diff --git a/SRC/zhseqr.f b/SRC/zhseqr.f index 3438fdea4d..6882c2b1c9 100644 --- a/SRC/zhseqr.f +++ b/SRC/zhseqr.f @@ -347,7 +347,8 @@ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, EXTERNAL ILAENV, LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0, ZLASET + EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0, + $ ZLASET * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, MAX, MIN @@ -398,7 +399,8 @@ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * * ==== Quick return in case of a workspace query ==== * - CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z, + CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + $ Z, $ LDZ, WORK, LWORK, INFO ) * ==== Ensure reported workspace size is backward-compatible with * . previous LAPACK versions. ==== @@ -413,7 +415,8 @@ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, IF( ILO.GT.1 ) $ CALL ZCOPY( ILO-1, H, LDH+1, W, 1 ) IF( IHI.LT.N ) - $ CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), 1 ) + $ CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), + $ 1 ) * * ==== Initialize Z, if requested ==== * @@ -436,13 +439,15 @@ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * ==== ZLAQR0 for big matrices; ZLAHQR for small ones ==== * IF( N.GT.NMIN ) THEN - CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, + $ IHI, $ Z, LDZ, WORK, LWORK, INFO ) ELSE * * ==== Small matrix ==== * - CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, + CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, + $ IHI, $ Z, LDZ, INFO ) * IF( INFO.GT.0 ) THEN @@ -469,9 +474,11 @@ SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, * CALL ZLACPY( 'A', N, N, H, LDH, HL, NL ) HL( N+1, N ) = ZERO - CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ), + CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, + $ N+1 ), $ NL ) - CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, W, + CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, + $ W, $ ILO, IHI, Z, LDZ, WORKL, NL, INFO ) IF( WANTT .OR. INFO.NE.0 ) $ CALL ZLACPY( 'A', N, N, HL, NL, H, LDH ) diff --git a/SRC/zla_gbrfsx_extended.f b/SRC/zla_gbrfsx_extended.f index b403fc4d33..091363f117 100644 --- a/SRC/zla_gbrfsx_extended.f +++ b/SRC/zla_gbrfsx_extended.f @@ -401,7 +401,8 @@ *> \ingroup la_gbrfsx_extended * * ===================================================================== - SUBROUTINE ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, + SUBROUTINE ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, + $ KU, $ NRHS, AB, LDAB, AFB, LDAFB, IPIV, $ COLEQU, C, B, LDB, Y, LDY, $ BERR_OUT, N_NORMS, ERR_BNDS_NORM, @@ -467,7 +468,8 @@ SUBROUTINE ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZGBTRS, ZGBMV, BLAS_ZGBMV_X, + EXTERNAL ZAXPY, ZCOPY, ZGBTRS, ZGBMV, + $ BLAS_ZGBMV_X, $ BLAS_ZGBMV2_X, ZLA_GBAMV, ZLA_WWADDW, DLAMCH, $ CHLA_TRANSTYPE, ZLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -538,7 +540,8 @@ SUBROUTINE ZLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, KL, KU, ! XXX: RES is no longer needed. CALL ZCOPY( N, RES, 1, DY, 1 ) - CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, N, + CALL ZGBTRS( TRANS, N, KL, KU, 1, AFB, LDAFB, IPIV, DY, + $ N, $ INFO ) * * Calculate relative changes DX_X, DZ_Z and ratios DXRAT, DZRAT. diff --git a/SRC/zla_geamv.f b/SRC/zla_geamv.f index 139b04848b..64b69c63ba 100644 --- a/SRC/zla_geamv.f +++ b/SRC/zla_geamv.f @@ -173,7 +173,8 @@ *> \ingroup la_geamv * * ===================================================================== - SUBROUTINE ZLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, + SUBROUTINE ZLA_GEAMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, + $ BETA, $ Y, INCY ) * * -- LAPACK computational routine -- diff --git a/SRC/zla_gercond_c.f b/SRC/zla_gercond_c.f index 3869a2949a..7fd26bc208 100644 --- a/SRC/zla_gercond_c.f +++ b/SRC/zla_gercond_c.f @@ -268,7 +268,8 @@ DOUBLE PRECISION FUNCTION ZLA_GERCOND_C( TRANS, N, A, LDA, AF, CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, $ WORK, N, INFO ) ELSE - CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ENDIF * @@ -290,7 +291,8 @@ DOUBLE PRECISION FUNCTION ZLA_GERCOND_C( TRANS, N, A, LDA, AF, END IF * IF ( NOTRANS ) THEN - CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ELSE CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, diff --git a/SRC/zla_gercond_x.f b/SRC/zla_gercond_x.f index 3f2d3d4f8e..731fa36d56 100644 --- a/SRC/zla_gercond_x.f +++ b/SRC/zla_gercond_x.f @@ -248,7 +248,8 @@ DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF, CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, $ WORK, N, INFO ) ELSE - CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ENDIF * @@ -266,7 +267,8 @@ DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF, END DO * IF ( NOTRANS ) THEN - CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, IPIV, + CALL ZGETRS( 'Conjugate transpose', N, 1, AF, LDAF, + $ IPIV, $ WORK, N, INFO ) ELSE CALL ZGETRS( 'No transpose', N, 1, AF, LDAF, IPIV, diff --git a/SRC/zla_gerfsx_extended.f b/SRC/zla_gerfsx_extended.f index 6c8f666463..6e0b39ce5f 100644 --- a/SRC/zla_gerfsx_extended.f +++ b/SRC/zla_gerfsx_extended.f @@ -388,7 +388,8 @@ *> \ingroup la_gerfsx_extended * * ===================================================================== - SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, + SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, + $ A, $ LDA, AF, LDAF, IPIV, COLEQU, C, B, $ LDB, Y, LDY, BERR_OUT, N_NORMS, $ ERRS_N, ERRS_C, RES, AYB, DY, @@ -454,7 +455,8 @@ SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, PARAMETER ( LA_LINRX_RCOND_I = 3 ) * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZGETRS, ZGEMV, BLAS_ZGEMV_X, + EXTERNAL ZAXPY, ZCOPY, ZGETRS, ZGEMV, + $ BLAS_ZGEMV_X, $ BLAS_ZGEMV2_X, ZLA_GEAMV, ZLA_WWADDW, DLAMCH, $ CHLA_TRANSTYPE, ZLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -513,7 +515,8 @@ SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, CALL ZGEMV( TRANS, N, N, (-1.0D+0,0.0D+0), A, LDA, $ Y( 1, J ), 1, (1.0D+0,0.0D+0), RES, 1) ELSE IF (Y_PREC_STATE .EQ. EXTRA_RESIDUAL) THEN - CALL BLAS_ZGEMV_X( TRANS_TYPE, N, N, (-1.0D+0,0.0D+0), A, + CALL BLAS_ZGEMV_X( TRANS_TYPE, N, N, (-1.0D+0,0.0D+0), + $ A, $ LDA, Y( 1, J ), 1, (1.0D+0,0.0D+0), $ RES, 1, PREC_TYPE ) ELSE @@ -673,7 +676,8 @@ SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, A, * op(A) = A, A**T, or A**H depending on TRANS (and type). * CALL ZCOPY( N, B( 1, J ), 1, RES, 1 ) - CALL ZGEMV( TRANS, N, N, (-1.0D+0,0.0D+0), A, LDA, Y(1,J), 1, + CALL ZGEMV( TRANS, N, N, (-1.0D+0,0.0D+0), A, LDA, Y(1,J), + $ 1, $ (1.0D+0,0.0D+0), RES, 1 ) DO I = 1, N diff --git a/SRC/zla_herfsx_extended.f b/SRC/zla_herfsx_extended.f index e56dbf11c4..5c6acf3be7 100644 --- a/SRC/zla_herfsx_extended.f +++ b/SRC/zla_herfsx_extended.f @@ -386,7 +386,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE ZLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE ZLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -458,7 +459,8 @@ SUBROUTINE ZLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZHETRS, ZHEMV, BLAS_ZHEMV_X, + EXTERNAL ZAXPY, ZCOPY, ZHETRS, ZHEMV, + $ BLAS_ZHEMV_X, $ BLAS_ZHEMV2_X, ZLA_HEAMV, ZLA_WWADDW, $ ZLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -538,7 +540,8 @@ SUBROUTINE ZLA_HERFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * CALL ZCOPY( N, B( 1, J ), 1, RES, 1 ) IF ( Y_PREC_STATE .EQ. BASE_RESIDUAL ) THEN - CALL ZHEMV( UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y( 1, J ), + CALL ZHEMV( UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y( 1, + $ J ), $ 1, DCMPLX(1.0D+0), RES, 1 ) ELSE IF ( Y_PREC_STATE .EQ. EXTRA_RESIDUAL ) THEN CALL BLAS_ZHEMV_X( UPLO2, N, DCMPLX(-1.0D+0), A, LDA, diff --git a/SRC/zla_herpvgrw.f b/SRC/zla_herpvgrw.f index ea99226c94..1e8213a70c 100644 --- a/SRC/zla_herpvgrw.f +++ b/SRC/zla_herpvgrw.f @@ -119,7 +119,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, + DOUBLE PRECISION FUNCTION ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, + $ AF, $ LDAF, IPIV, WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/zla_porfsx_extended.f b/SRC/zla_porfsx_extended.f index e71b7d15fd..4f3d07c36c 100644 --- a/SRC/zla_porfsx_extended.f +++ b/SRC/zla_porfsx_extended.f @@ -378,7 +378,8 @@ *> \ingroup la_porfsx_extended * * ===================================================================== - SUBROUTINE ZLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE ZLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, COLEQU, C, B, LDB, Y, $ LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -449,7 +450,8 @@ SUBROUTINE ZLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZPOTRS, ZHEMV, BLAS_ZHEMV_X, + EXTERNAL ZAXPY, ZCOPY, ZPOTRS, ZHEMV, + $ BLAS_ZHEMV_X, $ BLAS_ZHEMV2_X, ZLA_HEAMV, ZLA_WWADDW, $ ZLA_LIN_BERR, DLAMCH DOUBLE PRECISION DLAMCH @@ -509,7 +511,8 @@ SUBROUTINE ZLA_PORFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * CALL ZCOPY( N, B( 1, J ), 1, RES, 1 ) IF (Y_PREC_STATE .EQ. BASE_RESIDUAL) THEN - CALL ZHEMV(UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y(1,J), 1, + CALL ZHEMV(UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y(1,J), + $ 1, $ DCMPLX(1.0D+0), RES, 1) ELSE IF (Y_PREC_STATE .EQ. EXTRA_RESIDUAL) THEN CALL BLAS_ZHEMV_X(UPLO2, N, DCMPLX(-1.0D+0), A, LDA, diff --git a/SRC/zla_porpvgrw.f b/SRC/zla_porpvgrw.f index 6a2e9ac2de..b6b55ba7f9 100644 --- a/SRC/zla_porpvgrw.f +++ b/SRC/zla_porpvgrw.f @@ -103,7 +103,8 @@ *> \ingroup la_porpvgrw * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, + DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, + $ AF, $ LDAF, WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/zla_syrfsx_extended.f b/SRC/zla_syrfsx_extended.f index 0d8d17759f..737dcfaf34 100644 --- a/SRC/zla_syrfsx_extended.f +++ b/SRC/zla_syrfsx_extended.f @@ -386,7 +386,8 @@ *> \ingroup la_herfsx_extended * * ===================================================================== - SUBROUTINE ZLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, + SUBROUTINE ZLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, + $ LDA, $ AF, LDAF, IPIV, COLEQU, C, B, LDB, $ Y, LDY, BERR_OUT, N_NORMS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, RES, @@ -458,7 +459,8 @@ SUBROUTINE ZLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, INTEGER ILAUPLO * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZSYTRS, ZSYMV, BLAS_ZSYMV_X, + EXTERNAL ZAXPY, ZCOPY, ZSYTRS, ZSYMV, + $ BLAS_ZSYMV_X, $ BLAS_ZSYMV2_X, ZLA_SYAMV, ZLA_WWADDW, $ ZLA_LIN_BERR DOUBLE PRECISION DLAMCH @@ -538,7 +540,8 @@ SUBROUTINE ZLA_SYRFSX_EXTENDED( PREC_TYPE, UPLO, N, NRHS, A, LDA, * CALL ZCOPY( N, B( 1, J ), 1, RES, 1 ) IF ( Y_PREC_STATE .EQ. BASE_RESIDUAL ) THEN - CALL ZSYMV( UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y(1,J), 1, + CALL ZSYMV( UPLO, N, DCMPLX(-1.0D+0), A, LDA, Y(1,J), + $ 1, $ DCMPLX(1.0D+0), RES, 1 ) ELSE IF ( Y_PREC_STATE .EQ. EXTRA_RESIDUAL ) THEN CALL BLAS_ZSYMV_X( UPLO2, N, DCMPLX(-1.0D+0), A, LDA, diff --git a/SRC/zla_syrpvgrw.f b/SRC/zla_syrpvgrw.f index 5f06c0ab21..44acc0801b 100644 --- a/SRC/zla_syrpvgrw.f +++ b/SRC/zla_syrpvgrw.f @@ -119,7 +119,8 @@ *> \ingroup la_herpvgrw * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLA_SYRPVGRW( UPLO, N, INFO, A, LDA, AF, + DOUBLE PRECISION FUNCTION ZLA_SYRPVGRW( UPLO, N, INFO, A, LDA, + $ AF, $ LDAF, IPIV, WORK ) * * -- LAPACK computational routine -- diff --git a/SRC/zlabrd.f b/SRC/zlabrd.f index 814665b2d6..9a74d94dd3 100644 --- a/SRC/zlabrd.f +++ b/SRC/zlabrd.f @@ -208,7 +208,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, + SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, + $ Y, $ LDY ) * * -- LAPACK auxiliary routine -- @@ -280,7 +281,8 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE, $ A( I, 1 ), LDA, A( I, I ), 1, ZERO, $ Y( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', M-I+1, I-1, ONE, $ X( I, 1 ), LDX, A( I, I ), 1, ZERO, @@ -313,16 +315,19 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL ZGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, I+1 ), + CALL ZGEMV( 'No transpose', M-I, N-I, ONE, A( I+1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', N-I, I, ONE, $ Y( I+1, 1 ), LDY, A( I, I+1 ), LDA, ZERO, $ X( 1, I ), 1 ) CALL ZGEMV( 'No transpose', M-I, I, -ONE, A( I+1, 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) @@ -358,16 +363,20 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * * Compute X(i+1:m,i) * - CALL ZGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, I ), + CALL ZGEMV( 'No transpose', M-I, N-I+1, ONE, A( I+1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', N-I+1, I-1, ONE, $ Y( I, 1 ), LDY, A( I, I ), LDA, ZERO, $ X( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) - CALL ZGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, I ), + CALL ZGEMV( 'No transpose', I-1, N-I+1, ONE, A( 1, + $ I ), $ LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, 1 ), + CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, X( I+1, + $ 1 ), $ LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 ) CALL ZSCAL( M-I, TAUP( I ), X( I+1, I ), 1 ) CALL ZLACGV( N-I+1, A( I, I ), LDA ) @@ -375,7 +384,8 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, * Update A(i+1:m,i) * CALL ZLACGV( I-1, Y( I, 1 ), LDY ) - CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, 1 ), + CALL ZGEMV( 'No transpose', M-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 ) CALL ZLACGV( I-1, Y( I, 1 ), LDY ) CALL ZGEMV( 'No transpose', M-I, I, -ONE, X( I+1, 1 ), @@ -397,7 +407,8 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, CALL ZGEMV( 'Conjugate transpose', M-I, I-1, ONE, $ A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO, $ Y( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, 1 ), + CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, Y( I+1, + $ 1 ), $ LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', M-I, I, ONE, $ X( I+1, 1 ), LDX, A( I+1, I ), 1, ZERO, diff --git a/SRC/zlaed0.f b/SRC/zlaed0.f index 97366cd389..245ffe909b 100644 --- a/SRC/zlaed0.f +++ b/SRC/zlaed0.f @@ -173,7 +173,8 @@ SUBROUTINE ZLAED0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, DOUBLE PRECISION TEMP * .. * .. External Subroutines .. - EXTERNAL DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM, ZLAED7 + EXTERNAL DCOPY, DSTEQR, XERBLA, ZCOPY, ZLACRM, + $ ZLAED7 * .. * .. External Functions .. INTEGER ILAENV diff --git a/SRC/zlaed7.f b/SRC/zlaed7.f index bead2e0f2e..4e2c5580bc 100644 --- a/SRC/zlaed7.f +++ b/SRC/zlaed7.f @@ -243,7 +243,8 @@ *> \ingroup laed7 * * ===================================================================== - SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, + SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, + $ Q, $ LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) @@ -271,7 +272,8 @@ SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, $ INDXC, INDXP, IQ, IW, IZ, K, N1, N2, PTR * .. * .. External Subroutines .. - EXTERNAL DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM, ZLAED8 + EXTERNAL DLAED9, DLAEDA, DLAMRG, XERBLA, ZLACRM, + $ ZLAED8 * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -357,7 +359,8 @@ SUBROUTINE ZLAED7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, CALL DLAED9( K, 1, K, N, D, RWORK( IQ ), K, RHO, $ RWORK( IDLMDA ), RWORK( IW ), $ QSTORE( QPTR( CURR ) ), K, INFO ) - CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, Q, + CALL ZLACRM( QSIZ, K, WORK, QSIZ, QSTORE( QPTR( CURR ) ), K, + $ Q, $ LDQ, RWORK( IQ ) ) QPTR( CURR+1 ) = QPTR( CURR ) + K**2 IF( INFO.NE.0 ) THEN diff --git a/SRC/zlaed8.f b/SRC/zlaed8.f index 56e587ac1a..bddda985b5 100644 --- a/SRC/zlaed8.f +++ b/SRC/zlaed8.f @@ -223,7 +223,8 @@ *> \ingroup laed8 * * ===================================================================== - SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, + SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, + $ DLAMBDA, $ Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, $ GIVCOL, GIVNUM, INFO ) * @@ -260,7 +261,8 @@ SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, EXTERNAL IDAMAX, DLAMCH, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY, ZDROT, + EXTERNAL DCOPY, DLAMRG, DSCAL, XERBLA, ZCOPY, + $ ZDROT, $ ZLACPY * .. * .. Intrinsic Functions .. @@ -351,7 +353,8 @@ SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, PERM( J ) = INDXQ( INDX( J ) ) CALL ZCOPY( QSIZ, Q( 1, PERM( J ) ), 1, Q2( 1, J ), 1 ) 50 CONTINUE - CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), LDQ ) + CALL ZLACPY( 'A', QSIZ, N, Q2( 1, 1 ), LDQ2, Q( 1, 1 ), + $ LDQ ) RETURN END IF * @@ -473,7 +476,8 @@ SUBROUTINE ZLAED8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMBDA, * IF( K.LT.N ) THEN CALL DCOPY( N-K, DLAMBDA( K+1 ), 1, D( K+1 ), 1 ) - CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, K+1 ), + CALL ZLACPY( 'A', QSIZ, N-K, Q2( 1, K+1 ), LDQ2, Q( 1, + $ K+1 ), $ LDQ ) END IF * diff --git a/SRC/zlaein.f b/SRC/zlaein.f index a34ad026d8..bb2bff0d1d 100644 --- a/SRC/zlaein.f +++ b/SRC/zlaein.f @@ -145,7 +145,8 @@ *> \ingroup laein * * ===================================================================== - SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, + SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, + $ RWORK, $ EPS3, SMLNUM, INFO ) * * -- LAPACK auxiliary routine -- @@ -228,7 +229,8 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, * Scale supplied initial vector. * VNORM = DZNRM2( N, V, 1 ) - CALL ZDSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, 1 ) + CALL ZDSCAL( N, ( EPS3*ROOTN ) / MAX( VNORM, NRMSML ), V, + $ 1 ) END IF * IF( RIGHTV ) THEN @@ -314,7 +316,8 @@ SUBROUTINE ZLAEIN( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, * or U**H *x = scale*v for a left eigenvector, * overwriting x on v. * - CALL ZLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, V, + CALL ZLATRS( 'Upper', TRANS, 'Nonunit', NORMIN, N, B, LDB, + $ V, $ SCALE, RWORK, IERR ) NORMIN = 'Y' * diff --git a/SRC/zlags2.f b/SRC/zlags2.f index e8bb256e52..96c95495eb 100644 --- a/SRC/zlags2.f +++ b/SRC/zlags2.f @@ -154,7 +154,8 @@ *> \ingroup lags2 * * ===================================================================== - SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, + SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, + $ CSV, $ SNV, CSQ, SNQ ) * * -- LAPACK auxiliary routine -- @@ -238,17 +239,21 @@ SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, * zero (1,2) elements of U**H *A and V**H *B * IF( ( ABS( UA11R )+ABS1( UA12 ) ).EQ.ZERO ) THEN - CALL ZLARTG( -DCMPLX( VB11R ), DCONJG( VB12 ), CSQ, SNQ, + CALL ZLARTG( -DCMPLX( VB11R ), DCONJG( VB12 ), CSQ, + $ SNQ, $ R ) ELSE IF( ( ABS( VB11R )+ABS1( VB12 ) ).EQ.ZERO ) THEN - CALL ZLARTG( -DCMPLX( UA11R ), DCONJG( UA12 ), CSQ, SNQ, + CALL ZLARTG( -DCMPLX( UA11R ), DCONJG( UA12 ), CSQ, + $ SNQ, $ R ) ELSE IF( AUA12 / ( ABS( UA11R )+ABS1( UA12 ) ).LE.AVB12 / $ ( ABS( VB11R )+ABS1( VB12 ) ) ) THEN - CALL ZLARTG( -DCMPLX( UA11R ), DCONJG( UA12 ), CSQ, SNQ, + CALL ZLARTG( -DCMPLX( UA11R ), DCONJG( UA12 ), CSQ, + $ SNQ, $ R ) ELSE - CALL ZLARTG( -DCMPLX( VB11R ), DCONJG( VB12 ), CSQ, SNQ, + CALL ZLARTG( -DCMPLX( VB11R ), DCONJG( VB12 ), CSQ, + $ SNQ, $ R ) END IF * @@ -274,17 +279,21 @@ SUBROUTINE ZLAGS2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU, CSV, * zero (2,2) elements of U**H *A and V**H *B, and then swap. * IF( ( ABS1( UA21 )+ABS1( UA22 ) ).EQ.ZERO ) THEN - CALL ZLARTG( -DCONJG( VB21 ), DCONJG( VB22 ), CSQ, SNQ, + CALL ZLARTG( -DCONJG( VB21 ), DCONJG( VB22 ), CSQ, + $ SNQ, $ R ) ELSE IF( ( ABS1( VB21 )+ABS( VB22 ) ).EQ.ZERO ) THEN - CALL ZLARTG( -DCONJG( UA21 ), DCONJG( UA22 ), CSQ, SNQ, + CALL ZLARTG( -DCONJG( UA21 ), DCONJG( UA22 ), CSQ, + $ SNQ, $ R ) ELSE IF( AUA22 / ( ABS1( UA21 )+ABS1( UA22 ) ).LE.AVB22 / $ ( ABS1( VB21 )+ABS1( VB22 ) ) ) THEN - CALL ZLARTG( -DCONJG( UA21 ), DCONJG( UA22 ), CSQ, SNQ, + CALL ZLARTG( -DCONJG( UA21 ), DCONJG( UA22 ), CSQ, + $ SNQ, $ R ) ELSE - CALL ZLARTG( -DCONJG( VB21 ), DCONJG( VB22 ), CSQ, SNQ, + CALL ZLARTG( -DCONJG( VB21 ), DCONJG( VB22 ), CSQ, + $ SNQ, $ R ) END IF * diff --git a/SRC/zlagtm.f b/SRC/zlagtm.f index bb76289617..c74259fd1a 100644 --- a/SRC/zlagtm.f +++ b/SRC/zlagtm.f @@ -141,7 +141,8 @@ *> \ingroup lagtm * * ===================================================================== - SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, + SUBROUTINE ZLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, + $ BETA, $ B, LDB ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/zlahef.f b/SRC/zlahef.f index 23cc9ae64d..f9147d2add 100644 --- a/SRC/zlahef.f +++ b/SRC/zlahef.f @@ -174,7 +174,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -211,7 +212,8 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) EXTERNAL LSAME, IZAMAX * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, ZSWAP + EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT @@ -256,7 +258,8 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = DBLE( A( K, K ) ) IF( K.LT.N ) THEN - CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = DBLE( W( K, KW ) ) END IF @@ -624,7 +627,8 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) W( K, K ) = DBLE( A( K, K ) ) IF( K.LT.N ) $ CALL ZCOPY( N-K, A( K+1, K ), 1, W( K+1, K ), 1 ) - CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA, + CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, CONE, W( K, K ), 1 ) W( K, K ) = DBLE( W( K, K ) ) * @@ -671,13 +675,15 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1 ) CALL ZLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = DBLE( A( IMAX, IMAX ) ) IF( IMAX.LT.N ) $ CALL ZCOPY( N-IMAX, A( IMAX+1, IMAX ), 1, $ W( IMAX+1, K+1 ), 1 ) - CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ), $ 1 ) W( IMAX, K+1 ) = DBLE( W( IMAX, K+1 ) ) @@ -751,7 +757,8 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) $ LDA ) CALL ZLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/zlahef_aa.f b/SRC/zlahef_aa.f index 18fee92e3e..42c499b11b 100644 --- a/SRC/zlahef_aa.f +++ b/SRC/zlahef_aa.f @@ -173,8 +173,8 @@ SUBROUTINE ZLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, IZAMAX * .. * .. External Subroutines .. - EXTERNAL ZGEMM, ZGEMV, ZAXPY, ZLACGV, ZCOPY, ZSCAL, ZSWAP, - $ ZLASET, XERBLA + EXTERNAL ZGEMM, ZGEMV, ZAXPY, ZLACGV, ZCOPY, ZSCAL, + $ ZSWAP, ZLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX diff --git a/SRC/zlahef_rk.f b/SRC/zlahef_rk.f index 40caa457e3..753c0a9d23 100644 --- a/SRC/zlahef_rk.f +++ b/SRC/zlahef_rk.f @@ -301,7 +301,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, ZSWAP + EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT @@ -357,7 +358,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, $ CALL ZCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = DBLE( A( K, K ) ) IF( K.LT.N ) THEN - CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = DBLE( W( K, KW ) ) END IF @@ -423,7 +425,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy column IMAX to column KW-1 of W and update it * IF( IMAX.GT.1 ) - $ CALL ZCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ CALL ZCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, + $ KW-1 ), $ 1 ) W( IMAX, KW-1 ) = DBLE( A( IMAX, IMAX ) ) * @@ -876,7 +879,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column k+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL ZLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = DBLE( A( IMAX, IMAX ) ) * @@ -903,7 +907,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = CABS1( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -926,7 +931,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -955,7 +961,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -1015,7 +1022,8 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, $ LDA ) CALL ZLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (column K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/zlahef_rook.f b/SRC/zlahef_rook.f index 936104bf42..5a50ced2c9 100644 --- a/SRC/zlahef_rook.f +++ b/SRC/zlahef_rook.f @@ -221,7 +221,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, ZSWAP + EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT @@ -273,7 +274,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, $ CALL ZCOPY( K-1, A( 1, K ), 1, W( 1, KW ), 1 ) W( K, KW ) = DBLE( A( K, K ) ) IF( K.LT.N ) THEN - CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) W( K, KW ) = DBLE( W( K, KW ) ) END IF @@ -333,7 +335,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy column IMAX to column KW-1 of W and update it * IF( IMAX.GT.1 ) - $ CALL ZCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ CALL ZCOPY( IMAX-1, A( 1, IMAX ), 1, W( 1, + $ KW-1 ), $ 1 ) W( IMAX, KW-1 ) = DBLE( A( IMAX, IMAX ) ) * @@ -797,7 +800,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column k+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL ZLACGV( IMAX-K, W( K, K+1 ), 1 ) W( IMAX, K+1 ) = DBLE( A( IMAX, IMAX ) ) * @@ -824,7 +828,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = CABS1( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -847,7 +852,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -876,7 +882,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -936,7 +943,8 @@ SUBROUTINE ZLAHEF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, $ LDA ) CALL ZLACGV( KP-KK-1, A( KP, KK+1 ), LDA ) IF( KP.LT.N ) - $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (column K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/zlahqr.f b/SRC/zlahqr.f index 11a2bf68c6..77f75b74f6 100644 --- a/SRC/zlahqr.f +++ b/SRC/zlahqr.f @@ -288,7 +288,8 @@ SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, CALL ZSCAL( MIN( JHI, I+1 )-JLO+1, DCONJG( SC ), $ H( JLO, I ), 1 ) IF( WANTZ ) - $ CALL ZSCAL( IHIZ-ILOZ+1, DCONJG( SC ), Z( ILOZ, I ), 1 ) + $ CALL ZSCAL( IHIZ-ILOZ+1, DCONJG( SC ), Z( ILOZ, I ), + $ 1 ) END IF 20 CONTINUE * @@ -525,7 +526,8 @@ SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, IF( J.NE.M+1 ) THEN IF( I2.GT.J ) $ CALL ZSCAL( I2-J, TEMP, H( J, J+1 ), LDH ) - CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), 1 ) + CALL ZSCAL( J-I1, DCONJG( TEMP ), H( I1, J ), + $ 1 ) IF( WANTZ ) THEN CALL ZSCAL( NZ, DCONJG( TEMP ), Z( ILOZ, J ), $ 1 ) diff --git a/SRC/zlahr2.f b/SRC/zlahr2.f index 6d4cdb0ac4..87d1ebf864 100644 --- a/SRC/zlahr2.f +++ b/SRC/zlahr2.f @@ -225,7 +225,8 @@ SUBROUTINE ZLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Update I-th column of A - Y * V**H * CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) - CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY, + CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), + $ LDY, $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 ) CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) * @@ -275,7 +276,8 @@ SUBROUTINE ZLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(I) to annihilate * A(K+I+1:N,I) * - CALL ZLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, + CALL ZLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, $ TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE diff --git a/SRC/zlals0.f b/SRC/zlals0.f index 8b72d5d18b..694e924e9d 100644 --- a/SRC/zlals0.f +++ b/SRC/zlals0.f @@ -265,7 +265,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, + SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, + $ LDBX, $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, $ POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO ) * @@ -297,7 +298,8 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP * .. * .. External Subroutines .. - EXTERNAL DGEMV, XERBLA, ZCOPY, ZDROT, ZDSCAL, ZLACPY, + EXTERNAL DGEMV, XERBLA, ZCOPY, ZDROT, ZDSCAL, + $ ZLACPY, $ ZLASCL * .. * .. External Functions .. @@ -361,7 +363,8 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * CALL ZCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX ) DO 20 I = 2, N - CALL ZCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX ) + CALL ZCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), + $ LDBX ) 20 CONTINUE * * Step (3L): apply the inverse of the left singular vector @@ -481,7 +484,8 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * parentheses (x+y)+z. The goal is to prevent * optimizing compilers from doing x+(y+z). * - RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I+1, + RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, + $ -POLES( I+1, $ 2 ) )-DIFR( I, 1 ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -490,7 +494,8 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, IF( Z( J ).EQ.ZERO ) THEN RWORK( I ) = ZERO ELSE - RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I, + RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, + $ -POLES( I, $ 2 ) )-DIFL( I ) ) / $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 ) END IF @@ -532,10 +537,12 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, * IF( SQRE.EQ.1 ) THEN CALL ZCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX ) - CALL ZDROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S ) + CALL ZDROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, + $ S ) END IF IF( K.LT.MAX( M, N ) ) - $ CALL ZLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ), + $ CALL ZLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, + $ 1 ), $ LDBX ) * * Step (3R): permute rows of B. @@ -545,7 +552,8 @@ SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, CALL ZCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB ) END IF DO 190 I = 2, N - CALL ZCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB ) + CALL ZCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), + $ LDB ) 190 CONTINUE * * Step (4R): apply back the Givens rotations performed. diff --git a/SRC/zlalsa.f b/SRC/zlalsa.f index 815200bf13..e801580a6a 100644 --- a/SRC/zlalsa.f +++ b/SRC/zlalsa.f @@ -261,7 +261,8 @@ *> Osni Marques, LBNL/NERSC, USA \n * * ===================================================================== - SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, + SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, + $ U, $ LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, $ GIVCOL, LDGCOL, PERM, GIVNUM, C, S, RWORK, $ IWORK, INFO ) @@ -295,7 +296,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, $ NDIMR, NL, NLF, NLP1, NLVL, NR, NRF, NRP1, SQRE * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLASDT, XERBLA, ZCOPY, ZLALS0 + EXTERNAL DGEMM, DLASDT, XERBLA, ZCOPY, + $ ZLALS0 * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, DIMAG @@ -474,7 +476,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, NLF = IC - NL NRF = IC + 1 J = J - 1 - CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), LDBX, + CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, BX( NLF, 1 ), + $ LDBX, $ B( NLF, 1 ), LDB, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -519,7 +522,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, SQRE = 1 END IF J = J + 1 - CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), LDB, + CALL ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B( NLF, 1 ), + $ LDB, $ BX( NLF, 1 ), LDBX, PERM( NLF, LVL ), $ GIVPTR( J ), GIVCOL( NLF, LVL2 ), LDGCOL, $ GIVNUM( NLF, LVL2 ), LDU, POLES( NLF, LVL2 ), @@ -561,7 +565,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = DBLE( B( JROW, JCOL ) ) 200 CONTINUE 210 CONTINUE - CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO, RWORK( 1 ), $ NLP1 ) J = NLP1*NRHS*2 @@ -571,7 +576,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = DIMAG( B( JROW, JCOL ) ) 220 CONTINUE 230 CONTINUE - CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NLP1, NRHS, NLP1, ONE, VT( NLF, 1 ), + $ LDU, $ RWORK( 1+NLP1*NRHS*2 ), NLP1, ZERO, $ RWORK( 1+NLP1*NRHS ), NLP1 ) JREAL = 0 @@ -598,7 +604,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = DBLE( B( JROW, JCOL ) ) 260 CONTINUE 270 CONTINUE - CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO, RWORK( 1 ), $ NRP1 ) J = NRP1*NRHS*2 @@ -608,7 +615,8 @@ SUBROUTINE ZLALSA( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, RWORK( J ) = DIMAG( B( JROW, JCOL ) ) 280 CONTINUE 290 CONTINUE - CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), LDU, + CALL DGEMM( 'T', 'N', NRP1, NRHS, NRP1, ONE, VT( NRF, 1 ), + $ LDU, $ RWORK( 1+NRP1*NRHS*2 ), NRP1, ZERO, $ RWORK( 1+NRP1*NRHS ), NRP1 ) JREAL = 0 diff --git a/SRC/zlalsd.f b/SRC/zlalsd.f index 42e9d3c088..264ec68a2f 100644 --- a/SRC/zlalsd.f +++ b/SRC/zlalsd.f @@ -218,7 +218,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, EXTERNAL IDAMAX, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLARTG, DLASCL, DLASDA, DLASDQ, DLASET, + EXTERNAL DGEMM, DLARTG, DLASCL, DLASDA, DLASDQ, + $ DLASET, $ DLASRT, XERBLA, ZCOPY, ZDROT, ZLACPY, ZLALSA, $ ZLASCL, ZLASET * .. @@ -264,7 +265,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B, LDB ) ELSE RANK = 1 - CALL ZLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, D( 1 ), ONE, 1, NRHS, B, LDB, + $ INFO ) D( 1 ) = ABS( D( 1 ) ) END IF RETURN @@ -290,7 +292,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, DO 20 J = 1, N - 1 CS = RWORK( J*2-1 ) SN = RWORK( J*2 ) - CALL ZDROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, SN ) + CALL ZDROT( 1, B( J, I ), 1, B( J+1, I ), 1, CS, + $ SN ) 20 CONTINUE 30 CONTINUE END IF @@ -363,9 +366,11 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, TOL = RCND*ABS( D( IDAMAX( N, D, 1 ) ) ) DO 100 I = 1, N IF( D( I ).LE.TOL ) THEN - CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ), LDB ) + CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, B( I, 1 ), + $ LDB ) ELSE - CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, 1 ), + CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, B( I, + $ 1 ), $ LDB, INFO ) RANK = RANK + 1 END IF @@ -594,7 +599,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, * subproblems were not solved explicitly. * IF( ABS( D( I ) ).LE.TOL ) THEN - CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ), N ) + CALL ZLASET( 'A', 1, NRHS, CZERO, CZERO, WORK( BX+I-1 ), + $ N ) ELSE RANK = RANK + 1 CALL ZLASCL( 'G', 0, 0, D( I ), ONE, 1, NRHS, @@ -657,7 +663,8 @@ SUBROUTINE ZLALSD( UPLO, SMLSIZ, N, NRHS, D, E, B, LDB, RCOND, 300 CONTINUE 310 CONTINUE ELSE - CALL ZLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), N, + CALL ZLALSA( ICMPQ2, SMLSIZ, NSIZE, NRHS, WORK( BXST ), + $ N, $ B( ST, 1 ), LDB, RWORK( U+ST1 ), N, $ RWORK( VT+ST1 ), IWORK( K+ST1 ), $ RWORK( DIFL+ST1 ), RWORK( DIFR+ST1 ), diff --git a/SRC/zlangb.f b/SRC/zlangb.f index 9dad180873..2e162858de 100644 --- a/SRC/zlangb.f +++ b/SRC/zlangb.f @@ -202,7 +202,8 @@ DOUBLE PRECISION FUNCTION ZLANGB( NORM, N, KL, KU, AB, LDAB, TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -211,7 +212,8 @@ DOUBLE PRECISION FUNCTION ZLANGB( NORM, N, KL, KU, AB, LDAB, DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, + $ SUM ) 90 CONTINUE VALUE = SCALE*SQRT( SUM ) END IF diff --git a/SRC/zlange.f b/SRC/zlange.f index 92178b99ac..530c1e7ada 100644 --- a/SRC/zlange.f +++ b/SRC/zlange.f @@ -191,7 +191,8 @@ DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK ) TEMP = WORK( I ) IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlangt.f b/SRC/zlangt.f index de859ed673..1afade3a91 100644 --- a/SRC/zlangt.f +++ b/SRC/zlangt.f @@ -147,11 +147,13 @@ DOUBLE PRECISION FUNCTION ZLANGT( NORM, N, DL, D, DU ) * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. + $ DISNAN( ABS( DL( I ) ) ) ) $ ANORM = ABS(DL(I)) IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) ) $ ANORM = ABS(D(I)) - IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) ) + IF( ANORM.LT.ABS( DU( I ) ) .OR. + $ DISNAN (ABS( DU( I ) ) ) ) $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN @@ -184,7 +186,8 @@ DOUBLE PRECISION FUNCTION ZLANGT( NORM, N, DL, D, DU ) IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlanhb.f b/SRC/zlanhb.f index e04ca6dfb8..027780f1bf 100644 --- a/SRC/zlanhb.f +++ b/SRC/zlanhb.f @@ -192,7 +192,8 @@ DOUBLE PRECISION FUNCTION ZLANHB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -228,7 +229,8 @@ DOUBLE PRECISION FUNCTION ZLANHB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -237,7 +239,8 @@ DOUBLE PRECISION FUNCTION ZLANHB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/zlanhe.f b/SRC/zlanhe.f index c984fffd2d..31a14b5de1 100644 --- a/SRC/zlanhe.f +++ b/SRC/zlanhe.f @@ -184,7 +184,8 @@ DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -218,7 +219,8 @@ DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlanhf.f b/SRC/zlanhf.f index a81113ec9d..42ef4ecbac 100644 --- a/SRC/zlanhf.f +++ b/SRC/zlanhf.f @@ -243,7 +243,8 @@ *> \endverbatim *> * ===================================================================== - DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) + DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -678,7 +679,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is Hermitian). @@ -1130,7 +1132,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) END IF END IF END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -1144,7 +1147,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 3 - CALL ZLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(k,0) END DO DO J = 0, K - 1 @@ -1191,11 +1195,13 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL ZLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * trap L at A(0,0) END DO DO J = 1, K - 2 - CALL ZLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S ) + CALL ZLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO S = S + S @@ -1241,7 +1247,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**H is upper DO J = 1, K - 2 - CALL ZLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) + CALL ZLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k) END DO DO J = 0, K - 2 @@ -1303,7 +1310,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k-1 rect. at A(0,k) END DO DO J = 0, K - 3 - CALL ZLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(1,0) END DO S = S + S @@ -1353,7 +1361,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A is upper DO J = 0, K - 2 - CALL ZLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, + $ S ) * L at A(k+1,0) END DO DO J = 0, K - 1 @@ -1390,7 +1399,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * ilu=1 & A is lower DO J = 0, K - 1 - CALL ZLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, + $ S ) * trap L at A(1,0) END DO DO J = 1, K - 1 @@ -1430,7 +1440,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) IF( ILU.EQ.0 ) THEN * A**H is upper DO J = 1, K - 1 - CALL ZLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) + CALL ZLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, + $ S ) * U at A(0,k+1) END DO DO J = 0, K - 1 @@ -1438,7 +1449,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,0) END DO DO J = 0, K - 2 - CALL ZLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, + CALL ZLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, + $ SCALE, $ S ) * L at A(0,k) END DO @@ -1496,7 +1508,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) ELSE * A**H is lower DO J = 1, K - 1 - CALL ZLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) + CALL ZLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, + $ S ) * U at A(0,1) END DO DO J = K + 1, N @@ -1504,7 +1517,8 @@ DOUBLE PRECISION FUNCTION ZLANHF( NORM, TRANSR, UPLO, N, A, WORK ) * k by k rect. at A(0,k+1) END DO DO J = 0, K - 2 - CALL ZLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S ) + CALL ZLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, + $ S ) * L at A(0,0) END DO S = S + S diff --git a/SRC/zlanhp.f b/SRC/zlanhp.f index 192b9ca659..aa17ce9a16 100644 --- a/SRC/zlanhp.f +++ b/SRC/zlanhp.f @@ -181,7 +181,8 @@ DOUBLE PRECISION FUNCTION ZLANHP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is hermitian). @@ -220,7 +221,8 @@ DOUBLE PRECISION FUNCTION ZLANHP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlanhs.f b/SRC/zlanhs.f index 1aff115207..481434aa3c 100644 --- a/SRC/zlanhs.f +++ b/SRC/zlanhs.f @@ -185,7 +185,8 @@ DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 80 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlanht.f b/SRC/zlanht.f index 35e820a4fc..c34fcc3b42 100644 --- a/SRC/zlanht.f +++ b/SRC/zlanht.f @@ -164,7 +164,8 @@ DOUBLE PRECISION FUNCTION ZLANHT( NORM, N, D, E ) IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlansb.f b/SRC/zlansb.f index b69d56b325..1918361226 100644 --- a/SRC/zlansb.f +++ b/SRC/zlansb.f @@ -186,7 +186,8 @@ DOUBLE PRECISION FUNCTION ZLANSB( NORM, UPLO, N, K, AB, LDAB, 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -222,7 +223,8 @@ DOUBLE PRECISION FUNCTION ZLANSB( NORM, UPLO, N, K, AB, LDAB, IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -231,7 +233,8 @@ DOUBLE PRECISION FUNCTION ZLANSB( NORM, UPLO, N, K, AB, LDAB, IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), + CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 110 CONTINUE L = K + 1 diff --git a/SRC/zlansp.f b/SRC/zlansp.f index 264a06c596..5ec1419d10 100644 --- a/SRC/zlansp.f +++ b/SRC/zlansp.f @@ -175,7 +175,8 @@ DOUBLE PRECISION FUNCTION ZLANSP( NORM, UPLO, N, AP, WORK ) K = K + N - J + 1 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -214,7 +215,8 @@ DOUBLE PRECISION FUNCTION ZLANSP( NORM, UPLO, N, AP, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlansy.f b/SRC/zlansy.f index 069e2da5d2..297c04323b 100644 --- a/SRC/zlansy.f +++ b/SRC/zlansy.f @@ -179,7 +179,8 @@ DOUBLE PRECISION FUNCTION ZLANSY( NORM, UPLO, N, A, LDA, WORK ) 30 CONTINUE 40 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. + ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. + $ ( LSAME( NORM, 'O' ) ) .OR. $ ( NORM.EQ.'1' ) ) THEN * * Find normI(A) ( = norm1(A), since A is symmetric). @@ -213,7 +214,8 @@ DOUBLE PRECISION FUNCTION ZLANSY( NORM, UPLO, N, A, LDA, WORK ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlantb.f b/SRC/zlantb.f index dd2d0c31b5..3aec962dde 100644 --- a/SRC/zlantb.f +++ b/SRC/zlantb.f @@ -188,14 +188,16 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,14 +207,16 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) SUM = ABS( AB( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -308,7 +312,8 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -327,7 +332,8 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 290 J = 1, N - CALL ZLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), + CALL ZLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), + $ J ), $ 1, SCALE, SUM ) 290 CONTINUE END IF @@ -337,7 +343,8 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, SUM = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, + CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ SCALE, $ SUM ) 300 CONTINUE END IF @@ -345,7 +352,8 @@ DOUBLE PRECISION FUNCTION ZLANTB( NORM, UPLO, DIAG, N, K, AB, SCALE = ZERO SUM = ONE DO 310 J = 1, N - CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, + CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ SCALE, $ SUM ) 310 CONTINUE END IF diff --git a/SRC/zlantp.f b/SRC/zlantp.f index c4aa8fb9c7..6d5e21edf6 100644 --- a/SRC/zlantp.f +++ b/SRC/zlantp.f @@ -122,7 +122,8 @@ *> \ingroup lantp * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) + DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, + $ WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -173,7 +174,8 @@ DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 20 J = 1, N DO 10 I = K, K + J - 2 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -181,7 +183,8 @@ DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 40 J = 1, N DO 30 I = K + 1, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -192,7 +195,8 @@ DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 60 J = 1, N DO 50 I = K, K + J - 1 SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE @@ -200,7 +204,8 @@ DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) DO 80 J = 1, N DO 70 I = K, K + N - J SUM = ABS( AP( I ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -303,7 +308,8 @@ DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK ) SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * diff --git a/SRC/zlantr.f b/SRC/zlantr.f index dd91a2a923..593d98cebc 100644 --- a/SRC/zlantr.f +++ b/SRC/zlantr.f @@ -138,7 +138,8 @@ *> \ingroup lantr * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) * * -- LAPACK auxiliary routine -- @@ -189,14 +190,16 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -206,14 +209,16 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -308,7 +313,8 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -317,13 +323,15 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE diff --git a/SRC/zlaqgb.f b/SRC/zlaqgb.f index b83941f8c7..766b9baa74 100644 --- a/SRC/zlaqgb.f +++ b/SRC/zlaqgb.f @@ -156,7 +156,8 @@ *> \ingroup laqgb * * ===================================================================== - SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, + SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, + $ COLCND, $ AMAX, EQUED ) * * -- LAPACK auxiliary routine -- diff --git a/SRC/zlaqhb.f b/SRC/zlaqhb.f index f384307bd5..9c7892dacc 100644 --- a/SRC/zlaqhb.f +++ b/SRC/zlaqhb.f @@ -138,7 +138,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE ZLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE ZLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zlaqp2.f b/SRC/zlaqp2.f index d5a0f5c623..85a166736e 100644 --- a/SRC/zlaqp2.f +++ b/SRC/zlaqp2.f @@ -212,7 +212,8 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * Generate elementary reflector H(i). * IF( OFFPI.LT.M ) THEN - CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1, + CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), + $ 1, $ TAU( I ) ) ELSE CALL ZLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) ) diff --git a/SRC/zlaqps.f b/SRC/zlaqps.f index 49ce31f8b4..7cb95b5b17 100644 --- a/SRC/zlaqps.f +++ b/SRC/zlaqps.f @@ -173,7 +173,8 @@ *> \endhtmlonly * * ===================================================================== - SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, + SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, + $ VN1, $ VN2, AUXV, F, LDF ) * * -- LAPACK auxiliary routine -- @@ -248,7 +249,8 @@ SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, DO 20 J = 1, K - 1 F( K, J ) = DCONJG( F( K, J ) ) 20 CONTINUE - CALL ZGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, 1 ), + CALL ZGEMV( 'No transpose', M-RK+1, K-1, -CONE, A( RK, + $ 1 ), $ LDA, F( K, 1 ), LDF, CONE, A( RK, K ), 1 ) DO 30 J = 1, K - 1 F( K, J ) = DCONJG( F( K, J ) ) @@ -258,7 +260,8 @@ SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * Generate elementary reflector H(k). * IF( RK.LT.M ) THEN - CALL ZLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) ) + CALL ZLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, + $ TAU( K ) ) ELSE CALL ZLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) ) END IF @@ -287,7 +290,8 @@ SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * *A(RK:M,K). * IF( K.GT.1 ) THEN - CALL ZGEMV( 'Conjugate transpose', M-RK+1, K-1, -TAU( K ), + CALL ZGEMV( 'Conjugate transpose', M-RK+1, K-1, + $ -TAU( K ), $ A( RK, 1 ), LDA, A( RK, K ), 1, CZERO, $ AUXV( 1 ), 1 ) * @@ -299,7 +303,8 @@ SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**H. * IF( K.LT.N ) THEN - CALL ZGEMM( 'No transpose', 'Conjugate transpose', 1, N-K, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', 1, + $ N-K, $ K, -CONE, A( RK, 1 ), LDA, F( K+1, 1 ), LDF, $ CONE, A( RK, K+1 ), LDA ) END IF @@ -340,7 +345,8 @@ SUBROUTINE ZLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1, * A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**H. * IF( KB.LT.MIN( N, M-OFFSET ) ) THEN - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-RK, N-KB, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', M-RK, + $ N-KB, $ KB, -CONE, A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, $ CONE, A( RK+1, KB+1 ), LDA ) END IF diff --git a/SRC/zlaqr0.f b/SRC/zlaqr0.f index 21008d8609..025ed43b59 100644 --- a/SRC/zlaqr0.f +++ b/SRC/zlaqr0.f @@ -302,7 +302,8 @@ SUBROUTINE ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, COMPLEX*16 ZDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL ZLACPY, ZLAHQR, ZLAQR3, ZLAQR4, ZLAQR5 + EXTERNAL ZLACPY, ZLAHQR, ZLAQR3, ZLAQR4, + $ ZLAQR5 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DIMAG, INT, MAX, MIN, MOD, @@ -512,7 +513,8 @@ SUBROUTINE ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * * ==== Aggressive early deflation ==== * - CALL ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO, $ H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK, $ LWORK ) diff --git a/SRC/zlaqr2.f b/SRC/zlaqr2.f index ff0a8ecd7b..e1a741498b 100644 --- a/SRC/zlaqr2.f +++ b/SRC/zlaqr2.f @@ -265,7 +265,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * @@ -303,7 +304,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, + EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, + $ ZLAHQR, $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. @@ -331,7 +333,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to ZUNMHR ==== * - CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * @@ -400,7 +403,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, @@ -452,7 +456,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 20 CONTINUE ILST = I IF( IFST.NE.ILST ) - $ CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) + $ CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ INFO ) 30 CONTINUE END IF * @@ -476,7 +481,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT, $ WORK( JW+1 ) ) @@ -501,7 +507,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -515,7 +522,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 60 CONTINUE * * ==== Update horizontal slab in H ==== @@ -535,7 +543,8 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 80 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index 951d412f65..4a0cd79b06 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -262,7 +262,8 @@ *> University of Kansas, USA *> * ===================================================================== - SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * @@ -302,7 +303,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, ZLAQR4, + EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, + $ ZLAQR4, $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. @@ -330,13 +332,15 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * * ==== Workspace query call to ZUNMHR ==== * - CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV, + CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, + $ LDV, $ WORK, -1, INFO ) LWK2 = INT( WORK( 1 ) ) * * ==== Workspace query call to ZLAQR4 ==== * - CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V, + CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, + $ V, $ LDV, WORK, -1, INFQR ) LWK3 = INT( WORK( 1 ) ) * @@ -405,15 +409,18 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . here and there to keep track.) ==== * CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT ) - CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 ) + CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), + $ LDT+1 ) * CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV ) NMIN = ILAENV( 12, 'ZLAQR3', 'SV', JW, 1, JW, LWORK ) IF( JW.GT.NMIN ) THEN - CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, + CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), + $ 1, $ JW, V, LDV, WORK, LWORK, INFQR ) ELSE - CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1, + CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), + $ 1, $ JW, V, LDV, INFQR ) END IF * @@ -463,7 +470,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, 20 CONTINUE ILST = I IF( IFST.NE.ILST ) - $ CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO ) + $ CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, + $ INFO ) 30 CONTINUE END IF * @@ -487,7 +495,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU ) WORK( 1 ) = ONE * - CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT ) + CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), + $ LDT ) * CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT, $ WORK( JW+1 ) ) @@ -512,7 +521,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * . H and Z, if requested. ==== * IF( NS.GT.1 .AND. S.NE.ZERO ) - $ CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV, + $ CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, + $ LDV, $ WORK( JW+1 ), LWORK-JW, INFO ) * * ==== Update vertical slab in H ==== @@ -526,7 +536,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, KLN = MIN( NV, KWTOP-KROW ) CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ), $ LDH, V, LDV, ZERO, WV, LDWV ) - CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH ) + CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), + $ LDH ) 60 CONTINUE * * ==== Update horizontal slab in H ==== @@ -546,7 +557,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IF( WANTZ ) THEN DO 80 KROW = ILOZ, IHIZ, NV KLN = MIN( NV, IHIZ-KROW+1 ) - CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ), + CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, + $ KWTOP ), $ LDZ, V, LDV, ZERO, WV, LDWV ) CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ), $ LDZ ) diff --git a/SRC/zlaqr4.f b/SRC/zlaqr4.f index 026611eb21..efb34c9ef4 100644 --- a/SRC/zlaqr4.f +++ b/SRC/zlaqr4.f @@ -518,7 +518,8 @@ SUBROUTINE ZLAQR4( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * * ==== Aggressive early deflation ==== * - CALL ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, + CALL ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, + $ ILOZ, $ IHIZ, Z, LDZ, LS, LD, W, H( KV, 1 ), LDH, NHO, $ H( KV, KT ), LDH, NVE, H( KWV, 1 ), LDH, WORK, $ LWORK ) diff --git a/SRC/zlaqr5.f b/SRC/zlaqr5.f index c6beabfa96..2c19dac3bb 100644 --- a/SRC/zlaqr5.f +++ b/SRC/zlaqr5.f @@ -252,7 +252,8 @@ *> ACM Trans. Math. Softw. 40, 2, Article 12 (February 2014). *> * ===================================================================== - SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, + SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, + $ S, $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) IMPLICIT NONE @@ -301,7 +302,8 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, COMPLEX*16 VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, ZTRMM + EXTERNAL ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, + $ ZTRMM * .. * .. Statement Functions .. DOUBLE PRECISION CABS1 diff --git a/SRC/zlaqsb.f b/SRC/zlaqsb.f index e107018f7c..65aa58284e 100644 --- a/SRC/zlaqsb.f +++ b/SRC/zlaqsb.f @@ -138,7 +138,8 @@ *> \ingroup laqhb * * ===================================================================== - SUBROUTINE ZLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + SUBROUTINE ZLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zlaqz0.f b/SRC/zlaqz0.f index 61cfd67dba..70b513a282 100644 --- a/SRC/zlaqz0.f +++ b/SRC/zlaqz0.f @@ -278,7 +278,8 @@ *> \ingroup laqz0 *> * ===================================================================== - RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, + RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, + $ A, $ LDA, B, LDB, ALPHA, BETA, Q, LDQ, Z, $ LDZ, WORK, LWORK, RWORK, REC, $ INFO ) @@ -420,7 +421,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, NBR = NSR+ITEMP1 IF( N .LT. NMIN .OR. REC .GE. 2 ) THEN - CALL ZHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, LDB, + CALL ZHGEQZ( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, RWORK, $ INFO ) RETURN @@ -432,7 +434,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Workspace query to ZLAQZ2 NW = MAX( NWR, NMIN ) - CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, LDB, + CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B, + $ LDB, $ Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, ALPHA, $ BETA, WORK, NW, WORK, NW, WORK, -1, RWORK, REC, $ AED_INFO ) @@ -539,17 +542,20 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * to the top and deflate it DO K2 = K, ISTART2+1, -1 - CALL ZLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, S1, + CALL ZLARTG( B( K2-1, K2 ), B( K2-1, K2-1 ), C1, + $ S1, $ TEMP ) B( K2-1, K2 ) = TEMP B( K2-1, K2-1 ) = CZERO CALL ZROT( K2-2-ISTARTM+1, B( ISTARTM, K2 ), 1, $ B( ISTARTM, K2-1 ), 1, C1, S1 ) - CALL ZROT( MIN( K2+1, ISTOP )-ISTARTM+1, A( ISTARTM, + CALL ZROT( MIN( K2+1, ISTOP )-ISTARTM+1, + $ A( ISTARTM, $ K2 ), 1, A( ISTARTM, K2-1 ), 1, C1, S1 ) IF ( ILZ ) THEN - CALL ZROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, C1, + CALL ZROT( N, Z( 1, K2 ), 1, Z( 1, K2-1 ), 1, + $ C1, $ S1 ) END IF @@ -559,9 +565,11 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, A( K2, K2-1 ) = TEMP A( K2+1, K2-1 ) = CZERO - CALL ZROT( ISTOPM-K2+1, A( K2, K2 ), LDA, A( K2+1, + CALL ZROT( ISTOPM-K2+1, A( K2, K2 ), LDA, + $ A( K2+1, $ K2 ), LDA, C1, S1 ) - CALL ZROT( ISTOPM-K2+1, B( K2, K2 ), LDB, B( K2+1, + CALL ZROT( ISTOPM-K2+1, B( K2, K2 ), LDB, + $ B( K2+1, $ K2 ), LDB, C1, S1 ) IF( ILQ ) THEN CALL ZROT( N, Q( 1, K2 ), 1, Q( 1, K2+1 ), 1, @@ -623,7 +631,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for AED * - CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, LDA, + CALL ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NW, A, + $ LDA, $ B, LDB, Q, LDQ, Z, LDZ, N_UNDEFLATED, N_DEFLATED, $ ALPHA, BETA, WORK, NW, WORK( NW**2+1 ), NW, $ WORK( 2*NW**2+1 ), LWORK-2*NW**2, RWORK, REC, @@ -666,7 +675,8 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * * Time for a QZ sweep * - CALL ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, NBLOCK, + CALL ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ISTART2, ISTOP, NS, + $ NBLOCK, $ ALPHA( SHIFTPOS ), BETA( SHIFTPOS ), A, LDA, B, $ LDB, Q, LDQ, Z, LDZ, WORK, NBLOCK, WORK( NBLOCK** $ 2+1 ), NBLOCK, WORK( 2*NBLOCK**2+1 ), diff --git a/SRC/zlaqz1.f b/SRC/zlaqz1.f index 271c71ccaa..3b02e8f297 100644 --- a/SRC/zlaqz1.f +++ b/SRC/zlaqz1.f @@ -169,7 +169,8 @@ *> \ingroup laqz1 *> * ===================================================================== - SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, + SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, + $ B, $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ ) IMPLICIT NONE * @@ -205,7 +206,8 @@ SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL ZROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM, $ IHI-1 ), 1, C, S ) IF ( ILZ ) THEN - CALL ZROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+ + CALL ZROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, + $ IHI-1-ZSTART+ $ 1 ), 1, C, S ) END IF * @@ -221,10 +223,12 @@ SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, B( K+1, K ) = CZERO CALL ZROT( K+2-ISTARTM+1, A( ISTARTM, K+1 ), 1, A( ISTARTM, $ K ), 1, C, S ) - CALL ZROT( K-ISTARTM+1, B( ISTARTM, K+1 ), 1, B( ISTARTM, K ), + CALL ZROT( K-ISTARTM+1, B( ISTARTM, K+1 ), 1, B( ISTARTM, + $ K ), $ 1, C, S ) IF ( ILZ ) THEN - CALL ZROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, K-ZSTART+1 ), + CALL ZROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, + $ K-ZSTART+1 ), $ 1, C, S ) END IF * @@ -233,9 +237,11 @@ SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, CALL ZLARTG( A( K+1, K ), A( K+2, K ), C, S, TEMP ) A( K+1, K ) = TEMP A( K+2, K ) = CZERO - CALL ZROT( ISTOPM-K, A( K+1, K+1 ), LDA, A( K+2, K+1 ), LDA, C, + CALL ZROT( ISTOPM-K, A( K+1, K+1 ), LDA, A( K+2, K+1 ), LDA, + $ C, $ S ) - CALL ZROT( ISTOPM-K, B( K+1, K+1 ), LDB, B( K+2, K+1 ), LDB, C, + CALL ZROT( ISTOPM-K, B( K+1, K+1 ), LDB, B( K+2, K+1 ), LDB, + $ C, $ S ) IF ( ILQ ) THEN CALL ZROT( NQ, Q( 1, K+1-QSTART+1 ), 1, Q( 1, K+2-QSTART+ diff --git a/SRC/zlaqz2.f b/SRC/zlaqz2.f index 8e2836f1a4..8695497cd8 100644 --- a/SRC/zlaqz2.f +++ b/SRC/zlaqz2.f @@ -228,7 +228,8 @@ *> \ingroup laqz2 *> * ===================================================================== - RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, + RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, + $ NW, $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS, $ ND, ALPHA, BETA, QC, LDQC, ZC, LDZC, $ WORK, LWORK, RWORK, REC, INFO ) @@ -320,7 +321,8 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Store window in case of convergence failure CALL ZLACPY( 'ALL', JW, JW, A( KWTOP, KWTOP ), LDA, WORK, JW ) - CALL ZLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, WORK( JW**2+ + CALL ZLACPY( 'ALL', JW, JW, B( KWTOP, KWTOP ), LDB, + $ WORK( JW**2+ $ 1 ), JW ) * Transform window to real schur form @@ -335,7 +337,8 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Convergence failure, restore the window and exit ND = 0 NS = JW-QZ_SMALL_INFO - CALL ZLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), LDA ) + CALL ZLACPY( 'ALL', JW, JW, WORK, JW, A( KWTOP, KWTOP ), + $ LDA ) CALL ZLACPY( 'ALL', JW, JW, WORK( JW**2+1 ), JW, B( KWTOP, $ KWTOP ), LDB ) RETURN @@ -392,11 +395,14 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A( K, KWTOP-1 ) = TEMP A( K+1, KWTOP-1 ) = CZERO K2 = MAX( KWTOP, K-1 ) - CALL ZROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, C1, + CALL ZROT( IHI-K2+1, A( K, K2 ), LDA, A( K+1, K2 ), LDA, + $ C1, $ S1 ) - CALL ZROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, K-1 ), + CALL ZROT( IHI-( K-1 )+1, B( K, K-1 ), LDB, B( K+1, + $ K-1 ), $ LDB, C1, S1 ) - CALL ZROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, K+1-KWTOP+1 ), + CALL ZROT( JW, QC( 1, K-KWTOP+1 ), 1, QC( 1, + $ K+1-KWTOP+1 ), $ 1, C1, DCONJG( S1 ) ) END DO @@ -438,25 +444,29 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, $ IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, QC, + CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Q( 1, KWTOP ), LDQ, + $ QC, $ LDQC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, JW, WORK, N, Q( 1, KWTOP ), LDQ ) END IF IF ( KWTOP-1-ISTARTM+1 > 0 ) THEN - CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, A( ISTARTM, + CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ A( ISTARTM, $ KWTOP ), LDA, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL ZLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ A( ISTARTM, KWTOP ), LDA ) - CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, B( ISTARTM, + CALL ZGEMM( 'N', 'N', KWTOP-ISTARTM, JW, JW, CONE, + $ B( ISTARTM, $ KWTOP ), LDB, ZC, LDZC, CZERO, WORK, $ KWTOP-ISTARTM ) CALL ZLACPY( 'ALL', KWTOP-ISTARTM, JW, WORK, KWTOP-ISTARTM, $ B( ISTARTM, KWTOP ), LDB ) END IF IF ( ILZ ) THEN - CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, ZC, + CALL ZGEMM( 'N', 'N', N, JW, JW, CONE, Z( 1, KWTOP ), LDZ, + $ ZC, $ LDZC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, JW, WORK, N, Z( 1, KWTOP ), LDZ ) END IF diff --git a/SRC/zlaqz3.f b/SRC/zlaqz3.f index e8b7a073f3..cd10e1bcaf 100644 --- a/SRC/zlaqz3.f +++ b/SRC/zlaqz3.f @@ -233,7 +233,8 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, COMPLEX*16 :: TEMP, TEMP2, TEMP3, S * External Functions - EXTERNAL :: XERBLA, ZLASET, ZLARTG, ZROT, ZLAQZ1, ZGEMM, ZLACPY + EXTERNAL :: XERBLA, ZLASET, ZLARTG, ZROT, ZLAQZ1, ZGEMM, + $ ZLACPY DOUBLE PRECISION, EXTERNAL :: DLAMCH INFO = 0 @@ -328,17 +329,20 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS+1 SWIDTH = ISTOPM-( ILO+NS )+1 IF ( SWIDTH > 0 ) THEN - CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ A( ILO, ILO+NS ), LDA, CZERO, WORK, SHEIGHT ) CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ILO, $ ILO+NS ), LDA ) - CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ B( ILO, ILO+NS ), LDB, CZERO, WORK, SHEIGHT ) CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ILO, $ ILO+NS ), LDB ) END IF IF ( ILQ ) THEN - CALL ZGEMM( 'N', 'N', N, SHEIGHT, SHEIGHT, CONE, Q( 1, ILO ), + CALL ZGEMM( 'N', 'N', N, SHEIGHT, SHEIGHT, CONE, Q( 1, + $ ILO ), $ LDQ, QC, LDQC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, SHEIGHT, WORK, N, Q( 1, ILO ), LDQ ) END IF @@ -351,12 +355,14 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL ZGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ A( ISTARTM, ILO ), LDA, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ ILO ), LDA ) CALL ZGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ B( ISTARTM, ILO ), LDB, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ ILO ), LDB ) END IF IF ( ILZ ) THEN @@ -388,7 +394,8 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, * Move down the block with index k+i+j, updating * the (ns+np x ns+np) block: * (k:k+ns+np,k:k+ns+np-1) - CALL ZLAQZ1( .TRUE., .TRUE., K+I+J, ISTARTB, ISTOPB, IHI, + CALL ZLAQZ1( .TRUE., .TRUE., K+I+J, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NBLOCK, K+1, QC, LDQC, $ NBLOCK, K, ZC, LDZC ) END DO @@ -405,18 +412,22 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, $ LDQC, A( K+1, K+NS+NP ), LDA, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( K+1, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( K+1, $ K+NS+NP ), LDA ) CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, $ LDQC, B( K+1, K+NS+NP ), LDB, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( K+1, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( K+1, $ K+NS+NP ), LDB ) END IF IF ( ILQ ) THEN - CALL ZGEMM( 'N', 'N', N, NBLOCK, NBLOCK, CONE, Q( 1, K+1 ), + CALL ZGEMM( 'N', 'N', N, NBLOCK, NBLOCK, CONE, Q( 1, + $ K+1 ), $ LDQ, QC, LDQC, CZERO, WORK, N ) - CALL ZLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), LDQ ) + CALL ZLACPY( 'ALL', N, NBLOCK, WORK, N, Q( 1, K+1 ), + $ LDQ ) END IF * Update A(istartm:k,k:k+ns+npos-1) and B(istartm:k,k:k+ns+npos-1) @@ -459,7 +470,8 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, DO I = 1, NS * Chase the shift down to the bottom right corner DO ISHIFT = IHI-I, IHI-1 - CALL ZLAQZ1( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, IHI, + CALL ZLAQZ1( .TRUE., .TRUE., ISHIFT, ISTARTB, ISTOPB, + $ IHI, $ A, LDA, B, LDB, NS, IHI-NS+1, QC, LDQC, NS+1, $ IHI-NS, ZC, LDZC ) END DO @@ -473,17 +485,20 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, SHEIGHT = NS SWIDTH = ISTOPM-( IHI+1 )+1 IF ( SWIDTH > 0 ) THEN - CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ A( IHI-NS+1, IHI+1 ), LDA, CZERO, WORK, SHEIGHT ) CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ A( IHI-NS+1, IHI+1 ), LDA ) - CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, LDQC, + CALL ZGEMM( 'C', 'N', SHEIGHT, SWIDTH, SHEIGHT, CONE, QC, + $ LDQC, $ B( IHI-NS+1, IHI+1 ), LDB, CZERO, WORK, SHEIGHT ) CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, $ B( IHI-NS+1, IHI+1 ), LDB ) END IF IF ( ILQ ) THEN - CALL ZGEMM( 'N', 'N', N, NS, NS, CONE, Q( 1, IHI-NS+1 ), LDQ, + CALL ZGEMM( 'N', 'N', N, NS, NS, CONE, Q( 1, IHI-NS+1 ), + $ LDQ, $ QC, LDQC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, NS, WORK, N, Q( 1, IHI-NS+1 ), LDQ ) END IF @@ -496,16 +511,19 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, CALL ZGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ A( ISTARTM, IHI-NS ), LDA, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, A( ISTARTM, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ A( ISTARTM, $ IHI-NS ), LDA ) CALL ZGEMM( 'N', 'N', SHEIGHT, SWIDTH, SWIDTH, CONE, $ B( ISTARTM, IHI-NS ), LDB, ZC, LDZC, CZERO, WORK, $ SHEIGHT ) - CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, B( ISTARTM, + CALL ZLACPY( 'ALL', SHEIGHT, SWIDTH, WORK, SHEIGHT, + $ B( ISTARTM, $ IHI-NS ), LDB ) END IF IF ( ILZ ) THEN - CALL ZGEMM( 'N', 'N', N, NS+1, NS+1, CONE, Z( 1, IHI-NS ), LDZ, + CALL ZGEMM( 'N', 'N', N, NS+1, NS+1, CONE, Z( 1, IHI-NS ), + $ LDZ, $ ZC, LDZC, CZERO, WORK, N ) CALL ZLACPY( 'ALL', N, NS+1, WORK, N, Z( 1, IHI-NS ), LDZ ) END IF diff --git a/SRC/zlarf.f b/SRC/zlarf.f index a8bbf5f9f4..15127e6166 100644 --- a/SRC/zlarf.f +++ b/SRC/zlarf.f @@ -205,7 +205,8 @@ SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H * - CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) + CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, + $ LDC ) END IF ELSE * @@ -220,7 +221,8 @@ SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H * - CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) + CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, + $ LDC ) END IF END IF RETURN diff --git a/SRC/zlarfb.f b/SRC/zlarfb.f index 799a836665..beccaa0fdf 100644 --- a/SRC/zlarfb.f +++ b/SRC/zlarfb.f @@ -193,7 +193,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, + SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, + $ LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * * -- LAPACK auxiliary routine -- @@ -266,20 +267,23 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C2**H * V2 * - CALL ZGEMM( 'Conjugate transpose', 'No transpose', N, + CALL ZGEMM( 'Conjugate transpose', 'No transpose', + $ N, $ K, M-K, ONE, C( K+1, 1 ), LDC, $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**H or W * T * - CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**H @@ -320,13 +324,15 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C2 * V2 * - CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL ZGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, $ ONE, WORK, LDWORK ) END IF @@ -342,7 +348,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2**H * - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ N-K, K, -ONE, WORK, LDWORK, V( K+1, 1 ), $ LDV, ONE, C( 1, K+1 ), LDC ) END IF @@ -377,26 +384,30 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**H * DO 70 J = 1, K - CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) CALL ZLACGV( N, WORK( 1, J ), 1 ) 70 CONTINUE * * W := W * V2 * - CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C1**H * V1 * - CALL ZGEMM( 'Conjugate transpose', 'No transpose', N, + CALL ZGEMM( 'Conjugate transpose', 'No transpose', + $ N, $ K, M-K, ONE, C, LDC, V, LDV, ONE, WORK, $ LDWORK ) END IF * * W := W * T**H or W * T * - CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**H @@ -439,13 +450,15 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1 * - CALL ZGEMM( 'No transpose', 'No transpose', M, K, N-K, + CALL ZGEMM( 'No transpose', 'No transpose', M, K, + $ N-K, $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * @@ -460,7 +473,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1**H * - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ N-K, K, -ONE, WORK, LDWORK, V, LDV, ONE, $ C, LDC ) END IF @@ -518,7 +532,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**H or W * T * - CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**H * W**H @@ -535,7 +550,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V1 * - CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ N, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**H @@ -566,7 +582,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W + C2 * V2**H * - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ K, N-K, ONE, C( 1, K+1 ), LDC, $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK ) END IF @@ -582,14 +599,16 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C2 := C2 - W * V2 * - CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, $ C( 1, K+1 ), LDC ) END IF * * W := W * V1 * - CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit', + $ M, $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W @@ -617,7 +636,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * W := C2**H * DO 190 J = 1, K - CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), + $ 1 ) CALL ZLACGV( N, WORK( 1, J ), 1 ) 190 CONTINUE * @@ -637,7 +657,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * T**H or W * T * - CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, + $ K, $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**H * W**H @@ -653,7 +674,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W * V2 * - CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ N, $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**H @@ -686,7 +708,8 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * W := W + C1 * V1**H * - CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, + CALL ZGEMM( 'No transpose', 'Conjugate transpose', + $ M, $ K, N-K, ONE, C, LDC, V, LDV, ONE, WORK, $ LDWORK ) END IF @@ -702,13 +725,15 @@ SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, * * C1 := C1 - W * V1 * - CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, K, + CALL ZGEMM( 'No transpose', 'No transpose', M, N-K, + $ K, $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2 * - CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit', + $ M, $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) * * C1 := C1 - W diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f index a38cb8a8a8..cd3404f1c7 100644 --- a/SRC/zlarfgp.f +++ b/SRC/zlarfgp.f @@ -129,7 +129,8 @@ SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU ) * .. External Functions .. DOUBLE PRECISION DLAMCH, DLAPY3, DLAPY2, DZNRM2 COMPLEX*16 ZLADIV - EXTERNAL DLAMCH, DLAPY3, DLAPY2, DZNRM2, ZLADIV + EXTERNAL DLAMCH, DLAPY3, DLAPY2, DZNRM2, + $ ZLADIV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DIMAG, SIGN diff --git a/SRC/zlarft.f b/SRC/zlarft.f index 1995019a9a..958c77e27f 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -247,7 +247,8 @@ SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) * - CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) IF( I.GT.1 ) THEN @@ -299,14 +300,16 @@ SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H * - CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ), + 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 ) END IF * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) * - CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', K-I, + CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) IF( I.GT.1 ) THEN PREVLASTV = MIN( PREVLASTV, LASTV ) diff --git a/SRC/zlarrv.f b/SRC/zlarrv.f index 46cb6728d4..d18e6a2c9e 100644 --- a/SRC/zlarrv.f +++ b/SRC/zlarrv.f @@ -335,7 +335,8 @@ SUBROUTINE ZLARRV( N, VL, VU, D, L, PIVMIN, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLARRB, DLARRF, ZDSCAL, ZLAR1V, + EXTERNAL DCOPY, DLARRB, DLARRF, ZDSCAL, + $ ZLAR1V, $ ZLASET * .. * .. Intrinsic Functions .. diff --git a/SRC/zlarz.f b/SRC/zlarz.f index 3da8cb82d6..51f24f852b 100644 --- a/SRC/zlarz.f +++ b/SRC/zlarz.f @@ -167,7 +167,8 @@ SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) $ ZERO = ( 0.0D+0, 0.0D+0 ) ) * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV + EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, + $ ZLACGV * .. * .. External Functions .. LOGICAL LSAME @@ -188,7 +189,8 @@ SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )**H * v( 1:l ) ) * - CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ), + CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, + $ 1 ), $ LDC, V, INCV, ONE, WORK, 1 ) CALL ZLACGV( N, WORK, 1 ) * @@ -215,7 +217,8 @@ SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) * * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) * - CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, + CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), + $ LDC, $ V, INCV, ONE, WORK, 1 ) * * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) diff --git a/SRC/zlarzb.f b/SRC/zlarzb.f index 7d2102f865..584c3fade6 100644 --- a/SRC/zlarzb.f +++ b/SRC/zlarzb.f @@ -258,7 +258,8 @@ SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * * W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T or W( 1:m, 1:k ) * T * - CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T, + CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, + $ T, $ LDT, WORK, LDWORK ) * * C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**H @@ -273,7 +274,8 @@ SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, * V( 1:k, 1:l )**H * W( 1:n, 1:k )**H * IF( L.GT.0 ) - $ CALL ZGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV, + $ CALL ZGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, + $ LDV, $ WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC ) * ELSE IF( LSAME( SIDE, 'R' ) ) THEN @@ -299,7 +301,8 @@ SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, DO 50 J = 1, K CALL ZLACGV( K-J+1, T( J, J ), 1 ) 50 CONTINUE - CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T, + CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, + $ T, $ LDT, WORK, LDWORK ) DO 60 J = 1, K CALL ZLACGV( K-J+1, T( J, J ), 1 ) @@ -320,7 +323,8 @@ SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V, CALL ZLACGV( K, V( 1, J ), 1 ) 90 CONTINUE IF( L.GT.0 ) - $ CALL ZGEMM( 'No transpose', 'No transpose', M, L, K, -ONE, + $ CALL ZGEMM( 'No transpose', 'No transpose', M, L, K, + $ -ONE, $ WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC ) DO 100 J = 1, L CALL ZLACGV( K, V( 1, J ), 1 ) diff --git a/SRC/zlascl.f b/SRC/zlascl.f index 86b8329dc4..5001851cff 100644 --- a/SRC/zlascl.f +++ b/SRC/zlascl.f @@ -140,7 +140,8 @@ *> \ingroup lascl * * ===================================================================== - SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zlasr.f b/SRC/zlasr.f index 56e0967615..dbd3189947 100644 --- a/SRC/zlasr.f +++ b/SRC/zlasr.f @@ -238,12 +238,14 @@ SUBROUTINE ZLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) * Test the input parameters * INFO = 0 - IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN + IF( .NOT.( LSAME( SIDE, 'L' ) .OR. + $ LSAME( SIDE, 'R' ) ) ) THEN INFO = 1 ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN INFO = 2 - ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) + ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. + $ LSAME( DIRECT, 'B' ) ) ) $ THEN INFO = 3 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/zlasyf.f b/SRC/zlasyf.f index f09696a36a..0f10c6af21 100644 --- a/SRC/zlasyf.f +++ b/SRC/zlasyf.f @@ -174,7 +174,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) + SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -253,7 +254,8 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * CALL ZCOPY( K, A( 1, K ), 1, W( 1, KW ), 1 ) IF( K.LT.N ) - $ CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), LDA, + $ CALL ZGEMV( 'No transpose', K, N-K, -CONE, A( 1, K+1 ), + $ LDA, $ W( K, KW+1 ), LDW, CONE, W( 1, KW ), 1 ) * KSTEP = 1 @@ -548,7 +550,8 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * Copy column K of A to column K of W and update it * CALL ZCOPY( N-K+1, A( K, K ), 1, W( K, K ), 1 ) - CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), LDA, + CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + $ LDA, $ W( K, 1 ), LDW, CONE, W( K, K ), 1 ) * KSTEP = 1 @@ -585,10 +588,13 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * Copy column IMAX to column K+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1 ) - CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, K+1 ), + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), $ 1 ) - CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, 1 ), + CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, W( IMAX, + $ K+1 ), + $ 1 ) + CALL ZGEMV( 'No transpose', N-K+1, K-1, -CONE, A( K, + $ 1 ), $ LDA, W( IMAX, 1 ), LDW, CONE, W( K, K+1 ), $ 1 ) * @@ -647,7 +653,8 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) CALL ZCOPY( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) IF( KP.LT.N ) - $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZCOPY( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) * * Interchange rows KK and KP in first K-1 columns of A * (columns K (or K and K+1 for 2-by-2 pivot) of A will be diff --git a/SRC/zlasyf_aa.f b/SRC/zlasyf_aa.f index 4cd0597dd5..d27ab74b17 100644 --- a/SRC/zlasyf_aa.f +++ b/SRC/zlasyf_aa.f @@ -173,7 +173,8 @@ SUBROUTINE ZLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, EXTERNAL LSAME, ILAENV, IZAMAX * .. * .. External Subroutines .. - EXTERNAL ZGEMV, ZAXPY, ZSCAL, ZCOPY, ZSWAP, ZLASET, + EXTERNAL ZGEMV, ZAXPY, ZSCAL, ZCOPY, ZSWAP, + $ ZLASET, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/zlasyf_rk.f b/SRC/zlasyf_rk.f index 7c98c27b61..7f1d1d0f58 100644 --- a/SRC/zlasyf_rk.f +++ b/SRC/zlasyf_rk.f @@ -415,7 +415,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL ZCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL ZCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL ZCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -514,7 +515,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * and last N-K+2 columns of W * CALL ZSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -531,7 +533,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL ZSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL ZSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL ZSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -738,7 +741,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -758,7 +762,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = CABS1( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -780,7 +785,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -806,7 +812,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -841,7 +848,8 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL ZCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL ZCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL ZCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/zlasyf_rook.f b/SRC/zlasyf_rook.f index b5d26a7a0a..16ecd98bd0 100644 --- a/SRC/zlasyf_rook.f +++ b/SRC/zlasyf_rook.f @@ -326,7 +326,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column KW-1 of W and update it * - CALL ZCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), 1 ) + CALL ZCOPY( IMAX, A( 1, IMAX ), 1, W( 1, KW-1 ), + $ 1 ) CALL ZCOPY( K-IMAX, A( IMAX, IMAX+1 ), LDA, $ W( IMAX+1, KW-1 ), 1 ) * @@ -425,7 +426,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * and last N-K+2 columns of W * CALL ZSWAP( N-K+1, A( K, K ), LDA, A( P, K ), LDA ) - CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), LDW ) + CALL ZSWAP( N-KK+1, W( K, KKW ), LDW, W( P, KKW ), + $ LDW ) END IF * * Updated column KP is already stored in column KKW of W @@ -442,7 +444,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Interchange rows KK and KP in last N-KK+1 columns * of A and W * - CALL ZSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), LDA ) + CALL ZSWAP( N-KK+1, A( KK, KK ), LDA, A( KP, KK ), + $ LDA ) CALL ZSWAP( N-KK+1, W( KK, KKW ), LDW, W( KP, KKW ), $ LDW ) END IF @@ -652,7 +655,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy column IMAX to column K+1 of W and update it * - CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), 1) + CALL ZCOPY( IMAX-K, A( IMAX, K ), LDA, W( K, K+1 ), + $ 1) CALL ZCOPY( N-IMAX+1, A( IMAX, IMAX ), 1, $ W( IMAX, K+1 ), 1 ) IF( K.GT.1 ) @@ -672,7 +676,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), 1) + ITEMP = IMAX + IZAMAX( N-IMAX, W( IMAX+1, K+1 ), + $ 1) DTEMP = CABS1( W( ITEMP, K+1 ) ) IF( DTEMP.GT.ROWMAX ) THEN ROWMAX = DTEMP @@ -694,7 +699,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * copy column K+1 of W to column K of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * DONE = .TRUE. * @@ -720,7 +726,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * Copy updated JMAXth (next IMAXth) column to Kth of W * - CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), 1 ) + CALL ZCOPY( N-K+1, W( K, K+1 ), 1, W( K, K ), + $ 1 ) * END IF * @@ -755,7 +762,8 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * Copy non-updated column KK to column KP * A( KP, K ) = A( KK, K ) - CALL ZCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), LDA ) + CALL ZCOPY( KP-K-1, A( K+1, KK ), 1, A( KP, K+1 ), + $ LDA ) CALL ZCOPY( N-KP+1, A( KP, KK ), 1, A( KP, KP ), 1 ) * * Interchange rows KK and KP in first KK columns of A and W diff --git a/SRC/zlatbs.f b/SRC/zlatbs.f index 1c57e1bf5a..bb6329cd9b 100644 --- a/SRC/zlatbs.f +++ b/SRC/zlatbs.f @@ -239,7 +239,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, + SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, + $ X, $ SCALE, CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -275,7 +276,8 @@ SUBROUTINE ZLATBS( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, INTEGER IDAMAX, IZAMAX DOUBLE PRECISION DLAMCH, DZASUM COMPLEX*16 ZDOTC, ZDOTU, ZLADIV - EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC, + EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, + $ ZDOTC, $ ZDOTU, ZLADIV * .. * .. External Subroutines .. diff --git a/SRC/zlatdf.f b/SRC/zlatdf.f index 69263c0374..65a4c77205 100644 --- a/SRC/zlatdf.f +++ b/SRC/zlatdf.f @@ -201,7 +201,8 @@ SUBROUTINE ZLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, COMPLEX*16 WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM ) * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZGECON, ZGESC2, ZLASSQ, ZLASWP, + EXTERNAL ZAXPY, ZCOPY, ZGECON, ZGESC2, ZLASSQ, + $ ZLASWP, $ ZSCAL * .. * .. External Functions .. @@ -233,7 +234,8 @@ SUBROUTINE ZLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, * SPLUS = SPLUS + DBLE( ZDOTC( N-J, Z( J+1, J ), 1, Z( J+1, $ J ), 1 ) ) - SMINU = DBLE( ZDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) ) + SMINU = DBLE( ZDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), + $ 1 ) ) SPLUS = SPLUS*DBLE( RHS( J ) ) IF( SPLUS.GT.SMINU ) THEN RHS( J ) = BP diff --git a/SRC/zlatps.f b/SRC/zlatps.f index bb868bfaf5..e1c12b224a 100644 --- a/SRC/zlatps.f +++ b/SRC/zlatps.f @@ -263,7 +263,8 @@ SUBROUTINE ZLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, INTEGER IDAMAX, IZAMAX DOUBLE PRECISION DLAMCH, DZASUM COMPLEX*16 ZDOTC, ZDOTU, ZLADIV - EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC, + EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, + $ ZDOTC, $ ZDOTU, ZLADIV * .. * .. External Subroutines .. @@ -660,7 +661,8 @@ SUBROUTINE ZLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * Compute the update * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) * - CALL ZAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, X, + CALL ZAXPY( J-1, -X( J )*TSCAL, AP( IP-J+1 ), 1, + $ X, $ 1 ) I = IZAMAX( J-1, X, 1 ) XMAX = CABS1( X( I ) ) diff --git a/SRC/zlatrd.f b/SRC/zlatrd.f index 184c66d0d6..cc3cbfb51f 100644 --- a/SRC/zlatrd.f +++ b/SRC/zlatrd.f @@ -224,7 +224,8 @@ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG, ZSCAL + EXTERNAL ZAXPY, ZGEMV, ZHEMV, ZLACGV, ZLARFG, + $ ZSCAL * .. * .. External Functions .. LOGICAL LSAME @@ -257,7 +258,8 @@ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) $ LDA, W( I, IW+1 ), LDW, ONE, A( 1, I ), 1 ) CALL ZLACGV( N-I, W( I, IW+1 ), LDW ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) - CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1, IW+1 ), + CALL ZGEMV( 'No transpose', I, N-I, -ONE, W( 1, + $ IW+1 ), $ LDW, A( I, I+1 ), LDA, ONE, A( 1, I ), 1 ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) A( I, I ) = DBLE( A( I, I ) ) @@ -333,17 +335,20 @@ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW ) CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, $ W( I+1, 1 ), LDW, A( I+1, I ), 1, ZERO, $ W( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, 1 ), + CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, A( I+1, + $ 1 ), $ LDA, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, $ A( I+1, 1 ), LDA, A( I+1, I ), 1, ZERO, $ W( 1, I ), 1 ) - CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, 1 ), + CALL ZGEMV( 'No transpose', N-I, I-1, -ONE, W( I+1, + $ 1 ), $ LDW, W( 1, I ), 1, ONE, W( I+1, I ), 1 ) CALL ZSCAL( N-I, TAU( I ), W( I+1, I ), 1 ) ALPHA = -HALF*TAU( I )*ZDOTC( N-I, W( I+1, I ), 1, $ A( I+1, I ), 1 ) - CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), 1 ) + CALL ZAXPY( N-I, ALPHA, A( I+1, I ), 1, W( I+1, I ), + $ 1 ) END IF * 20 CONTINUE diff --git a/SRC/zlatrs.f b/SRC/zlatrs.f index b9e463b575..4b06c227b0 100644 --- a/SRC/zlatrs.f +++ b/SRC/zlatrs.f @@ -235,7 +235,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, + SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, + $ SCALE, $ CNORM, INFO ) * * -- LAPACK auxiliary routine -- @@ -271,7 +272,8 @@ SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, INTEGER IDAMAX, IZAMAX DOUBLE PRECISION DLAMCH, DZASUM COMPLEX*16 ZDOTC, ZDOTU, ZLADIV - EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, ZDOTC, + EXTERNAL LSAME, IDAMAX, IZAMAX, DLAMCH, DZASUM, + $ ZDOTC, $ ZDOTU, ZLADIV * .. * .. External Subroutines .. @@ -787,7 +789,8 @@ SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, IF( UPPER ) THEN CSUMJ = ZDOTU( J-1, A( 1, J ), 1, X, 1 ) ELSE IF( J.LT.N ) THEN - CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) + CSUMJ = ZDOTU( N-J, A( J+1, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * @@ -921,7 +924,8 @@ SUBROUTINE ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, IF( UPPER ) THEN CSUMJ = ZDOTC( J-1, A( 1, J ), 1, X, 1 ) ELSE IF( J.LT.N ) THEN - CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), 1 ) + CSUMJ = ZDOTC( N-J, A( J+1, J ), 1, X( J+1 ), + $ 1 ) END IF ELSE * diff --git a/SRC/zlatrs3.f b/SRC/zlatrs3.f index 7dff18f1e8..c352e6e3b8 100644 --- a/SRC/zlatrs3.f +++ b/SRC/zlatrs3.f @@ -271,7 +271,8 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, ZLANGE, DLARMM - EXTERNAL ILAENV, LSAME, DLAMCH, ZLANGE, DLARMM + EXTERNAL ILAENV, LSAME, DLAMCH, ZLANGE, + $ DLARMM * .. * .. External Subroutines .. EXTERNAL ZLATRS, ZDSCAL, XERBLA @@ -373,7 +374,8 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, CALL ZLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X( 1, 1), $ SCALE( 1 ), CNORM, INFO ) DO K = 2, NRHS - CALL ZLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, K ), + CALL ZLATRS( UPLO, TRANS, DIAG, 'Y', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -400,10 +402,12 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute upper bound of A( I1:I2-1, J1:J2-1 ). * IF( NOTRAN ) THEN - ANRM = ZLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = ZLANGE( 'I', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + I+(J-1)*NBA ) = ANRM ELSE - ANRM = ZLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, W ) + ANRM = ZLANGE( '1', I2-I1, J2-J1, A( I1, J1 ), LDA, + $ W ) WORK( AWRK + J+(I-1) * NBA ) = ANRM END IF TMAX = MAX( TMAX, ANRM ) @@ -420,7 +424,8 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * in the computation of the column norms CNORM. * DO K = 1, NRHS - CALL ZLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, K ), + CALL ZLATRS( UPLO, TRANS, DIAG, 'N', N, A, LDA, X( 1, + $ K ), $ SCALE( K ), CNORM, INFO ) END DO RETURN @@ -603,7 +608,8 @@ SUBROUTINE ZLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * Compute scaling factor to survive the linear update * simulating consistent scaling. * - BNRM = ZLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, W ) + BNRM = ZLANGE( 'I', I2-I1, 1, X( I1, RHS ), LDX, + $ W ) BNRM = BNRM*( SCAMIN / WORK( I+KK*LDS ) ) XNRM( KK ) = XNRM( KK )*( SCAMIN / WORK( J+KK*LDS) ) ANRM = WORK( AWRK + I+(J-1)*NBA ) diff --git a/SRC/zlaunhr_col_getrfnp.f b/SRC/zlaunhr_col_getrfnp.f index cce56382a2..f2835e8b7a 100644 --- a/SRC/zlaunhr_col_getrfnp.f +++ b/SRC/zlaunhr_col_getrfnp.f @@ -167,7 +167,8 @@ SUBROUTINE ZLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) INTEGER IINFO, J, JB, NB * .. * .. External Subroutines .. - EXTERNAL ZGEMM, ZLAUNHR_COL_GETRFNP2, ZTRSM, XERBLA + EXTERNAL ZGEMM, ZLAUNHR_COL_GETRFNP2, ZTRSM, + $ XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -224,14 +225,16 @@ SUBROUTINE ZLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) * * Compute block row of U. * - CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', + $ JB, $ N-J-JB+1, CONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * - CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1, + CALL ZGEMM( 'No transpose', 'No transpose', + $ M-J-JB+1, $ N-J-JB+1, JB, -CONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, CONE, A( J+JB, J+JB ), $ LDA ) diff --git a/SRC/zlaunhr_col_getrfnp2.f b/SRC/zlaunhr_col_getrfnp2.f index cc9b41e70b..14273231ff 100644 --- a/SRC/zlaunhr_col_getrfnp2.f +++ b/SRC/zlaunhr_col_getrfnp2.f @@ -164,7 +164,8 @@ *> \endverbatim * * ===================================================================== - RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, + $ INFO ) IMPLICIT NONE * * -- LAPACK computational routine -- @@ -296,7 +297,8 @@ RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) * Update B22, i.e. compute the Schur complement * B22 := B22 - B21*B12 * - CALL ZGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), LDA, + CALL ZGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), + $ LDA, $ A( 1, N1+1 ), LDA, CONE, A( N1+1, N1+1 ), LDA ) * * Factor B22, recursive call diff --git a/SRC/zlauu2.f b/SRC/zlauu2.f index 7d4ca49c24..dc6cd19ead 100644 --- a/SRC/zlauu2.f +++ b/SRC/zlauu2.f @@ -165,10 +165,12 @@ SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO ) DO 10 I = 1, N AII = DBLE( A( I, I ) ) IF( I.LT.N ) THEN - A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA, + A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), + $ LDA, $ A( I, I+1 ), LDA ) ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) - CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, I+1 ), + CALL ZGEMV( 'No transpose', I-1, N-I, ONE, A( 1, + $ I+1 ), $ LDA, A( I, I+1 ), LDA, DCMPLX( AII ), $ A( 1, I ), 1 ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) @@ -184,7 +186,8 @@ SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO ) DO 20 I = 1, N AII = DBLE( A( I, I ) ) IF( I.LT.N ) THEN - A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1, + A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), + $ 1, $ A( I+1, I ), 1 ) ) CALL ZLACGV( I-1, A( I, 1 ), LDA ) CALL ZGEMV( 'Conjugate transpose', N-I, I-1, ONE, diff --git a/SRC/zlauum.f b/SRC/zlauum.f index 6f4ab7746e..2cb1d6f474 100644 --- a/SRC/zlauum.f +++ b/SRC/zlauum.f @@ -203,7 +203,8 @@ SUBROUTINE ZLAUUM( UPLO, N, A, LDA, INFO ) $ A( I, 1 ), LDA ) CALL ZLAUU2( 'Lower', IB, A( I, I ), LDA, INFO ) IF( I+IB.LE.N ) THEN - CALL ZGEMM( 'Conjugate transpose', 'No transpose', IB, + CALL ZGEMM( 'Conjugate transpose', 'No transpose', + $ IB, $ I-1, N-I-IB+1, CONE, A( I+IB, I ), LDA, $ A( I+IB, 1 ), LDA, CONE, A( I, 1 ), LDA ) CALL ZHERK( 'Lower', 'Conjugate transpose', IB, diff --git a/SRC/zpbcon.f b/SRC/zpbcon.f index 26c8cb703d..c9a03fe12f 100644 --- a/SRC/zpbcon.f +++ b/SRC/zpbcon.f @@ -232,13 +232,15 @@ SUBROUTINE ZPBCON( UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, * * Multiply by inv(U). * - CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATBS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL ZLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATBS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ KD, AB, LDAB, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/zpbequ.f b/SRC/zpbequ.f index 5f32d3e21d..0c842fbacd 100644 --- a/SRC/zpbequ.f +++ b/SRC/zpbequ.f @@ -127,7 +127,8 @@ *> \ingroup pbequ * * ===================================================================== - SUBROUTINE ZPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) + SUBROUTINE ZPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zpbrfs.f b/SRC/zpbrfs.f index 3ce6f0f223..f6186cc76b 100644 --- a/SRC/zpbrfs.f +++ b/SRC/zpbrfs.f @@ -226,7 +226,8 @@ SUBROUTINE ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHBMV, ZLACN2, ZPBTRS + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHBMV, ZLACN2, + $ ZPBTRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN @@ -412,7 +413,8 @@ SUBROUTINE ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * * Multiply by diag(W)*inv(A**H). * - CALL ZPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, INFO ) + CALL ZPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -423,7 +425,8 @@ SUBROUTINE ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL ZPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, INFO ) + CALL ZPBTRS( UPLO, N, KD, 1, AFB, LDAFB, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/zpbsv.f b/SRC/zpbsv.f index c591d9a794..e08950a454 100644 --- a/SRC/zpbsv.f +++ b/SRC/zpbsv.f @@ -192,7 +192,8 @@ SUBROUTINE ZPBSV( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zpbsvx.f b/SRC/zpbsvx.f index 73a8291a4a..423077b258 100644 --- a/SRC/zpbsvx.f +++ b/SRC/zpbsvx.f @@ -337,7 +337,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, + SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, + $ LDAFB, $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, $ WORK, RWORK, INFO ) * @@ -373,7 +374,8 @@ SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EXTERNAL LSAME, DLAMCH, ZLANHB * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAQHB, ZPBCON, ZPBEQU, + EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAQHB, ZPBCON, + $ ZPBEQU, $ ZPBRFS, ZPBTRF, ZPBTRS * .. * .. Intrinsic Functions .. @@ -396,7 +398,9 @@ SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN @@ -453,7 +457,8 @@ SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Equilibrate the matrix. * - CALL ZLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) + CALL ZLAQHB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, + $ EQUED ) RCEQU = LSAME( EQUED, 'Y' ) END IF END IF @@ -501,7 +506,8 @@ SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * * Compute the reciprocal of the condition number of A. * - CALL ZPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, RWORK, + CALL ZPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, + $ RWORK, $ INFO ) * * Compute the solution matrix X. @@ -512,7 +518,8 @@ SUBROUTINE ZPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, + CALL ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/zpbtrf.f b/SRC/zpbtrf.f index 3202d0f629..3c1c8b54a3 100644 --- a/SRC/zpbtrf.f +++ b/SRC/zpbtrf.f @@ -175,7 +175,8 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZHERK, ZPBTF2, ZPOTF2, ZTRSM + EXTERNAL XERBLA, ZGEMM, ZHERK, ZPBTF2, ZPOTF2, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC MIN @@ -272,14 +273,16 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A12 * - CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', + CALL ZTRSM( 'Left', 'Upper', + $ 'Conjugate transpose', $ 'Non-unit', IB, I2, CONE, $ AB( KD+1, I ), LDAB-1, $ AB( KD+1-IB, I+IB ), LDAB-1 ) * * Update A22 * - CALL ZHERK( 'Upper', 'Conjugate transpose', I2, IB, + CALL ZHERK( 'Upper', 'Conjugate transpose', I2, + $ IB, $ -ONE, AB( KD+1-IB, I+IB ), LDAB-1, ONE, $ AB( KD+1, I+IB ), LDAB-1 ) END IF @@ -296,7 +299,8 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A13 (in the work array). * - CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', + CALL ZTRSM( 'Left', 'Upper', + $ 'Conjugate transpose', $ 'Non-unit', IB, I3, CONE, $ AB( KD+1, I ), LDAB-1, WORK, LDWORK ) * @@ -311,7 +315,8 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A33 * - CALL ZHERK( 'Upper', 'Conjugate transpose', I3, IB, + CALL ZHERK( 'Upper', 'Conjugate transpose', I3, + $ IB, $ -ONE, WORK, LDWORK, ONE, $ AB( KD+1, I+KD ), LDAB-1 ) * @@ -381,7 +386,8 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A22 * - CALL ZHERK( 'Lower', 'No transpose', I2, IB, -ONE, + CALL ZHERK( 'Lower', 'No transpose', I2, IB, + $ -ONE, $ AB( 1+IB, I ), LDAB-1, ONE, $ AB( 1, I+IB ), LDAB-1 ) END IF @@ -414,7 +420,8 @@ SUBROUTINE ZPBTRF( UPLO, N, KD, AB, LDAB, INFO ) * * Update A33 * - CALL ZHERK( 'Lower', 'No transpose', I3, IB, -ONE, + CALL ZHERK( 'Lower', 'No transpose', I3, IB, + $ -ONE, $ WORK, LDWORK, ONE, AB( 1, I+KD ), $ LDAB-1 ) * diff --git a/SRC/zpbtrs.f b/SRC/zpbtrs.f index 5272697d1a..8f47f07d9d 100644 --- a/SRC/zpbtrs.f +++ b/SRC/zpbtrs.f @@ -185,12 +185,14 @@ SUBROUTINE ZPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL ZTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ KD, AB, LDAB, B( 1, J ), 1 ) * * Solve U*X = B, overwriting B with X. * - CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB, + CALL ZTBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) 10 CONTINUE ELSE @@ -201,12 +203,14 @@ SUBROUTINE ZPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) * * Solve L*X = B, overwriting B with X. * - CALL ZTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB, + CALL ZTBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, + $ AB, $ LDAB, B( 1, J ), 1 ) * * Solve L**H *X = B, overwriting B with X. * - CALL ZTBSV( 'Lower', 'Conjugate transpose', 'Non-unit', N, + CALL ZTBSV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ N, $ KD, AB, LDAB, B( 1, J ), 1 ) 20 CONTINUE END IF diff --git a/SRC/zpftrf.f b/SRC/zpftrf.f index 3c5689c8e7..8e641cad58 100644 --- a/SRC/zpftrf.f +++ b/SRC/zpftrf.f @@ -305,7 +305,8 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'L', N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'R', 'L', 'C', 'N', N2, N1, CONE, A( 0 ), N, + CALL ZTRSM( 'R', 'L', 'C', 'N', N2, N1, CONE, A( 0 ), + $ N, $ A( N1 ), N ) CALL ZHERK( 'U', 'N', N2, N1, -ONE, A( N1 ), N, ONE, $ A( N ), N ) @@ -322,7 +323,8 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'L', N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'L', 'L', 'N', 'N', N1, N2, CONE, A( N2 ), N, + CALL ZTRSM( 'L', 'L', 'N', 'N', N1, N2, CONE, A( N2 ), + $ N, $ A( 0 ), N ) CALL ZHERK( 'U', 'C', N2, N1, -ONE, A( 0 ), N, ONE, $ A( N1 ), N ) @@ -345,9 +347,11 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'U', N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'L', 'U', 'C', 'N', N1, N2, CONE, A( 0 ), N1, + CALL ZTRSM( 'L', 'U', 'C', 'N', N1, N2, CONE, A( 0 ), + $ N1, $ A( N1*N1 ), N1 ) - CALL ZHERK( 'L', 'C', N2, N1, -ONE, A( N1*N1 ), N1, ONE, + CALL ZHERK( 'L', 'C', N2, N1, -ONE, A( N1*N1 ), N1, + $ ONE, $ A( 1 ), N1 ) CALL ZPOTRF( 'L', N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -362,7 +366,8 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'U', N1, A( N2*N2 ), N2, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'R', 'U', 'N', 'N', N2, N1, CONE, A( N2*N2 ), + CALL ZTRSM( 'R', 'U', 'N', 'N', N2, N1, CONE, + $ A( N2*N2 ), $ N2, A( 0 ), N2 ) CALL ZHERK( 'L', 'N', N2, N1, -ONE, A( 0 ), N2, ONE, $ A( N1*N2 ), N2 ) @@ -391,7 +396,8 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'L', K, A( 1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'R', 'L', 'C', 'N', K, K, CONE, A( 1 ), N+1, + CALL ZTRSM( 'R', 'L', 'C', 'N', K, K, CONE, A( 1 ), + $ N+1, $ A( K+1 ), N+1 ) CALL ZHERK( 'U', 'N', K, K, -ONE, A( K+1 ), N+1, ONE, $ A( 0 ), N+1 ) @@ -431,9 +437,11 @@ SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) CALL ZPOTRF( 'U', K, A( 0+K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRSM( 'L', 'U', 'C', 'N', K, K, CONE, A( K ), N1, + CALL ZTRSM( 'L', 'U', 'C', 'N', K, K, CONE, A( K ), + $ N1, $ A( K*( K+1 ) ), K ) - CALL ZHERK( 'L', 'C', K, K, -ONE, A( K*( K+1 ) ), K, ONE, + CALL ZHERK( 'L', 'C', K, K, -ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( 0 ), K ) CALL ZPOTRF( 'L', K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) diff --git a/SRC/zpftri.f b/SRC/zpftri.f index 8aa9bf1fbd..7e045d6060 100644 --- a/SRC/zpftri.f +++ b/SRC/zpftri.f @@ -238,7 +238,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZTFTRI, ZLAUUM, ZTRMM, ZHERK + EXTERNAL XERBLA, ZTFTRI, ZLAUUM, ZTRMM, + $ ZHERK * .. * .. Intrinsic Functions .. INTRINSIC MOD @@ -313,7 +314,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'L', N1, A( 0 ), N, INFO ) CALL ZHERK( 'L', 'C', N1, N2, ONE, A( N1 ), N, ONE, $ A( 0 ), N ) - CALL ZTRMM( 'L', 'U', 'N', 'N', N2, N1, CONE, A( N ), N, + CALL ZTRMM( 'L', 'U', 'N', 'N', N2, N1, CONE, A( N ), + $ N, $ A( N1 ), N ) CALL ZLAUUM( 'U', N2, A( N ), N, INFO ) * @@ -326,7 +328,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'L', N1, A( N2 ), N, INFO ) CALL ZHERK( 'L', 'N', N1, N2, ONE, A( 0 ), N, ONE, $ A( N2 ), N ) - CALL ZTRMM( 'R', 'U', 'C', 'N', N1, N2, CONE, A( N1 ), N, + CALL ZTRMM( 'R', 'U', 'C', 'N', N1, N2, CONE, A( N1 ), + $ N, $ A( 0 ), N ) CALL ZLAUUM( 'U', N2, A( N1 ), N, INFO ) * @@ -342,9 +345,11 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0), T2 -> a(1), S -> a(0+N1*N1) * CALL ZLAUUM( 'U', N1, A( 0 ), N1, INFO ) - CALL ZHERK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, ONE, + CALL ZHERK( 'U', 'N', N1, N2, ONE, A( N1*N1 ), N1, + $ ONE, $ A( 0 ), N1 ) - CALL ZTRMM( 'R', 'L', 'N', 'N', N1, N2, CONE, A( 1 ), N1, + CALL ZTRMM( 'R', 'L', 'N', 'N', N1, N2, CONE, A( 1 ), + $ N1, $ A( N1*N1 ), N1 ) CALL ZLAUUM( 'L', N2, A( 1 ), N1, INFO ) * @@ -356,7 +361,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'U', N1, A( N2*N2 ), N2, INFO ) CALL ZHERK( 'U', 'C', N1, N2, ONE, A( 0 ), N2, ONE, $ A( N2*N2 ), N2 ) - CALL ZTRMM( 'L', 'L', 'C', 'N', N2, N1, CONE, A( N1*N2 ), + CALL ZTRMM( 'L', 'L', 'C', 'N', N2, N1, CONE, + $ A( N1*N2 ), $ N2, A( 0 ), N2 ) CALL ZLAUUM( 'L', N2, A( N1*N2 ), N2, INFO ) * @@ -381,7 +387,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'L', K, A( 1 ), N+1, INFO ) CALL ZHERK( 'L', 'C', K, K, ONE, A( K+1 ), N+1, ONE, $ A( 1 ), N+1 ) - CALL ZTRMM( 'L', 'U', 'N', 'N', K, K, CONE, A( 0 ), N+1, + CALL ZTRMM( 'L', 'U', 'N', 'N', K, K, CONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) CALL ZLAUUM( 'U', K, A( 0 ), N+1, INFO ) * @@ -394,7 +401,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'L', K, A( K+1 ), N+1, INFO ) CALL ZHERK( 'L', 'N', K, K, ONE, A( 0 ), N+1, ONE, $ A( K+1 ), N+1 ) - CALL ZTRMM( 'R', 'U', 'C', 'N', K, K, CONE, A( K ), N+1, + CALL ZTRMM( 'R', 'U', 'C', 'N', K, K, CONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) CALL ZLAUUM( 'U', K, A( K ), N+1, INFO ) * @@ -411,7 +419,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) * T1 -> a(0+k), T2 -> a(0+0), S -> a(0+k*(k+1)); lda=k * CALL ZLAUUM( 'U', K, A( K ), K, INFO ) - CALL ZHERK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, ONE, + CALL ZHERK( 'U', 'N', K, K, ONE, A( K*( K+1 ) ), K, + $ ONE, $ A( K ), K ) CALL ZTRMM( 'R', 'L', 'N', 'N', K, K, CONE, A( 0 ), K, $ A( K*( K+1 ) ), K ) @@ -426,7 +435,8 @@ SUBROUTINE ZPFTRI( TRANSR, UPLO, N, A, INFO ) CALL ZLAUUM( 'U', K, A( K*( K+1 ) ), K, INFO ) CALL ZHERK( 'U', 'C', K, K, ONE, A( 0 ), K, ONE, $ A( K*( K+1 ) ), K ) - CALL ZTRMM( 'L', 'L', 'C', 'N', K, K, CONE, A( K*K ), K, + CALL ZTRMM( 'L', 'L', 'C', 'N', K, K, CONE, A( K*K ), + $ K, $ A( 0 ), K ) CALL ZLAUUM( 'L', K, A( K*K ), K, INFO ) * diff --git a/SRC/zpftrs.f b/SRC/zpftrs.f index def00e3608..5b274d64a7 100644 --- a/SRC/zpftrs.f +++ b/SRC/zpftrs.f @@ -281,14 +281,18 @@ SUBROUTINE ZPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO ) * start execution: there are two triangular solves * IF( LOWER ) THEN - CALL ZTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, B, + CALL ZTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) - CALL ZTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, B, + CALL ZTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) ELSE - CALL ZTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, B, + CALL ZTFSM( TRANSR, 'L', UPLO, 'C', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) - CALL ZTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, B, + CALL ZTFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, CONE, A, + $ B, $ LDB ) END IF * diff --git a/SRC/zpocon.f b/SRC/zpocon.f index fc129dd68c..3b07832731 100644 --- a/SRC/zpocon.f +++ b/SRC/zpocon.f @@ -217,13 +217,15 @@ SUBROUTINE ZPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, * * Multiply by inv(U). * - CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ A, LDA, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/zporfs.f b/SRC/zporfs.f index 160f0defa8..cf200c932d 100644 --- a/SRC/zporfs.f +++ b/SRC/zporfs.f @@ -220,7 +220,8 @@ SUBROUTINE ZPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHEMV, ZLACN2, ZPOTRS + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHEMV, ZLACN2, + $ ZPOTRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -293,7 +294,8 @@ SUBROUTINE ZPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * Compute residual R = B - A * X * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL ZHEMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * diff --git a/SRC/zporfsx.f b/SRC/zporfsx.f index c81bb097b2..29f7c8a391 100644 --- a/SRC/zporfsx.f +++ b/SRC/zporfsx.f @@ -387,7 +387,8 @@ *> \ingroup porfsx * * ===================================================================== - SUBROUTINE ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, + SUBROUTINE ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, + $ B, $ LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -452,7 +453,8 @@ SUBROUTINE ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL DLAMCH, ZLANHE, ZLA_PORCOND_X, ZLA_PORCOND_C + EXTERNAL DLAMCH, ZLANHE, ZLA_PORCOND_X, + $ ZLA_PORCOND_C DOUBLE PRECISION DLAMCH, ZLANHE, ZLA_PORCOND_X, ZLA_PORCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -509,7 +511,8 @@ SUBROUTINE ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, * * Test input parameters. * - IF (.NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF (.NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -595,7 +598,8 @@ SUBROUTINE ZPORFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, S, B, $ INFO ) END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF ( N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1 ) THEN * * Compute scaled normwise condition number cond(A*C). diff --git a/SRC/zposv.f b/SRC/zposv.f index 82ef534f31..8db30067c0 100644 --- a/SRC/zposv.f +++ b/SRC/zposv.f @@ -158,7 +158,8 @@ SUBROUTINE ZPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zposvx.f b/SRC/zposvx.f index 9a24c28175..b857c5efb5 100644 --- a/SRC/zposvx.f +++ b/SRC/zposvx.f @@ -301,7 +301,8 @@ *> \ingroup posvx * * ===================================================================== - SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, $ RWORK, INFO ) * @@ -337,7 +338,8 @@ SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, EXTERNAL LSAME, DLAMCH, ZLANHE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACPY, ZLAQHE, ZPOCON, ZPOEQU, ZPORFS, + EXTERNAL XERBLA, ZLACPY, ZLAQHE, ZPOCON, ZPOEQU, + $ ZPORFS, $ ZPOTRF, ZPOTRS * .. * .. Intrinsic Functions .. @@ -359,10 +361,13 @@ SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -451,7 +456,8 @@ SUBROUTINE ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, * * Compute the reciprocal of the condition number of A. * - CALL ZPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) + CALL ZPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * Compute the solution matrix X. * diff --git a/SRC/zposvxx.f b/SRC/zposvxx.f index af6fd4f7f6..1cb1b613a2 100644 --- a/SRC/zposvxx.f +++ b/SRC/zposvxx.f @@ -487,7 +487,8 @@ *> \ingroup posvxx * * ===================================================================== - SUBROUTINE ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, + SUBROUTINE ZPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ EQUED, $ S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) diff --git a/SRC/zpotf2.f b/SRC/zpotf2.f index 32c1eec7e6..37322bb443 100644 --- a/SRC/zpotf2.f +++ b/SRC/zpotf2.f @@ -202,7 +202,8 @@ SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO ) * * Compute L(J,J) and test for non-positive-definiteness. * - AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( J, 1 ), LDA, + AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( J, 1 ), + $ LDA, $ A( J, 1 ), LDA ) ) IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN A( J, J ) = AJJ @@ -215,7 +216,8 @@ SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO ) * IF( J.LT.N ) THEN CALL ZLACGV( J-1, A( J, 1 ), LDA ) - CALL ZGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, 1 ), + CALL ZGEMV( 'No transpose', N-J, J-1, -CONE, A( J+1, + $ 1 ), $ LDA, A( J, 1 ), LDA, CONE, A( J+1, J ), 1 ) CALL ZLACGV( J-1, A( J, 1 ), LDA ) CALL ZDSCAL( N-J, ONE / AJJ, A( J+1, J ), 1 ) diff --git a/SRC/zpotrf.f b/SRC/zpotrf.f index 593fda039d..c003af8968 100644 --- a/SRC/zpotrf.f +++ b/SRC/zpotrf.f @@ -135,7 +135,8 @@ SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO ) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZHERK, ZPOTRF2, ZTRSM + EXTERNAL XERBLA, ZGEMM, ZHERK, ZPOTRF2, + $ ZTRSM * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -194,7 +195,8 @@ SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO ) * * Compute the current block row. * - CALL ZGEMM( 'Conjugate transpose', 'No transpose', JB, + CALL ZGEMM( 'Conjugate transpose', 'No transpose', + $ JB, $ N-J-JB+1, J-1, -CONE, A( 1, J ), LDA, $ A( 1, J+JB ), LDA, CONE, A( J, J+JB ), $ LDA ) @@ -227,7 +229,8 @@ SUBROUTINE ZPOTRF( UPLO, N, A, LDA, INFO ) $ N-J-JB+1, JB, J-1, -CONE, A( J+JB, 1 ), $ LDA, A( J, 1 ), LDA, CONE, A( J+JB, J ), $ LDA ) - CALL ZTRSM( 'Right', 'Lower', 'Conjugate transpose', + CALL ZTRSM( 'Right', 'Lower', + $ 'Conjugate transpose', $ 'Non-unit', N-J-JB+1, JB, CONE, A( J, J ), $ LDA, A( J+JB, J ), LDA ) END IF diff --git a/SRC/zpotri.f b/SRC/zpotri.f index 6c55166f59..e79ffc6e31 100644 --- a/SRC/zpotri.f +++ b/SRC/zpotri.f @@ -123,7 +123,8 @@ SUBROUTINE ZPOTRI( UPLO, N, A, LDA, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zpotrs.f b/SRC/zpotrs.f index 01dbbf58e8..045b4c7225 100644 --- a/SRC/zpotrs.f +++ b/SRC/zpotrs.f @@ -173,7 +173,8 @@ SUBROUTINE ZPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', 'Non-unit', + CALL ZTRSM( 'Left', 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ N, NRHS, ONE, A, LDA, B, LDB ) * * Solve U*X = B, overwriting B with X. @@ -191,7 +192,8 @@ SUBROUTINE ZPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO ) * * Solve L**H *X = B, overwriting B with X. * - CALL ZTRSM( 'Left', 'Lower', 'Conjugate transpose', 'Non-unit', + CALL ZTRSM( 'Left', 'Lower', 'Conjugate transpose', + $ 'Non-unit', $ N, NRHS, ONE, A, LDA, B, LDB ) END IF * diff --git a/SRC/zppcon.f b/SRC/zppcon.f index 0d7571b1ad..2b25e75660 100644 --- a/SRC/zppcon.f +++ b/SRC/zppcon.f @@ -115,7 +115,8 @@ *> \ingroup ppcon * * ===================================================================== - SUBROUTINE ZPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO ) + SUBROUTINE ZPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -212,13 +213,15 @@ SUBROUTINE ZPPCON( UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO ) * * Multiply by inv(U). * - CALL ZLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATPS( 'Upper', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEU, RWORK, INFO ) ELSE * * Multiply by inv(L). * - CALL ZLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N, + CALL ZLATPS( 'Lower', 'No transpose', 'Non-unit', NORMIN, + $ N, $ AP, WORK, SCALEL, RWORK, INFO ) NORMIN = 'Y' * diff --git a/SRC/zpprfs.f b/SRC/zpprfs.f index 9440b7d55c..755832e21d 100644 --- a/SRC/zpprfs.f +++ b/SRC/zpprfs.f @@ -167,7 +167,8 @@ *> \ingroup pprfs * * ===================================================================== - SUBROUTINE ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + SUBROUTINE ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -208,7 +209,8 @@ SUBROUTINE ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHPMV, ZLACN2, ZPPTRS + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZHPMV, ZLACN2, + $ ZPPTRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -277,7 +279,8 @@ SUBROUTINE ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, * Compute residual R = B - A * X * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZHPMV( UPLO, N, -CONE, AP, X( 1, J ), 1, CONE, WORK, 1 ) + CALL ZHPMV( UPLO, N, -CONE, AP, X( 1, J ), 1, CONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * diff --git a/SRC/zppsv.f b/SRC/zppsv.f index 8440aaa9c4..28c46a72b4 100644 --- a/SRC/zppsv.f +++ b/SRC/zppsv.f @@ -172,7 +172,8 @@ SUBROUTINE ZPPSV( UPLO, N, NRHS, AP, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zppsvx.f b/SRC/zppsvx.f index d40bda29dd..8cf6af090b 100644 --- a/SRC/zppsvx.f +++ b/SRC/zppsvx.f @@ -307,7 +307,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, + SUBROUTINE ZPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, + $ LDB, $ X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -342,7 +343,8 @@ SUBROUTINE ZPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, EXTERNAL LSAME, DLAMCH, ZLANHP * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAQHP, ZPPCON, ZPPEQU, + EXTERNAL XERBLA, ZCOPY, ZLACPY, ZLAQHP, ZPPCON, + $ ZPPEQU, $ ZPPRFS, ZPPTRF, ZPPTRS * .. * .. Intrinsic Functions .. @@ -364,10 +366,13 @@ SUBROUTINE ZPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * * Test the input parameters. * - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) + IF( .NOT.NOFACT .AND. + $ .NOT.EQUIL .AND. + $ .NOT.LSAME( FACT, 'F' ) ) $ THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -462,7 +467,8 @@ SUBROUTINE ZPPSVX( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, * Use iterative refinement to improve the computed solution and * compute error bounds and backward error estimates for it. * - CALL ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, + CALL ZPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, + $ BERR, $ WORK, RWORK, INFO ) * * Transform the solution matrix X to a solution of the original diff --git a/SRC/zpptrf.f b/SRC/zpptrf.f index c15fced3ea..3c9ea20011 100644 --- a/SRC/zpptrf.f +++ b/SRC/zpptrf.f @@ -185,7 +185,8 @@ SUBROUTINE ZPPTRF( UPLO, N, AP, INFO ) * Compute elements 1:J-1 of column J. * IF( J.GT.1 ) - $ CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ CALL ZTPSV( 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ J-1, AP, AP( JC ), 1 ) * * Compute U(J,J) and test for non-positive-definiteness. diff --git a/SRC/zpptri.f b/SRC/zpptri.f index ac3799793e..a8780a5b4a 100644 --- a/SRC/zpptri.f +++ b/SRC/zpptri.f @@ -173,9 +173,11 @@ SUBROUTINE ZPPTRI( UPLO, N, AP, INFO ) JJ = 1 DO 20 J = 1, N JJN = JJ + N - J + 1 - AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), 1 ) ) + AP( JJ ) = DBLE( ZDOTC( N-J+1, AP( JJ ), 1, AP( JJ ), + $ 1 ) ) IF( J.LT.N ) - $ CALL ZTPMV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ CALL ZTPMV( 'Lower', 'Conjugate transpose', + $ 'Non-unit', $ N-J, AP( JJN ), AP( JJ+1 ), 1 ) JJ = JJN 20 CONTINUE diff --git a/SRC/zpptrs.f b/SRC/zpptrs.f index 599f81ad61..aacb83dca9 100644 --- a/SRC/zpptrs.f +++ b/SRC/zpptrs.f @@ -168,7 +168,8 @@ SUBROUTINE ZPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO ) * * Solve U**H *X = B, overwriting B with X. * - CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', N, + CALL ZTPSV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ N, $ AP, B( 1, I ), 1 ) * * Solve U*X = B, overwriting B with X. @@ -189,7 +190,8 @@ SUBROUTINE ZPPTRS( UPLO, N, NRHS, AP, B, LDB, INFO ) * * Solve L**H *X = Y, overwriting B with X. * - CALL ZTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', N, + CALL ZTPSV( 'Lower', 'Conjugate transpose', 'Non-unit', + $ N, $ AP, B( 1, I ), 1 ) 20 CONTINUE END IF diff --git a/SRC/zpstf2.f b/SRC/zpstf2.f index 3a05b48184..c135f4a1a4 100644 --- a/SRC/zpstf2.f +++ b/SRC/zpstf2.f @@ -139,7 +139,8 @@ *> \ingroup pstf2 * * ===================================================================== - SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -176,7 +177,8 @@ SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL DLAMCH, LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZDSCAL, ZGEMV, ZLACGV, ZSWAP, XERBLA + EXTERNAL ZDSCAL, ZGEMV, ZLACGV, ZSWAP, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCONJG, MAX, SQRT @@ -301,7 +303,8 @@ SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * IF( J.LT.N ) THEN CALL ZLACGV( J-1, A( 1, J ), 1 ) - CALL ZGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ), LDA, + CALL ZGEMV( 'Trans', J-1, N-J, -CONE, A( 1, J+1 ), + $ LDA, $ A( 1, J ), 1, CONE, A( J, J+1 ), LDA ) CALL ZLACGV( J-1, A( 1, J ), 1 ) CALL ZDSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA ) @@ -347,7 +350,8 @@ SUBROUTINE ZPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) A( PVT, PVT ) = A( J, J ) CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) IF( PVT.LT.N ) - $ CALL ZSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, PVT ), + $ CALL ZSWAP( N-PVT, A( PVT+1, J ), 1, A( PVT+1, + $ PVT ), $ 1 ) DO 170 I = J + 1, PVT - 1 ZTEMP = DCONJG( A( I, J ) ) diff --git a/SRC/zpstrf.f b/SRC/zpstrf.f index 4135f8ed28..f3b1e37267 100644 --- a/SRC/zpstrf.f +++ b/SRC/zpstrf.f @@ -139,7 +139,8 @@ *> \ingroup pstrf * * ===================================================================== - SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) + SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -177,7 +178,8 @@ SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) EXTERNAL DLAMCH, ILAENV, LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZDSCAL, ZGEMV, ZHERK, ZLACGV, ZPSTF2, ZSWAP, + EXTERNAL ZDSCAL, ZGEMV, ZHERK, ZLACGV, ZPSTF2, + $ ZSWAP, $ XERBLA * .. * .. Intrinsic Functions .. @@ -324,7 +326,8 @@ SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * IF( J.LT.N ) THEN CALL ZLACGV( J-1, A( 1, J ), 1 ) - CALL ZGEMV( 'Trans', J-K, N-J, -CONE, A( K, J+1 ), + CALL ZGEMV( 'Trans', J-K, N-J, -CONE, A( K, + $ J+1 ), $ LDA, A( K, J ), 1, CONE, A( J, J+1 ), $ LDA ) CALL ZLACGV( J-1, A( 1, J ), 1 ) @@ -391,7 +394,8 @@ SUBROUTINE ZPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO ) * Pivot OK, so can now swap pivot rows and columns * A( PVT, PVT ) = A( J, J ) - CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), LDA ) + CALL ZSWAP( J-1, A( J, 1 ), LDA, A( PVT, 1 ), + $ LDA ) IF( PVT.LT.N ) $ CALL ZSWAP( N-PVT, A( PVT+1, J ), 1, $ A( PVT+1, PVT ), 1 ) diff --git a/SRC/zptsvx.f b/SRC/zptsvx.f index 1acd6b6d46..662dbee2fa 100644 --- a/SRC/zptsvx.f +++ b/SRC/zptsvx.f @@ -265,7 +265,8 @@ SUBROUTINE ZPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, EXTERNAL LSAME, DLAMCH, ZLANHT * .. * .. External Subroutines .. - EXTERNAL DCOPY, XERBLA, ZCOPY, ZLACPY, ZPTCON, ZPTRFS, + EXTERNAL DCOPY, XERBLA, ZCOPY, ZLACPY, ZPTCON, + $ ZPTRFS, $ ZPTTRF, ZPTTRS * .. * .. Intrinsic Functions .. @@ -326,7 +327,8 @@ SUBROUTINE ZPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL ZPTRFS( 'Lower', N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, + CALL ZPTRFS( 'Lower', N, NRHS, D, E, DF, EF, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/zrscl.f b/SRC/zrscl.f index dfa4d293bc..5b365a0533 100644 --- a/SRC/zrscl.f +++ b/SRC/zrscl.f @@ -171,7 +171,8 @@ SUBROUTINE ZRSCL( N, A, X, INCX ) ELSE IF( (ABS( UR ).GT.SAFMAX).OR.(ABS( UI ).GT.SAFMAX) ) THEN IF( (ABSR.GT.OV).OR.(ABSI.GT.OV) ) THEN * This means that a and b are both Inf. No need for scaling. - CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X, INCX ) + CALL ZSCAL( N, DCMPLX( ONE / UR, -ONE / UI ), X, + $ INCX ) ELSE CALL ZDSCAL( N, SAFMIN, X, INCX ) IF( (ABS( UR ).GT.OV).OR.(ABS( UI ).GT.OV) ) THEN diff --git a/SRC/zspcon.f b/SRC/zspcon.f index 7234dc6730..bfa7a55b33 100644 --- a/SRC/zspcon.f +++ b/SRC/zspcon.f @@ -115,7 +115,8 @@ *> \ingroup hpcon * * ===================================================================== - SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO ) + SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zspmv.f b/SRC/zspmv.f index 16eaa11a59..db145f46bb 100644 --- a/SRC/zspmv.f +++ b/SRC/zspmv.f @@ -187,7 +187,8 @@ SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/zspr.f b/SRC/zspr.f index a4cb5d09b0..134f983594 100644 --- a/SRC/zspr.f +++ b/SRC/zspr.f @@ -166,7 +166,8 @@ SUBROUTINE ZSPR( UPLO, N, ALPHA, X, INCX, AP ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/zsprfs.f b/SRC/zsprfs.f index e781894505..9ce3be12bb 100644 --- a/SRC/zsprfs.f +++ b/SRC/zsprfs.f @@ -176,7 +176,8 @@ *> \ingroup hprfs * * ===================================================================== - SUBROUTINE ZSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + SUBROUTINE ZSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -218,7 +219,8 @@ SUBROUTINE ZSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZSPMV, ZSPTRS + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZSPMV, + $ ZSPTRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX diff --git a/SRC/zspsv.f b/SRC/zspsv.f index 4ec49cce3d..15737e8031 100644 --- a/SRC/zspsv.f +++ b/SRC/zspsv.f @@ -191,7 +191,8 @@ SUBROUTINE ZSPSV( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zspsvx.f b/SRC/zspsvx.f index 909db72a1a..ec495af66c 100644 --- a/SRC/zspsvx.f +++ b/SRC/zspsvx.f @@ -273,7 +273,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, + SUBROUTINE ZSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, + $ X, $ LDX, RCOND, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- @@ -308,7 +309,8 @@ SUBROUTINE ZSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, EXTERNAL LSAME, DLAMCH, ZLANSP * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZLACPY, ZSPCON, ZSPRFS, ZSPTRF, + EXTERNAL XERBLA, ZCOPY, ZLACPY, ZSPCON, ZSPRFS, + $ ZSPTRF, $ ZSPTRS * .. * .. Intrinsic Functions .. @@ -322,7 +324,8 @@ SUBROUTINE ZSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NOFACT = LSAME( FACT, 'N' ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -370,7 +373,8 @@ SUBROUTINE ZSPSVX( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * Use iterative refinement to improve the computed solutions and * compute error bounds and backward error estimates for them. * - CALL ZSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, + CALL ZSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, + $ FERR, $ BERR, WORK, RWORK, INFO ) * * Set INFO = N+1 if the matrix is singular to working precision. diff --git a/SRC/zsptrf.f b/SRC/zsptrf.f index 852db0268b..1f8af54976 100644 --- a/SRC/zsptrf.f +++ b/SRC/zsptrf.f @@ -507,7 +507,8 @@ SUBROUTINE ZSPTRF( UPLO, N, AP, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, AP( KPC+1 ), + $ CALL ZSWAP( N-KP, AP( KNC+KP-KK+1 ), 1, + $ AP( KPC+1 ), $ 1 ) KX = KNC + KP - KK DO 80 J = KK + 1, KP - 1 diff --git a/SRC/zsptri.f b/SRC/zsptri.f index 407f857bfa..cff89df959 100644 --- a/SRC/zsptri.f +++ b/SRC/zsptri.f @@ -219,7 +219,8 @@ SUBROUTINE ZSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ ZDOTU( K-1, WORK, 1, AP( KC ), 1 ) @@ -244,18 +245,21 @@ SUBROUTINE ZSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.GT.1 ) THEN CALL ZCOPY( K-1, AP( KC ), 1, WORK, 1 ) - CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, AP( KC ), + CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, + $ AP( KC ), $ 1 ) AP( KC+K-1 ) = AP( KC+K-1 ) - $ ZDOTU( K-1, WORK, 1, AP( KC ), 1 ) AP( KCNEXT+K-1 ) = AP( KCNEXT+K-1 ) - - $ ZDOTU( K-1, AP( KC ), 1, AP( KCNEXT ), + $ ZDOTU( K-1, AP( KC ), 1, + $ AP( KCNEXT ), $ 1 ) CALL ZCOPY( K-1, AP( KCNEXT ), 1, WORK, 1 ) CALL ZSPMV( UPLO, K-1, -ONE, AP, WORK, 1, ZERO, $ AP( KCNEXT ), 1 ) AP( KCNEXT+K ) = AP( KCNEXT+K ) - - $ ZDOTU( K-1, WORK, 1, AP( KCNEXT ), 1 ) + $ ZDOTU( K-1, WORK, 1, AP( KCNEXT ), + $ 1 ) END IF KSTEP = 2 KCNEXT = KCNEXT + K + 1 @@ -346,7 +350,8 @@ SUBROUTINE ZSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, AP( KC+1 ), 1, WORK, 1 ) - CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KC+1 ), 1 ) AP( KC ) = AP( KC ) - ZDOTU( N-K, WORK, 1, AP( KC+1 ), $ 1 ) @@ -354,10 +359,12 @@ SUBROUTINE ZSPTRI( UPLO, N, AP, IPIV, WORK, INFO ) $ ZDOTU( N-K, AP( KC+1 ), 1, $ AP( KCNEXT+2 ), 1 ) CALL ZCOPY( N-K, AP( KCNEXT+2 ), 1, WORK, 1 ) - CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, 1, + CALL ZSPMV( UPLO, N-K, -ONE, AP( KC+( N-K+1 ) ), WORK, + $ 1, $ ZERO, AP( KCNEXT+2 ), 1 ) AP( KCNEXT ) = AP( KCNEXT ) - - $ ZDOTU( N-K, WORK, 1, AP( KCNEXT+2 ), 1 ) + $ ZDOTU( N-K, WORK, 1, AP( KCNEXT+2 ), + $ 1 ) END IF KSTEP = 2 KCNEXT = KCNEXT - ( N-K+3 ) diff --git a/SRC/zsptrs.f b/SRC/zsptrs.f index 18373b5ecc..76b68cc0de 100644 --- a/SRC/zsptrs.f +++ b/SRC/zsptrs.f @@ -268,7 +268,8 @@ SUBROUTINE ZSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -285,7 +286,8 @@ SUBROUTINE ZSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, AP( KC ), + CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, + $ AP( KC ), $ 1, ONE, B( K, 1 ), LDB ) CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ AP( KC+K ), 1, ONE, B( K+1, 1 ), LDB ) @@ -356,7 +358,8 @@ SUBROUTINE ZSPTRS( UPLO, N, NRHS, AP, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+2 ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS, -ONE, AP( KC+N-K+2 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/zstedc.f b/SRC/zstedc.f index 24542f0018..ab6e3f1568 100644 --- a/SRC/zstedc.f +++ b/SRC/zstedc.f @@ -238,7 +238,8 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, XERBLA, + EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF, + $ XERBLA, $ ZLACPY, ZLACRM, ZLAED0, ZSTEQR, ZSWAP * .. * .. Intrinsic Functions .. @@ -409,12 +410,15 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * Scale. * ORGNRM = DLANST( 'M', M, D( START ), E( START ) ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), + $ M, $ INFO ) - CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ), + CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, + $ E( START ), $ M-1, INFO ) * - CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, START ), + CALL ZLAED0( N, M, D( START ), E( START ), Z( 1, + $ START ), $ LDZ, WORK, N, RWORK, IWORK, INFO ) IF( INFO.GT.0 ) THEN INFO = ( INFO / ( M+1 )+START-1 )*( N+1 ) + @@ -424,13 +428,15 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * * Scale back. * - CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M, + CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), + $ M, $ INFO ) * ELSE CALL DSTEQR( 'I', M, D( START ), E( START ), RWORK, M, $ RWORK( M*M+1 ), INFO ) - CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, N, + CALL ZLACRM( N, M, Z( 1, START ), LDZ, RWORK, M, WORK, + $ N, $ RWORK( M*M+1 ) ) CALL ZLACPY( 'A', N, M, WORK, N, Z( 1, START ), LDZ ) IF( INFO.GT.0 ) THEN diff --git a/SRC/zstein.f b/SRC/zstein.f index 91ad5002c8..bb92ac2362 100644 --- a/SRC/zstein.f +++ b/SRC/zstein.f @@ -223,7 +223,8 @@ SUBROUTINE ZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, EXTERNAL IDAMAX, DLAMCH, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAGTF, DLAGTS, DLARNV, DSCAL, XERBLA + EXTERNAL DCOPY, DLAGTF, DLAGTS, DLARNV, DSCAL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, MAX, SQRT @@ -366,7 +367,8 @@ SUBROUTINE ZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Compute LU factors with partial pivoting ( PT = LU ) * TOL = ZERO - CALL DLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, WORK( INDRV2+2 ), + CALL DLAGTF( BLKSIZ, WORK( INDRV4+1 ), XJ, + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), TOL, WORK( INDRV5+1 ), IWORK, $ IINFO ) * @@ -387,7 +389,8 @@ SUBROUTINE ZSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * * Solve the system LU = Pb. * - CALL DLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), WORK( INDRV2+2 ), + CALL DLAGTS( -1, BLKSIZ, WORK( INDRV4+1 ), + $ WORK( INDRV2+2 ), $ WORK( INDRV3+1 ), WORK( INDRV5+1 ), IWORK, $ WORK( INDRV1+1 ), TOL, IINFO ) * diff --git a/SRC/zstemr.f b/SRC/zstemr.f index ff35872f41..287517f7fa 100644 --- a/SRC/zstemr.f +++ b/SRC/zstemr.f @@ -381,7 +381,8 @@ SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, EXTERNAL LSAME, DLAMCH, DLANST * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAE2, DLAEV2, DLARRC, DLARRE, DLARRJ, + EXTERNAL DCOPY, DLAE2, DLAEV2, DLARRC, DLARRE, + $ DLARRJ, $ DLARRR, DLASRT, DSCAL, XERBLA, ZLARRV, ZSWAP * .. * .. Intrinsic Functions .. diff --git a/SRC/zsteqr.f b/SRC/zsteqr.f index e29c179e00..a6b76fb839 100644 --- a/SRC/zsteqr.f +++ b/SRC/zsteqr.f @@ -169,7 +169,8 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) EXTERNAL LSAME, DLAMCH, DLANST, DLAPY2 * .. * .. External Subroutines .. - EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT, XERBLA, + EXTERNAL DLAE2, DLAEV2, DLARTG, DLASCL, DLASRT, + $ XERBLA, $ ZLASET, ZLASR, ZSWAP * .. * .. Intrinsic Functions .. @@ -275,13 +276,15 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) $ GO TO 10 IF( ANORM.GT.SSFMAX ) THEN ISCALE = 1 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMAX, LEND-L, 1, E( L ), N, $ INFO ) ELSE IF( ANORM.LT.SSFMIN ) THEN ISCALE = 2 - CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), N, + CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L+1, 1, D( L ), + $ N, $ INFO ) CALL DLASCL( 'G', 0, 0, ANORM, SSFMIN, LEND-L, 1, E( L ), N, $ INFO ) @@ -324,7 +327,8 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L+1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, S ) + CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C, + $ S ) WORK( L ) = C WORK( N-1+L ) = S CALL ZLASR( 'R', 'V', 'B', N, 2, WORK( L ), @@ -383,7 +387,8 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = M - L + 1 - CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ), WORK( N-1+L ), + CALL ZLASR( 'R', 'V', 'B', N, MM, WORK( L ), + $ WORK( N-1+L ), $ Z( 1, L ), LDZ ) END IF * @@ -431,7 +436,8 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( M.EQ.L-1 ) THEN IF( ICOMPZ.GT.0 ) THEN - CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, S ) + CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C, + $ S ) WORK( M ) = C WORK( N-1+M ) = S CALL ZLASR( 'R', 'V', 'F', N, 2, WORK( M ), @@ -490,7 +496,8 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) * IF( ICOMPZ.GT.0 ) THEN MM = L - M + 1 - CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ), WORK( N-1+M ), + CALL ZLASR( 'R', 'V', 'F', N, MM, WORK( M ), + $ WORK( N-1+M ), $ Z( 1, M ), LDZ ) END IF * @@ -516,12 +523,14 @@ SUBROUTINE ZSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) IF( ISCALE.EQ.1 ) THEN CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL DLASCL( 'G', 0, 0, SSFMAX, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) ELSE IF( ISCALE.EQ.2 ) THEN CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV+1, 1, $ D( LSV ), N, INFO ) - CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, E( LSV ), + CALL DLASCL( 'G', 0, 0, SSFMIN, ANORM, LENDSV-LSV, 1, + $ E( LSV ), $ N, INFO ) END IF * diff --git a/SRC/zsycon_rook.f b/SRC/zsycon_rook.f index cb60693be5..83f9c7e37c 100644 --- a/SRC/zsycon_rook.f +++ b/SRC/zsycon_rook.f @@ -135,7 +135,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, + SUBROUTINE ZSYCON_ROOK( UPLO, N, A, LDA, IPIV, ANORM, RCOND, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zsyequb.f b/SRC/zsyequb.f index 64341cee4e..e15dead7b4 100644 --- a/SRC/zsyequb.f +++ b/SRC/zsyequb.f @@ -129,7 +129,8 @@ *> Tech report version: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.3.1679 *> * ===================================================================== - SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) + SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -182,7 +183,8 @@ SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO ) * Test the input parameters. * INFO = 0 - IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN + IF ( .NOT. ( LSAME( UPLO, 'U' ) .OR. + $ LSAME( UPLO, 'L' ) ) ) THEN INFO = -1 ELSE IF ( N .LT. 0 ) THEN INFO = -2 diff --git a/SRC/zsymv.f b/SRC/zsymv.f index 776ff393c4..1121a36d35 100644 --- a/SRC/zsymv.f +++ b/SRC/zsymv.f @@ -154,7 +154,8 @@ *> \ingroup hemv * * ===================================================================== - SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) + SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, + $ INCY ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -196,7 +197,8 @@ SUBROUTINE ZSYMV( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/zsyr.f b/SRC/zsyr.f index 3c44391708..7f4c3f4416 100644 --- a/SRC/zsyr.f +++ b/SRC/zsyr.f @@ -172,7 +172,8 @@ SUBROUTINE ZSYR( UPLO, N, ALPHA, X, INCX, A, LDA ) * Test the input parameters. * INFO = 0 - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = 1 ELSE IF( N.LT.0 ) THEN INFO = 2 diff --git a/SRC/zsyrfs.f b/SRC/zsyrfs.f index 14348f7759..cfee8b1cb9 100644 --- a/SRC/zsyrfs.f +++ b/SRC/zsyrfs.f @@ -188,7 +188,8 @@ *> \ingroup herfs * * ===================================================================== - SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, + SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + $ LDB, $ X, LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -230,7 +231,8 @@ SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZSYMV, ZSYTRS + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZSYMV, + $ ZSYTRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -303,7 +305,8 @@ SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * Compute residual R = B - A * X * CALL ZCOPY( N, B( 1, J ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, 1 ) + CALL ZSYMV( UPLO, N, -ONE, A, LDA, X( 1, J ), 1, ONE, WORK, + $ 1 ) * * Compute componentwise relative backward error from formula * @@ -410,7 +413,8 @@ SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, * * Multiply by diag(W)*inv(A**T). * - CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) DO 110 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 110 CONTINUE @@ -421,7 +425,8 @@ SUBROUTINE ZSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, DO 120 I = 1, N WORK( I ) = RWORK( I )*WORK( I ) 120 CONTINUE - CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, INFO ) + CALL ZSYTRS( UPLO, N, 1, AF, LDAF, IPIV, WORK, N, + $ INFO ) END IF GO TO 100 END IF diff --git a/SRC/zsyrfsx.f b/SRC/zsyrfsx.f index 09bee88dc1..bd4e9b1bde 100644 --- a/SRC/zsyrfsx.f +++ b/SRC/zsyrfsx.f @@ -396,7 +396,8 @@ *> \ingroup herfsx * * ===================================================================== - SUBROUTINE ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, $ WORK, RWORK, INFO ) @@ -462,7 +463,8 @@ SUBROUTINE ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * .. * .. External Functions .. EXTERNAL LSAME, ILAPREC - EXTERNAL DLAMCH, ZLANSY, ZLA_SYRCOND_X, ZLA_SYRCOND_C + EXTERNAL DLAMCH, ZLANSY, ZLA_SYRCOND_X, + $ ZLA_SYRCOND_C DOUBLE PRECISION DLAMCH, ZLANSY, ZLA_SYRCOND_X, ZLA_SYRCOND_C LOGICAL LSAME INTEGER ILAPREC @@ -519,7 +521,8 @@ SUBROUTINE ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Test input parameters. * - IF ( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF ( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.RCEQU .AND. .NOT.LSAME( EQUED, 'N' ) ) THEN INFO = -2 @@ -605,16 +608,19 @@ SUBROUTINE ZSYRFSX( UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, $ INFO ) END IF - ERR_LBND = MAX( 10.0D+0, SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) + ERR_LBND = MAX( 10.0D+0, + $ SQRT( DBLE( N ) ) ) * DLAMCH( 'Epsilon' ) IF (N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1) THEN * * Compute scaled normwise condition number cond(A*C). * IF ( RCEQU ) THEN - RCOND_TMP = ZLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .TRUE., INFO, WORK, RWORK ) ELSE - RCOND_TMP = ZLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, + RCOND_TMP = ZLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, + $ IPIV, $ S, .FALSE., INFO, WORK, RWORK ) END IF DO J = 1, NRHS diff --git a/SRC/zsysv.f b/SRC/zsysv.f index c2aabab7e8..d13bfb91f1 100644 --- a/SRC/zsysv.f +++ b/SRC/zsysv.f @@ -205,7 +205,8 @@ SUBROUTINE ZSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zsysv_aa.f b/SRC/zsysv_aa.f index 01115c35d1..59dafa80ef 100644 --- a/SRC/zsysv_aa.f +++ b/SRC/zsysv_aa.f @@ -197,7 +197,8 @@ SUBROUTINE ZSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zsysv_rk.f b/SRC/zsysv_rk.f index a6e45f3325..c54396a8c8 100644 --- a/SRC/zsysv_rk.f +++ b/SRC/zsysv_rk.f @@ -224,7 +224,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, + SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -262,7 +263,8 @@ SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -280,7 +282,8 @@ SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) + CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, + $ INFO ) LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT @@ -302,7 +305,8 @@ SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, * * Solve the system A*X = B with BLAS3 solver, overwriting B with X. * - CALL ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO ) + CALL ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/zsysv_rook.f b/SRC/zsysv_rook.f index 9619e16952..ab938e1d34 100644 --- a/SRC/zsysv_rook.f +++ b/SRC/zsysv_rook.f @@ -200,7 +200,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, + SUBROUTINE ZSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ WORK, $ LWORK, INFO ) * * -- LAPACK driver routine -- @@ -238,7 +239,8 @@ SUBROUTINE ZSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * INFO = 0 LQUERY = ( LWORK.EQ.-1 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 @@ -278,7 +280,8 @@ SUBROUTINE ZSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * * Solve with TRS_ROOK ( Use Level 2 BLAS) * - CALL ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + CALL ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, + $ INFO ) * END IF * diff --git a/SRC/zsysvx.f b/SRC/zsysvx.f index 3cea26e180..07d4a32c88 100644 --- a/SRC/zsysvx.f +++ b/SRC/zsysvx.f @@ -280,7 +280,8 @@ *> \ingroup hesvx * * ===================================================================== - SUBROUTINE ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, + SUBROUTINE ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + $ B, $ LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, $ RWORK, INFO ) * @@ -318,7 +319,8 @@ SUBROUTINE ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANSY * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACPY, ZSYCON, ZSYRFS, ZSYTRF, ZSYTRS + EXTERNAL XERBLA, ZLACPY, ZSYCON, ZSYRFS, ZSYTRF, + $ ZSYTRS * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -332,7 +334,8 @@ SUBROUTINE ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) + ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) $ THEN INFO = -2 ELSE IF( N.LT.0 ) THEN @@ -388,7 +391,8 @@ SUBROUTINE ZSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * * Compute the reciprocal of the condition number of A. * - CALL ZSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, INFO ) + CALL ZSYCON( UPLO, N, AF, LDAF, IPIV, ANORM, RCOND, WORK, + $ INFO ) * * Compute the solution vectors X. * diff --git a/SRC/zsysvxx.f b/SRC/zsysvxx.f index 803755dc0e..ef04438bbf 100644 --- a/SRC/zsysvxx.f +++ b/SRC/zsysvxx.f @@ -500,7 +500,8 @@ *> \ingroup hesvxx * * ===================================================================== - SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, + SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, + $ IPIV, $ EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, $ NPARAMS, PARAMS, WORK, RWORK, INFO ) @@ -628,7 +629,8 @@ SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * * Compute row and column scalings to equilibrate the matrix A. * - CALL ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFEQU ) + CALL ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, + $ INFEQU ) IF( INFEQU.EQ.0 ) THEN * * Equilibrate the matrix. @@ -648,7 +650,8 @@ SUBROUTINE ZSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, * Compute the LDL^T or UDU^T factorization of A. * CALL ZLACPY( UPLO, N, N, A, LDA, AF, LDAF ) - CALL ZSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), INFO ) + CALL ZSYTRF( UPLO, N, AF, LDAF, IPIV, WORK, 5*MAX(1,N), + $ INFO ) * * Return if INFO is non-zero. * diff --git a/SRC/zsytf2.f b/SRC/zsytf2.f index d9b0e45d7e..b238f2a8b0 100644 --- a/SRC/zsytf2.f +++ b/SRC/zsytf2.f @@ -482,7 +482,8 @@ SUBROUTINE ZSYTF2( UPLO, N, A, LDA, IPIV, INFO ) JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) IF( IMAX.LT.N ) THEN - JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 ) + JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + $ 1 ) ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) ) END IF * @@ -514,7 +515,8 @@ SUBROUTINE ZSYTF2( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), $ LDA ) T = A( KK, KK ) diff --git a/SRC/zsytf2_rk.f b/SRC/zsytf2_rk.f index e97382a851..6b68d0f949 100644 --- a/SRC/zsytf2_rk.f +++ b/SRC/zsytf2_rk.f @@ -470,7 +470,8 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * the interchanges in columns k+1:N. * IF( K.LT.N ) - $ CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), LDA ) + $ CALL ZSWAP( N-K, A( K, K+1 ), LDA, A( P, K+1 ), + $ LDA ) * END IF * @@ -485,7 +486,8 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( KP.GT.1 ) $ CALL ZSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL ZSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL ZSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -527,7 +529,8 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = CONE / A( K, K ) - CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -546,7 +549,8 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF * * Store the superdiagonal element of D in array E @@ -704,14 +708,16 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = CABS1( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -770,7 +776,8 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) IF( P.LT.N ) $ CALL ZSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL ZSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL ZSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -792,9 +799,11 @@ SUBROUTINE ZSYTF2_RK( UPLO, N, A, LDA, E, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/zsytf2_rook.f b/SRC/zsytf2_rook.f index 62bbbf9a30..cfba0f9300 100644 --- a/SRC/zsytf2_rook.f +++ b/SRC/zsytf2_rook.f @@ -419,7 +419,8 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( KP.GT.1 ) $ CALL ZSWAP( KP-1, A( 1, KK ), 1, A( 1, KP ), 1 ) IF( ( KK.GT.1 ) .AND. ( KP.LT.(KK-1) ) ) - $ CALL ZSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, KP+1 ), + $ CALL ZSWAP( KK-KP-1, A( KP+1, KK ), 1, A( KP, + $ KP+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) @@ -453,7 +454,8 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*1/D(k)*W(k)**T * D11 = CONE / A( K, K ) - CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) * * Store U(k) in column k * @@ -472,7 +474,8 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * = A - W(k)*(1/D(k))*W(k)**T * = A - (W(k)/D(k))*(D(k))*(W(k)/D(K))**T * - CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, LDA ) + CALL ZSYR( UPLO, K-1, -D11, A( 1, K ), 1, A, + $ LDA ) END IF END IF * @@ -602,14 +605,16 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * Determine both ROWMAX and JMAX. * IF( IMAX.NE.K ) THEN - JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA ) + JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), + $ LDA ) ROWMAX = CABS1( A( IMAX, JMAX ) ) ELSE ROWMAX = ZERO END IF * IF( IMAX.LT.N ) THEN - ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), + ITEMP = IMAX + IZAMAX( N-IMAX, A( IMAX+1, + $ IMAX ), $ 1 ) DTEMP = CABS1( A( ITEMP, IMAX ) ) IF( DTEMP.GT.ROWMAX ) THEN @@ -668,7 +673,8 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) IF( P.LT.N ) $ CALL ZSWAP( N-P, A( P+1, K ), 1, A( P+1, P ), 1 ) IF( P.GT.(K+1) ) - $ CALL ZSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), LDA ) + $ CALL ZSWAP( P-K-1, A( K+1, K ), 1, A( P, K+1 ), + $ LDA ) T = A( K, K ) A( K, K ) = A( P, P ) A( P, P ) = T @@ -683,9 +689,11 @@ SUBROUTINE ZSYTF2_ROOK( UPLO, N, A, LDA, IPIV, INFO ) * submatrix A(k:n,k:n) * IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 ) + $ CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), + $ 1 ) IF( ( KK.LT.N ) .AND. ( KP.GT.(KK+1) ) ) - $ CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ), + $ CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, + $ KK+1 ), $ LDA ) T = A( KK, KK ) A( KK, KK ) = A( KP, KP ) diff --git a/SRC/zsytrf.f b/SRC/zsytrf.f index 677f4a2dde..aef88b1091 100644 --- a/SRC/zsytrf.f +++ b/SRC/zsytrf.f @@ -250,7 +250,8 @@ SUBROUTINE ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IWS = LDWORK*NB IF( LWORK.LT.IWS ) THEN NB = MAX( LWORK / LDWORK, 1 ) - NBMIN = MAX( 2, ILAENV( 2, 'ZSYTRF', UPLO, N, -1, -1, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZSYTRF', UPLO, N, -1, -1, + $ -1 ) ) END IF ELSE IWS = 1 @@ -279,7 +280,8 @@ SUBROUTINE ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k-kb+1:k of A and use blocked code to * update columns 1:k-kb * - CALL ZLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, IINFO ) + CALL ZLASYF( UPLO, K, NB, KB, A, LDA, IPIV, WORK, N, + $ IINFO ) ELSE * * Use unblocked code to factorize columns 1:k of A @@ -319,13 +321,15 @@ SUBROUTINE ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL ZLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, IPIV( K ), + CALL ZLASYF( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ IPIV( K ), $ WORK, N, IINFO ) ELSE * * Use unblocked code to factorize columns k:n of A * - CALL ZSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), IINFO ) + CALL ZSYTF2( UPLO, N-K+1, A( K, K ), LDA, IPIV( K ), + $ IINFO ) KB = N - K + 1 END IF * diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f index dc017163aa..749e2523ed 100644 --- a/SRC/zsytrf_aa.f +++ b/SRC/zsytrf_aa.f @@ -163,7 +163,8 @@ SUBROUTINE ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO) EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL ZLASYF_AA, ZGEMM, ZGEMV, ZSCAL, ZCOPY, + EXTERNAL ZLASYF_AA, ZGEMM, ZGEMV, ZSCAL, + $ ZCOPY, $ ZSWAP, XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/zsytrf_aa_2stage.f b/SRC/zsytrf_aa_2stage.f index 6836d55511..c53386c410 100644 --- a/SRC/zsytrf_aa_2stage.f +++ b/SRC/zsytrf_aa_2stage.f @@ -192,7 +192,8 @@ SUBROUTINE ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGBTRF, ZGEMM, ZGETRF, + EXTERNAL XERBLA, ZCOPY, ZGBTRF, ZGEMM, + $ ZGETRF, $ ZLACPY, ZLASET, ZLASWP, ZTRSM, ZSWAP * .. * .. Intrinsic Functions .. diff --git a/SRC/zsytrf_rk.f b/SRC/zsytrf_rk.f index d7a51e3fab..a56b8a2054 100644 --- a/SRC/zsytrf_rk.f +++ b/SRC/zsytrf_rk.f @@ -426,7 +426,8 @@ SUBROUTINE ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK, * Factorize columns k:k+kb-1 of A and use blocked code to * update columns k+kb:n * - CALL ZLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, E( K ), + CALL ZLASYF_RK( UPLO, N-K+1, NB, KB, A( K, K ), LDA, + $ E( K ), $ IPIV( K ), WORK, LDWORK, IINFO ) diff --git a/SRC/zsytrf_rook.f b/SRC/zsytrf_rook.f index 059d4d5971..958849befc 100644 --- a/SRC/zsytrf_rook.f +++ b/SRC/zsytrf_rook.f @@ -205,7 +205,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zsytri.f b/SRC/zsytri.f index f3efbb92d0..470f086997 100644 --- a/SRC/zsytri.f +++ b/SRC/zsytri.f @@ -222,7 +222,8 @@ SUBROUTINE ZSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -247,10 +248,12 @@ SUBROUTINE ZSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -ONE, A, LDA, WORK, 1, ZERO, $ A( 1, K+1 ), 1 ) @@ -309,9 +312,11 @@ SUBROUTINE ZSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -334,18 +339,23 @@ SUBROUTINE ZSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ ZDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ ZDOTU( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K, -ONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ ZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ ZDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 ) + $ ZDOTU( N-K, WORK, 1, A( K+1, K-1 ), + $ 1 ) END IF KSTEP = 2 END IF diff --git a/SRC/zsytri2x.f b/SRC/zsytri2x.f index 3477b54521..fb097ea4bd 100644 --- a/SRC/zsytri2x.f +++ b/SRC/zsytri2x.f @@ -383,8 +383,10 @@ SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) I=I+1 @@ -567,12 +569,16 @@ SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN IP=IPIV(I) - IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) ELSE IP=-IPIV(I) - IF ( I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF ( I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF ( I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF ( I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) I=I-1 ENDIF I=I-1 diff --git a/SRC/zsytri_3x.f b/SRC/zsytri_3x.f index 9cb592f229..ebed7208ff 100644 --- a/SRC/zsytri_3x.f +++ b/SRC/zsytri_3x.f @@ -156,7 +156,8 @@ *> \endverbatim * * ===================================================================== - SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) + SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -189,7 +190,8 @@ SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZGEMM, ZSYSWAPR, ZTRTRI, ZTRMM, XERBLA + EXTERNAL ZGEMM, ZSYSWAPR, ZTRTRI, ZTRMM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MOD @@ -434,8 +436,10 @@ SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = 1, N IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * @@ -630,8 +634,10 @@ SUBROUTINE ZSYTRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO ) DO I = N, 1, -1 IP = ABS( IPIV( I ) ) IF( IP.NE.I ) THEN - IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I ,IP ) - IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP ,I ) + IF (I .LT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, I , + $ IP ) + IF (I .GT. IP) CALL ZSYSWAPR( UPLO, N, A, LDA, IP , + $ I ) END IF END DO * diff --git a/SRC/zsytri_rook.f b/SRC/zsytri_rook.f index 16624eaa61..e9e75e5c18 100644 --- a/SRC/zsytri_rook.f +++ b/SRC/zsytri_rook.f @@ -237,7 +237,8 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -262,10 +263,12 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) CALL ZCOPY( K-1, A( 1, K ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, K ), + A( K, K ) = A( K, K ) - ZDOTU( K-1, WORK, 1, A( 1, + $ K ), $ 1 ) A( K, K+1 ) = A( K, K+1 ) - - $ ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), 1 ) + $ ZDOTU( K-1, A( 1, K ), 1, A( 1, K+1 ), + $ 1 ) CALL ZCOPY( K-1, A( 1, K+1 ), 1, WORK, 1 ) CALL ZSYMV( UPLO, K-1, -CONE, A, LDA, WORK, 1, CZERO, $ A( 1, K+1 ), 1 ) @@ -284,7 +287,8 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL ZSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -298,7 +302,8 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL ZSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -313,7 +318,8 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) IF( KP.NE.K ) THEN IF( KP.GT.1 ) $ CALL ZSWAP( KP-1, A( 1, K ), 1, A( 1, KP ), 1 ) - CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), LDA ) + CALL ZSWAP( K-KP-1, A( KP+1, K ), 1, A( KP, KP+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -351,9 +357,11 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) END IF KSTEP = 1 @@ -376,18 +384,23 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) * IF( K.LT.N ) THEN CALL ZCOPY( N-K, A( K+1, K ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K ), 1 ) - A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, K ), + A( K, K ) = A( K, K ) - ZDOTU( N-K, WORK, 1, A( K+1, + $ K ), $ 1 ) A( K, K-1 ) = A( K, K-1 ) - - $ ZDOTU( N-K, A( K+1, K ), 1, A( K+1, K-1 ), + $ ZDOTU( N-K, A( K+1, K ), 1, A( K+1, + $ K-1 ), $ 1 ) CALL ZCOPY( N-K, A( K+1, K-1 ), 1, WORK, 1 ) - CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, 1, + CALL ZSYMV( UPLO, N-K,-CONE, A( K+1, K+1 ), LDA, WORK, + $ 1, $ CZERO, A( K+1, K-1 ), 1 ) A( K-1, K-1 ) = A( K-1, K-1 ) - - $ ZDOTU( N-K, WORK, 1, A( K+1, K-1 ), 1 ) + $ ZDOTU( N-K, WORK, 1, A( K+1, K-1 ), + $ 1 ) END IF KSTEP = 2 END IF @@ -400,8 +413,10 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP @@ -414,8 +429,10 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) * TEMP = A( K, K ) A( K, K ) = A( KP, KP ) @@ -429,8 +446,10 @@ SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO ) KP = -IPIV( K ) IF( KP.NE.K ) THEN IF( KP.LT.N ) - $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), 1 ) - CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), LDA ) + $ CALL ZSWAP( N-KP, A( KP+1, K ), 1, A( KP+1, KP ), + $ 1 ) + CALL ZSWAP( KP-K-1, A( K+1, K ), 1, A( KP, K+1 ), + $ LDA ) TEMP = A( K, K ) A( K, K ) = A( KP, KP ) A( KP, KP ) = TEMP diff --git a/SRC/zsytrs.f b/SRC/zsytrs.f index e5b303d58d..f8e20c730a 100644 --- a/SRC/zsytrs.f +++ b/SRC/zsytrs.f @@ -208,7 +208,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-1, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -228,7 +229,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U(K)), where U(K) is the transformation * stored in columns K-1 and K of A. * - CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-2, NRHS, -ONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) CALL ZGERU( K-2, NRHS, -ONE, A( 1, K-1 ), 1, B( K-1, 1 ), $ LDB, B( 1, 1 ), LDB ) @@ -271,7 +273,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -287,7 +290,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * Multiply by inv(U**T(K+1)), where U(K+1) is the transformation * stored in columns K and K+1 of A. * - CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, K ), + CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, A( 1, + $ K ), $ 1, ONE, B( K, 1 ), LDB ) CALL ZGEMV( 'Transpose', K-1, NRHS, -ONE, B, LDB, $ A( 1, K+1 ), 1, ONE, B( K+1, 1 ), LDB ) @@ -334,7 +338,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in column K of A. * IF( K.LT.N ) - $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL ZGERU( N-K, NRHS, -ONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -355,7 +360,8 @@ SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS, -ONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) diff --git a/SRC/zsytrs2.f b/SRC/zsytrs2.f index a9c0ad0bf8..57afb3e4f5 100644 --- a/SRC/zsytrs2.f +++ b/SRC/zsytrs2.f @@ -160,7 +160,8 @@ SUBROUTINE ZSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL ZSCAL, ZSYCONV, ZSWAP, ZTRSM, XERBLA + EXTERNAL ZSCAL, ZSYCONV, ZSWAP, ZTRSM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX diff --git a/SRC/zsytrs_3.f b/SRC/zsytrs_3.f index ca49c35753..88cf7a38af 100644 --- a/SRC/zsytrs_3.f +++ b/SRC/zsytrs_3.f @@ -247,7 +247,8 @@ SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U \P**T * B) -> B [ (U \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'U', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (U \P**T * B) ] * @@ -273,7 +274,8 @@ SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (U**T \ B) -> B [ U**T \ (D \ (U \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'U', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (U**T \ (D \ (U \P**T * B) )) ] * @@ -314,7 +316,8 @@ SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM( 'L', 'L', 'N', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * Compute D \ B -> B [ D \ (L \P**T * B) ] * @@ -340,7 +343,8 @@ SUBROUTINE ZSYTRS_3( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (D \ (L \P**T * B) ) ] * - CALL ZTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, LDB ) + CALL ZTRSM('L', 'L', 'T', 'U', N, NRHS, ONE, A, LDA, B, + $ LDB ) * * P * B [ P * (L**T \ (D \ (L \P**T * B) )) ] * diff --git a/SRC/zsytrs_aa.f b/SRC/zsytrs_aa.f index 26a6eea6df..a88d771323 100644 --- a/SRC/zsytrs_aa.f +++ b/SRC/zsytrs_aa.f @@ -214,7 +214,8 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U**T \ B -> B [ (U**T \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL ZTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -224,10 +225,13 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL ZLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN - CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 ) - CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1 ) + CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL ZGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, + CALL ZGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, + $ LDB, $ INFO ) * * 3) Backward substitution with U @@ -236,7 +240,8 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, + $ 2 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -266,7 +271,8 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute L \ B -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) END IF * @@ -276,10 +282,13 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 ) - CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1 ) + CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), + $ 1 ) + CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), + $ 1 ) END IF - CALL ZGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, + CALL ZGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, + $ LDB, $ INFO) * * 3) Backward substitution with L**T @@ -288,7 +297,8 @@ SUBROUTINE ZSYTRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, + $ 1 ), $ LDA, B( 2, 1 ), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/zsytrs_aa_2stage.f b/SRC/zsytrs_aa_2stage.f index 229e1f189f..6ddb166ca6 100644 --- a/SRC/zsytrs_aa_2stage.f +++ b/SRC/zsytrs_aa_2stage.f @@ -216,7 +216,8 @@ SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * - CALL ZTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL ZTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -229,7 +230,8 @@ SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), + CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, + $ NB+1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] @@ -250,7 +252,8 @@ SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L \ B) -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * END IF @@ -263,7 +266,8 @@ SUBROUTINE ZSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - CALL ZTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), + CALL ZTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, + $ 1), $ LDA, B(NB+1, 1), LDB) * * Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] diff --git a/SRC/zsytrs_rook.f b/SRC/zsytrs_rook.f index 961780ad43..179edf7d11 100644 --- a/SRC/zsytrs_rook.f +++ b/SRC/zsytrs_rook.f @@ -224,7 +224,8 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * Multiply by inv(U(K)), where U(K) is the transformation * stored in column K of A. * - CALL ZGERU( K-1, NRHS, -CONE, A( 1, K ), 1, B( K, 1 ), LDB, + CALL ZGERU( K-1, NRHS, -CONE, A( 1, K ), 1, B( K, 1 ), + $ LDB, $ B( 1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -251,7 +252,8 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, IF( K.GT.2 ) THEN CALL ZGERU( K-2, NRHS,-CONE, A( 1, K ), 1, B( K, 1 ), $ LDB, B( 1, 1 ), LDB ) - CALL ZGERU( K-2, NRHS,-CONE, A( 1, K-1 ), 1, B( K-1, 1 ), + CALL ZGERU( K-2, NRHS,-CONE, A( 1, K-1 ), 1, B( K-1, + $ 1 ), $ LDB, B( 1, 1 ), LDB ) END IF * @@ -364,7 +366,8 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL ZGERU( N-K, NRHS, -CONE, A( K+1, K ), 1, B( K, 1 ), + $ CALL ZGERU( N-K, NRHS, -CONE, A( K+1, K ), 1, B( K, + $ 1 ), $ LDB, B( K+1, 1 ), LDB ) * * Multiply by the inverse of the diagonal block. @@ -389,7 +392,8 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K and K+1 of A. * IF( K.LT.N-1 ) THEN - CALL ZGERU( N-K-1, NRHS,-CONE, A( K+2, K ), 1, B( K, 1 ), + CALL ZGERU( N-K-1, NRHS,-CONE, A( K+2, K ), 1, B( K, + $ 1 ), $ LDB, B( K+2, 1 ), LDB ) CALL ZGERU( N-K-1, NRHS,-CONE, A( K+2, K+1 ), 1, $ B( K+1, 1 ), LDB, B( K+2, 1 ), LDB ) @@ -434,7 +438,8 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in column K of A. * IF( K.LT.N ) - $ CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + $ CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K ), 1, CONE, B( K, 1 ), LDB ) * * Interchange rows K and IPIV(K). @@ -451,9 +456,11 @@ SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * stored in columns K-1 and K of A. * IF( K.LT.N ) THEN - CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K ), 1, CONE, B( K, 1 ), LDB ) - CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, 1 ), + CALL ZGEMV( 'Transpose', N-K, NRHS, -CONE, B( K+1, + $ 1 ), $ LDB, A( K+1, K-1 ), 1, CONE, B( K-1, 1 ), $ LDB ) END IF diff --git a/SRC/ztbcon.f b/SRC/ztbcon.f index 6837666bc6..ce77c646d2 100644 --- a/SRC/ztbcon.f +++ b/SRC/ztbcon.f @@ -139,7 +139,8 @@ *> \ingroup tbcon * * ===================================================================== - SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, + SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, + $ WORK, $ RWORK, INFO ) * * -- LAPACK computational routine -- @@ -252,13 +253,15 @@ SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, * * Multiply by inv(A). * - CALL ZLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD, + CALL ZLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ KD, $ AB, LDAB, WORK, SCALE, RWORK, INFO ) ELSE * * Multiply by inv(A**H). * - CALL ZLATBS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL ZLATBS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, KD, AB, LDAB, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ztbrfs.f b/SRC/ztbrfs.f index 9e2c5a63e6..18c5d358fd 100644 --- a/SRC/ztbrfs.f +++ b/SRC/ztbrfs.f @@ -220,7 +220,8 @@ SUBROUTINE ZTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTBMV, ZTBSV + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTBMV, + $ ZTBSV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN diff --git a/SRC/ztbtrs.f b/SRC/ztbtrs.f index bafca1880e..38b8dd304f 100644 --- a/SRC/ztbtrs.f +++ b/SRC/ztbtrs.f @@ -187,7 +187,8 @@ SUBROUTINE ZTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 @@ -232,7 +233,8 @@ SUBROUTINE ZTBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * Solve A * X = B, A**T * X = B, or A**H * X = B. * DO 30 J = 1, NRHS - CALL ZTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) + CALL ZTBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), + $ 1 ) 30 CONTINUE * RETURN diff --git a/SRC/ztfsm.f b/SRC/ztfsm.f index 79d3bff29a..cba6cdb0d4 100644 --- a/SRC/ztfsm.f +++ b/SRC/ztfsm.f @@ -294,7 +294,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, + SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, + $ A, $ B, LDB ) * * -- LAPACK computational routine -- @@ -349,7 +350,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, INFO = -3 ELSE IF( .NOT.NOTRANS .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -4 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -5 ELSE IF( M.LT.0 ) THEN @@ -420,12 +422,15 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A, M, B, LDB ) ELSE - CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) - CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), + CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, + $ A( M1 ), $ M, B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, $ A( M ), M, B( M1, 0 ), LDB ) @@ -437,12 +442,15 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'C' * IF( M.EQ.1 ) THEN - CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M, B, LDB ) ELSE - CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, + $ ALPHA, $ A( M ), M, B( M1, 0 ), LDB ) - CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), + CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, + $ A( M1 ), $ M, B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, $ A( 0 ), M, B, LDB ) @@ -461,7 +469,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, $ A( M2 ), M, B, LDB ) - CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), M, + CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, A( 0 ), + $ M, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, $ A( M1 ), M, B( M1, 0 ), LDB ) @@ -473,7 +482,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, $ A( M1 ), M, B( M1, 0 ), LDB ) - CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), M, + CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, A( 0 ), + $ M, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, $ A( M2 ), M, B, LDB ) @@ -496,10 +506,12 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'N' * IF( M.EQ.1 ) THEN - CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, $ A( M1*M1 ), M1, B, LDB, ALPHA, @@ -514,10 +526,12 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * TRANS = 'C' * IF( M.EQ.1 ) THEN - CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, + $ ALPHA, $ A( 0 ), M1, B, LDB ) ELSE - CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, + CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, + $ ALPHA, $ A( 1 ), M1, B( M1, 0 ), LDB ) CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, $ A( M1*M1 ), M1, B( M1, 0 ), LDB, @@ -539,7 +553,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, $ A( M2*M2 ), M2, B, LDB ) - CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), M2, + CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( 0 ), + $ M2, $ B, LDB, ALPHA, B( M1, 0 ), LDB ) CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) @@ -551,7 +566,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, $ A( M1*M2 ), M2, B( M1, 0 ), LDB ) - CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), M2, + CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( 0 ), + $ M2, $ B( M1, 0 ), LDB, ALPHA, B, LDB ) CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, $ A( M2*M2 ), M2, B, LDB ) @@ -611,7 +627,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, ALPHA, $ A( K+1 ), M+1, B, LDB ) - CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), M+1, + CALL ZGEMM( 'C', 'N', K, N, K, -CONE, A( 0 ), + $ M+1, $ B, LDB, ALPHA, B( K, 0 ), LDB ) CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, CONE, $ A( K ), M+1, B( K, 0 ), LDB ) @@ -622,7 +639,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * and TRANS = 'C' CALL ZTRSM( 'L', 'U', 'N', DIAG, K, N, ALPHA, $ A( K ), M+1, B( K, 0 ), LDB ) - CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), M+1, + CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), + $ M+1, $ B( K, 0 ), LDB, ALPHA, B, LDB ) CALL ZTRSM( 'L', 'L', 'C', DIAG, K, N, CONE, $ A( K+1 ), M+1, B, LDB ) @@ -678,7 +696,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'L', 'U', 'C', DIAG, K, N, ALPHA, $ A( K*( K+1 ) ), K, B, LDB ) - CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, B, + CALL ZGEMM( 'N', 'N', K, N, K, -CONE, A( 0 ), K, + $ B, $ LDB, ALPHA, B( K, 0 ), LDB ) CALL ZTRSM( 'L', 'L', 'N', DIAG, K, N, CONE, $ A( K*K ), K, B( K, 0 ), LDB ) @@ -744,7 +763,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, $ A( N ), N, B( 0, N1 ), LDB ) - CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), + CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( N1 ), N, ALPHA, B( 0, 0 ), $ LDB ) CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, @@ -757,7 +777,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, $ A( 0 ), N, B( 0, 0 ), LDB ) - CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), + CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( N1 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, @@ -776,7 +797,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N1, ALPHA, $ A( N2 ), N, B( 0, 0 ), LDB ) - CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), + CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N, ALPHA, B( 0, N1 ), $ LDB ) CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N2, CONE, @@ -789,7 +811,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N2, ALPHA, $ A( N1 ), N, B( 0, N1 ), LDB ) - CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), + CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N, ALPHA, B( 0, 0 ), LDB ) CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N1, CONE, $ A( N2 ), N, B( 0, 0 ), LDB ) @@ -813,7 +836,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( 1 ), N1, B( 0, N1 ), LDB ) - CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, N1 ), + CALL ZGEMM( 'N', 'C', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, 0 ), $ LDB ) CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, @@ -826,7 +850,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( 0 ), N1, B( 0, 0 ), LDB ) - CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, 0 ), + CALL ZGEMM( 'N', 'N', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( N1*N1 ), N1, ALPHA, B( 0, N1 ), $ LDB ) CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, @@ -845,7 +870,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'U', 'N', DIAG, M, N1, ALPHA, $ A( N2*N2 ), N2, B( 0, 0 ), LDB ) - CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, 0 ), + CALL ZGEMM( 'N', 'C', M, N2, N1, -CONE, B( 0, + $ 0 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, N1 ), $ LDB ) CALL ZTRSM( 'R', 'L', 'C', DIAG, M, N2, CONE, @@ -858,7 +884,8 @@ SUBROUTINE ZTFSM( TRANSR, SIDE, UPLO, TRANS, DIAG, M, N, ALPHA, A, * CALL ZTRSM( 'R', 'L', 'N', DIAG, M, N2, ALPHA, $ A( N1*N2 ), N2, B( 0, N1 ), LDB ) - CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, N1 ), + CALL ZGEMM( 'N', 'N', M, N1, N2, -CONE, B( 0, + $ N1 ), $ LDB, A( 0 ), N2, ALPHA, B( 0, 0 ), $ LDB ) CALL ZTRSM( 'R', 'U', 'C', DIAG, M, N1, CONE, diff --git a/SRC/ztftri.f b/SRC/ztftri.f index b37a69c2e2..eb84ab3246 100644 --- a/SRC/ztftri.f +++ b/SRC/ztftri.f @@ -263,7 +263,8 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) INFO = -1 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. .NOT.LSAME( DIAG, 'U' ) ) + ELSE IF( .NOT.LSAME( DIAG, 'N' ) .AND. + $ .NOT.LSAME( DIAG, 'U' ) ) $ THEN INFO = -3 ELSE IF( N.LT.0 ) THEN @@ -319,14 +320,16 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL ZTRTRI( 'L', DIAG, N1, A( 0 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'R', 'L', 'N', DIAG, N2, N1, -CONE, A( 0 ), + CALL ZTRMM( 'R', 'L', 'N', DIAG, N2, N1, -CONE, + $ A( 0 ), $ N, A( N1 ), N ) CALL ZTRTRI( 'U', DIAG, N2, A( N ), N, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'U', 'C', DIAG, N2, N1, CONE, A( N ), N, + CALL ZTRMM( 'L', 'U', 'C', DIAG, N2, N1, CONE, A( N ), + $ N, $ A( N1 ), N ) * ELSE @@ -338,14 +341,16 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL ZTRTRI( 'L', DIAG, N1, A( N2 ), N, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'L', 'C', DIAG, N1, N2, -CONE, A( N2 ), + CALL ZTRMM( 'L', 'L', 'C', DIAG, N1, N2, -CONE, + $ A( N2 ), $ N, A( 0 ), N ) CALL ZTRTRI( 'U', DIAG, N2, A( N1 ), N, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + N1 IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'R', 'U', 'N', DIAG, N1, N2, CONE, A( N1 ), + CALL ZTRMM( 'R', 'U', 'N', DIAG, N1, N2, CONE, + $ A( N1 ), $ N, A( 0 ), N ) * END IF @@ -362,7 +367,8 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL ZTRTRI( 'U', DIAG, N1, A( 0 ), N1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'U', 'N', DIAG, N1, N2, -CONE, A( 0 ), + CALL ZTRMM( 'L', 'U', 'N', DIAG, N1, N2, -CONE, + $ A( 0 ), $ N1, A( N1*N1 ), N1 ) CALL ZTRTRI( 'L', DIAG, N2, A( 1 ), N1, INFO ) IF( INFO.GT.0 ) @@ -417,7 +423,8 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'U', 'C', DIAG, K, K, CONE, A( 0 ), N+1, + CALL ZTRMM( 'L', 'U', 'C', DIAG, K, K, CONE, A( 0 ), + $ N+1, $ A( K+1 ), N+1 ) * ELSE @@ -429,14 +436,16 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL ZTRTRI( 'L', DIAG, K, A( K+1 ), N+1, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'L', 'C', DIAG, K, K, -CONE, A( K+1 ), + CALL ZTRMM( 'L', 'L', 'C', DIAG, K, K, -CONE, + $ A( K+1 ), $ N+1, A( 0 ), N+1 ) CALL ZTRTRI( 'U', DIAG, K, A( K ), N+1, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'R', 'U', 'N', DIAG, K, K, CONE, A( K ), N+1, + CALL ZTRMM( 'R', 'U', 'N', DIAG, K, K, CONE, A( K ), + $ N+1, $ A( 0 ), N+1 ) END IF ELSE @@ -452,14 +461,16 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) CALL ZTRTRI( 'U', DIAG, K, A( K ), K, INFO ) IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'U', 'N', DIAG, K, K, -CONE, A( K ), K, + CALL ZTRMM( 'L', 'U', 'N', DIAG, K, K, -CONE, A( K ), + $ K, $ A( K*( K+1 ) ), K ) CALL ZTRTRI( 'L', DIAG, K, A( 0 ), K, INFO ) IF( INFO.GT.0 ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'R', 'L', 'C', DIAG, K, K, CONE, A( 0 ), K, + CALL ZTRMM( 'R', 'L', 'C', DIAG, K, K, CONE, A( 0 ), + $ K, $ A( K*( K+1 ) ), K ) ELSE * @@ -477,7 +488,8 @@ SUBROUTINE ZTFTRI( TRANSR, UPLO, DIAG, N, A, INFO ) $ INFO = INFO + K IF( INFO.GT.0 ) $ RETURN - CALL ZTRMM( 'L', 'L', 'N', DIAG, K, K, CONE, A( K*K ), K, + CALL ZTRMM( 'L', 'L', 'N', DIAG, K, K, CONE, A( K*K ), + $ K, $ A( 0 ), K ) END IF END IF diff --git a/SRC/ztgevc.f b/SRC/ztgevc.f index eb060af98b..a6e254da51 100644 --- a/SRC/ztgevc.f +++ b/SRC/ztgevc.f @@ -528,7 +528,8 @@ SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * Back transform eigenvector if HOWMNY='B'. * IF( ILBACK ) THEN - CALL ZGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), LDVL, + CALL ZGEMV( 'N', N, N+1-JE, CONE, VL( 1, JE ), + $ LDVL, $ WORK( JE ), 1, CZERO, WORK( N+1 ), 1 ) ISRC = 2 IBEG = 1 diff --git a/SRC/ztgex2.f b/SRC/ztgex2.f index c6f9e2de31..d2941e0da2 100644 --- a/SRC/ztgex2.f +++ b/SRC/ztgex2.f @@ -316,7 +316,8 @@ SUBROUTINE ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, CALL ZLACPY( 'Full', M, M, S, LDST, WORK, M ) CALL ZLACPY( 'Full', M, M, T, LDST, WORK( M*M+1 ), M ) CALL ZROT( 2, WORK, 1, WORK( 3 ), 1, CZ, -DCONJG( SZ ) ) - CALL ZROT( 2, WORK( 5 ), 1, WORK( 7 ), 1, CZ, -DCONJG( SZ ) ) + CALL ZROT( 2, WORK( 5 ), 1, WORK( 7 ), 1, CZ, + $ -DCONJG( SZ ) ) CALL ZROT( 2, WORK, 2, WORK( 2 ), 2, CQ, -SQ ) CALL ZROT( 2, WORK( 5 ), 2, WORK( 6 ), 2, CQ, -SQ ) DO 10 I = 1, 2 @@ -345,8 +346,10 @@ SUBROUTINE ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, $ DCONJG( SZ ) ) CALL ZROT( J1+1, B( 1, J1 ), 1, B( 1, J1+1 ), 1, CZ, $ DCONJG( SZ ) ) - CALL ZROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, SQ ) - CALL ZROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, SQ ) + CALL ZROT( N-J1+1, A( J1, J1 ), LDA, A( J1+1, J1 ), LDA, CQ, + $ SQ ) + CALL ZROT( N-J1+1, B( J1, J1 ), LDB, B( J1+1, J1 ), LDB, CQ, + $ SQ ) * * Set N1 by N2 (2,1) blocks to 0 * diff --git a/SRC/ztgexc.f b/SRC/ztgexc.f index f7287ee260..c89016b078 100644 --- a/SRC/ztgexc.f +++ b/SRC/ztgexc.f @@ -262,7 +262,8 @@ SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap with next one below * - CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, + CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ LDZ, $ HERE, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE @@ -279,7 +280,8 @@ SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, * * Swap with next one above * - CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, + CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ LDZ, $ HERE, INFO ) IF( INFO.NE.0 ) THEN ILST = HERE diff --git a/SRC/ztgsen.f b/SRC/ztgsen.f index 45d6525df5..fca4d0eedb 100644 --- a/SRC/ztgsen.f +++ b/SRC/ztgsen.f @@ -428,7 +428,8 @@ *> 1996. *> * ===================================================================== - SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * @@ -469,7 +470,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, ZTGEXC, + EXTERNAL XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, + $ ZTGEXC, $ ZTGSYL * .. * .. Intrinsic Functions .. @@ -593,7 +595,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * and Z that will swap adjacent diagonal blocks in (A, B). * IF( K.NE.KS ) - $ CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, K, KS, IERR ) * IF( IERR.GT.0 ) THEN @@ -623,7 +626,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, N2 = N - M I = N1 + 1 CALL ZLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) IJB = 0 CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, @@ -665,14 +669,16 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu estimate. * - CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl estimate. * - CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -700,7 +706,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -709,7 +716,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -729,7 +737,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -738,7 +747,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, diff --git a/SRC/ztgsja.f b/SRC/ztgsja.f index b2bb5182d4..2a2175a4a6 100644 --- a/SRC/ztgsja.f +++ b/SRC/ztgsja.f @@ -418,7 +418,8 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARTG, XERBLA, ZCOPY, ZDSCAL, ZLAGS2, ZLAPLL, + EXTERNAL DLARTG, XERBLA, ZCOPY, ZDSCAL, ZLAGS2, + $ ZLAPLL, $ ZLASET, ZROT * .. * .. Intrinsic Functions .. @@ -441,9 +442,13 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, INFO = 0 IF( .NOT.( INITU .OR. WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN INFO = -1 - ELSE IF( .NOT.( INITV .OR. WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITV .OR. + $ WANTV .OR. + $ LSAME( JOBV, 'N' ) ) ) THEN INFO = -2 - ELSE IF( .NOT.( INITQ .OR. WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN + ELSE IF( .NOT.( INITQ .OR. + $ WANTQ .OR. + $ LSAME( JOBQ, 'N' ) ) ) THEN INFO = -3 ELSE IF( M.LT.0 ) THEN INFO = -4 @@ -513,7 +518,8 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, * Update (K+I)-th and (K+J)-th rows of matrix A: U**H *A * IF( K+J.LE.M ) - $ CALL ZROT( L, A( K+J, N-L+1 ), LDA, A( K+I, N-L+1 ), + $ CALL ZROT( L, A( K+J, N-L+1 ), LDA, A( K+I, + $ N-L+1 ), $ LDA, CSU, DCONJG( SNU ) ) * * Update I-th and J-th rows of matrix B: V**H *B @@ -556,10 +562,12 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ SNU ) * IF( WANTV ) - $ CALL ZROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, SNV ) + $ CALL ZROT( P, V( 1, J ), 1, V( 1, I ), 1, CSV, + $ SNV ) * IF( WANTQ ) - $ CALL ZROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, CSQ, + $ CALL ZROT( N, Q( 1, N-L+J ), 1, Q( 1, N-L+I ), 1, + $ CSQ, $ SNQ ) * 10 CONTINUE @@ -576,7 +584,8 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, ERROR = ZERO DO 30 I = 1, MIN( L, M-K ) CALL ZCOPY( L-I+1, A( K+I, N-L+I ), LDA, WORK, 1 ) - CALL ZCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), 1 ) + CALL ZCOPY( L-I+1, B( I, N-L+I ), LDB, WORK( L+1 ), + $ 1 ) CALL ZLAPLL( L-I+1, WORK, 1, WORK( L+1 ), 1, SSMIN ) ERROR = MAX( ERROR, SSMIN ) 30 CONTINUE @@ -619,16 +628,19 @@ SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, $ CALL ZDSCAL( P, -ONE, V( 1, I ), 1 ) END IF * - CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), ALPHA( K+I ), + CALL DLARTG( ABS( GAMMA ), ONE, BETA( K+I ), + $ ALPHA( K+I ), $ RWK ) * IF( ALPHA( K+I ).GE.BETA( K+I ) ) THEN - CALL ZDSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, N-L+I ), + CALL ZDSCAL( L-I+1, ONE / ALPHA( K+I ), A( K+I, + $ N-L+I ), $ LDA ) ELSE CALL ZDSCAL( L-I+1, ONE / BETA( K+I ), B( I, N-L+I ), $ LDB ) - CALL ZCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, N-L+I ), + CALL ZCOPY( L-I+1, B( I, N-L+I ), LDB, A( K+I, + $ N-L+I ), $ LDA ) END IF * diff --git a/SRC/ztgsna.f b/SRC/ztgsna.f index abbea8cad3..73f35a97a5 100644 --- a/SRC/ztgsna.f +++ b/SRC/ztgsna.f @@ -346,10 +346,12 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LOGICAL LSAME DOUBLE PRECISION DLAMCH, DLAPY2, DZNRM2 COMPLEX*16 ZDOTC - EXTERNAL LSAME, DLAMCH, DLAPY2, DZNRM2, ZDOTC + EXTERNAL LSAME, DLAMCH, DLAPY2, DZNRM2, + $ ZDOTC * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMV, ZLACPY, ZTGEXC, ZTGSYL + EXTERNAL XERBLA, ZGEMV, ZLACPY, ZTGEXC, + $ ZTGSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCMPLX, MAX @@ -465,7 +467,8 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * IF( WANTDF ) THEN IF( N.EQ.1 ) THEN - DIF( KS ) = DLAPY2( ABS( A( 1, 1 ) ), ABS( B( 1, 1 ) ) ) + DIF( KS ) = DLAPY2( ABS( A( 1, 1 ) ), ABS( B( 1, + $ 1 ) ) ) ELSE * * Estimate the reciprocal condition number of the k-th @@ -479,7 +482,8 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, IFST = K ILST = 1 * - CALL ZTGEXC( .FALSE., .FALSE., N, WORK, N, WORK( N*N+1 ), + CALL ZTGEXC( .FALSE., .FALSE., N, WORK, N, + $ WORK( N*N+1 ), $ N, DUMMY, 1, DUMMY1, 1, IFST, ILST, IERR ) * IF( IERR.GT.0 ) THEN @@ -498,7 +502,8 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, N1 = 1 N2 = N - N1 I = N*N + 1 - CALL ZTGSYL( 'N', IDIFJB, N2, N1, WORK( N*N1+N1+1 ), + CALL ZTGSYL( 'N', IDIFJB, N2, N1, + $ WORK( N*N1+N1+1 ), $ N, WORK, N, WORK( N1+1 ), N, $ WORK( N*N1+N1+I ), N, WORK( I ), N, $ WORK( N1+I ), N, SCALE, DIF( KS ), DUMMY, diff --git a/SRC/ztgsy2.f b/SRC/ztgsy2.f index 87fed3a23c..1253c99d5e 100644 --- a/SRC/ztgsy2.f +++ b/SRC/ztgsy2.f @@ -254,7 +254,8 @@ *> Umea University, S-901 87 Umea, Sweden. * * ===================================================================== - SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, $ INFO ) * @@ -294,7 +295,8 @@ SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZGESC2, ZGETC2, ZLATDF, ZSCAL + EXTERNAL XERBLA, ZAXPY, ZGESC2, ZGETC2, ZLATDF, + $ ZSCAL * .. * .. Intrinsic Functions .. INTRINSIC DCMPLX, DCONJG, MAX @@ -391,8 +393,10 @@ SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, * IF( I.GT.1 ) THEN ALPHA = -RHS( 1 ) - CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), 1 ) - CALL ZAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), 1 ) + CALL ZAXPY( I-1, ALPHA, A( 1, I ), 1, C( 1, J ), + $ 1 ) + CALL ZAXPY( I-1, ALPHA, D( 1, I ), 1, F( 1, J ), + $ 1 ) END IF IF( J.LT.N ) THEN CALL ZAXPY( N-J, RHS( 2 ), B( J, J+1 ), LDB, @@ -436,9 +440,11 @@ SUBROUTINE ZTGSY2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, CALL ZGESC2( LDZ, Z, LDZ, RHS, IPIV, JPIV, SCALOC ) IF( SCALOC.NE.ONE ) THEN DO 40 K = 1, N - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 40 CONTINUE SCALE = SCALE*SCALOC diff --git a/SRC/ztgsyl.f b/SRC/ztgsyl.f index 23f2571f5b..47ba8164f0 100644 --- a/SRC/ztgsyl.f +++ b/SRC/ztgsyl.f @@ -290,7 +290,8 @@ *> July 1989, pp 745-751. *> * ===================================================================== - SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, + SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DIF, WORK, LWORK, $ IWORK, INFO ) * @@ -333,7 +334,8 @@ SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZGEMM, ZLACPY, ZLASET, ZSCAL, ZTGSY2 + EXTERNAL XERBLA, ZGEMM, ZLACPY, ZLASET, ZSCAL, + $ ZTGSY2 * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, MAX, SQRT @@ -437,7 +439,8 @@ SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, DSCALE = ZERO DSUM = ONE PQ = M*N - CALL ZTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, D, + CALL ZTGSY2( TRANS, IFUNC, M, N, A, LDA, B, LDB, C, LDC, + $ D, $ LDD, E, LDE, F, LDF, SCALE, DSUM, DSCALE, $ INFO ) IF( DSCALE.NE.ZERO ) THEN @@ -525,7 +528,8 @@ SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, IS = IWORK( I ) IE = IWORK( I+1 ) - 1 MB = IE - IS + 1 - CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), LDA, + CALL ZTGSY2( TRANS, IFUNC, MB, NB, A( IS, IS ), + $ LDA, $ B( JS, JS ), LDB, C( IS, JS ), LDC, $ D( IS, IS ), LDD, E( JS, JS ), LDE, $ F( IS, JS ), LDF, SCALOC, DSUM, DSCALE, @@ -634,9 +638,11 @@ SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ INFO = LINFO IF( SCALOC.NE.ONE ) THEN DO 160 K = 1, JS - 1 - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 160 CONTINUE DO 170 K = JS, JE @@ -652,9 +658,11 @@ SUBROUTINE ZTGSYL( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, $ F( IE+1, K ), 1 ) 180 CONTINUE DO 190 K = JE + 1, N - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), C( 1, + $ K ), $ 1 ) - CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, K ), + CALL ZSCAL( M, DCMPLX( SCALOC, ZERO ), F( 1, + $ K ), $ 1 ) 190 CONTINUE SCALE = SCALE*SCALOC diff --git a/SRC/ztpcon.f b/SRC/ztpcon.f index 1e3bc4bb7e..c285398ddf 100644 --- a/SRC/ztpcon.f +++ b/SRC/ztpcon.f @@ -235,13 +235,15 @@ SUBROUTINE ZTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, * * Multiply by inv(A). * - CALL ZLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, AP, + CALL ZLATPS( UPLO, 'No transpose', DIAG, NORMIN, N, + $ AP, $ WORK, SCALE, RWORK, INFO ) ELSE * * Multiply by inv(A**H). * - CALL ZLATPS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL ZLATPS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, AP, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f index e5006ed3c9..3f9fa32f79 100644 --- a/SRC/ztpmlqt.f +++ b/SRC/ztpmlqt.f @@ -210,7 +210,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, + SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/ztpmqrt.f b/SRC/ztpmqrt.f index 215242f402..c753505bd2 100644 --- a/SRC/ztpmqrt.f +++ b/SRC/ztpmqrt.f @@ -212,7 +212,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT, + SUBROUTINE ZTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, + $ LDT, $ A, LDA, B, LDB, WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/ztprfb.f b/SRC/ztprfb.f index 6d7f05ec42..4552e7accd 100644 --- a/SRC/ztprfb.f +++ b/SRC/ztprfb.f @@ -433,7 +433,8 @@ SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL ZGEMM( 'N', 'C', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL ZGEMM( 'N', 'C', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL ZGEMM( 'N', 'C', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( NP, KP ), LDV, ONE, B( 1, NP ), LDB ) CALL ZTRMM( 'R', 'U', 'C', 'N', M, L, ONE, V( NP, 1 ), LDV, $ WORK, LDWORK ) @@ -674,7 +675,8 @@ SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * CALL ZGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) - CALL ZGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, + CALL ZGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), + $ LDWORK, $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) CALL ZTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV, $ WORK, LDWORK ) diff --git a/SRC/ztprfs.f b/SRC/ztprfs.f index e5ea125763..6c4e513bbe 100644 --- a/SRC/ztprfs.f +++ b/SRC/ztprfs.f @@ -170,7 +170,8 @@ *> \ingroup tprfs * * ===================================================================== - SUBROUTINE ZTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, + SUBROUTINE ZTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, + $ LDX, $ FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -205,7 +206,8 @@ SUBROUTINE ZTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTPMV, ZTPSV + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTPMV, + $ ZTPSV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX diff --git a/SRC/ztptrs.f b/SRC/ztptrs.f index 4dffcd566b..bf40b413dd 100644 --- a/SRC/ztptrs.f +++ b/SRC/ztptrs.f @@ -127,7 +127,8 @@ *> \ingroup tptrs * * ===================================================================== - SUBROUTINE ZTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) + SUBROUTINE ZTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -171,7 +172,8 @@ SUBROUTINE ZTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/ztrcon.f b/SRC/ztrcon.f index 0e4071e35e..15373cb52e 100644 --- a/SRC/ztrcon.f +++ b/SRC/ztrcon.f @@ -250,7 +250,8 @@ SUBROUTINE ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, * * Multiply by inv(A**H). * - CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG, NORMIN, + CALL ZLATRS( UPLO, 'Conjugate transpose', DIAG, + $ NORMIN, $ N, A, LDA, WORK, SCALE, RWORK, INFO ) END IF NORMIN = 'Y' diff --git a/SRC/ztrevc.f b/SRC/ztrevc.f index 7a3cf17768..e373ac1fcd 100644 --- a/SRC/ztrevc.f +++ b/SRC/ztrevc.f @@ -214,7 +214,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -254,7 +255,8 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, IZAMAX, DLAMCH, DZASUM * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS + EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, + $ ZLATRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX @@ -388,7 +390,8 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 60 CONTINUE ELSE IF( KI.GT.1 ) - $ CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR, WORK( 1 ), + $ CALL ZGEMV( 'N', N, KI-1, CMONE, VR, LDVR, + $ WORK( 1 ), $ 1, DCMPLX( SCALE ), VR( 1, KI ), 1 ) * II = IZAMAX( N, VR( 1, KI ), 1 ) @@ -437,7 +440,8 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 100 CONTINUE * IF( KI.LT.N ) THEN - CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + CALL ZLATRS( 'Upper', 'Conjugate transpose', + $ 'Non-unit', $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, $ WORK( KI+1 ), SCALE, RWORK, INFO ) WORK( KI ) = SCALE @@ -457,7 +461,8 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 110 CONTINUE ELSE IF( KI.LT.N ) - $ CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), LDVL, + $ CALL ZGEMV( 'N', N, N-KI, CMONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1 ), 1, DCMPLX( SCALE ), $ VL( 1, KI ), 1 ) * diff --git a/SRC/ztrevc3.f b/SRC/ztrevc3.f index eaf39d77a7..0b0a3d6bd0 100644 --- a/SRC/ztrevc3.f +++ b/SRC/ztrevc3.f @@ -240,7 +240,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) IMPLICIT NONE * @@ -280,10 +281,12 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LOGICAL LSAME INTEGER ILAENV, IZAMAX DOUBLE PRECISION DLAMCH, DZASUM - EXTERNAL LSAME, ILAENV, IZAMAX, DLAMCH, DZASUM + EXTERNAL LSAME, ILAENV, IZAMAX, DLAMCH, + $ DZASUM * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS, + EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, + $ ZLATRS, $ ZGEMM, ZLASET, ZLACPY * .. * .. Intrinsic Functions .. @@ -543,7 +546,8 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 100 CONTINUE * IF( KI.LT.N ) THEN - CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + 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 @@ -554,7 +558,8 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, 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 ) + 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 ) ) @@ -568,7 +573,8 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * ------------------------------ * 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, + $ CALL ZGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), + $ LDVL, $ WORK( KI+1 + IV*N ), 1, DCMPLX( SCALE ), $ VL( 1, KI ), 1 ) * diff --git a/SRC/ztrexc.f b/SRC/ztrexc.f index 1ebb18bed7..1355c34143 100644 --- a/SRC/ztrexc.f +++ b/SRC/ztrexc.f @@ -214,7 +214,8 @@ SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO ) * Apply transformation to the matrix T. * IF( K+2.LE.N ) - $ CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS, + $ CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, + $ CS, $ SN ) CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, $ DCONJG( SN ) ) diff --git a/SRC/ztrrfs.f b/SRC/ztrrfs.f index 8399259170..c55dd331c2 100644 --- a/SRC/ztrrfs.f +++ b/SRC/ztrrfs.f @@ -178,7 +178,8 @@ *> \ingroup trrfs * * ===================================================================== - SUBROUTINE ZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, + SUBROUTINE ZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, + $ X, $ LDX, FERR, BERR, WORK, RWORK, INFO ) * * -- LAPACK computational routine -- @@ -214,7 +215,8 @@ SUBROUTINE ZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTRMV, ZTRSV + EXTERNAL XERBLA, ZAXPY, ZCOPY, ZLACN2, ZTRMV, + $ ZTRSV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX diff --git a/SRC/ztrsen.f b/SRC/ztrsen.f index 2a3257f6a8..d848d4a0d8 100644 --- a/SRC/ztrsen.f +++ b/SRC/ztrsen.f @@ -260,7 +260,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, + SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, + $ S, $ SEP, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -298,7 +299,8 @@ SUBROUTINE ZTRSEN( JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, EXTERNAL LSAME, ZLANGE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACN2, ZLACPY, ZTREXC, ZTRSYL + EXTERNAL XERBLA, ZLACN2, ZLACPY, ZTREXC, + $ ZTRSYL * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/ztrsna.f b/SRC/ztrsna.f index b2b2362b3a..dbd6a7d810 100644 --- a/SRC/ztrsna.f +++ b/SRC/ztrsna.f @@ -244,7 +244,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, $ LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, $ INFO ) * @@ -286,10 +287,12 @@ SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, INTEGER IZAMAX DOUBLE PRECISION DLAMCH, DZNRM2 COMPLEX*16 ZDOTC - EXTERNAL LSAME, IZAMAX, DLAMCH, DZNRM2, ZDOTC + EXTERNAL LSAME, IZAMAX, DLAMCH, DZNRM2, + $ ZDOTC * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC + EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, + $ ZTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -398,7 +401,8 @@ SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * diagonal element to the (1,1) position. * CALL ZLACPY( 'Full', N, N, T, LDT, WORK, LDWORK ) - CALL ZTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1, IERR ) + CALL ZTREXC( 'No Q', N, WORK, LDWORK, DUMMY, 1, K, 1, + $ IERR ) * * Form C = T22 - lambda*I in WORK(2:N,2:N). * @@ -414,7 +418,8 @@ SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, KASE = 0 NORMIN = 'N' 30 CONTINUE - CALL ZLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE, ISAVE ) + CALL ZLACN2( N-1, WORK( 1, N+1 ), WORK, EST, KASE, + $ ISAVE ) * IF( KASE.NE.0 ) THEN IF( KASE.EQ.1 ) THEN diff --git a/SRC/ztrsyl.f b/SRC/ztrsyl.f index 0c861be3c9..0ae6d5748e 100644 --- a/SRC/ztrsyl.f +++ b/SRC/ztrsyl.f @@ -189,7 +189,8 @@ SUBROUTINE ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME DOUBLE PRECISION DLAMCH, ZLANGE COMPLEX*16 ZDOTC, ZDOTU, ZLADIV - EXTERNAL LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, ZLADIV + EXTERNAL LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, + $ ZLADIV * .. * .. External Subroutines .. EXTERNAL XERBLA, ZDSCAL diff --git a/SRC/ztrsyl3.f b/SRC/ztrsyl3.f index 60ed8e28e7..eb40ae0d21 100644 --- a/SRC/ztrsyl3.f +++ b/SRC/ztrsyl3.f @@ -153,7 +153,8 @@ * Angelika Schwarz, Umea University, Sweden. * * ===================================================================== - SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, + SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, + $ C, $ LDC, SCALE, SWORK, LDSWORK, INFO ) IMPLICIT NONE * @@ -187,10 +188,12 @@ SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLARMM, ZLANGE - EXTERNAL DLAMCH, DLARMM, ILAENV, LSAME, ZLANGE + EXTERNAL DLAMCH, DLARMM, ILAENV, LSAME, + $ ZLANGE * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDSCAL, ZGEMM, ZLASCL, ZTRSYL + EXTERNAL XERBLA, ZDSCAL, ZGEMM, ZLASCL, + $ ZTRSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, EXPONENT, MAX, MIN diff --git a/SRC/ztrtri.f b/SRC/ztrtri.f index 95bd49a665..3c8f86915a 100644 --- a/SRC/ztrtri.f +++ b/SRC/ztrtri.f @@ -199,9 +199,11 @@ SUBROUTINE ZTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * * Compute rows 1:j-1 of current block column * - CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, + CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, ONE, A, LDA, A( 1, J ), LDA ) - CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, + CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, + $ J-1, $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) * * Compute inverse of current diagonal block diff --git a/SRC/ztrtrs.f b/SRC/ztrtrs.f index 43ce109ac2..ef4a2f01b8 100644 --- a/SRC/ztrtrs.f +++ b/SRC/ztrtrs.f @@ -177,10 +177,12 @@ SUBROUTINE ZTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * INFO = 0 NOUNIT = LSAME( DIAG, 'N' ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. - $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN + $ LSAME( TRANS, 'T' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) THEN INFO = -2 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN INFO = -3 diff --git a/SRC/ztzrzf.f b/SRC/ztzrzf.f index 2160ae63d9..125542053e 100644 --- a/SRC/ztzrzf.f +++ b/SRC/ztzrzf.f @@ -281,7 +281,8 @@ SUBROUTINE ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL ZLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ), + CALL ZLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, + $ M1 ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:i-1,i:n) from the right diff --git a/SRC/zunbdb.f b/SRC/zunbdb.f index ec7a380428..2965b8c810 100644 --- a/SRC/zunbdb.f +++ b/SRC/zunbdb.f @@ -282,7 +282,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, + $ LDX12, $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1, $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO ) * @@ -316,7 +317,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, DOUBLE PRECISION Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZLARF, ZLARFGP, ZSCAL, XERBLA + EXTERNAL ZAXPY, ZLARF, ZLARFGP, ZSCAL, + $ XERBLA EXTERNAL ZLACGV * * .. @@ -407,9 +409,11 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ 0.0D0 ), X12(I,I-1), 1, X11(I,I), 1 ) END IF IF( I .EQ. 1 ) THEN - CALL ZSCAL( M-P-I+1, DCMPLX( Z2, 0.0D0 ), X21(I,I), 1 ) + CALL ZSCAL( M-P-I+1, DCMPLX( Z2, 0.0D0 ), X21(I,I), + $ 1 ) ELSE - CALL ZSCAL( M-P-I+1, DCMPLX( Z2*COS(PHI(I-1)), 0.0D0 ), + CALL ZSCAL( M-P-I+1, DCMPLX( Z2*COS(PHI(I-1)), + $ 0.0D0 ), $ X21(I,I), 1 ) CALL ZAXPY( M-P-I+1, DCMPLX( -Z2*Z3*Z4*SIN(PHI(I-1)), $ 0.0D0 ), X22(I,I-1), 1, X21(I,I), 1 ) @@ -419,7 +423,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ DZNRM2( P-I+1, X11(I,I), 1 ) ) * IF( P .GT. I ) THEN - CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, + $ TAUP1(I) ) ELSE IF ( P .EQ. I ) THEN CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF @@ -447,14 +452,17 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, END IF * IF( I .LT. Q ) THEN - CALL ZSCAL( Q-I, DCMPLX( -Z1*Z3*SIN(THETA(I)), 0.0D0 ), + CALL ZSCAL( Q-I, DCMPLX( -Z1*Z3*SIN(THETA(I)), + $ 0.0D0 ), $ X11(I,I+1), LDX11 ) CALL ZAXPY( Q-I, DCMPLX( Z2*Z3*COS(THETA(I)), 0.0D0 ), $ X21(I,I+1), LDX21, X11(I,I+1), LDX11 ) END IF - CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4*SIN(THETA(I)), 0.0D0 ), + CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4*SIN(THETA(I)), + $ 0.0D0 ), $ X12(I,I), LDX12 ) - CALL ZAXPY( M-Q-I+1, DCMPLX( Z2*Z4*COS(THETA(I)), 0.0D0 ), + CALL ZAXPY( M-Q-I+1, DCMPLX( Z2*Z4*COS(THETA(I)), + $ 0.0D0 ), $ X22(I,I), LDX22, X12(I,I), LDX12 ) * IF( I .LT. Q ) @@ -485,13 +493,16 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL ZLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL ZLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL ZLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), + CALL ZLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN @@ -522,7 +533,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), + CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) @@ -569,7 +581,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL ZSCAL( M-P-I+1, DCMPLX( Z2, 0.0D0 ), X21(I,I), $ LDX21 ) ELSE - CALL ZSCAL( M-P-I+1, DCMPLX( Z2*COS(PHI(I-1)), 0.0D0 ), + CALL ZSCAL( M-P-I+1, DCMPLX( Z2*COS(PHI(I-1)), + $ 0.0D0 ), $ X21(I,I), LDX21 ) CALL ZAXPY( M-P-I+1, DCMPLX( -Z2*Z3*Z4*SIN(PHI(I-1)), $ 0.0D0 ), X22(I-1,I), LDX22, X21(I,I), LDX21 ) @@ -581,7 +594,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL ZLACGV( P-I+1, X11(I,I), LDX11 ) CALL ZLACGV( M-P-I+1, X21(I,I), LDX21 ) * - CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) + CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, + $ TAUP1(I) ) X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, @@ -594,7 +608,8 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * CALL ZLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), $ X11(I+1,I), LDX11, WORK ) - CALL ZLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I), + CALL ZLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), $ X12(I,I), LDX12, WORK ) CALL ZLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), $ X21(I+1,I), LDX21, WORK ) @@ -605,14 +620,17 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, CALL ZLACGV( M-P-I+1, X21(I,I), LDX21 ) * IF( I .LT. Q ) THEN - CALL ZSCAL( Q-I, DCMPLX( -Z1*Z3*SIN(THETA(I)), 0.0D0 ), + CALL ZSCAL( Q-I, DCMPLX( -Z1*Z3*SIN(THETA(I)), + $ 0.0D0 ), $ X11(I+1,I), 1 ) CALL ZAXPY( Q-I, DCMPLX( Z2*Z3*COS(THETA(I)), 0.0D0 ), $ X21(I+1,I), 1, X11(I+1,I), 1 ) END IF - CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4*SIN(THETA(I)), 0.0D0 ), + CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4*SIN(THETA(I)), + $ 0.0D0 ), $ X12(I,I), 1 ) - CALL ZAXPY( M-Q-I+1, DCMPLX( Z2*Z4*COS(THETA(I)), 0.0D0 ), + CALL ZAXPY( M-Q-I+1, DCMPLX( Z2*Z4*COS(THETA(I)), + $ 0.0D0 ), $ X22(I,I), 1, X12(I,I), 1 ) * IF( I .LT. Q ) @@ -620,10 +638,12 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, $ DZNRM2( M-Q-I+1, X12(I,I), 1 ) ) * IF( I .LT. Q ) THEN - CALL ZLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, TAUQ1(I) ) + CALL ZLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, + $ TAUQ1(I) ) X11(I+1,I) = ONE END IF - CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF( I .LT. Q ) THEN @@ -645,8 +665,10 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, * DO I = Q + 1, P * - CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4, 0.0D0 ), X12(I,I), 1 ) - CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) + CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4, 0.0D0 ), X12(I,I), + $ 1 ) + CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, + $ TAUQ2(I) ) X12(I,I) = ONE * IF ( P .GT. I ) THEN diff --git a/SRC/zunbdb1.f b/SRC/zunbdb1.f index cf791f87b5..e3756d2b8b 100644 --- a/SRC/zunbdb1.f +++ b/SRC/zunbdb1.f @@ -199,7 +199,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -228,7 +229,8 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, XERBLA + EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, + $ XERBLA EXTERNAL ZLACGV * .. * .. External Functions .. @@ -291,14 +293,16 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, X21(I,I) = ONE CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)), $ X11(I,I+1), LDX11, WORK(ILARF) ) - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, DCONJG(TAUP2(I)), + CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ DCONJG(TAUP2(I)), $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN CALL ZDROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, $ S ) CALL ZLACGV( Q-I, X21(I,I+1), LDX21 ) - CALL ZLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, TAUQ1(I) ) + CALL ZLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, + $ TAUQ1(I) ) S = DBLE( X21(I,I+1) ) X21(I,I+1) = ONE CALL ZLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), diff --git a/SRC/zunbdb2.f b/SRC/zunbdb2.f index 768dc82fc8..ccf8c3d994 100644 --- a/SRC/zunbdb2.f +++ b/SRC/zunbdb2.f @@ -197,7 +197,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -227,7 +228,8 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, ZLACGV, + EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, + $ ZLACGV, $ XERBLA * .. * .. External Functions .. @@ -309,11 +311,13 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, C = COS( PHI(I) ) S = SIN( PHI(I) ) X11(I+1,I) = ONE - CALL ZLARF( 'L', P-I, Q-I, X11(I+1,I), 1, DCONJG(TAUP1(I)), + CALL ZLARF( 'L', P-I, Q-I, X11(I+1,I), 1, + $ DCONJG(TAUP1(I)), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF X21(I,I) = ONE - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, DCONJG(TAUP2(I)), + CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ DCONJG(TAUP2(I)), $ X21(I,I+1), LDX21, WORK(ILARF) ) * END DO @@ -323,7 +327,8 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, DO I = P + 1, Q CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) X21(I,I) = ONE - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, DCONJG(TAUP2(I)), + CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ DCONJG(TAUP2(I)), $ X21(I,I+1), LDX21, WORK(ILARF) ) END DO * diff --git a/SRC/zunbdb3.f b/SRC/zunbdb3.f index b3681d727a..2f03c477f9 100644 --- a/SRC/zunbdb3.f +++ b/SRC/zunbdb3.f @@ -197,7 +197,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -226,7 +227,8 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZLACGV, XERBLA + EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZLACGV, + $ XERBLA * .. * .. External Functions .. DOUBLE PRECISION DZNRM2 @@ -302,7 +304,8 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) IF( I .LT. M-P ) THEN - CALL ZLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) ) + CALL ZLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, + $ TAUP2(I) ) PHI(I) = ATAN2( DBLE( X21(I+1,I) ), DBLE( X11(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) diff --git a/SRC/zunbdb4.f b/SRC/zunbdb4.f index c038bc5e5a..5ffacd757a 100644 --- a/SRC/zunbdb4.f +++ b/SRC/zunbdb4.f @@ -208,7 +208,8 @@ *> Algorithms, 50(1):33-65, 2009. *> * ===================================================================== - SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, + SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ PHI, $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * @@ -239,7 +240,8 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, ZLACGV, + EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, + $ ZLACGV, $ XERBLA * .. * .. External Functions .. @@ -303,22 +305,26 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ LORBDB5, CHILDINFO ) CALL ZSCAL( P, NEGONE, PHANTOM(1), 1 ) CALL ZLARFGP( P, PHANTOM(1), PHANTOM(2), 1, TAUP1(1) ) - CALL ZLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, TAUP2(1) ) + CALL ZLARFGP( M-P, PHANTOM(P+1), PHANTOM(P+2), 1, + $ TAUP2(1) ) THETA(I) = ATAN2( DBLE( PHANTOM(1) ), DBLE( PHANTOM(P+1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) PHANTOM(1) = ONE PHANTOM(P+1) = ONE - CALL ZLARF( 'L', P, Q, PHANTOM(1), 1, DCONJG(TAUP1(1)), X11, + CALL ZLARF( 'L', P, Q, PHANTOM(1), 1, DCONJG(TAUP1(1)), + $ X11, $ LDX11, WORK(ILARF) ) - CALL ZLARF( 'L', M-P, Q, PHANTOM(P+1), 1, DCONJG(TAUP2(1)), + CALL ZLARF( 'L', M-P, Q, PHANTOM(P+1), 1, + $ DCONJG(TAUP2(1)), $ X21, LDX21, WORK(ILARF) ) ELSE CALL ZUNBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), $ LDX21, WORK(IORBDB5), LORBDB5, CHILDINFO ) CALL ZSCAL( P-I+1, NEGONE, X11(I,I-1), 1 ) - CALL ZLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, TAUP1(I) ) + CALL ZLARFGP( P-I+1, X11(I,I-1), X11(I+1,I-1), 1, + $ TAUP1(I) ) CALL ZLARFGP( M-P-I+1, X21(I,I-1), X21(I+1,I-1), 1, $ TAUP2(I) ) THETA(I) = ATAN2( DBLE( X11(I,I-1) ), DBLE( X21(I,I-1) ) ) @@ -367,10 +373,12 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, * DO I = P + 1, Q CALL ZLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) - CALL ZLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), LDX21, + CALL ZLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), + $ LDX21, $ TAUQ1(I) ) X21(M-Q+I-P,I) = ONE - CALL ZLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, TAUQ1(I), + CALL ZLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) END DO diff --git a/SRC/zunbdb5.f b/SRC/zunbdb5.f index d53a738ccf..7eb9c69cfa 100644 --- a/SRC/zunbdb5.f +++ b/SRC/zunbdb5.f @@ -152,7 +152,8 @@ *> \ingroup unbdb5 * * ===================================================================== - SUBROUTINE ZUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE ZUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zunbdb6.f b/SRC/zunbdb6.f index 9ee659f9cc..0fd81e4a74 100644 --- a/SRC/zunbdb6.f +++ b/SRC/zunbdb6.f @@ -155,7 +155,8 @@ *> \ingroup unbdb6 * * ===================================================================== - SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, + SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, + $ Q2, $ LDQ2, WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -239,11 +240,13 @@ SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL ZGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL ZGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL ZGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL ZGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL ZGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) @@ -285,11 +288,13 @@ SUBROUTINE ZUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, WORK(I) = ZERO END DO ELSE - CALL ZGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, WORK, + CALL ZGEMV( 'C', M1, N, ONE, Q1, LDQ1, X1, INCX1, ZERO, + $ WORK, $ 1 ) END IF * - CALL ZGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, 1 ) + CALL ZGEMV( 'C', M2, N, ONE, Q2, LDQ2, X2, INCX2, ONE, WORK, + $ 1 ) * CALL ZGEMV( 'N', M1, N, NEGONE, Q1, LDQ1, WORK, 1, ONE, X1, $ INCX1 ) diff --git a/SRC/zuncsd.f b/SRC/zuncsd.f index ddb030516c..d2c2a1bf78 100644 --- a/SRC/zuncsd.f +++ b/SRC/zuncsd.f @@ -312,7 +312,8 @@ *> \ingroup uncsd * * ===================================================================== - RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, + RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, + $ TRANS, $ SIGNS, M, P, Q, X11, LDX11, X12, $ LDX12, X21, LDX21, X22, LDX22, THETA, $ U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, @@ -361,7 +362,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, LOGICAL LRQUERY * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZBBCSD, ZLACPY, ZLAPMR, ZLAPMT, + EXTERNAL XERBLA, ZBBCSD, ZLACPY, ZLAPMR, + $ ZLAPMT, $ ZUNBDB, ZUNGLQ, ZUNGQR * .. * .. External Functions .. @@ -429,7 +431,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE SIGNST = 'D' END IF - CALL ZUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, M, + CALL ZUNCSD( JOBV1T, JOBV2T, JOBU1, JOBU2, TRANST, SIGNST, + $ M, $ Q, P, X11, LDX11, X21, LDX21, X12, LDX12, X22, $ LDX22, THETA, V1T, LDV1T, V2T, LDV2T, U1, LDU1, $ U2, LDU2, WORK, LWORK, RWORK, LRWORK, IWORK, @@ -532,7 +535,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Transform to bidiagonal block form * - CALL ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21, + CALL ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, + $ X21, $ LDX21, X22, LDX22, THETA, RWORK(IPHI), WORK(ITAUP1), $ WORK(ITAUP2), WORK(ITAUQ1), WORK(ITAUQ2), $ WORK(IORBDB), LORBDBWORK, CHILDINFO ) @@ -542,7 +546,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, IF( COLMAJOR ) THEN IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQRWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -558,7 +563,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -575,7 +581,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, ELSE IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'U', Q, P, X11, LDX11, U1, LDU1 ) - CALL ZUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGLQ), + CALL ZUNGLQ( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGLQ), $ LORGLQWORK, INFO) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -591,7 +598,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, V1T(1,J) = ZERO V1T(J,1) = ZERO END DO - CALL ZUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL ZUNGQR( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGQR), LORGQRWORK, INFO ) END IF IF( WANTV2T .AND. M-Q .GT. 0 ) THEN @@ -609,7 +617,8 @@ RECURSIVE SUBROUTINE ZUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, * * Compute the CSD of the matrix in bidiagonal-block form * - CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, THETA, + CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, Q, + $ THETA, $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, V2T, $ LDV2T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), diff --git a/SRC/zuncsd2by1.f b/SRC/zuncsd2by1.f index 08ccc1f6f3..b5f6b93b20 100644 --- a/SRC/zuncsd2by1.f +++ b/SRC/zuncsd2by1.f @@ -250,7 +250,8 @@ *> \ingroup uncsd2by1 * * ===================================================================== - SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, + SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, + $ LDX11, $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) @@ -293,7 +294,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, COMPLEX*16 CDUM( 1, 1 ) * .. * .. External Subroutines .. - EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, ZUNBDB1, + EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, + $ ZUNBDB1, $ ZUNBDB2, ZUNBDB3, ZUNBDB4, ZUNGLQ, ZUNGQR, $ XERBLA * .. @@ -389,7 +391,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = 1 LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, WORK, -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN @@ -410,17 +413,20 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, + CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, + $ THETA, $ 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, DUM, + CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), + CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, + $ WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) @@ -437,13 +443,15 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, + CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, + $ THETA, $ 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, DUM, + CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN @@ -470,7 +478,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO $ ) LORBDB = M + INT( WORK(1) ) @@ -481,7 +490,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, 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, + 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) ) ) @@ -541,7 +551,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -557,7 +568,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END DO CALL ZLACPY( 'U', Q-1, Q-1, X21(1,2), LDX21, V1T(2,2), $ LDV1T ) - CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, WORK(ITAUQ1), + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T(2,2), LDV1T, + $ WORK(ITAUQ1), $ WORK(IORGLQ), LORGLQ, CHILDINFO ) END IF * @@ -600,7 +612,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, U1(1,J) = ZERO U1(J,1) = ZERO END DO - CALL ZLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), LDU1 ) + CALL ZLACPY( 'L', P-1, P-1, X11(2,1), LDX11, U1(2,2), + $ LDU1 ) CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, WORK(ITAUP1), $ WORK(IORGQR), LORGQR, CHILDINFO ) END IF @@ -650,7 +663,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, * IF( WANTU1 .AND. P .GT. 0 ) THEN CALL ZLACPY( 'L', P, Q, X11, LDX11, U1, LDU1 ) - CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), WORK(IORGQR), + CALL ZUNGQR( P, P, Q, U1, LDU1, WORK(ITAUP1), + $ WORK(IORGQR), $ LORGQR, CHILDINFO ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN @@ -733,7 +747,8 @@ SUBROUTINE ZUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, LDX11, END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL ZLACPY( 'U', M-Q, Q, X21, LDX21, V1T, LDV1T ) - CALL ZLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), LDX11, + CALL ZLACPY( 'U', P-(M-Q), Q-(M-Q), X11(M-Q+1,M-Q+1), + $ LDX11, $ V1T(M-Q+1,M-Q+1), LDV1T ) CALL ZLACPY( 'U', -P+Q, Q-P, X21(M-Q+1,P+1), LDX21, $ V1T(P+1,P+1), LDV1T ) diff --git a/SRC/zung2l.f b/SRC/zung2l.f index 9c5061e146..39073c0b8f 100644 --- a/SRC/zung2l.f +++ b/SRC/zung2l.f @@ -179,7 +179,8 @@ SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, + CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, $ LDA, WORK ) CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) diff --git a/SRC/zungbr.f b/SRC/zungbr.f index edd4768ed6..aa448966e7 100644 --- a/SRC/zungbr.f +++ b/SRC/zungbr.f @@ -154,7 +154,8 @@ *> \ingroup ungbr * * ===================================================================== - SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zunghr.f b/SRC/zunghr.f index 0c1a7697a6..e4d4361bbe 100644 --- a/SRC/zunghr.f +++ b/SRC/zunghr.f @@ -123,7 +123,8 @@ *> \ingroup unghr * * ===================================================================== - SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, + $ INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zunglq.f b/SRC/zunglq.f index f97b566244..cad89816c9 100644 --- a/SRC/zunglq.f +++ b/SRC/zunglq.f @@ -212,7 +212,8 @@ SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZUNGLQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -253,12 +254,14 @@ SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL ZLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**H to A(i+ib:m,i:n) from the right * - CALL ZLARFB( 'Right', 'Conjugate transpose', 'Forward', + CALL ZLARFB( 'Right', 'Conjugate transpose', + $ 'Forward', $ 'Rowwise', M-I-IB+1, N-I+1, IB, A( I, I ), $ LDA, WORK, LDWORK, A( I+IB, I ), LDA, $ WORK( IB+1 ), LDWORK ) @@ -266,7 +269,8 @@ SUBROUTINE ZUNGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to columns i:n of current block * - CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL ZUNGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set columns 1:i-1 of current block to zero diff --git a/SRC/zungql.f b/SRC/zungql.f index 3abe20dba8..65c6c55aa2 100644 --- a/SRC/zungql.f +++ b/SRC/zungql.f @@ -222,7 +222,8 @@ SUBROUTINE ZUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQL', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQL', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF diff --git a/SRC/zungqr.f b/SRC/zungqr.f index a7f6b24fea..0898e5f7d5 100644 --- a/SRC/zungqr.f +++ b/SRC/zungqr.f @@ -213,7 +213,8 @@ SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZUNGQR', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -267,7 +268,8 @@ SUBROUTINE ZUNGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H to rows i:m of current block * - CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK, + CALL ZUNG2R( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), + $ WORK, $ IINFO ) * * Set rows 1:i-1 of current block to zero diff --git a/SRC/zungrq.f b/SRC/zungrq.f index f3ddf10f6f..78cee12b4f 100644 --- a/SRC/zungrq.f +++ b/SRC/zungrq.f @@ -222,7 +222,8 @@ SUBROUTINE ZUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * determine the minimum value of NB. * NB = LWORK / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNGRQ', ' ', M, N, K, -1 ) ) + NBMIN = MAX( 2, ILAENV( 2, 'ZUNGRQ', ' ', M, N, K, + $ -1 ) ) END IF END IF END IF @@ -266,7 +267,8 @@ SUBROUTINE ZUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * - CALL ZLARFB( 'Right', 'Conjugate transpose', 'Backward', + CALL ZLARFB( 'Right', 'Conjugate transpose', + $ 'Backward', $ 'Rowwise', II-1, N-K+I+IB-1, IB, A( II, 1 ), $ LDA, WORK, LDWORK, A, LDA, WORK( IB+1 ), $ LDWORK ) @@ -274,7 +276,8 @@ SUBROUTINE ZUNGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * * Apply H**H to columns 1:n-k+i+ib-1 of current block * - CALL ZUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, TAU( I ), + CALL ZUNGR2( IB, N-K+I+IB-1, IB, A( II, 1 ), LDA, + $ TAU( I ), $ WORK, IINFO ) * * Set columns n-k+i+ib:n of current block to zero diff --git a/SRC/zungtr.f b/SRC/zungtr.f index 020763bc39..42d70dc535 100644 --- a/SRC/zungtr.f +++ b/SRC/zungtr.f @@ -218,7 +218,8 @@ SUBROUTINE ZUNGTR( UPLO, N, A, LDA, TAU, WORK, LWORK, INFO ) * * Generate Q(1:n-1,1:n-1) * - CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, IINFO ) + CALL ZUNGQL( N-1, N-1, N-1, A, LDA, TAU, WORK, LWORK, + $ IINFO ) * ELSE * diff --git a/SRC/zunhr_col.f b/SRC/zunhr_col.f index 7ec5b53bf3..49c2eb40af 100644 --- a/SRC/zunhr_col.f +++ b/SRC/zunhr_col.f @@ -282,7 +282,8 @@ SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) $ NPLUSONE * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZLAUNHR_COL_GETRFNP, ZSCAL, ZTRSM, + EXTERNAL ZCOPY, ZLAUNHR_COL_GETRFNP, ZSCAL, + $ ZTRSM, $ XERBLA * .. * .. Intrinsic Functions .. diff --git a/SRC/zunm22.f b/SRC/zunm22.f index c11c050d46..e83625148e 100644 --- a/SRC/zunm22.f +++ b/SRC/zunm22.f @@ -216,7 +216,8 @@ SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, IF( N1.EQ.0 .OR. N2.EQ.0 ) NW = 1 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN @@ -282,13 +283,15 @@ SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL ZLACPY( 'All', N1, LEN, C( N2+1, I ), LDC, WORK, $ LDWORK ) - CALL ZTRMM( 'Left', 'Lower', 'No Transpose', 'Non-Unit', + CALL ZTRMM( 'Left', 'Lower', 'No Transpose', + $ 'Non-Unit', $ N1, LEN, ONE, Q( 1, N2+1 ), LDQ, WORK, $ LDWORK ) * * Multiply top part of C by Q11. * - CALL ZGEMM( 'No Transpose', 'No Transpose', N1, LEN, N2, + CALL ZGEMM( 'No Transpose', 'No Transpose', N1, LEN, + $ N2, $ ONE, Q, LDQ, C( 1, I ), LDC, ONE, WORK, $ LDWORK ) * @@ -296,13 +299,15 @@ SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL ZLACPY( 'All', N2, LEN, C( 1, I ), LDC, $ WORK( N1+1 ), LDWORK ) - CALL ZTRMM( 'Left', 'Upper', 'No Transpose', 'Non-Unit', + CALL ZTRMM( 'Left', 'Upper', 'No Transpose', + $ 'Non-Unit', $ N2, LEN, ONE, Q( N1+1, 1 ), LDQ, $ WORK( N1+1 ), LDWORK ) * * Multiply bottom part of C by Q22. * - CALL ZGEMM( 'No Transpose', 'No Transpose', N2, LEN, N1, + CALL ZGEMM( 'No Transpose', 'No Transpose', N2, LEN, + $ N1, $ ONE, Q( N1+1, N2+1 ), LDQ, C( N2+1, I ), LDC, $ ONE, WORK( N1+1 ), LDWORK ) * @@ -360,13 +365,15 @@ SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL ZLACPY( 'All', LEN, N2, C( I, N1+1 ), LDC, WORK, $ LDWORK ) - CALL ZTRMM( 'Right', 'Upper', 'No Transpose', 'Non-Unit', + CALL ZTRMM( 'Right', 'Upper', 'No Transpose', + $ 'Non-Unit', $ LEN, N2, ONE, Q( N1+1, 1 ), LDQ, WORK, $ LDWORK ) * * Multiply left part of C by Q11. * - CALL ZGEMM( 'No Transpose', 'No Transpose', LEN, N2, N1, + CALL ZGEMM( 'No Transpose', 'No Transpose', LEN, N2, + $ N1, $ ONE, C( I, 1 ), LDC, Q, LDQ, ONE, WORK, $ LDWORK ) * @@ -374,13 +381,15 @@ SUBROUTINE ZUNM22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, * CALL ZLACPY( 'All', LEN, N1, C( I, 1 ), LDC, $ WORK( 1 + N2*LDWORK ), LDWORK ) - CALL ZTRMM( 'Right', 'Lower', 'No Transpose', 'Non-Unit', + CALL ZTRMM( 'Right', 'Lower', 'No Transpose', + $ 'Non-Unit', $ LEN, N1, ONE, Q( 1, N2+1 ), LDQ, $ WORK( 1 + N2*LDWORK ), LDWORK ) * * Multiply right part of C by Q22. * - CALL ZGEMM( 'No Transpose', 'No Transpose', LEN, N1, N2, + CALL ZGEMM( 'No Transpose', 'No Transpose', LEN, N1, + $ N2, $ ONE, C( I, N1+1 ), LDC, Q( N1+1, N2+1 ), LDQ, $ ONE, WORK( 1 + N2*LDWORK ), LDWORK ) * diff --git a/SRC/zunm2r.f b/SRC/zunm2r.f index 385536e87d..4e76979837 100644 --- a/SRC/zunm2r.f +++ b/SRC/zunm2r.f @@ -273,7 +273,8 @@ SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF AII = A( I, I ) A( I, I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), LDC, + CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), + $ LDC, $ WORK ) A( I, I ) = AII 10 CONTINUE diff --git a/SRC/zunmbr.f b/SRC/zunmbr.f index c6d238e920..499d15123c 100644 --- a/SRC/zunmbr.f +++ b/SRC/zunmbr.f @@ -270,18 +270,22 @@ SUBROUTINE ZUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, IF( M.GT.0 .AND. N.GT.0 ) THEN IF( APPLYQ ) THEN IF( LEFT ) THEN - NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, M-1, + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M-1, N, + $ M-1, $ -1 ) ELSE - NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, N-1, + NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N-1, + $ N-1, $ -1 ) END IF ELSE IF( LEFT ) THEN - NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N, M-1, + NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M-1, N, + $ M-1, $ -1 ) ELSE - NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1, N-1, + NB = ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N-1, + $ N-1, $ -1 ) END IF END IF @@ -329,7 +333,8 @@ SUBROUTINE ZUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, I1 = 1 I2 = 2 END IF - CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, + CALL ZUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, + $ TAU, $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) END IF ELSE diff --git a/SRC/zunmhr.f b/SRC/zunmhr.f index 01ec623b3e..8183f56854 100644 --- a/SRC/zunmhr.f +++ b/SRC/zunmhr.f @@ -226,7 +226,8 @@ SUBROUTINE ZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -2 ELSE IF( M.LT.0 ) THEN diff --git a/SRC/zunmlq.f b/SRC/zunmlq.f index 500121dbcf..6b7b8468d3 100644 --- a/SRC/zunmlq.f +++ b/SRC/zunmlq.f @@ -242,7 +242,8 @@ SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT @@ -267,7 +268,8 @@ SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMLQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -276,7 +278,8 @@ SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -332,7 +335,8 @@ SUBROUTINE ZUNMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, IB, + CALL ZLARFB( SIDE, TRANST, 'Forward', 'Rowwise', MI, NI, + $ IB, $ A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/zunmql.f b/SRC/zunmql.f index a0761f86bf..3822da5df3 100644 --- a/SRC/zunmql.f +++ b/SRC/zunmql.f @@ -244,7 +244,8 @@ SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQL', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -269,7 +270,8 @@ SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQL', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -278,7 +280,8 @@ SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -324,7 +327,8 @@ SUBROUTINE ZUNMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, NI, + CALL ZLARFB( SIDE, TRANS, 'Backward', 'Columnwise', MI, + $ NI, $ IB, A( 1, I ), LDA, WORK( IWT ), LDT, C, LDC, $ WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/zunmqr.f b/SRC/zunmqr.f index 98ebdb7c25..6db7bc50a7 100644 --- a/SRC/zunmqr.f +++ b/SRC/zunmqr.f @@ -241,7 +241,8 @@ SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Compute the workspace requirements * - NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, K, + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) LWKOPT = NW*NB + TSIZE WORK( 1 ) = LWKOPT @@ -266,7 +267,8 @@ SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMQR', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -275,7 +277,8 @@ SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * @@ -307,7 +310,8 @@ SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + CALL ZLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * @@ -325,7 +329,8 @@ SUBROUTINE ZUNMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H or H**H * - CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI, + CALL ZLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, + $ NI, $ IB, A( I, I ), LDA, WORK( IWT ), LDT, $ C( IC, JC ), LDC, WORK, LDWORK ) 10 CONTINUE diff --git a/SRC/zunmr2.f b/SRC/zunmr2.f index f6778f1dd9..0ccd59bb49 100644 --- a/SRC/zunmr2.f +++ b/SRC/zunmr2.f @@ -270,7 +270,8 @@ SUBROUTINE ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, CALL ZLACGV( NQ-K+I-1, A( I, 1 ), LDA ) AII = A( I, NQ-K+I ) A( I, NQ-K+I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, WORK ) + CALL ZLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, + $ WORK ) A( I, NQ-K+I ) = AII CALL ZLACGV( NQ-K+I-1, A( I, 1 ), LDA ) 10 CONTINUE diff --git a/SRC/zunmr3.f b/SRC/zunmr3.f index c6c52eb154..d1d9a1f754 100644 --- a/SRC/zunmr3.f +++ b/SRC/zunmr3.f @@ -174,7 +174,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE ZUNMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, INFO ) * * -- LAPACK computational routine -- diff --git a/SRC/zunmrq.f b/SRC/zunmrq.f index 8c5c8ded32..9a0d0b71de 100644 --- a/SRC/zunmrq.f +++ b/SRC/zunmrq.f @@ -245,7 +245,8 @@ SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -270,7 +271,8 @@ SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -279,7 +281,8 @@ SUBROUTINE ZUNMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Use unblocked code * - CALL ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + CALL ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + $ WORK, $ IINFO ) ELSE * diff --git a/SRC/zunmrz.f b/SRC/zunmrz.f index 3be96f466c..23c1f17876 100644 --- a/SRC/zunmrz.f +++ b/SRC/zunmrz.f @@ -183,7 +183,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, + SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -268,7 +269,8 @@ SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( M.EQ.0 .OR. N.EQ.0 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, N, + NB = MIN( NBMAX, ILAENV( 1, 'ZUNMRQ', SIDE // TRANS, M, + $ N, $ K, -1 ) ) LWKOPT = NW*NB + TSIZE END IF @@ -298,7 +300,8 @@ SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, IF( NB.GT.1 .AND. NB.LT.K ) THEN IF( LWORK.LT.LWKOPT ) THEN NB = (LWORK-TSIZE) / LDWORK - NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, K, + NBMIN = MAX( 2, ILAENV( 2, 'ZUNMRQ', SIDE // TRANS, M, N, + $ K, $ -1 ) ) END IF END IF @@ -347,7 +350,8 @@ SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL ZLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA, + CALL ZLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), + $ LDA, $ TAU( I ), WORK( IWT ), LDT ) * IF( LEFT ) THEN diff --git a/SRC/zunmtr.f b/SRC/zunmtr.f index c0193a8ba5..c5544d23a8 100644 --- a/SRC/zunmtr.f +++ b/SRC/zunmtr.f @@ -167,7 +167,8 @@ *> \ingroup unmtr * * ===================================================================== - SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, + SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, + $ LDC, $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- @@ -221,7 +222,8 @@ SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, INFO = -1 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -2 - ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) + ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. + $ .NOT.LSAME( TRANS, 'C' ) ) $ THEN INFO = -3 ELSE IF( M.LT.0 ) THEN @@ -284,7 +286,8 @@ SUBROUTINE ZUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, * * Q was determined by a call to ZHETRD with UPLO = 'U' * - CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, + CALL ZUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, + $ C, $ LDC, WORK, LWORK, IINFO ) ELSE * diff --git a/SRC/zupmtr.f b/SRC/zupmtr.f index 52416c4699..0da3a9f017 100644 --- a/SRC/zupmtr.f +++ b/SRC/zupmtr.f @@ -146,7 +146,8 @@ *> \ingroup upmtr * * ===================================================================== - SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, + SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, + $ WORK, $ INFO ) * * -- LAPACK computational routine -- From 3ccdccea9b0336f2a96bd6af7e6dcc67ce5e604f Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Wed, 12 Jul 2023 16:37:16 -0700 Subject: [PATCH 040/206] LAPACK SRC long lines updated manually --- INSTALL/droundup_lwork.f | 3 ++- INSTALL/sroundup_lwork.f | 3 ++- SRC/chetrd_hb2st.F | 21 ++++++++++++++------- SRC/chptrf.f | 3 ++- SRC/cla_gerfsx_extended.f | 3 ++- SRC/claqz3.f | 11 ++++++----- SRC/dlaein.f | 3 ++- SRC/dsytrd_sb2st.F | 21 ++++++++++++++------- SRC/dtrsyl3.f | 3 ++- SRC/slaein.f | 3 ++- SRC/ssytrd_sb2st.F | 21 ++++++++++++++------- SRC/strsyl3.f | 3 ++- SRC/zhetrd_hb2st.F | 21 ++++++++++++++------- SRC/zhptrf.f | 3 ++- SRC/zla_gerfsx_extended.f | 3 ++- 15 files changed, 82 insertions(+), 43 deletions(-) diff --git a/INSTALL/droundup_lwork.f b/INSTALL/droundup_lwork.f index 77c8790827..28ec970f7a 100644 --- a/INSTALL/droundup_lwork.f +++ b/INSTALL/droundup_lwork.f @@ -77,7 +77,8 @@ DOUBLE PRECISION FUNCTION DROUNDUP_LWORK( LWORK ) * IF( INT( DROUNDUP_LWORK ) .LT. LWORK ) THEN * Force round up of LWORK - DROUNDUP_LWORK = DROUNDUP_LWORK * ( 1.0D+0 + EPSILON(0.0D+0) ) + DROUNDUP_LWORK = DROUNDUP_LWORK * + $ ( 1.0D+0 + EPSILON(0.0D+0) ) ENDIF * RETURN diff --git a/INSTALL/sroundup_lwork.f b/INSTALL/sroundup_lwork.f index c45bff3e14..bfe57ee238 100644 --- a/INSTALL/sroundup_lwork.f +++ b/INSTALL/sroundup_lwork.f @@ -77,7 +77,8 @@ REAL FUNCTION SROUNDUP_LWORK( LWORK ) * IF( INT( SROUNDUP_LWORK ) .LT. LWORK ) THEN * Force round up of LWORK - SROUNDUP_LWORK = SROUNDUP_LWORK * ( 1.0E+0 + EPSILON(0.0E+0) ) + SROUNDUP_LWORK = SROUNDUP_LWORK * + $ ( 1.0E+0 + EPSILON(0.0E+0) ) ENDIF * RETURN diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index 9639f581c6..205c10f724 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -276,7 +276,8 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, COMPLEX TMP * .. * .. External Subroutines .. - EXTERNAL CHB2ST_KERNELS, CLACPY, CLASET, XERBLA + EXTERNAL CHB2ST_KERNELS, CLACPY, + $ CLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX, CEILING, REAL @@ -300,13 +301,16 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, -1, -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_HB2ST', VECT, N, KD, + $ -1, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'CHETRD_HB2ST', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'CHETRD_HB2ST', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN @@ -526,7 +530,8 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP$ DEPEND(in:WORK(MYID-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL CHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -536,7 +541,8 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL CHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -544,7 +550,8 @@ SUBROUTINE CHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP END TASK ENDIF #else - CALL CHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL CHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, diff --git a/SRC/chptrf.f b/SRC/chptrf.f index 37e0ff5272..7e7d1a1719 100644 --- a/SRC/chptrf.f +++ b/SRC/chptrf.f @@ -594,7 +594,8 @@ SUBROUTINE CHPTRF( UPLO, N, AP, IPIV, INFO ) * where L(k) and L(k+1) are the k-th and (k+1)-th * columns of L * - D = SLAPY2( REAL( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ), + D = SLAPY2( + $ REAL( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ), $ AIMAG( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ) ) D11 = REAL( AP( K+1+K*( 2*N-K-1 ) / 2 ) ) / D D22 = REAL( AP( K+( K-1 )*( 2*N-K ) / 2 ) ) / D diff --git a/SRC/cla_gerfsx_extended.f b/SRC/cla_gerfsx_extended.f index 3c1d7b8c1b..7cf40b45f5 100644 --- a/SRC/cla_gerfsx_extended.f +++ b/SRC/cla_gerfsx_extended.f @@ -521,7 +521,8 @@ SUBROUTINE CLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, $ LDA, Y( 1, J ), 1, (1.0E+0,0.0E+0), $ RES, 1, PREC_TYPE ) ELSE - CALL BLAS_CGEMV2_X( TRANS_TYPE, N, N, (-1.0E+0,0.0E+0), + CALL BLAS_CGEMV2_X( TRANS_TYPE, N, N, + $ (-1.0E+0,0.0E+0), $ A, LDA, Y(1, J), Y_TAIL, 1, (1.0E+0,0.0E+0), RES, 1, $ PREC_TYPE) END IF diff --git a/SRC/claqz3.f b/SRC/claqz3.f index e7229bc481..1c8002306b 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -231,7 +231,8 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, COMPLEX :: TEMP, TEMP2, TEMP3, S * External Functions - EXTERNAL :: XERBLA, CLASET, CLARTG, CROT, CLAQZ1, CGEMM, CLACPY + EXTERNAL :: XERBLA, CLASET, CLARTG, CROT, + $ CLAQZ1, CGEMM, CLACPY REAL, EXTERNAL :: SLAMCH INFO = 0 @@ -301,10 +302,10 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, END IF CALL CLARTG( TEMP2, TEMP3, C, S, TEMP ) - CALL CROT( NS, A( ILO, ILO ), LDA, A( ILO+1, ILO ), LDA, C, - $ S ) - CALL CROT( NS, B( ILO, ILO ), LDB, B( ILO+1, ILO ), LDB, C, - $ S ) + CALL CROT( NS, A( ILO, ILO ), LDA, A( ILO+1, ILO ), LDA, + $ C, S ) + CALL CROT( NS, B( ILO, ILO ), LDB, B( ILO+1, ILO ), LDB, + $ C, S ) CALL CROT( NS+1, QC( 1, 1 ), 1, QC( 1, 2 ), 1, C, $ CONJG( S ) ) diff --git a/SRC/dlaein.f b/SRC/dlaein.f index b2e2846739..5a79b21424 100644 --- a/SRC/dlaein.f +++ b/SRC/dlaein.f @@ -381,7 +381,8 @@ SUBROUTINE DLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Scale supplied initial vector. * - NORM = DLAPY2( DNRM2( N, VR, 1 ), DNRM2( N, VI, 1 ) ) + NORM = DLAPY2( DNRM2( N, VR, 1 ), + $ DNRM2( N, VI, 1 ) ) REC = ( EPS3*ROOTN ) / MAX( NORM, NRMSML ) CALL DSCAL( N, REC, VR, 1 ) CALL DSCAL( N, REC, VI, 1 ) diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index b6afe75dbc..db0aa588df 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -273,7 +273,8 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, $ SIDEV, SIZETAU, LDV, LHMIN, LWMIN * .. * .. External Subroutines .. - EXTERNAL DSB2ST_KERNELS, DLACPY, DLASET, XERBLA + EXTERNAL DSB2ST_KERNELS, DLACPY, + $ DLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX, CEILING, REAL @@ -296,13 +297,16 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, -1, -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_SB2ST', VECT, N, KD, + $ -1, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'DSYTRD_SB2ST', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SB2ST', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN @@ -494,7 +498,8 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP$ DEPEND(in:WORK(MYID-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL DSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -504,7 +509,8 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL DSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -512,7 +518,8 @@ SUBROUTINE DSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP END TASK ENDIF #else - CALL DSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL DSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index 8330cb9bd0..d599311308 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -1224,7 +1224,8 @@ SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) BUF = BUF * SCALOC - CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) ) + CALL DLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, + $ IWORK(1) ) END IF * * Combine with buffer scaling factor. SCALE will be flushed if diff --git a/SRC/slaein.f b/SRC/slaein.f index 792b84d6b5..069116fe39 100644 --- a/SRC/slaein.f +++ b/SRC/slaein.f @@ -381,7 +381,8 @@ SUBROUTINE SLAEIN( RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, * * Scale supplied initial vector. * - NORM = SLAPY2( SNRM2( N, VR, 1 ), SNRM2( N, VI, 1 ) ) + NORM = SLAPY2( SNRM2( N, VR, 1 ), + $ SNRM2( N, VI, 1 ) ) REC = ( EPS3*ROOTN ) / MAX( NORM, NRMSML ) CALL SSCAL( N, REC, VR, 1 ) CALL SSCAL( N, REC, VI, 1 ) diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index f9751e2b7d..0840f306de 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -273,7 +273,8 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, $ SISEV, SIZETAU, LDV, LHMIN, LWMIN * .. * .. External Subroutines .. - EXTERNAL SSB2ST_KERNELS, SLACPY, SLASET, XERBLA + EXTERNAL SSB2ST_KERNELS, SLACPY, + $ SLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX, CEILING, REAL @@ -297,13 +298,16 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, -1, -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_SB2ST', VECT, N, KD, + $ -1, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'SSYTRD_SB2ST', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'SSYTRD_SB2ST', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN @@ -495,7 +499,8 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP$ DEPEND(in:WORK(MYID-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL SSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -505,7 +510,8 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL SSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -513,7 +519,8 @@ SUBROUTINE SSYTRD_SB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP END TASK ENDIF #else - CALL SSB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL SSB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index 3899ba6299..fd2c83572a 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -1227,7 +1227,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * SCALOC = MIN( BIGNUM / SCAL, ONE / BUF ) BUF = BUF * SCALOC - CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, IWORK(1) ) + CALL SLASCL( 'G', -1, -1, ONE, SCALOC, M, N, C, LDC, + $ IWORK(1) ) END IF * * Combine with buffer scaling factor. SCALE will be flushed if diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 78ebf35c12..282ede2e82 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -276,7 +276,8 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, COMPLEX*16 TMP * .. * .. External Subroutines .. - EXTERNAL ZHB2ST_KERNELS, ZLACPY, ZLASET, XERBLA + EXTERNAL ZHB2ST_KERNELS, ZLACPY, + $ ZLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MIN, MAX, CEILING, DBLE, REAL @@ -299,13 +300,16 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, * * Determine the block size, the workspace size and the hous size. * - IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, -1, -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_HB2ST', VECT, N, KD, + $ -1, -1 ) IF( N.EQ.0 .OR. KD.LE.1 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'ZHETRD_HB2ST', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'ZHETRD_HB2ST', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.AFTERS1 .AND. .NOT.LSAME( STAGE1, 'N' ) ) THEN @@ -526,7 +530,8 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP$ DEPEND(in:WORK(MYID-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL ZHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -536,7 +541,8 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP TASK DEPEND(in:WORK(MYID+SHIFT-1)) !$OMP$ DEPEND(out:WORK(MYID)) TID = OMP_GET_THREAD_NUM() - CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL ZHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, @@ -544,7 +550,8 @@ SUBROUTINE ZHETRD_HB2ST( STAGE1, VECT, UPLO, N, KD, AB, LDAB, !$OMP END TASK ENDIF #else - CALL ZHB2ST_KERNELS( UPLO, WANTQ, TTYPE, + CALL ZHB2ST_KERNELS( + $ UPLO, WANTQ, TTYPE, $ STIND, EDIND, SWEEPID, N, KD, IB, $ WORK ( INDA ), LDA, $ HOUS( INDV ), HOUS( INDTAU ), LDV, diff --git a/SRC/zhptrf.f b/SRC/zhptrf.f index ce843c81db..7802c98b63 100644 --- a/SRC/zhptrf.f +++ b/SRC/zhptrf.f @@ -594,7 +594,8 @@ SUBROUTINE ZHPTRF( UPLO, N, AP, IPIV, INFO ) * where L(k) and L(k+1) are the k-th and (k+1)-th * columns of L * - D = DLAPY2( DBLE( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ), + D = DLAPY2( + $ DBLE( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ), $ DIMAG( AP( K+1+( K-1 )*( 2*N-K ) / 2 ) ) ) D11 = DBLE( AP( K+1+K*( 2*N-K-1 ) / 2 ) ) / D D22 = DBLE( AP( K+( K-1 )*( 2*N-K ) / 2 ) ) / D diff --git a/SRC/zla_gerfsx_extended.f b/SRC/zla_gerfsx_extended.f index 6e0b39ce5f..2058bc1fdb 100644 --- a/SRC/zla_gerfsx_extended.f +++ b/SRC/zla_gerfsx_extended.f @@ -520,7 +520,8 @@ SUBROUTINE ZLA_GERFSX_EXTENDED( PREC_TYPE, TRANS_TYPE, N, NRHS, $ LDA, Y( 1, J ), 1, (1.0D+0,0.0D+0), $ RES, 1, PREC_TYPE ) ELSE - CALL BLAS_ZGEMV2_X( TRANS_TYPE, N, N, (-1.0D+0,0.0D+0), + CALL BLAS_ZGEMV2_X( TRANS_TYPE, N, N, + $ (-1.0D+0,0.0D+0), $ A, LDA, Y(1, J), Y_TAIL, 1, (1.0D+0,0.0D+0), RES, 1, $ PREC_TYPE) END IF From 19d3a4e63859d966198cb0b6dc6d7a078cae7033 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Thu, 27 Jul 2023 15:09:21 -0700 Subject: [PATCH 041/206] Add extended API with _64 suffix to MATGEN --- TESTING/MATGEN/CMakeLists.txt | 23 +++++++++- TESTING/MATGEN/clagge.f | 1 + TESTING/MATGEN/claghe.f | 1 + TESTING/MATGEN/clagsy.f | 1 + TESTING/MATGEN/clahilb.f | 1 + TESTING/MATGEN/clakf2.f | 1 + TESTING/MATGEN/clarge.f | 1 + TESTING/MATGEN/clarnd.f | 1 + TESTING/MATGEN/claror.f | 1 + TESTING/MATGEN/clarot.f | 1 + TESTING/MATGEN/clatm1.f | 1 + TESTING/MATGEN/clatm2.f | 1 + TESTING/MATGEN/clatm3.f | 1 + TESTING/MATGEN/clatm5.f | 1 + TESTING/MATGEN/clatm6.f | 1 + TESTING/MATGEN/clatme.f | 1 + TESTING/MATGEN/clatmr.f | 1 + TESTING/MATGEN/clatms.f | 1 + TESTING/MATGEN/clatmt.f | 1 + TESTING/MATGEN/dlagge.f | 1 + TESTING/MATGEN/dlagsy.f | 1 + TESTING/MATGEN/dlahilb.f | 1 + TESTING/MATGEN/dlakf2.f | 1 + TESTING/MATGEN/dlaran.f | 1 + TESTING/MATGEN/dlarge.f | 1 + TESTING/MATGEN/dlarnd.f | 1 + TESTING/MATGEN/dlaror.f | 1 + TESTING/MATGEN/dlarot.f | 1 + TESTING/MATGEN/dlatm1.f | 1 + TESTING/MATGEN/dlatm2.f | 1 + TESTING/MATGEN/dlatm3.f | 1 + TESTING/MATGEN/dlatm5.f | 1 + TESTING/MATGEN/dlatm6.f | 1 + TESTING/MATGEN/dlatm7.f | 1 + TESTING/MATGEN/dlatme.f | 1 + TESTING/MATGEN/dlatmr.f | 1 + TESTING/MATGEN/dlatms.f | 1 + TESTING/MATGEN/dlatmt.f | 1 + TESTING/MATGEN/matgen_64.h | 81 +++++++++++++++++++++++++++++++++++ TESTING/MATGEN/slagge.f | 1 + TESTING/MATGEN/slagsy.f | 1 + TESTING/MATGEN/slahilb.f | 1 + TESTING/MATGEN/slakf2.f | 1 + TESTING/MATGEN/slaran.f | 1 + TESTING/MATGEN/slarge.f | 1 + TESTING/MATGEN/slarnd.f | 1 + TESTING/MATGEN/slaror.f | 1 + TESTING/MATGEN/slarot.f | 1 + TESTING/MATGEN/slatm1.f | 1 + TESTING/MATGEN/slatm2.f | 1 + TESTING/MATGEN/slatm3.f | 1 + TESTING/MATGEN/slatm5.f | 1 + TESTING/MATGEN/slatm6.f | 1 + TESTING/MATGEN/slatm7.f | 1 + TESTING/MATGEN/slatme.f | 1 + TESTING/MATGEN/slatmr.f | 1 + TESTING/MATGEN/slatms.f | 1 + TESTING/MATGEN/slatmt.f | 1 + TESTING/MATGEN/zlagge.f | 1 + TESTING/MATGEN/zlaghe.f | 1 + TESTING/MATGEN/zlagsy.f | 1 + TESTING/MATGEN/zlahilb.f | 1 + TESTING/MATGEN/zlakf2.f | 1 + TESTING/MATGEN/zlarge.f | 1 + TESTING/MATGEN/zlarnd.f | 1 + TESTING/MATGEN/zlaror.f | 1 + TESTING/MATGEN/zlarot.f | 1 + TESTING/MATGEN/zlatm1.f | 1 + TESTING/MATGEN/zlatm2.f | 1 + TESTING/MATGEN/zlatm3.f | 1 + TESTING/MATGEN/zlatm5.f | 1 + TESTING/MATGEN/zlatm6.f | 1 + TESTING/MATGEN/zlatme.f | 1 + TESTING/MATGEN/zlatmr.f | 1 + TESTING/MATGEN/zlatms.f | 1 + TESTING/MATGEN/zlatmt.f | 1 + 76 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 TESTING/MATGEN/matgen_64.h diff --git a/TESTING/MATGEN/CMakeLists.txt b/TESTING/MATGEN/CMakeLists.txt index 0b3f89ed2c..1e218ee3d6 100644 --- a/TESTING/MATGEN/CMakeLists.txt +++ b/TESTING/MATGEN/CMakeLists.txt @@ -47,7 +47,28 @@ if(BUILD_COMPLEX16) endif() list(REMOVE_DUPLICATES SOURCES) -add_library(${TMGLIB} ${SOURCES}) +add_library(${TMGLIB}_obj OBJECT ${SOURCES}) +set_target_properties( + ${TMGLIB}_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) + +if(BUILD_INDEX64_EXT_API) + set(SOURCES_64) + list(APPEND SOURCES_64 ${SOURCES}) + add_library(${TMGLIB}_64_obj OBJECT ${SOURCES_64}) + target_compile_options(${TMGLIB}_64_obj PRIVATE ${FOPT_ILP64} -DMATGEN_64) + set_target_properties( + ${TMGLIB}_64_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) +endif() + +add_library(${TMGLIB} + $ + $<$: $>) set_target_properties( ${TMGLIB} PROPERTIES diff --git a/TESTING/MATGEN/clagge.f b/TESTING/MATGEN/clagge.f index 4575608f69..6a1a19f80e 100644 --- a/TESTING/MATGEN/clagge.f +++ b/TESTING/MATGEN/clagge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/claghe.f b/TESTING/MATGEN/claghe.f index 723e0f2d14..2dbba8e8bb 100644 --- a/TESTING/MATGEN/claghe.f +++ b/TESTING/MATGEN/claghe.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAGHE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clagsy.f b/TESTING/MATGEN/clagsy.f index b01d155653..f8822d0237 100644 --- a/TESTING/MATGEN/clagsy.f +++ b/TESTING/MATGEN/clagsy.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clahilb.f b/TESTING/MATGEN/clahilb.f index e6b497715d..3aa93c982a 100644 --- a/TESTING/MATGEN/clahilb.f +++ b/TESTING/MATGEN/clahilb.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clakf2.f b/TESTING/MATGEN/clakf2.f index 5f03cc181c..27c0495671 100644 --- a/TESTING/MATGEN/clakf2.f +++ b/TESTING/MATGEN/clakf2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarge.f b/TESTING/MATGEN/clarge.f index 77086a4815..ccd2afeb0e 100644 --- a/TESTING/MATGEN/clarge.f +++ b/TESTING/MATGEN/clarge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarnd.f b/TESTING/MATGEN/clarnd.f index df08d67966..34e5f849ee 100644 --- a/TESTING/MATGEN/clarnd.f +++ b/TESTING/MATGEN/clarnd.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/claror.f b/TESTING/MATGEN/claror.f index de5331e1f6..d04bcf4f12 100644 --- a/TESTING/MATGEN/claror.f +++ b/TESTING/MATGEN/claror.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarot.f b/TESTING/MATGEN/clarot.f index 901c0ee8a2..17328e7ca7 100644 --- a/TESTING/MATGEN/clarot.f +++ b/TESTING/MATGEN/clarot.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm1.f b/TESTING/MATGEN/clatm1.f index 05a90fdced..7c86bd2564 100644 --- a/TESTING/MATGEN/clatm1.f +++ b/TESTING/MATGEN/clatm1.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm2.f b/TESTING/MATGEN/clatm2.f index cd2dc7ae47..77ac2d507c 100644 --- a/TESTING/MATGEN/clatm2.f +++ b/TESTING/MATGEN/clatm2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm3.f b/TESTING/MATGEN/clatm3.f index 863325b3f2..4588a2c9a0 100644 --- a/TESTING/MATGEN/clatm3.f +++ b/TESTING/MATGEN/clatm3.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm5.f b/TESTING/MATGEN/clatm5.f index 25904e45f8..db7a221805 100644 --- a/TESTING/MATGEN/clatm5.f +++ b/TESTING/MATGEN/clatm5.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm6.f b/TESTING/MATGEN/clatm6.f index 632e896d8c..e03a600380 100644 --- a/TESTING/MATGEN/clatm6.f +++ b/TESTING/MATGEN/clatm6.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatme.f b/TESTING/MATGEN/clatme.f index 213a4b3bca..66e03b7ab9 100644 --- a/TESTING/MATGEN/clatme.f +++ b/TESTING/MATGEN/clatme.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatmr.f b/TESTING/MATGEN/clatmr.f index 34536d9b94..c43e7077ad 100644 --- a/TESTING/MATGEN/clatmr.f +++ b/TESTING/MATGEN/clatmr.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatms.f b/TESTING/MATGEN/clatms.f index a1951216bb..01800f8b32 100644 --- a/TESTING/MATGEN/clatms.f +++ b/TESTING/MATGEN/clatms.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatmt.f b/TESTING/MATGEN/clatmt.f index 05eb5566a9..63bd7550ac 100644 --- a/TESTING/MATGEN/clatmt.f +++ b/TESTING/MATGEN/clatmt.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b CLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlagge.f b/TESTING/MATGEN/dlagge.f index ffd11d2785..1399684713 100644 --- a/TESTING/MATGEN/dlagge.f +++ b/TESTING/MATGEN/dlagge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlagsy.f b/TESTING/MATGEN/dlagsy.f index 7ba58ee4f5..11d71085fb 100644 --- a/TESTING/MATGEN/dlagsy.f +++ b/TESTING/MATGEN/dlagsy.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlahilb.f b/TESTING/MATGEN/dlahilb.f index cf0712b51c..3cfe6a2a19 100644 --- a/TESTING/MATGEN/dlahilb.f +++ b/TESTING/MATGEN/dlahilb.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlakf2.f b/TESTING/MATGEN/dlakf2.f index 76baefdcdd..81d7d07166 100644 --- a/TESTING/MATGEN/dlakf2.f +++ b/TESTING/MATGEN/dlakf2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlaran.f b/TESTING/MATGEN/dlaran.f index 24f6e97278..6510d3166d 100644 --- a/TESTING/MATGEN/dlaran.f +++ b/TESTING/MATGEN/dlaran.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLARAN * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarge.f b/TESTING/MATGEN/dlarge.f index 4f1c09477d..10d7e10b71 100644 --- a/TESTING/MATGEN/dlarge.f +++ b/TESTING/MATGEN/dlarge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarnd.f b/TESTING/MATGEN/dlarnd.f index f41f2ceab8..f9f5f1a4a5 100644 --- a/TESTING/MATGEN/dlarnd.f +++ b/TESTING/MATGEN/dlarnd.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlaror.f b/TESTING/MATGEN/dlaror.f index 183aa00d0a..4abbe12ebd 100644 --- a/TESTING/MATGEN/dlaror.f +++ b/TESTING/MATGEN/dlaror.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarot.f b/TESTING/MATGEN/dlarot.f index 7337dc682c..9ffb693f58 100644 --- a/TESTING/MATGEN/dlarot.f +++ b/TESTING/MATGEN/dlarot.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm1.f b/TESTING/MATGEN/dlatm1.f index b0d8ffa3e3..27f7be3aaa 100644 --- a/TESTING/MATGEN/dlatm1.f +++ b/TESTING/MATGEN/dlatm1.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm2.f b/TESTING/MATGEN/dlatm2.f index 5a55addc36..41490814a9 100644 --- a/TESTING/MATGEN/dlatm2.f +++ b/TESTING/MATGEN/dlatm2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm3.f b/TESTING/MATGEN/dlatm3.f index f5a4a66b30..6e67586867 100644 --- a/TESTING/MATGEN/dlatm3.f +++ b/TESTING/MATGEN/dlatm3.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm5.f b/TESTING/MATGEN/dlatm5.f index 429315b0d5..7fdb1622a0 100644 --- a/TESTING/MATGEN/dlatm5.f +++ b/TESTING/MATGEN/dlatm5.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm6.f b/TESTING/MATGEN/dlatm6.f index 01941609cf..7d6c2b2b35 100644 --- a/TESTING/MATGEN/dlatm6.f +++ b/TESTING/MATGEN/dlatm6.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm7.f b/TESTING/MATGEN/dlatm7.f index 38c993dad7..8ebb7b5abd 100644 --- a/TESTING/MATGEN/dlatm7.f +++ b/TESTING/MATGEN/dlatm7.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATM7 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatme.f b/TESTING/MATGEN/dlatme.f index 311f16e2da..5fd3fde975 100644 --- a/TESTING/MATGEN/dlatme.f +++ b/TESTING/MATGEN/dlatme.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatmr.f b/TESTING/MATGEN/dlatmr.f index efb016b91e..ff2470e09c 100644 --- a/TESTING/MATGEN/dlatmr.f +++ b/TESTING/MATGEN/dlatmr.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatms.f b/TESTING/MATGEN/dlatms.f index e6b9fbece2..859f31f0c6 100644 --- a/TESTING/MATGEN/dlatms.f +++ b/TESTING/MATGEN/dlatms.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatmt.f b/TESTING/MATGEN/dlatmt.f index bdd167f2d1..27bf375c58 100644 --- a/TESTING/MATGEN/dlatmt.f +++ b/TESTING/MATGEN/dlatmt.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b DLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/matgen_64.h b/TESTING/MATGEN/matgen_64.h new file mode 100644 index 0000000000..827468ec77 --- /dev/null +++ b/TESTING/MATGEN/matgen_64.h @@ -0,0 +1,81 @@ +#ifndef MATGEN_64_H +#define MATGEN_64_H +#ifdef MATGEN_64 + +#define CLAGGE CLAGGE_64 +#define CLAGHE CLAGHE_64 +#define CLAGSY CLAGSY_64 +#define CLAHILB CLAHILB_64 +#define CLAKF2 CLAKF2_64 +#define CLARGE CLARGE_64 +#define CLARND CLARND_64 +#define CLAROR CLAROR_64 +#define CLAROT CLAROT_64 +#define CLATM1 CLATM1_64 +#define CLATM2 CLATM2_64 +#define CLATM3 CLATM3_64 +#define CLATM5 CLATM5_64 +#define CLATM6 CLATM6_64 +#define CLATME CLATME_64 +#define CLATMR CLATMR_64 +#define CLATMS CLATMS_64 +#define CLATMT CLATMT_64 +#define DLAGGE DLAGGE_64 +#define DLAGSY DLAGSY_64 +#define DLAHILB DLAHILB_64 +#define DLAKF2 DLAKF2_64 +#define DLARAN DLARAN_64 +#define DLARGE DLARGE_64 +#define DLARND DLARND_64 +#define DLAROR DLAROR_64 +#define DLAROT DLAROT_64 +#define DLATM1 DLATM1_64 +#define DLATM2 DLATM2_64 +#define DLATM3 DLATM3_64 +#define DLATM5 DLATM5_64 +#define DLATM6 DLATM6_64 +#define DLATM7 DLATM7_64 +#define DLATME DLATME_64 +#define DLATMR DLATMR_64 +#define DLATMS DLATMS_64 +#define DLATMT DLATMT_64 +#define SLAGGE SLAGGE_64 +#define SLAGSY SLAGSY_64 +#define SLAHILB SLAHILB_64 +#define SLAKF2 SLAKF2_64 +#define SLARAN SLARAN_64 +#define SLARGE SLARGE_64 +#define SLARND SLARND_64 +#define SLAROR SLAROR_64 +#define SLAROT SLAROT_64 +#define SLATM1 SLATM1_64 +#define SLATM2 SLATM2_64 +#define SLATM3 SLATM3_64 +#define SLATM5 SLATM5_64 +#define SLATM6 SLATM6_64 +#define SLATM7 SLATM7_64 +#define SLATME SLATME_64 +#define SLATMR SLATMR_64 +#define SLATMS SLATMS_64 +#define SLATMT SLATMT_64 +#define ZLAGGE ZLAGGE_64 +#define ZLAGHE ZLAGHE_64 +#define ZLAGSY ZLAGSY_64 +#define ZLAHILB ZLAHILB_64 +#define ZLAKF2 ZLAKF2_64 +#define ZLARGE ZLARGE_64 +#define ZLARND ZLARND_64 +#define ZLAROR ZLAROR_64 +#define ZLAROT ZLAROT_64 +#define ZLATM1 ZLATM1_64 +#define ZLATM2 ZLATM2_64 +#define ZLATM3 ZLATM3_64 +#define ZLATM5 ZLATM5_64 +#define ZLATM6 ZLATM6_64 +#define ZLATME ZLATME_64 +#define ZLATMR ZLATMR_64 +#define ZLATMS ZLATMS_64 +#define ZLATMT ZLATMT_64 + +#endif +#endif diff --git a/TESTING/MATGEN/slagge.f b/TESTING/MATGEN/slagge.f index 9627d563d8..d84e403703 100644 --- a/TESTING/MATGEN/slagge.f +++ b/TESTING/MATGEN/slagge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slagsy.f b/TESTING/MATGEN/slagsy.f index dd319dadcd..756ed3baf6 100644 --- a/TESTING/MATGEN/slagsy.f +++ b/TESTING/MATGEN/slagsy.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slahilb.f b/TESTING/MATGEN/slahilb.f index 4dc8333463..ccb8db33cb 100644 --- a/TESTING/MATGEN/slahilb.f +++ b/TESTING/MATGEN/slahilb.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slakf2.f b/TESTING/MATGEN/slakf2.f index ef9f90adf0..d407a510cd 100644 --- a/TESTING/MATGEN/slakf2.f +++ b/TESTING/MATGEN/slakf2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slaran.f b/TESTING/MATGEN/slaran.f index 586612d9f4..2fdbe82325 100644 --- a/TESTING/MATGEN/slaran.f +++ b/TESTING/MATGEN/slaran.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLARAN * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarge.f b/TESTING/MATGEN/slarge.f index 8bebf48d5d..67d35d75a8 100644 --- a/TESTING/MATGEN/slarge.f +++ b/TESTING/MATGEN/slarge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarnd.f b/TESTING/MATGEN/slarnd.f index c2d7a5cb2d..fcbcab1b6b 100644 --- a/TESTING/MATGEN/slarnd.f +++ b/TESTING/MATGEN/slarnd.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slaror.f b/TESTING/MATGEN/slaror.f index 0fc0a7272d..09ae74a576 100644 --- a/TESTING/MATGEN/slaror.f +++ b/TESTING/MATGEN/slaror.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarot.f b/TESTING/MATGEN/slarot.f index ab4c22ad76..0f73da5d23 100644 --- a/TESTING/MATGEN/slarot.f +++ b/TESTING/MATGEN/slarot.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm1.f b/TESTING/MATGEN/slatm1.f index bd01cb620f..07ff8832aa 100644 --- a/TESTING/MATGEN/slatm1.f +++ b/TESTING/MATGEN/slatm1.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm2.f b/TESTING/MATGEN/slatm2.f index b259c333ea..b92ac09be0 100644 --- a/TESTING/MATGEN/slatm2.f +++ b/TESTING/MATGEN/slatm2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm3.f b/TESTING/MATGEN/slatm3.f index f4e8337344..5402b64126 100644 --- a/TESTING/MATGEN/slatm3.f +++ b/TESTING/MATGEN/slatm3.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm5.f b/TESTING/MATGEN/slatm5.f index 37a629225c..32703bacba 100644 --- a/TESTING/MATGEN/slatm5.f +++ b/TESTING/MATGEN/slatm5.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm6.f b/TESTING/MATGEN/slatm6.f index b0d27f7dcd..5332410785 100644 --- a/TESTING/MATGEN/slatm6.f +++ b/TESTING/MATGEN/slatm6.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm7.f b/TESTING/MATGEN/slatm7.f index 9f9863b00a..46b509bf0d 100644 --- a/TESTING/MATGEN/slatm7.f +++ b/TESTING/MATGEN/slatm7.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATM7 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatme.f b/TESTING/MATGEN/slatme.f index 049409ca56..6672959920 100644 --- a/TESTING/MATGEN/slatme.f +++ b/TESTING/MATGEN/slatme.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatmr.f b/TESTING/MATGEN/slatmr.f index 124a6246a9..44276338fb 100644 --- a/TESTING/MATGEN/slatmr.f +++ b/TESTING/MATGEN/slatmr.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatms.f b/TESTING/MATGEN/slatms.f index eb4f4b38ed..db7ae802dc 100644 --- a/TESTING/MATGEN/slatms.f +++ b/TESTING/MATGEN/slatms.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatmt.f b/TESTING/MATGEN/slatmt.f index f06dcc46c0..34bf9dcadc 100644 --- a/TESTING/MATGEN/slatmt.f +++ b/TESTING/MATGEN/slatmt.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b SLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlagge.f b/TESTING/MATGEN/zlagge.f index 8c2a9676ed..8ae6b32e35 100644 --- a/TESTING/MATGEN/zlagge.f +++ b/TESTING/MATGEN/zlagge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlaghe.f b/TESTING/MATGEN/zlaghe.f index fb77cfb4ca..a58d550fc7 100644 --- a/TESTING/MATGEN/zlaghe.f +++ b/TESTING/MATGEN/zlaghe.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAGHE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlagsy.f b/TESTING/MATGEN/zlagsy.f index adbb41e39e..cbc8ed770a 100644 --- a/TESTING/MATGEN/zlagsy.f +++ b/TESTING/MATGEN/zlagsy.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlahilb.f b/TESTING/MATGEN/zlahilb.f index 858b7444af..da65e4b6e4 100644 --- a/TESTING/MATGEN/zlahilb.f +++ b/TESTING/MATGEN/zlahilb.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlakf2.f b/TESTING/MATGEN/zlakf2.f index b6b9ca4a7b..1186d9c8a3 100644 --- a/TESTING/MATGEN/zlakf2.f +++ b/TESTING/MATGEN/zlakf2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarge.f b/TESTING/MATGEN/zlarge.f index f899bfd3ef..7674da80a1 100644 --- a/TESTING/MATGEN/zlarge.f +++ b/TESTING/MATGEN/zlarge.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarnd.f b/TESTING/MATGEN/zlarnd.f index 6e66d2bb2e..4933ecbc61 100644 --- a/TESTING/MATGEN/zlarnd.f +++ b/TESTING/MATGEN/zlarnd.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlaror.f b/TESTING/MATGEN/zlaror.f index 8ae8f9dc61..3823e05c97 100644 --- a/TESTING/MATGEN/zlaror.f +++ b/TESTING/MATGEN/zlaror.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarot.f b/TESTING/MATGEN/zlarot.f index 901b5ddbd3..be1d745aff 100644 --- a/TESTING/MATGEN/zlarot.f +++ b/TESTING/MATGEN/zlarot.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm1.f b/TESTING/MATGEN/zlatm1.f index c916c8ca19..e442f2a34a 100644 --- a/TESTING/MATGEN/zlatm1.f +++ b/TESTING/MATGEN/zlatm1.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm2.f b/TESTING/MATGEN/zlatm2.f index af0151587e..537e6e82fa 100644 --- a/TESTING/MATGEN/zlatm2.f +++ b/TESTING/MATGEN/zlatm2.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm3.f b/TESTING/MATGEN/zlatm3.f index e7fab607cf..da134cb830 100644 --- a/TESTING/MATGEN/zlatm3.f +++ b/TESTING/MATGEN/zlatm3.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm5.f b/TESTING/MATGEN/zlatm5.f index 07eeb6a1f2..4dda417fec 100644 --- a/TESTING/MATGEN/zlatm5.f +++ b/TESTING/MATGEN/zlatm5.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm6.f b/TESTING/MATGEN/zlatm6.f index 104becfd1b..f4b695aad2 100644 --- a/TESTING/MATGEN/zlatm6.f +++ b/TESTING/MATGEN/zlatm6.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatme.f b/TESTING/MATGEN/zlatme.f index a081353ce9..7ceb2f26ef 100644 --- a/TESTING/MATGEN/zlatme.f +++ b/TESTING/MATGEN/zlatme.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatmr.f b/TESTING/MATGEN/zlatmr.f index 935d717e7b..6a77300abb 100644 --- a/TESTING/MATGEN/zlatmr.f +++ b/TESTING/MATGEN/zlatmr.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatms.f b/TESTING/MATGEN/zlatms.f index b8421eede1..dd81ccdd4e 100644 --- a/TESTING/MATGEN/zlatms.f +++ b/TESTING/MATGEN/zlatms.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatmt.f b/TESTING/MATGEN/zlatmt.f index 25036483c0..af130c3d00 100644 --- a/TESTING/MATGEN/zlatmt.f +++ b/TESTING/MATGEN/zlatmt.f @@ -1,3 +1,4 @@ +#include "matgen_64.h" *> \brief \b ZLATMT * * =========== DOCUMENTATION =========== From ba11da83016133f1cede28ba64d4981ee6f9a390 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Thu, 27 Jul 2023 15:37:12 -0700 Subject: [PATCH 042/206] MATGEN long lines updated by script --- TESTING/MATGEN/clarnd.f | 3 ++- TESTING/MATGEN/clarot.f | 3 ++- TESTING/MATGEN/clatm1.f | 3 ++- TESTING/MATGEN/clatm5.f | 3 ++- TESTING/MATGEN/clatmr.f | 30 ++++++++++++++-------- TESTING/MATGEN/clatms.f | 48 +++++++++++++++++++++++------------ TESTING/MATGEN/clatmt.f | 45 ++++++++++++++++++++++----------- TESTING/MATGEN/dlahilb.f | 3 ++- TESTING/MATGEN/dlarot.f | 3 ++- TESTING/MATGEN/dlatm1.f | 3 ++- TESTING/MATGEN/dlatm3.f | 3 ++- TESTING/MATGEN/dlatm5.f | 3 ++- TESTING/MATGEN/dlatmr.f | 36 ++++++++++++++++++--------- TESTING/MATGEN/dlatms.f | 54 ++++++++++++++++++++++++++-------------- TESTING/MATGEN/dlatmt.f | 48 +++++++++++++++++++++++------------ TESTING/MATGEN/slahilb.f | 3 ++- TESTING/MATGEN/slarot.f | 3 ++- TESTING/MATGEN/slatm1.f | 3 ++- TESTING/MATGEN/slatm3.f | 3 ++- TESTING/MATGEN/slatm5.f | 3 ++- TESTING/MATGEN/slatmr.f | 36 ++++++++++++++++++--------- TESTING/MATGEN/slatms.f | 54 ++++++++++++++++++++++++++-------------- TESTING/MATGEN/slatmt.f | 48 +++++++++++++++++++++++------------ TESTING/MATGEN/zlarnd.f | 3 ++- TESTING/MATGEN/zlarot.f | 3 ++- TESTING/MATGEN/zlatm1.f | 3 ++- TESTING/MATGEN/zlatm5.f | 3 ++- TESTING/MATGEN/zlatmr.f | 33 ++++++++++++++++-------- TESTING/MATGEN/zlatms.f | 48 +++++++++++++++++++++++------------ TESTING/MATGEN/zlatmt.f | 42 ++++++++++++++++++++----------- 30 files changed, 384 insertions(+), 192 deletions(-) diff --git a/TESTING/MATGEN/clarnd.f b/TESTING/MATGEN/clarnd.f index 34e5f849ee..1995dbdc96 100644 --- a/TESTING/MATGEN/clarnd.f +++ b/TESTING/MATGEN/clarnd.f @@ -125,7 +125,8 @@ COMPLEX FUNCTION CLARND( IDIST, ISEED ) * * real and imaginary parts each normal (0,1) * - CLARND = SQRT( -TWO*LOG( T1 ) )*EXP( CMPLX( ZERO, TWOPI*T2 ) ) + CLARND = SQRT( -TWO*LOG( T1 ) )* + $ EXP( CMPLX( ZERO, TWOPI*T2 ) ) ELSE IF( IDIST.EQ.4 ) THEN * * uniform distribution on the unit disc abs(z) <= 1 diff --git a/TESTING/MATGEN/clarot.f b/TESTING/MATGEN/clarot.f index 17328e7ca7..5e22508fbf 100644 --- a/TESTING/MATGEN/clarot.f +++ b/TESTING/MATGEN/clarot.f @@ -225,7 +225,8 @@ *> \ingroup complex_matgen * * ===================================================================== - SUBROUTINE CLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, + SUBROUTINE CLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, + $ XLEFT, $ XRIGHT ) * * -- LAPACK auxiliary routine -- diff --git a/TESTING/MATGEN/clatm1.f b/TESTING/MATGEN/clatm1.f index 7c86bd2564..a5220885de 100644 --- a/TESTING/MATGEN/clatm1.f +++ b/TESTING/MATGEN/clatm1.f @@ -134,7 +134,8 @@ *> \ingroup complex_matgen * * ===================================================================== - SUBROUTINE CLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) + SUBROUTINE CLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/clatm5.f b/TESTING/MATGEN/clatm5.f index db7a221805..9348f71805 100644 --- a/TESTING/MATGEN/clatm5.f +++ b/TESTING/MATGEN/clatm5.f @@ -263,7 +263,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD, + SUBROUTINE CLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, + $ LDD, $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * diff --git a/TESTING/MATGEN/clatmr.f b/TESTING/MATGEN/clatmr.f index c43e7077ad..c066d76daf 100644 --- a/TESTING/MATGEN/clatmr.f +++ b/TESTING/MATGEN/clatmr.f @@ -531,7 +531,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, LOGICAL LSAME REAL CLANGB, CLANGE, CLANSB, CLANSP, CLANSY COMPLEX CLATM2, CLATM3 - EXTERNAL LSAME, CLANGB, CLANGE, CLANSB, CLANSP, CLANSY, + EXTERNAL LSAME, CLANGB, CLANGE, + $ CLANSB, CLANSP, CLANSY, $ CLATM2, CLATM3 * .. * .. External Subroutines .. @@ -898,7 +899,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 170 J = 1, N DO 160 I = 1, J - CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -917,7 +919,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 190 J = 1, N DO 180 I = 1, J - CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -936,7 +939,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 210 J = 1, N DO 200 I = 1, J - CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -964,7 +968,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 230 J = 1, N DO 220 I = 1, J - CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -1017,7 +1022,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 270 J = 1, N DO 260 I = J - KUU, J - CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = CLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -1107,7 +1113,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 390 J = 1, N DO 380 I = 1, J - A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( I, J ) = CLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( J, I ) = CZERO @@ -1143,7 +1150,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ISUB = 1 JSUB = JSUB + 1 END IF - A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU, IDIST, + A( ISUB, JSUB ) = CLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 420 CONTINUE @@ -1201,7 +1209,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, A( J-I+1, I+N ) = CZERO ELSE IF( ISYM.EQ.0 ) THEN - A( J-I+1, I ) = CONJG( CLATM2( M, N, I, J, KL, + A( J-I+1, I ) = CONJG( CLATM2( M, N, I, J, + $ KL, $ KU, IDIST, ISEED, D, IGRADE, DL, $ DR, IPVTNG, IWORK, SPARSE ) ) ELSE @@ -1217,7 +1226,8 @@ SUBROUTINE CLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 510 J = 1, N DO 500 I = J - KUU, J - A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU, IDIST, + A( I-J+KUU+1, J ) = CLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 500 CONTINUE diff --git a/TESTING/MATGEN/clatms.f b/TESTING/MATGEN/clatms.f index 01800f8b32..8211a3f3a7 100644 --- a/TESTING/MATGEN/clatms.f +++ b/TESTING/MATGEN/clatms.f @@ -375,7 +375,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, EXTERNAL LSAME, SLARND, CLARND * .. * .. External Subroutines .. - EXTERNAL CLAGGE, CLAGHE, CLAGSY, CLAROT, CLARTG, CLASET, + EXTERNAL CLAGGE, CLAGHE, CLAGSY, + $ CLAROT, CLARTG, CLASET, $ SLATM1, SSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -535,7 +536,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * * Compute D according to COND and MODE * - CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) + CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = 1 RETURN @@ -648,7 +650,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL CLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL CLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -669,7 +672,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW CTEMP = CZERO ILTEMP = JCH.GT.JKU - CALL CLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, + CALL CLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -682,7 +686,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = CZERO - CALL CLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL CLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -706,7 +711,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL CLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL CLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -727,7 +733,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL CTEMP = CZERO ILTEMP = JCH.GT.JKL - CALL CLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, + CALL CLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -740,7 +747,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL CLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -772,7 +780,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL CLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL CLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -793,7 +802,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N CTEMP = CZERO - CALL CLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL CLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -831,7 +841,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL CLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL CLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -852,7 +863,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M CTEMP = CZERO - CALL CLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL CLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -941,13 +953,15 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, CTEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, + CALL CLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ CT, $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, CTEMP ) ICOL = JCH @@ -1017,7 +1031,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL CLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ CTEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) @@ -1043,7 +1058,8 @@ SUBROUTINE CLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, CTEMP ) IL = MIN( N+1-JCH, K+2 ) diff --git a/TESTING/MATGEN/clatmt.f b/TESTING/MATGEN/clatmt.f index 63bd7550ac..336b298c6a 100644 --- a/TESTING/MATGEN/clatmt.f +++ b/TESTING/MATGEN/clatmt.f @@ -383,7 +383,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, EXTERNAL CLARND, SLARND, LSAME * .. * .. External Subroutines .. - EXTERNAL CLAGGE, CLAGHE, CLAGSY, CLAROT, CLARTG, CLASET, + EXTERNAL CLAGGE, CLAGHE, CLAGSY, + $ CLAROT, CLARTG, CLASET, $ SLATM7, SSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -657,7 +658,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL CLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL CLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -678,7 +680,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW CTEMP = CZERO ILTEMP = JCH.GT.JKU - CALL CLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, + CALL CLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -691,7 +694,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = CZERO - CALL CLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL CLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -715,7 +719,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL CLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL CLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -736,7 +741,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL CTEMP = CZERO ILTEMP = JCH.GT.JKL - CALL CLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, + CALL CLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -749,7 +755,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL CLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -781,7 +788,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL CLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL CLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -802,7 +810,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N CTEMP = CZERO - CALL CLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL CLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -840,7 +849,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL CLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL CLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -861,7 +871,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M CTEMP = CZERO - CALL CLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL CLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -950,13 +961,15 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, CTEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = CZERO - CALL CLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, + CALL CLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ CT, $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, CTEMP ) ICOL = JCH @@ -1026,7 +1039,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL CLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ CTEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) @@ -1052,7 +1066,8 @@ SUBROUTINE CLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = CONJG( C ) ST = CONJG( S ) END IF - CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL CLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, CTEMP ) IL = MIN( N+1-JCH, K+2 ) diff --git a/TESTING/MATGEN/dlahilb.f b/TESTING/MATGEN/dlahilb.f index 3cfe6a2a19..afaa5009a8 100644 --- a/TESTING/MATGEN/dlahilb.f +++ b/TESTING/MATGEN/dlahilb.f @@ -121,7 +121,8 @@ *> \ingroup double_matgen * * ===================================================================== - SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO) + SUBROUTINE DLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, + $ INFO) * * -- LAPACK test routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/dlarot.f b/TESTING/MATGEN/dlarot.f index 9ffb693f58..99cc47a276 100644 --- a/TESTING/MATGEN/dlarot.f +++ b/TESTING/MATGEN/dlarot.f @@ -222,7 +222,8 @@ *> \ingroup double_matgen * * ===================================================================== - SUBROUTINE DLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, + SUBROUTINE DLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, + $ XLEFT, $ XRIGHT ) * * -- LAPACK auxiliary routine -- diff --git a/TESTING/MATGEN/dlatm1.f b/TESTING/MATGEN/dlatm1.f index 27f7be3aaa..8189d3724b 100644 --- a/TESTING/MATGEN/dlatm1.f +++ b/TESTING/MATGEN/dlatm1.f @@ -132,7 +132,8 @@ *> \ingroup double_matgen * * ===================================================================== - SUBROUTINE DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) + SUBROUTINE DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/dlatm3.f b/TESTING/MATGEN/dlatm3.f index 6e67586867..05053ac648 100644 --- a/TESTING/MATGEN/dlatm3.f +++ b/TESTING/MATGEN/dlatm3.f @@ -221,7 +221,8 @@ *> \ingroup double_matgen * * ===================================================================== - DOUBLE PRECISION FUNCTION DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + DOUBLE PRECISION FUNCTION DLATM3( M, N, I, J, ISUB, JSUB, KL, + $ KU, $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * diff --git a/TESTING/MATGEN/dlatm5.f b/TESTING/MATGEN/dlatm5.f index 7fdb1622a0..618c354d79 100644 --- a/TESTING/MATGEN/dlatm5.f +++ b/TESTING/MATGEN/dlatm5.f @@ -263,7 +263,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD, + SUBROUTINE DLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, + $ LDD, $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * diff --git a/TESTING/MATGEN/dlatmr.f b/TESTING/MATGEN/dlatmr.f index ff2470e09c..836dcec83b 100644 --- a/TESTING/MATGEN/dlatmr.f +++ b/TESTING/MATGEN/dlatmr.f @@ -504,9 +504,11 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * .. * .. External Functions .. LOGICAL LSAME - DOUBLE PRECISION DLANGB, DLANGE, DLANSB, DLANSP, DLANSY, DLATM2, + DOUBLE PRECISION DLANGB, DLANGE, DLANSB, + $ DLANSP, DLANSY, DLATM2, $ DLATM3 - EXTERNAL LSAME, DLANGB, DLANGE, DLANSB, DLANSP, DLANSY, + EXTERNAL LSAME, DLANGB, DLANGE, + $ DLANSB, DLANSP, DLANSY, $ DLATM2, DLATM3 * .. * .. External Subroutines .. @@ -847,7 +849,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 140 J = 1, N DO 130 I = 1, J - TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -862,7 +865,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 160 J = 1, N DO 150 I = 1, J - TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -877,7 +881,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 180 J = 1, N DO 170 I = 1, J - TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -901,7 +906,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 200 J = 1, N DO 190 I = 1, J - TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -946,7 +952,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 240 J = 1, N DO 230 I = J - KUU, J - TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -1013,7 +1020,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 340 J = 1, N DO 330 I = 1, J - A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( J, I ) = ZERO @@ -1024,7 +1032,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 360 J = 1, N DO 350 I = 1, J - A( J, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( J, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( I, J ) = ZERO @@ -1042,7 +1051,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ISUB = 1 JSUB = JSUB + 1 END IF - A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU, IDIST, + A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 370 CONTINUE @@ -1097,7 +1107,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IF( I.LT.1 ) THEN A( J-I+1, I+N ) = ZERO ELSE - A( J-I+1, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, + A( J-I+1, I ) = DLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) END IF @@ -1108,7 +1119,8 @@ SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 460 J = 1, N DO 450 I = J - KUU, J - A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, + A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 450 CONTINUE diff --git a/TESTING/MATGEN/dlatms.f b/TESTING/MATGEN/dlatms.f index 859f31f0c6..0ca3b7fb56 100644 --- a/TESTING/MATGEN/dlatms.f +++ b/TESTING/MATGEN/dlatms.f @@ -359,7 +359,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, EXTERNAL LSAME, DLARND * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLAGGE, DLAGSY, DLAROT, DLARTG, DLASET, + EXTERNAL DCOPY, DLAGGE, DLAGSY, + $ DLAROT, DLARTG, DLASET, $ DLATM1, DSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -514,7 +515,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * * Compute D according to COND and MODE * - CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) + CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = 1 RETURN @@ -621,7 +623,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -639,7 +642,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW TEMP = ZERO ILTEMP = JCH.GT.JKU - CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, + CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -648,7 +652,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = ZERO - CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -672,7 +677,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -690,7 +696,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL TEMP = ZERO ILTEMP = JCH.GT.JKL - CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, + CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -699,7 +706,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -731,7 +739,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -749,7 +758,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N TEMP = ZERO - CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL DLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -784,7 +794,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -802,7 +813,8 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M TEMP = ZERO - CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL DLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -864,13 +876,15 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, $ ICOL+1 ), EXTRA, C, S, DUMMY ) TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, + CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ -S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, + CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ C, $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, TEMP ) ICOL = JCH @@ -922,11 +936,13 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ANGLE = TWOPI*DLARND( 1, ISEED ) C = COS( ANGLE ) S = -SIN( ANGLE ) - CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ TEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) - CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, + CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, + $ C, $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, DUMMY, TEMP ) * @@ -937,12 +953,14 @@ SUBROUTINE DLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ EXTRA, C, S, DUMMY ) TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, TEMP ) IL = MIN( N+1-JCH, K+2 ) EXTRA = ZERO - CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, + CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, + $ C, $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) ICOL = JCH diff --git a/TESTING/MATGEN/dlatmt.f b/TESTING/MATGEN/dlatmt.f index 27bf375c58..9430164131 100644 --- a/TESTING/MATGEN/dlatmt.f +++ b/TESTING/MATGEN/dlatmt.f @@ -632,7 +632,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL DLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -650,7 +651,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW TEMP = ZERO ILTEMP = JCH.GT.JKU - CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, + CALL DLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -659,7 +661,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = ZERO - CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL DLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -683,7 +686,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL DLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -701,7 +705,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL TEMP = ZERO ILTEMP = JCH.GT.JKL - CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, + CALL DLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -710,7 +715,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL DLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -742,7 +748,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL DLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -760,7 +767,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N TEMP = ZERO - CALL DLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL DLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -795,7 +803,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL DLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -813,7 +822,8 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M TEMP = ZERO - CALL DLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL DLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -875,13 +885,15 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL DLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, $ ICOL+1 ), EXTRA, C, S, DUMMY ) TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, + CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ -S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = ZERO - CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, + CALL DLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ C, $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, TEMP ) ICOL = JCH @@ -933,11 +945,13 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ANGLE = TWOPI*DLARND( 1, ISEED ) C = COS( ANGLE ) S = -SIN( ANGLE ) - CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL DLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ TEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) - CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, + CALL DLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, + $ C, $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, DUMMY, TEMP ) * @@ -948,12 +962,14 @@ SUBROUTINE DLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL DLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ EXTRA, C, S, DUMMY ) TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL DLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, TEMP ) IL = MIN( N+1-JCH, K+2 ) EXTRA = ZERO - CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, + CALL DLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, + $ C, $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) ICOL = JCH diff --git a/TESTING/MATGEN/slahilb.f b/TESTING/MATGEN/slahilb.f index ccb8db33cb..2695bc3fb7 100644 --- a/TESTING/MATGEN/slahilb.f +++ b/TESTING/MATGEN/slahilb.f @@ -121,7 +121,8 @@ *> \ingroup real_matgen * * ===================================================================== - SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO) + SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, + $ INFO) * * -- LAPACK test routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/slarot.f b/TESTING/MATGEN/slarot.f index 0f73da5d23..ed92521585 100644 --- a/TESTING/MATGEN/slarot.f +++ b/TESTING/MATGEN/slarot.f @@ -222,7 +222,8 @@ *> \ingroup real_matgen * * ===================================================================== - SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, + SUBROUTINE SLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, + $ XLEFT, $ XRIGHT ) * * -- LAPACK auxiliary routine -- diff --git a/TESTING/MATGEN/slatm1.f b/TESTING/MATGEN/slatm1.f index 07ff8832aa..d6cfbd7364 100644 --- a/TESTING/MATGEN/slatm1.f +++ b/TESTING/MATGEN/slatm1.f @@ -132,7 +132,8 @@ *> \ingroup real_matgen * * ===================================================================== - SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) + SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/slatm3.f b/TESTING/MATGEN/slatm3.f index 5402b64126..594012ff9d 100644 --- a/TESTING/MATGEN/slatm3.f +++ b/TESTING/MATGEN/slatm3.f @@ -221,7 +221,8 @@ *> \ingroup real_matgen * * ===================================================================== - REAL FUNCTION SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + REAL FUNCTION SLATM3( M, N, I, J, ISUB, JSUB, KL, + $ KU, $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * diff --git a/TESTING/MATGEN/slatm5.f b/TESTING/MATGEN/slatm5.f index 32703bacba..b4790b917f 100644 --- a/TESTING/MATGEN/slatm5.f +++ b/TESTING/MATGEN/slatm5.f @@ -263,7 +263,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD, + SUBROUTINE SLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, + $ LDD, $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * diff --git a/TESTING/MATGEN/slatmr.f b/TESTING/MATGEN/slatmr.f index 44276338fb..7635395a21 100644 --- a/TESTING/MATGEN/slatmr.f +++ b/TESTING/MATGEN/slatmr.f @@ -504,9 +504,11 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * .. * .. External Functions .. LOGICAL LSAME - REAL SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, SLATM2, + REAL SLANGB, SLANGE, SLANSB, + $ SLANSP, SLANSY, SLATM2, $ SLATM3 - EXTERNAL LSAME, SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, + EXTERNAL LSAME, SLANGB, SLANGE, + $ SLANSB, SLANSP, SLANSY, $ SLATM2, SLATM3 * .. * .. External Subroutines .. @@ -847,7 +849,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 140 J = 1, N DO 130 I = 1, J - TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -862,7 +865,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 160 J = 1, N DO 150 I = 1, J - TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -877,7 +881,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 180 J = 1, N DO 170 I = 1, J - TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -901,7 +906,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 200 J = 1, N DO 190 I = 1, J - TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -946,7 +952,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 240 J = 1, N DO 230 I = J - KUU, J - TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -1013,7 +1020,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 340 J = 1, N DO 330 I = 1, J - A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( J, I ) = ZERO @@ -1024,7 +1032,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 360 J = 1, N DO 350 I = 1, J - A( J, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( J, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( I, J ) = ZERO @@ -1042,7 +1051,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ISUB = 1 JSUB = JSUB + 1 END IF - A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, IDIST, + A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 370 CONTINUE @@ -1097,7 +1107,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IF( I.LT.1 ) THEN A( J-I+1, I+N ) = ZERO ELSE - A( J-I+1, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, + A( J-I+1, I ) = SLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) END IF @@ -1108,7 +1119,8 @@ SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 460 J = 1, N DO 450 I = J - KUU, J - A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, + A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 450 CONTINUE diff --git a/TESTING/MATGEN/slatms.f b/TESTING/MATGEN/slatms.f index db7ae802dc..dad00527fe 100644 --- a/TESTING/MATGEN/slatms.f +++ b/TESTING/MATGEN/slatms.f @@ -359,7 +359,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, EXTERNAL LSAME, SLARND * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLAGGE, SLAGSY, SLAROT, SLARTG, SLATM1, + EXTERNAL SCOPY, SLAGGE, SLAGSY, + $ SLAROT, SLARTG, SLATM1, $ SLASET, SSCAL, XERBLA * .. * .. Intrinsic Functions .. @@ -514,7 +515,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * * Compute D according to COND and MODE * - CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) + CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = 1 RETURN @@ -621,7 +623,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -639,7 +642,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW TEMP = ZERO ILTEMP = JCH.GT.JKU - CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, + CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -648,7 +652,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = ZERO - CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -672,7 +677,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -690,7 +696,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL TEMP = ZERO ILTEMP = JCH.GT.JKL - CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, + CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -699,7 +706,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -731,7 +739,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -749,7 +758,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N TEMP = ZERO - CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL SLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -784,7 +794,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -802,7 +813,8 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M TEMP = ZERO - CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL SLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -864,13 +876,15 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, $ ICOL+1 ), EXTRA, C, S, DUMMY ) TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, + CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ -S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, + CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ C, $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, TEMP ) ICOL = JCH @@ -922,11 +936,13 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ANGLE = TWOPI*SLARND( 1, ISEED ) C = COS( ANGLE ) S = -SIN( ANGLE ) - CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ TEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) - CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, + CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, + $ C, $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, DUMMY, TEMP ) * @@ -937,12 +953,14 @@ SUBROUTINE SLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ EXTRA, C, S, DUMMY ) TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, TEMP ) IL = MIN( N+1-JCH, K+2 ) EXTRA = ZERO - CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, + CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, + $ C, $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) ICOL = JCH diff --git a/TESTING/MATGEN/slatmt.f b/TESTING/MATGEN/slatmt.f index 34bf9dcadc..0a390dc4b5 100644 --- a/TESTING/MATGEN/slatmt.f +++ b/TESTING/MATGEN/slatmt.f @@ -632,7 +632,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -650,7 +651,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW TEMP = ZERO ILTEMP = JCH.GT.JKU - CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, + CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -659,7 +661,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = ZERO - CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -683,7 +686,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -701,7 +705,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL TEMP = ZERO ILTEMP = JCH.GT.JKL - CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, + CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ -S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, TEMP, EXTRA ) IF( ILTEMP ) THEN @@ -710,7 +715,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, -S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ TEMP ) @@ -742,7 +748,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -760,7 +767,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N TEMP = ZERO - CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL SLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -795,7 +803,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -813,7 +822,8 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M TEMP = ZERO - CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL SLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, TEMP ) IF( ILTEMP ) THEN @@ -875,13 +885,15 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, $ ICOL+1 ), EXTRA, C, S, DUMMY ) TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, + CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ -S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = ZERO - CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, + CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ C, $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, TEMP ) ICOL = JCH @@ -933,11 +945,13 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ANGLE = TWOPI*SLARND( 1, ISEED ) C = COS( ANGLE ) S = -SIN( ANGLE ) - CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ TEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) - CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, + CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, + $ C, $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, DUMMY, TEMP ) * @@ -948,12 +962,14 @@ SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ EXTRA, C, S, DUMMY ) TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) - CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, TEMP ) IL = MIN( N+1-JCH, K+2 ) EXTRA = ZERO - CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, + CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, + $ C, $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, TEMP, EXTRA ) ICOL = JCH diff --git a/TESTING/MATGEN/zlarnd.f b/TESTING/MATGEN/zlarnd.f index 4933ecbc61..bbc0df4c8b 100644 --- a/TESTING/MATGEN/zlarnd.f +++ b/TESTING/MATGEN/zlarnd.f @@ -125,7 +125,8 @@ COMPLEX*16 FUNCTION ZLARND( IDIST, ISEED ) * * real and imaginary parts each normal (0,1) * - ZLARND = SQRT( -TWO*LOG( T1 ) )*EXP( DCMPLX( ZERO, TWOPI*T2 ) ) + ZLARND = SQRT( -TWO*LOG( T1 ) )* + $ EXP( DCMPLX( ZERO, TWOPI*T2 ) ) ELSE IF( IDIST.EQ.4 ) THEN * * uniform distribution on the unit disc abs(z) <= 1 diff --git a/TESTING/MATGEN/zlarot.f b/TESTING/MATGEN/zlarot.f index be1d745aff..49ff62ffe2 100644 --- a/TESTING/MATGEN/zlarot.f +++ b/TESTING/MATGEN/zlarot.f @@ -225,7 +225,8 @@ *> \ingroup complex16_matgen * * ===================================================================== - SUBROUTINE ZLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, XLEFT, + SUBROUTINE ZLAROT( LROWS, LLEFT, LRIGHT, NL, C, S, A, LDA, + $ XLEFT, $ XRIGHT ) * * -- LAPACK auxiliary routine -- diff --git a/TESTING/MATGEN/zlatm1.f b/TESTING/MATGEN/zlatm1.f index e442f2a34a..18d499dbcc 100644 --- a/TESTING/MATGEN/zlatm1.f +++ b/TESTING/MATGEN/zlatm1.f @@ -134,7 +134,8 @@ *> \ingroup complex16_matgen * * ===================================================================== - SUBROUTINE ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO ) + SUBROUTINE ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, + $ INFO ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/TESTING/MATGEN/zlatm5.f b/TESTING/MATGEN/zlatm5.f index 4dda417fec..4fc2b82ffb 100644 --- a/TESTING/MATGEN/zlatm5.f +++ b/TESTING/MATGEN/zlatm5.f @@ -263,7 +263,8 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD, + SUBROUTINE ZLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, + $ LDD, $ E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA, $ QBLCKB ) * diff --git a/TESTING/MATGEN/zlatmr.f b/TESTING/MATGEN/zlatmr.f index 6a77300abb..2d6b342638 100644 --- a/TESTING/MATGEN/zlatmr.f +++ b/TESTING/MATGEN/zlatmr.f @@ -529,9 +529,11 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * .. * .. External Functions .. LOGICAL LSAME - DOUBLE PRECISION ZLANGB, ZLANGE, ZLANSB, ZLANSP, ZLANSY + DOUBLE PRECISION ZLANGB, ZLANGE, ZLANSB, + $ ZLANSP, ZLANSY COMPLEX*16 ZLATM2, ZLATM3 - EXTERNAL LSAME, ZLANGB, ZLANGE, ZLANSB, ZLANSP, ZLANSY, + EXTERNAL LSAME, ZLANGB, ZLANGE, + $ ZLANSB, ZLANSP, ZLANSY, $ ZLATM2, ZLATM3 * .. * .. External Subroutines .. @@ -898,7 +900,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 170 J = 1, N DO 160 I = 1, J - CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -917,7 +920,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 190 J = 1, N DO 180 I = 1, J - CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -936,7 +940,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 210 J = 1, N DO 200 I = 1, J - CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -964,7 +969,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 230 J = 1, N DO 220 I = 1, J - CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) * @@ -1017,7 +1023,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 270 J = 1, N DO 260 I = J - KUU, J - CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, + CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, $ SPARSE ) MNSUB = MIN( ISUB, JSUB ) @@ -1107,7 +1114,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 390 J = 1, N DO 380 I = 1, J - A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST, ISEED, + A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST, + $ ISEED, $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) IF( I.NE.J ) $ A( J, I ) = CZERO @@ -1143,7 +1151,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ISUB = 1 JSUB = JSUB + 1 END IF - A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU, IDIST, + A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 420 CONTINUE @@ -1201,7 +1210,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, A( J-I+1, I+N ) = CZERO ELSE IF( ISYM.EQ.0 ) THEN - A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL, + A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, + $ KL, $ KU, IDIST, ISEED, D, IGRADE, DL, $ DR, IPVTNG, IWORK, SPARSE ) ) ELSE @@ -1217,7 +1227,8 @@ SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * DO 510 J = 1, N DO 500 I = J - KUU, J - A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST, + A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, + $ IDIST, $ ISEED, D, IGRADE, DL, DR, IPVTNG, $ IWORK, SPARSE ) 500 CONTINUE diff --git a/TESTING/MATGEN/zlatms.f b/TESTING/MATGEN/zlatms.f index dd81ccdd4e..779edf2bfb 100644 --- a/TESTING/MATGEN/zlatms.f +++ b/TESTING/MATGEN/zlatms.f @@ -375,7 +375,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, EXTERNAL LSAME, DLARND, ZLARND * .. * .. External Subroutines .. - EXTERNAL DLATM1, DSCAL, XERBLA, ZLAGGE, ZLAGHE, ZLAGSY, + EXTERNAL DLATM1, DSCAL, XERBLA, + $ ZLAGGE, ZLAGHE, ZLAGSY, $ ZLAROT, ZLARTG, ZLASET * .. * .. Intrinsic Functions .. @@ -535,7 +536,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, * * Compute D according to COND and MODE * - CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, IINFO ) + CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = 1 RETURN @@ -648,7 +650,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -669,7 +672,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW CTEMP = CZERO ILTEMP = JCH.GT.JKU - CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, + CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -682,7 +686,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = CZERO - CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -706,7 +711,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -727,7 +733,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL CTEMP = CZERO ILTEMP = JCH.GT.JKL - CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, + CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, CTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -740,7 +747,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ CTEMP ) @@ -772,7 +780,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -793,7 +802,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N CTEMP = CZERO - CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -831,7 +841,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -852,7 +863,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M CTEMP = CZERO - CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, CTEMP ) IF( ILTEMP ) THEN @@ -941,13 +953,15 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, CTEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, + CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ CT, $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, CTEMP ) ICOL = JCH @@ -1017,7 +1031,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ CTEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) @@ -1043,7 +1058,8 @@ SUBROUTINE ZLATMS( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, CTEMP ) IL = MIN( N+1-JCH, K+2 ) diff --git a/TESTING/MATGEN/zlatmt.f b/TESTING/MATGEN/zlatmt.f index af130c3d00..2f62fa628f 100644 --- a/TESTING/MATGEN/zlatmt.f +++ b/TESTING/MATGEN/zlatmt.f @@ -657,7 +657,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL ) IF( JR.LT.M ) THEN IL = MIN( N, JR+JKU ) + 1 - ICOL - CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, + CALL ZLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, + $ C, $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, EXTRA, DUMMY ) END IF @@ -678,7 +679,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IR + 2 - IROW ZTEMP = CZERO ILTEMP = JCH.GT.JKU - CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, S, + CALL ZLAROT( .FALSE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IROW-ISKEW*IC+IOFFST, IC ), $ ILDA, ZTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -691,7 +693,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JCH-JKU-JKL ) IL = IC + 2 - ICOL EXTRA = CZERO - CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., + CALL ZLAROT( .TRUE., JCH.GT.JKU+JKL, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ ZTEMP ) @@ -715,7 +718,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU ) IF( JC.LT.N ) THEN IL = MIN( M, JC+JKL ) + 1 - IROW - CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, + CALL ZLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, + $ C, $ S, A( IROW-ISKEW*JC+IOFFST, JC ), $ ILDA, EXTRA, DUMMY ) END IF @@ -736,7 +740,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IL = IC + 2 - ICOL ZTEMP = CZERO ILTEMP = JCH.GT.JKL - CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, S, + CALL ZLAROT( .TRUE., ILTEMP, .TRUE., IL, C, + $ S, $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), $ ILDA, ZTEMP, EXTRA ) IF( ILTEMP ) THEN @@ -749,7 +754,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JCH-JKL-JKU ) IL = IR + 2 - IROW EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., + CALL ZLAROT( .FALSE., JCH.GT.JKL+JKU, + $ .TRUE., $ IL, C, S, A( IROW-ISKEW*ICOL+ $ IOFFST, ICOL ), ILDA, EXTRA, $ ZTEMP ) @@ -781,7 +787,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MAX( 1, JC-JKU+1 ) IF( JC.GT.0 ) THEN IL = MIN( M, JC+JKL+1 ) + 1 - IROW - CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, + CALL ZLAROT( .FALSE., .FALSE., JC+JKL.LT.M, + $ IL, $ C, S, A( IROW-ISKEW*JC+IOFFST, $ JC ), ILDA, DUMMY, EXTRA ) END IF @@ -802,7 +809,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MIN( N-1, JCH+JKU ) ILTEMP = JCH + JKU.LT.N ZTEMP = CZERO - CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, + CALL ZLAROT( .TRUE., ILEXTR, ILTEMP, + $ ICOL+2-IC, $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), $ ILDA, EXTRA, ZTEMP ) IF( ILTEMP ) THEN @@ -840,7 +848,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, ICOL = MAX( 1, JR-JKL+1 ) IF( JR.GT.0 ) THEN IL = MIN( N, JR+JKU+1 ) + 1 - ICOL - CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, + CALL ZLAROT( .TRUE., .FALSE., JR+JKU.LT.N, + $ IL, $ C, S, A( JR-ISKEW*ICOL+IOFFST, $ ICOL ), ILDA, DUMMY, EXTRA ) END IF @@ -861,7 +870,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, IROW = MIN( M-1, JCH+JKL ) ILTEMP = JCH + JKL.LT.M ZTEMP = CZERO - CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, + CALL ZLAROT( .FALSE., ILEXTR, ILTEMP, + $ IROW+2-IR, $ C, S, A( IR-ISKEW*JCH+IOFFST, $ JCH ), ILDA, EXTRA, ZTEMP ) IF( ILTEMP ) THEN @@ -950,13 +960,15 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), $ ILDA, ZTEMP, EXTRA ) IROW = MAX( 1, JCH-K ) IL = MIN( JCH+1, K+2 ) EXTRA = CZERO - CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, CT, + CALL ZLAROT( .FALSE., JCH.GT.K, .TRUE., IL, + $ CT, $ ST, A( IROW-ISKEW*JCH+IOFFG, JCH ), $ ILDA, EXTRA, ZTEMP ) ICOL = JCH @@ -1026,7 +1038,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, + CALL ZLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, + $ S, $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, $ ZTEMP, EXTRA ) ICOL = MAX( 1, JC-K+1 ) @@ -1052,7 +1065,8 @@ SUBROUTINE ZLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, CT = DCONJG( C ) ST = DCONJG( S ) END IF - CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, + CALL ZLAROT( .TRUE., .TRUE., .TRUE., K+2, C, + $ S, $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), $ ILDA, EXTRA, ZTEMP ) IL = MIN( N+1-JCH, K+2 ) From dae4c5a3a44141ce411742aa2f9ea850493dd764 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Thu, 27 Jul 2023 16:50:55 -0700 Subject: [PATCH 043/206] Add LAPACKE examples for extended _64 API --- LAPACKE/example/CMakeLists.txt | 25 ++++- LAPACKE/example/example_DGELS_colmajor_64.c | 93 +++++++++++++++++ LAPACKE/example/example_DGELS_rowmajor_64.c | 93 +++++++++++++++++ LAPACKE/example/example_DGESV_colmajor_64.c | 108 ++++++++++++++++++++ LAPACKE/example/example_DGESV_rowmajor_64.c | 105 +++++++++++++++++++ LAPACKE/example/lapacke_example_aux.c | 32 ++++++ LAPACKE/example/lapacke_example_aux.h | 4 + 7 files changed, 456 insertions(+), 4 deletions(-) create mode 100644 LAPACKE/example/example_DGELS_colmajor_64.c create mode 100644 LAPACKE/example/example_DGELS_rowmajor_64.c create mode 100644 LAPACKE/example/example_DGESV_colmajor_64.c create mode 100644 LAPACKE/example/example_DGESV_rowmajor_64.c diff --git a/LAPACKE/example/CMakeLists.txt b/LAPACKE/example/CMakeLists.txt index 27db8ee216..509ee4edea 100644 --- a/LAPACKE/example/CMakeLists.txt +++ b/LAPACKE/example/CMakeLists.txt @@ -3,12 +3,29 @@ add_executable(xexample_DGESV_colmajor example_DGESV_colmajor.c lapacke_example_ add_executable(xexample_DGELS_rowmajor example_DGELS_rowmajor.c lapacke_example_aux.c lapacke_example_aux.h) add_executable(xexample_DGELS_colmajor example_DGELS_colmajor.c lapacke_example_aux.c lapacke_example_aux.h) -target_link_libraries(xexample_DGESV_rowmajor ${LAPACKELIB}) -target_link_libraries(xexample_DGESV_colmajor ${LAPACKELIB}) -target_link_libraries(xexample_DGELS_rowmajor ${LAPACKELIB}) -target_link_libraries(xexample_DGELS_colmajor ${LAPACKELIB}) +target_link_libraries(xexample_DGESV_rowmajor ${LAPACKELIB} ${BLAS_LIBRARIES}) +target_link_libraries(xexample_DGESV_colmajor ${LAPACKELIB} ${BLAS_LIBRARIES}) +target_link_libraries(xexample_DGELS_rowmajor ${LAPACKELIB} ${BLAS_LIBRARIES}) +target_link_libraries(xexample_DGELS_colmajor ${LAPACKELIB} ${BLAS_LIBRARIES}) add_test(example_DGESV_rowmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_rowmajor) add_test(example_DGESV_colmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_colmajor) add_test(example_DGELS_rowmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGELS_rowmajor) add_test(example_DGELS_colmajor ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGELS_colmajor) + +if(BUILD_INDEX64_EXT_API) + add_executable(xexample_DGESV_rowmajor_64 example_DGESV_rowmajor_64.c lapacke_example_aux.c lapacke_example_aux.h) + add_executable(xexample_DGESV_colmajor_64 example_DGESV_colmajor_64.c lapacke_example_aux.c lapacke_example_aux.h) + add_executable(xexample_DGELS_rowmajor_64 example_DGELS_rowmajor_64.c lapacke_example_aux.c lapacke_example_aux.h) + add_executable(xexample_DGELS_colmajor_64 example_DGELS_colmajor_64.c lapacke_example_aux.c lapacke_example_aux.h) + + target_link_libraries(xexample_DGESV_rowmajor_64 ${LAPACKELIB} ${BLAS_LIBRARIES}) + target_link_libraries(xexample_DGESV_colmajor_64 ${LAPACKELIB} ${BLAS_LIBRARIES}) + target_link_libraries(xexample_DGELS_rowmajor_64 ${LAPACKELIB} ${BLAS_LIBRARIES}) + target_link_libraries(xexample_DGELS_colmajor_64 ${LAPACKELIB} ${BLAS_LIBRARIES}) + + add_test(example_DGESV_rowmajor_64 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_rowmajor_64) + add_test(example_DGESV_colmajor_64 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGESV_colmajor_64) + add_test(example_DGELS_rowmajor_64 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGELS_rowmajor_64) + add_test(example_DGELS_colmajor_64 ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xexample_DGELS_colmajor_64) +endif() diff --git a/LAPACKE/example/example_DGELS_colmajor_64.c b/LAPACKE/example/example_DGELS_colmajor_64.c new file mode 100644 index 0000000000..2adf95fd53 --- /dev/null +++ b/LAPACKE/example/example_DGELS_colmajor_64.c @@ -0,0 +1,93 @@ +/* + LAPACKE Example : Calling DGELS using col-major layout + ===================================================== + + The program computes the solution to the system of linear + equations with a square matrix A and multiple + right-hand sides B, where A is the coefficient matrix + and b is the right-hand side matrix: + + Description + =========== + + In this example, we wish solve the least squares problem min_x || B - Ax || + for two right-hand sides using the LAPACK routine DGELS. For input we will + use the 5-by-3 matrix + + ( 1 1 1 ) + ( 2 3 4 ) + A = ( 3 5 2 ) + ( 4 2 5 ) + ( 5 4 3 ) + and the 5-by-2 matrix + + ( -10 -3 ) + ( 12 14 ) + B = ( 14 12 ) + ( 16 16 ) + ( 18 16 ) + We will first store the input matrix as a static C two-dimensional array, + which is stored in col-major layout, and let LAPACKE handle the work space + array allocation. The LAPACK base name for this function is gels, and we + will use double precision (d), so the LAPACKE function name is LAPACKE_dgels. + + lda=5 and ldb=5. The output for each right hand side is stored in b as + consecutive vectors of length 3. The correct answer for this problem is + the 3-by-2 matrix + + ( 2 1 ) + ( 1 1 ) + ( 1 2 ) + + A complete C program for this example is given below. Note that when the arrays + are passed to the LAPACK routine, they must be dereferenced, since LAPACK is + expecting arrays of type double *, not double **. + + + LAPACKE Interface + ================= + + LAPACKE_dgels (col-major, high-level) Example Program Results + + -- LAPACKE Example routine -- + -- LAPACK is a software package provided by Univ. of Tennessee, -- + -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +*/ +/* Calling DGELS using col-major layout */ + +/* Includes */ +#include +#include +#include "lapacke_example_aux.h" + +/* Main program */ +int main (int argc, const char * argv[]) +{ + /* Locals */ + double A[5][3] = {{1,2,3},{4,5,1},{3,5,2},{4,1,4},{2,5,3}}; + double b[5][2] = {{-10,12},{14,16},{18,-3},{14,12},{16,16}}; + int64_t info,m,n,lda,ldb,nrhs; + + /* Initialization */ + m = 5; + n = 3; + nrhs = 2; + lda = 5; + ldb = 5; + + /* Print Entry Matrix */ + print_matrix_colmajor_64( "Entry Matrix A", m, n, *A, lda ); + /* Print Right Rand Side */ + print_matrix_colmajor_64( "Right Hand Side b", n, nrhs, *b, ldb ); + printf( "\n" ); + + /* Executable statements */ + printf( "LAPACKE_dgels_64 (col-major, high-level) Example Program Results\n" ); + /* Solve least squares problem*/ + info = LAPACKE_dgels_64(LAPACK_COL_MAJOR,'N',m,n,nrhs,*A,lda,*b,ldb); + + /* Print Solution */ + print_matrix_colmajor_64( "Solution", n, nrhs, *b, ldb ); + printf( "\n" ); + exit( info ); +} /* End of LAPACKE_dgels Example */ diff --git a/LAPACKE/example/example_DGELS_rowmajor_64.c b/LAPACKE/example/example_DGELS_rowmajor_64.c new file mode 100644 index 0000000000..4571b2e377 --- /dev/null +++ b/LAPACKE/example/example_DGELS_rowmajor_64.c @@ -0,0 +1,93 @@ +/* + LAPACKE Example : Calling DGELS using row-major layout + ===================================================== + + The program computes the solution to the system of linear + equations with a square matrix A and multiple + right-hand sides B, where A is the coefficient matrix + and b is the right-hand side matrix: + + Description + =========== + + In this example, we wish solve the least squares problem min_x || B - Ax || + for two right-hand sides using the LAPACK routine DGELS. For input we will + use the 5-by-3 matrix + + ( 1 1 1 ) + ( 2 3 4 ) + A = ( 3 5 2 ) + ( 4 2 5 ) + ( 5 4 3 ) + and the 5-by-2 matrix + + ( -10 -3 ) + ( 12 14 ) + B = ( 14 12 ) + ( 16 16 ) + ( 18 16 ) + We will first store the input matrix as a static C two-dimensional array, + which is stored in row-major layout, and let LAPACKE handle the work space + array allocation. The LAPACK base name for this function is gels, and we + will use double precision (d), so the LAPACKE function name is LAPACKE_dgels. + + thus lda=3 and ldb=2. The output for each right hand side is stored in b as + consecutive vectors of length 3. The correct answer for this problem is + the 3-by-2 matrix + + ( 2 1 ) + ( 1 1 ) + ( 1 2 ) + + A complete C program for this example is given below. Note that when the arrays + are passed to the LAPACK routine, they must be dereferenced, since LAPACK is + expecting arrays of type double *, not double **. + + + LAPACKE Interface + ================= + + LAPACKE_dgels (row-major, high-level) Example Program Results + + -- LAPACKE Example routine -- + -- LAPACK is a software package provided by Univ. of Tennessee, -- + -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +*/ +/* Calling DGELS using row-major layout */ + +/* Includes */ +#include +#include +#include "lapacke_example_aux.h" + +/* Main program */ +int main (int argc, const char * argv[]) +{ + /* Locals */ + double A[5][3] = {{1,1,1},{2,3,4},{3,5,2},{4,2,5},{5,4,3}}; + double b[5][2] = {{-10,-3},{12,14},{14,12},{16,16},{18,16}}; + int64_t info,m,n,lda,ldb,nrhs; + + /* Initialization */ + m = 5; + n = 3; + nrhs = 2; + lda = 3; + ldb = 2; + + /* Print Entry Matrix */ + print_matrix_rowmajor_64( "Entry Matrix A", m, n, *A, lda ); + /* Print Right Rand Side */ + print_matrix_rowmajor_64( "Right Hand Side b", n, nrhs, *b, ldb ); + printf( "\n" ); + + /* Executable statements */ + printf( "LAPACKE_dgels_64 (row-major, high-level) Example Program Results\n" ); + /* Solve least squares problem*/ + info = LAPACKE_dgels_64(LAPACK_ROW_MAJOR,'N',m,n,nrhs,*A,lda,*b,ldb); + + /* Print Solution */ + print_matrix_rowmajor_64( "Solution", n, nrhs, *b, ldb ); + printf( "\n" ); + exit( 0 ); +} /* End of LAPACKE_dgels Example */ diff --git a/LAPACKE/example/example_DGESV_colmajor_64.c b/LAPACKE/example/example_DGESV_colmajor_64.c new file mode 100644 index 0000000000..9c132dfc4d --- /dev/null +++ b/LAPACKE/example/example_DGESV_colmajor_64.c @@ -0,0 +1,108 @@ +/* + LAPACKE_dgesv Example + ===================== + + The program computes the solution to the system of linear + equations with a square matrix A and multiple + right-hand sides B, where A is the coefficient matrix + and b is the right-hand side matrix: + + Description + =========== + + The routine solves for X the system of linear equations A*X = B, + where A is an n-by-n matrix, the columns of matrix B are individual + right-hand sides, and the columns of X are the corresponding + solutions. + + The LU decomposition with partial pivoting and row interchanges is + used to factor A as A = P*L*U, where P is a permutation matrix, L + is unit lower triangular, and U is upper triangular. The factored + form of A is then used to solve the system of equations A*X = B. + + LAPACKE Interface + ================= + + LAPACKE_dgesv (col-major, high-level) Example Program Results + + -- LAPACKE Example routine -- + -- LAPACK is a software package provided by Univ. of Tennessee, -- + -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +*/ +/* Includes */ +#include +#include +#include +#include "lapacke_64.h" +#include "lapacke_example_aux.h" + +/* Main program */ +int main(int argc, char **argv) { + + /* Locals */ + int64_t n, nrhs, lda, ldb, info; + int i, j; + /* Local arrays */ + double *A, *b; + int64_t *ipiv; + + /* Default Value */ + n = 5; nrhs = 1; + + /* Arguments */ + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } + + /* Initialization */ + lda=n, ldb=n; + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + + for( i = 0; i < n; i++ ) { + for( j = 0; j < n; j++ ) A[i+j*lda] = ((double) rand()) / ((double) RAND_MAX) - 0.5; + } + + for(i=0;i 0 ) { + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + exit( 1 ); + } + if (info <0) exit( 1 ); + /* Print solution */ + print_matrix_colmajor_64( "Solution", n, nrhs, b, ldb ); + /* Print details of LU factorization */ + print_matrix_colmajor_64( "Details of LU factorization", n, n, A, lda ); + /* Print pivot indices */ + print_vector_64( "Pivot indices", n, ipiv ); + exit( 0 ); +} /* End of LAPACKE_dgesv Example */ + diff --git a/LAPACKE/example/example_DGESV_rowmajor_64.c b/LAPACKE/example/example_DGESV_rowmajor_64.c new file mode 100644 index 0000000000..28f65fa137 --- /dev/null +++ b/LAPACKE/example/example_DGESV_rowmajor_64.c @@ -0,0 +1,105 @@ +/* + LAPACKE_dgesv Example + ===================== + + The program computes the solution to the system of linear + equations with a square matrix A and multiple + right-hand sides B, where A is the coefficient matrix + and b is the right-hand side matrix: + + Description + =========== + + The routine solves for X the system of linear equations A*X = B, + where A is an n-by-n matrix, the columns of matrix B are individual + right-hand sides, and the columns of X are the corresponding + solutions. + + The LU decomposition with partial pivoting and row interchanges is + used to factor A as A = P*L*U, where P is a permutation matrix, L + is unit lower triangular, and U is upper triangular. The factored + form of A is then used to solve the system of equations A*X = B. + + LAPACKE Interface + ================= + + LAPACKE_dgesv (row-major, high-level) Example Program Results + + -- LAPACKE Example routine -- + -- LAPACK is a software package provided by Univ. of Tennessee, -- + -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +*/ +#include +#include +#include +#include +#include "lapacke_example_aux.h" + +/* Main program */ +int main(int argc, char **argv) { + + /* Locals */ + int64_t n, nrhs, lda, ldb, info; + int i, j; + /* Local arrays */ + double *A, *b; + int64_t *ipiv; + + /* Default Value */ + n = 5; nrhs = 1; + + /* Arguments */ + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } + + /* Initialization */ + lda=n, ldb=nrhs; + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + + for( i = 0; i < n; i++ ) { + for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; + } + + for(i=0;i 0 ) { + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + exit( 1 ); + } + if (info <0) exit( 1 ); + /* Print solution */ + print_matrix_rowmajor_64( "Solution", n, nrhs, b, ldb ); + /* Print details of LU factorization */ + print_matrix_rowmajor_64( "Details of LU factorization", n, n, A, lda ); + /* Print pivot indices */ + print_vector_64( "Pivot indices", n, ipiv ); + exit( 0 ); +} /* End of LAPACKE_dgesv Example */ + diff --git a/LAPACKE/example/lapacke_example_aux.c b/LAPACKE/example/lapacke_example_aux.c index 19fff79055..3a70ba689b 100644 --- a/LAPACKE/example/lapacke_example_aux.c +++ b/LAPACKE/example/lapacke_example_aux.c @@ -31,3 +31,35 @@ void print_vector( char* desc, lapack_int n, lapack_int* vec ) { for( j = 0; j < n; j++ ) printf( " %6" LAPACK_IFMT, vec[j] ); printf( "\n" ); } + +/* ILP64 routines */ +/* Auxiliary routine: printing a matrix */ +void print_matrix_rowmajor_64( char* desc, int64_t m, int64_t n, double* mat, int64_t ldm ) { + int64_t i, j; + printf( "\n %s\n", desc ); + + for( i = 0; i < m; i++ ) { + for( j = 0; j < n; j++ ) printf( " %6.2f", mat[i*ldm+j] ); + printf( "\n" ); + } +} + + +/* Auxiliary routine: printing a matrix */ +void print_matrix_colmajor_64( char* desc, int64_t m, int64_t n, double* mat, int64_t ldm ) { + int64_t i, j; + printf( "\n %s\n", desc ); + + for( i = 0; i < m; i++ ) { + for( j = 0; j < n; j++ ) printf( " %6.2f", mat[i+j*ldm] ); + printf( "\n" ); + } +} + +/* Auxiliary routine: printing a vector of integers */ +void print_vector_64( char* desc, int64_t n, int64_t* vec ) { + int64_t j; + printf( "\n %s\n", desc ); + for( j = 0; j < n; j++ ) printf( " %6" LAPACK_IFMT, vec[j] ); + printf( "\n" ); +} diff --git a/LAPACKE/example/lapacke_example_aux.h b/LAPACKE/example/lapacke_example_aux.h index f83351152c..2b3389fa1d 100644 --- a/LAPACKE/example/lapacke_example_aux.h +++ b/LAPACKE/example/lapacke_example_aux.h @@ -6,4 +6,8 @@ void print_matrix_rowmajor( char* desc, lapack_int m, lapack_int n, double* mat, void print_matrix_colmajor( char* desc, lapack_int m, lapack_int n, double* mat, lapack_int ldm ); void print_vector( char* desc, lapack_int n, lapack_int* vec ); +void print_matrix_rowmajor_64( char* desc, int64_t m, int64_t n, double* mat, int64_t ldm ); +void print_matrix_colmajor_64( char* desc, int64_t m, int64_t n, double* mat, int64_t ldm ); +void print_vector_64( char* desc, int64_t n, int64_t* vec ); + #endif /* _LAPACKE_EXAMPLE_AUX_*/ From 56aa97941636a35a1b9da439e384f6632cce2154 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Fri, 28 Jul 2023 12:55:13 -0700 Subject: [PATCH 044/206] Fix problem with missed mod files in parallel LAPACK build --- SRC/CMakeLists.txt | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 22930b5ebf..d73cdec28a 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -2,6 +2,7 @@ # This is the makefile to create a library for LAPACK. # The files are organized as follows: +# ALLMOD -- Part of ALLAUX # ALLAUX -- Auxiliary routines called from all precisions # SCLAUX -- Auxiliary routines called from single precision # DZLAUX -- Auxiliary routines called from double precision @@ -35,13 +36,14 @@ # ####################################################################### +set(ALLMOD la_xisnan.F90 la_constants.f90) + set(ALLAUX ilaenv.f ilaenv2stage.f ieeeck.f lsamen.f iparmq.f iparam2stage.F - ilaprec.f ilatrans.f ilauplo.f iladiag.f chla_transtype.f la_xisnan.F90 + ilaprec.f ilatrans.f ilauplo.f iladiag.f chla_transtype.f ../INSTALL/ilaver.f ../INSTALL/lsame.f xerbla.f xerbla_array.f ../INSTALL/slamch.f) set(SCLAUX - la_constants.f90 sbdsvdx.f sbdsdc.f sbdsqr.f sdisna.f slabad.f slacpy.f sladiv.f slae2.f slaebz.f slaed0.f slaed1.f slaed2.f slaed3.f slaed4.f slaed5.f slaed6.f @@ -60,7 +62,6 @@ set(SCLAUX ${SECOND_SRC}) set(DZLAUX - la_constants.f90 dbdsdc.f dbdsvdx.f dbdsqr.f ddisna.f disnan.f @@ -516,7 +517,17 @@ if(BUILD_COMPLEX16) endif() list(REMOVE_DUPLICATES SOURCES) +# Use special target for MOD files to guarantee they are built before +# any other files that depend on them +add_library(mod_files OBJECT ${ALLMOD}) +set_target_properties( + mod_files PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) + add_library(${LAPACKLIB}_obj OBJECT ${SOURCES}) +target_link_libraries(${LAPACKLIB}_obj mod_files) set_target_properties( ${LAPACKLIB}_obj PROPERTIES POSITION_INDEPENDENT_CODE ON @@ -530,6 +541,7 @@ if(BUILD_INDEX64_EXT_API) list(REMOVE_ITEM SOURCES_64 ${SECOND_SRC}) list(REMOVE_ITEM SOURCES_64 ${DSECOND_SRC}) add_library(${LAPACKLIB}_64_obj OBJECT ${SOURCES_64}) + target_link_libraries(${LAPACKLIB}_64_obj mod_files) target_compile_options(${LAPACKLIB}_64_obj PRIVATE ${FOPT_ILP64} -DLAPACK_64) set_target_properties( ${LAPACKLIB}_64_obj PROPERTIES @@ -539,6 +551,7 @@ if(BUILD_INDEX64_EXT_API) endif() add_library(${LAPACKLIB} + $ $ $<$: $>) set_target_properties( From ac2c5681bc4f49156376226df63b794298fbe355 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Fri, 28 Jul 2023 16:58:11 -0700 Subject: [PATCH 045/206] MATGEN fix -Werror=conversion problems --- TESTING/MATGEN/clahilb.f | 18 +++++++++--------- TESTING/MATGEN/slahilb.f | 10 +++++----- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/TESTING/MATGEN/clahilb.f b/TESTING/MATGEN/clahilb.f index 3aa93c982a..e47bb36e9f 100644 --- a/TESTING/MATGEN/clahilb.f +++ b/TESTING/MATGEN/clahilb.f @@ -226,15 +226,15 @@ SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, IF ( LSAMEN( 2, C2, 'SY' ) ) THEN DO J = 1, N DO I = 1, N - A(I, J) = D1(MOD(J,SIZE_D)+1) * (REAL(M) / (I + J - 1)) - $ * D1(MOD(I,SIZE_D)+1) + A(I, J) = D1(MOD(J,SIZE_D)+1) * (REAL(M) + $ / REAL(I + J - 1)) * D1(MOD(I,SIZE_D)+1) END DO END DO ELSE DO J = 1, N DO I = 1, N - A(I, J) = D1(MOD(J,SIZE_D)+1) * (REAL(M) / (I + J - 1)) - $ * D2(MOD(I,SIZE_D)+1) + A(I, J) = D1(MOD(J,SIZE_D)+1) * (REAL(M) + $ / REAL(I + J - 1)) * D2(MOD(I,SIZE_D)+1) END DO END DO END IF @@ -247,10 +247,10 @@ SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, * Generate the true solutions in X. Because B = the first NRHS * columns of M*I, the true solutions are just the first NRHS columns * of the inverse Hilbert matrix. - WORK(1) = N + WORK(1) = REAL(N) DO J = 2, N - WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) ) - $ * (N +J -1) + WORK(J) = ( ( (WORK(J-1)/REAL(J-1)) * REAL(J-1 - N) ) + $ / REAL(J-1) ) * REAL(N +J -1) END DO * If we are testing SY routines, @@ -260,7 +260,7 @@ SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, DO I = 1, N X(I, J) = $ INVD1(MOD(J,SIZE_D)+1) * - $ ((WORK(I)*WORK(J)) / (I + J - 1)) + $ ((WORK(I)*WORK(J)) / REAL(I + J - 1)) $ * INVD1(MOD(I,SIZE_D)+1) END DO END DO @@ -269,7 +269,7 @@ SUBROUTINE CLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, DO I = 1, N X(I, J) = $ INVD2(MOD(J,SIZE_D)+1) * - $ ((WORK(I)*WORK(J)) / (I + J - 1)) + $ ((WORK(I)*WORK(J)) / REAL(I + J - 1)) $ * INVD1(MOD(I,SIZE_D)+1) END DO END DO diff --git a/TESTING/MATGEN/slahilb.f b/TESTING/MATGEN/slahilb.f index 2695bc3fb7..5fe5888a18 100644 --- a/TESTING/MATGEN/slahilb.f +++ b/TESTING/MATGEN/slahilb.f @@ -197,7 +197,7 @@ SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, * Generate the scaled Hilbert matrix in A DO J = 1, N DO I = 1, N - A(I, J) = REAL(M) / (I + J - 1) + A(I, J) = REAL(M) / REAL(I + J - 1) END DO END DO * @@ -208,15 +208,15 @@ SUBROUTINE SLAHILB( N, NRHS, A, LDA, X, LDX, B, LDB, WORK, * Generate the true solutions in X. Because B = the first NRHS * columns of M*I, the true solutions are just the first NRHS columns * of the inverse Hilbert matrix. - WORK(1) = N + WORK(1) = REAL(N) DO J = 2, N - WORK(J) = ( ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1) ) - $ * (N +J -1) + WORK(J) = ( ( (WORK(J-1)/REAL(J-1)) * REAL(J-1 - N) ) + $ /REAL(J-1) ) * REAL(N +J -1) END DO * DO J = 1, NRHS DO I = 1, N - X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1) + X(I, J) = (WORK(I)*WORK(J)) / REAL(I + J - 1) END DO END DO * From 81823e958c62856a042d39936ce9276f09b545d3 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Fri, 28 Jul 2023 17:13:04 -0700 Subject: [PATCH 046/206] Fix -Werror=conversion problems in LAPACK with integer-8 --- SRC/cbbcsd.f | 6 +++--- SRC/cbdsqr.f | 8 +++++--- SRC/cgbrfs.f | 9 +++++---- SRC/cgebal.f | 4 ++-- SRC/cgejsv.f | 6 +++--- SRC/cgelq.f | 8 ++++---- SRC/cgelsd.f | 4 ++-- SRC/cgelsy.f | 4 ++-- SRC/cgeqr.f | 8 ++++---- SRC/cgerfs.f | 9 +++++---- SRC/cgesdd.f | 4 ++-- SRC/cgesvdq.f | 8 ++++---- SRC/cggbal.f | 4 ++-- SRC/cggglm.f | 2 +- SRC/cgglse.f | 2 +- SRC/cggsvd3.f | 4 ++-- SRC/cgtrfs.f | 9 +++++---- SRC/chbevd_2stage.f | 8 ++++---- SRC/cheequb.f | 14 +++++++------- SRC/cheevd_2stage.f | 8 ++++---- SRC/cheevr.f | 2 +- SRC/cheevx.f | 3 ++- SRC/cherfs.f | 9 +++++---- SRC/chetrf_aa_2stage.f | 2 +- SRC/chgeqz.f | 2 +- SRC/chprfs.f | 9 +++++---- SRC/chsein.f | 2 +- SRC/clantb.f | 4 ++-- SRC/clantp.f | 4 ++-- SRC/clantr.f | 4 ++-- SRC/claqz0.f | 3 ++- SRC/claqz2.f | 2 +- SRC/claqz3.f | 2 +- SRC/cpbrfs.f | 9 +++++---- SRC/cporfs.f | 9 +++++---- SRC/cpprfs.f | 9 +++++---- SRC/cpstf2.f | 2 +- SRC/cpstrf.f | 2 +- SRC/cptrfs.f | 9 +++++---- SRC/csprfs.f | 9 +++++---- SRC/cstein.f | 4 ++-- SRC/cstemr.f | 2 +- SRC/csyequb.f | 12 ++++++------ SRC/csyrfs.f | 9 +++++---- SRC/csytrf_aa_2stage.f | 4 ++-- SRC/csytri2.f | 2 +- SRC/ctbrfs.f | 9 +++++---- SRC/ctgevc.f | 4 ++-- SRC/ctprfs.f | 9 +++++---- SRC/ctrevc.f | 2 +- SRC/ctrevc3.f | 2 +- SRC/ctrrfs.f | 9 +++++---- SRC/ctrsyl.f | 2 +- SRC/ctrsyl3.f | 12 ++++++------ SRC/cunbdb6.f | 2 +- SRC/cuncsd.f | 2 +- SRC/cuncsd2by1.f | 2 +- SRC/cungql.f | 2 +- SRC/sbbcsd.f | 6 +++--- SRC/sbdsqr.f | 7 ++++--- SRC/sbdsvdx.f | 4 ++-- SRC/sgbrfs.f | 7 ++++--- SRC/sgebal.f | 4 ++-- SRC/sgelq.f | 8 ++++---- SRC/sgelsy.f | 4 ++-- SRC/sgeqr.f | 8 ++++---- SRC/sgerfs.f | 7 ++++--- SRC/sgesdd.f | 2 +- SRC/sgesvdq.f | 8 ++++---- SRC/sggbal.f | 4 ++-- SRC/sggglm.f | 2 +- SRC/sgglse.f | 2 +- SRC/sggsvd3.f | 4 ++-- SRC/sgtrfs.f | 7 ++++--- SRC/shgeqz.f | 2 +- SRC/shsein.f | 2 +- SRC/slantb.f | 4 ++-- SRC/slantp.f | 4 ++-- SRC/slantr.f | 4 ++-- SRC/slaqz0.f | 3 ++- SRC/slarrd.f | 8 ++++---- SRC/slarre.f | 11 +++++++---- SRC/slarrk.f | 4 ++-- SRC/slasq2.f | 2 +- SRC/slasy2.f | 2 +- SRC/sorbdb.f | 2 +- SRC/sorbdb1.f | 2 +- SRC/sorbdb2.f | 2 +- SRC/sorbdb3.f | 2 +- SRC/sorbdb4.f | 2 +- SRC/sorbdb6.f | 2 +- SRC/sorcsd.f | 2 +- SRC/sorcsd2by1.f | 2 +- SRC/spbrfs.f | 7 ++++--- SRC/sporfs.f | 7 ++++--- SRC/spprfs.f | 7 ++++--- SRC/spstf2.f | 2 +- SRC/spstrf.f | 2 +- SRC/sptrfs.f | 7 ++++--- SRC/ssprfs.f | 7 ++++--- SRC/sstebz.f | 8 ++++---- SRC/sstein.f | 4 ++-- SRC/sstemr.f | 2 +- SRC/sstevr.f | 2 +- SRC/ssyequb.f | 14 +++++++------- SRC/ssyev_2stage.f | 2 +- SRC/ssyevd_2stage.f | 4 ++-- SRC/ssyevr.f | 2 +- SRC/ssyevr_2stage.f | 2 +- SRC/ssyevx_2stage.f | 2 +- SRC/ssygv_2stage.f | 2 +- SRC/ssyrfs.f | 7 ++++--- SRC/ssytrd_2stage.f | 4 ++-- SRC/ssytrf_aa_2stage.f | 2 +- SRC/stbrfs.f | 7 ++++--- SRC/stgevc.f | 4 ++-- SRC/stgex2.f | 2 +- SRC/stgexc.f | 2 +- SRC/stprfs.f | 7 ++++--- SRC/strevc.f | 2 +- SRC/strevc3.f | 4 ++-- SRC/strrfs.f | 7 ++++--- SRC/strsyl.f | 2 +- SRC/strsyl3.f | 12 ++++++------ 124 files changed, 321 insertions(+), 286 deletions(-) diff --git a/SRC/cbbcsd.f b/SRC/cbbcsd.f index b8b61e71bf..68228c6246 100644 --- a/SRC/cbbcsd.f +++ b/SRC/cbbcsd.f @@ -420,7 +420,7 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, * IF( INFO .EQ. 0 .AND. Q .EQ. 0 ) THEN LRWORKMIN = 1 - RWORK(1) = LRWORKMIN + RWORK(1) = REAL( LRWORKMIN ) RETURN END IF * @@ -437,7 +437,7 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, IV2TSN = IV2TCS + Q LRWORKOPT = IV2TSN + Q - 1 LRWORKMIN = LRWORKOPT - RWORK(1) = LRWORKOPT + RWORK(1) = REAL( LRWORKOPT ) IF( LRWORK .LT. LRWORKMIN .AND. .NOT. LQUERY ) THEN INFO = -28 END IF @@ -456,7 +456,7 @@ SUBROUTINE CBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, UNFL = SLAMCH( 'Safe minimum' ) TOLMUL = MAX( TEN, MIN( HUNDRED, EPS**MEIGHTH ) ) TOL = TOLMUL*EPS - THRESH = MAX( TOL, MAXITR*Q*Q*UNFL ) + THRESH = MAX( TOL, REAL( MAXITR*Q*Q )*UNFL ) * * Test for negligible sines or cosines * diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index 3aeb0bc78c..ed985b0759 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -404,12 +404,14 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, 40 CONTINUE 50 CONTINUE SMINOA = SMINOA / SQRT( REAL( N ) ) - THRESH = MAX( TOL*SMINOA, MAXITR*(N*(N*UNFL)) ) + THRESH = MAX( TOL*SMINOA, + $ REAL(MAXITR)*(REAL(N)*(REAL(N)*UNFL)) ) ELSE * * Absolute accuracy desired * - THRESH = MAX( ABS( TOL )*SMAX, MAXITR*(N*(N*UNFL)) ) + THRESH = MAX( ABS( TOL )*SMAX, + $ REAL(MAXITR)*(REAL(N)*(REAL(N)*UNFL)) ) END IF * * Prepare for main iteration loop for the singular values @@ -581,7 +583,7 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Compute shift. First, test if shifting would ruin relative * accuracy, and if so set the shift to zero. * - IF( TOL.GE.ZERO .AND. N*TOL*( SMIN / SMAX ).LE. + IF( TOL.GE.ZERO .AND. REAL( N )*TOL*( SMIN / SMAX ).LE. $ MAX( EPS, HNDRTH*TOL ) ) THEN * * Use a zero shift to avoid loss of relative accuracy diff --git a/SRC/cgbrfs.f b/SRC/cgbrfs.f index 2217b1ed20..e294788ac8 100644 --- a/SRC/cgbrfs.f +++ b/SRC/cgbrfs.f @@ -317,7 +317,7 @@ SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, NZ = MIN( KL+KU+2, N+1 ) EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -426,10 +426,11 @@ SUBROUTINE CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cgebal.f b/SRC/cgebal.f index 7e80636697..16ea928124 100644 --- a/SRC/cgebal.f +++ b/SRC/cgebal.f @@ -267,7 +267,7 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) END DO * IF( CANSWAP ) THEN - SCALE( L ) = I + SCALE( L ) = REAL( I ) IF( I.NE.L ) THEN CALL CSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) CALL CSWAP( N-K+1, A( I, K ), LDA, A( L, K ), @@ -304,7 +304,7 @@ SUBROUTINE CGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) END DO * IF( CANSWAP ) THEN - SCALE( K ) = J + SCALE( K ) = REAL( J ) IF( J.NE.K ) THEN CALL CSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) CALL CSWAP( N-K+1, A( J, K ), LDA, A( K, K ), diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f index 6cd6b62b85..1dd4b1c608 100644 --- a/SRC/cgejsv.f +++ b/SRC/cgejsv.f @@ -952,9 +952,9 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, CALL XERBLA( 'CGEJSV', - INFO ) RETURN ELSE IF ( LQUERY ) THEN - CWORK(1) = OPTWRK - CWORK(2) = MINWRK - RWORK(1) = MINRWRK + CWORK(1) = CMPLX( OPTWRK ) + CWORK(2) = CMPLX( MINWRK ) + RWORK(1) = REAL( MINRWRK ) IWORK(1) = MAX( 4, MINIWRK ) RETURN END IF diff --git a/SRC/cgelq.f b/SRC/cgelq.f index b27f57fffb..69dd97af5c 100644 --- a/SRC/cgelq.f +++ b/SRC/cgelq.f @@ -289,12 +289,12 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, * IF( INFO.EQ.0 ) THEN IF( MINT ) THEN - T( 1 ) = MINTSZ + T( 1 ) = CMPLX( MINTSZ ) ELSE - T( 1 ) = MB*M*NBLCKS + 5 + T( 1 ) = CMPLX( MB*M*NBLCKS + 5 ) END IF - T( 2 ) = MB - T( 3 ) = NB + T( 2 ) = CMPLX( MB ) + T( 3 ) = CMPLX( NB ) IF( MINW ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index be10101a02..8e96a3fa63 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -375,7 +375,7 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, MINWRK = MIN( MINWRK, MAXWRK ) WORK( 1 ) = SROUNDUP_LWORK(MAXWRK) IWORK( 1 ) = LIWORK - RWORK( 1 ) = LRWORK + RWORK( 1 ) = REAL( LRWORK ) * IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN INFO = -12 @@ -667,7 +667,7 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, 10 CONTINUE WORK( 1 ) = SROUNDUP_LWORK(MAXWRK) IWORK( 1 ) = LIWORK - RWORK( 1 ) = LRWORK + RWORK( 1 ) = REAL( LRWORK ) RETURN * * End of CGELSD diff --git a/SRC/cgelsy.f b/SRC/cgelsy.f index 8634a9cc48..cadc382044 100644 --- a/SRC/cgelsy.f +++ b/SRC/cgelsy.f @@ -357,7 +357,7 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, * CALL CGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), $ LWORK-MN, RWORK, INFO ) - WSIZE = MN + REAL( WORK( MN+1 ) ) + WSIZE = REAL( MN ) + REAL( WORK( MN+1 ) ) * * complex workspace: MN+NB*(N+1). real workspace 2*N. * Details of Householder rotations stored in WORK(1:MN). @@ -418,7 +418,7 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, $ LDA, $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) - WSIZE = MAX( WSIZE, 2*MN+REAL( WORK( 2*MN+1 ) ) ) + WSIZE = MAX( WSIZE, REAL( 2*MN )+REAL( WORK( 2*MN+1 ) ) ) * * complex workspace: 2*MN+NB*NRHS. * diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index 767574b1da..7c08393a07 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -281,12 +281,12 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * IF( INFO.EQ.0 ) THEN IF( MINT ) THEN - T( 1 ) = MINTSZ + T( 1 ) = CMPLX( MINTSZ ) ELSE - T( 1 ) = NB*N*NBLCKS + 5 + T( 1 ) = CMPLX( NB*N*NBLCKS + 5 ) END IF - T( 2 ) = MB - T( 3 ) = NB + T( 2 ) = CMPLX( MB ) + T( 3 ) = CMPLX( NB ) IF( MINW ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE diff --git a/SRC/cgerfs.f b/SRC/cgerfs.f index 084b9e0fcb..900853f0ad 100644 --- a/SRC/cgerfs.f +++ b/SRC/cgerfs.f @@ -293,7 +293,7 @@ SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -398,10 +398,11 @@ SUBROUTINE CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cgesdd.f b/SRC/cgesdd.f index 558e35699b..a58f3b4414 100644 --- a/SRC/cgesdd.f +++ b/SRC/cgesdd.f @@ -289,8 +289,8 @@ SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * INFO = 0 MINMN = MIN( M, N ) - MNTHR1 = INT( MINMN*17.0E0 / 9.0E0 ) - MNTHR2 = INT( MINMN*5.0E0 / 3.0E0 ) + MNTHR1 = INT( REAL( MINMN )*17.0E0 / 9.0E0 ) + MNTHR2 = INT( REAL( MINMN )*5.0E0 / 3.0E0 ) WNTQA = LSAME( JOBZ, 'A' ) WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS diff --git a/SRC/cgesvdq.f b/SRC/cgesvdq.f index d0df8b38f9..70aab395a7 100644 --- a/SRC/cgesvdq.f +++ b/SRC/cgesvdq.f @@ -735,9 +735,9 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * Return optimal workspace * IWORK(1) = IMINWRK - CWORK(1) = OPTWRK - CWORK(2) = MINWRK - RWORK(1) = RMINWRK + CWORK(1) = CMPLX( OPTWRK ) + CWORK(2) = CMPLX( MINWRK ) + RWORK(1) = REAL( RMINWRK ) RETURN END IF * @@ -1416,7 +1416,7 @@ SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ASCALED ) $ CALL SLASCL( 'G',0,0, ONE,SQRT(REAL(M)), NR,1, S, N, IERR ) IF ( CONDA ) RWORK(1) = SCONDA - RWORK(2) = p - NR + RWORK(2) = REAL( p - NR ) * .. p-NR is the number of singular values that are computed as * exact zeros in CGESVD() applied to the (possibly truncated) * full row rank triangular (trapezoidal) factor of A. diff --git a/SRC/cggbal.f b/SRC/cggbal.f index 765180a4b4..17c4db95c1 100644 --- a/SRC/cggbal.f +++ b/SRC/cggbal.f @@ -349,7 +349,7 @@ SUBROUTINE CGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Permute rows M and I * 160 CONTINUE - LSCALE( M ) = I + LSCALE( M ) = REAL( I ) IF( I.EQ.M ) $ GO TO 170 CALL CSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA ) @@ -358,7 +358,7 @@ SUBROUTINE CGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Permute columns M and J * 170 CONTINUE - RSCALE( M ) = J + RSCALE( M ) = REAL( J ) IF( J.EQ.M ) $ GO TO 180 CALL CSWAP( L, A( 1, J ), 1, A( 1, M ), 1 ) diff --git a/SRC/cggglm.f b/SRC/cggglm.f index 1ccf20ff45..5d2f018d0d 100644 --- a/SRC/cggglm.f +++ b/SRC/cggglm.f @@ -351,7 +351,7 @@ SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, CALL CUNMRQ( 'Left', 'Conjugate transpose', P, 1, NP, $ B( MAX( 1, N-P+1 ), 1 ), LDB, WORK( M+1 ), Y, $ MAX( 1, P ), WORK( M+NP+1 ), LWORK-M-NP, INFO ) - WORK( 1 ) = M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) ) + WORK( 1 ) = CMPLX( M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) ) ) * RETURN * diff --git a/SRC/cgglse.f b/SRC/cgglse.f index 0c83b88bf6..2b5bef4bcb 100644 --- a/SRC/cgglse.f +++ b/SRC/cgglse.f @@ -349,7 +349,7 @@ SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, * CALL CUNMRQ( 'Left', 'Conjugate Transpose', N, 1, P, B, LDB, $ WORK( 1 ), X, N, WORK( P+MN+1 ), LWORK-P-MN, INFO ) - WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) + WORK( 1 ) = CMPLX( P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) ) * RETURN * diff --git a/SRC/cggsvd3.f b/SRC/cggsvd3.f index 2cc3850666..a465f08aa8 100644 --- a/SRC/cggsvd3.f +++ b/SRC/cggsvd3.f @@ -457,8 +457,8 @@ SUBROUTINE CGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * ULP = SLAMCH( 'Precision' ) UNFL = SLAMCH( 'Safe Minimum' ) - TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP - TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP + TOLA = REAL( MAX( M, N ) )*MAX( ANORM, UNFL )*ULP + TOLB = REAL( MAX( P, N ) )*MAX( BNORM, UNFL )*ULP * CALL CGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, $ TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, diff --git a/SRC/cgtrfs.f b/SRC/cgtrfs.f index b21ef758cd..7857504560 100644 --- a/SRC/cgtrfs.f +++ b/SRC/cgtrfs.f @@ -312,7 +312,7 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, NZ = 4 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -438,10 +438,11 @@ SUBROUTINE CGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * DO 60 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 60 CONTINUE * diff --git a/SRC/chbevd_2stage.f b/SRC/chbevd_2stage.f index 9e1be2e6b6..ce09a1244d 100644 --- a/SRC/chbevd_2stage.f +++ b/SRC/chbevd_2stage.f @@ -346,8 +346,8 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, END IF * IF( INFO.EQ.0 ) THEN - WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + WORK( 1 ) = CMPLX( LWMIN ) + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -448,8 +448,8 @@ SUBROUTINE CHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, CALL SSCAL( IMAX, ONE / SIGMA, W, 1 ) END IF * - WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + WORK( 1 ) = CMPLX( LWMIN ) + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/cheequb.f b/SRC/cheequb.f index 34b04f1500..5b122c7933 100644 --- a/SRC/cheequb.f +++ b/SRC/cheequb.f @@ -236,7 +236,7 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, S( J ) = 1.0E0 / S( J ) END DO - TOL = ONE / SQRT( 2.0E0 * N ) + TOL = ONE / SQRT( 2.0E0 * REAL( N ) ) DO ITER = 1, MAX_ITER SCALE = 0.0E0 @@ -268,23 +268,23 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, DO I = 1, N AVG = AVG + REAL( S( I )*WORK( I ) ) END DO - AVG = AVG / N + AVG = AVG / REAL( N ) STD = 0.0E0 DO I = N+1, 2*N WORK( I ) = S( I-N ) * WORK( I-N ) - AVG END DO CALL CLASSQ( N, WORK( N+1 ), 1, SCALE, SUMSQ ) - STD = SCALE * SQRT( SUMSQ / N ) + STD = SCALE * SQRT( SUMSQ / REAL( N ) ) IF ( STD .LT. TOL * AVG ) GOTO 999 DO I = 1, N T = CABS1( A( I, I ) ) SI = S( I ) - C2 = ( N-1 ) * T - C1 = REAL( ( N-2 ) * ( WORK( I ) - T*SI ) ) - C0 = REAL( -(T*SI)*SI + 2*WORK( I )*SI - N*AVG ) + C2 = REAL( N-1 ) * T + C1 = REAL( N-2 ) * ( REAL( WORK( I ) ) - T*SI ) + C0 = REAL( -(T*SI)*SI + 2*WORK( I )*SI - REAL( N )*AVG ) D = C1*C1 - 4*C0*C2 IF ( D .LE. 0 ) THEN @@ -319,7 +319,7 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, END DO END IF - AVG = AVG + REAL( ( U + WORK( I ) ) * D / N ) + AVG = AVG + ( U + REAL( WORK( I ) ) ) * D / REAL( N ) S( I ) = SI END DO END DO diff --git a/SRC/cheevd_2stage.f b/SRC/cheevd_2stage.f index 30b46b1f8d..af8998a001 100644 --- a/SRC/cheevd_2stage.f +++ b/SRC/cheevd_2stage.f @@ -339,8 +339,8 @@ SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LIWMIN = 1 END IF END IF - WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + WORK( 1 ) = CMPLX( LWMIN ) + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -438,8 +438,8 @@ SUBROUTINE CHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, CALL SSCAL( IMAX, ONE / SIGMA, W, 1 ) END IF * - WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + WORK( 1 ) = CMPLX( LWMIN ) + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/cheevr.f b/SRC/cheevr.f index e2e9a5cda5..383f4c4f2b 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -623,7 +623,7 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) * - IF (ABSTOL .LE. TWO*N*EPS) THEN + IF (ABSTOL .LE. TWO*REAL( N )*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. diff --git a/SRC/cheevx.f b/SRC/cheevx.f index bb8bb4a206..805b05e8a4 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -355,7 +355,8 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, ELSE LWKMIN = 2*N NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) - NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, -1, -1 ) ) + NB = MAX( NB, ILAENV( 1, 'CUNMTR', UPLO, N, -1, + $ -1, -1 ) ) LWKOPT = ( NB + 1 )*N END IF WORK( 1 ) = SROUNDUP_LWORK( LWKOPT ) diff --git a/SRC/cherfs.f b/SRC/cherfs.f index 382a531ea1..e43ad33d68 100644 --- a/SRC/cherfs.f +++ b/SRC/cherfs.f @@ -289,7 +289,7 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -398,10 +398,11 @@ SUBROUTINE CHERFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index 352879b82c..c23a552194 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -271,7 +271,7 @@ SUBROUTINE CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Save NB * - TB( 1 ) = NB + TB( 1 ) = CMPLX( NB ) * IF( UPPER ) THEN * diff --git a/SRC/chgeqz.f b/SRC/chgeqz.f index 37235435a8..9d419be327 100644 --- a/SRC/chgeqz.f +++ b/SRC/chgeqz.f @@ -385,7 +385,7 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, * Check Argument Values * INFO = 0 - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = CMPLX( MAX( 1, N ) ) LQUERY = ( LWORK.EQ.-1 ) IF( ISCHUR.EQ.0 ) THEN INFO = -1 diff --git a/SRC/chprfs.f b/SRC/chprfs.f index 30549b26bd..833a7db858 100644 --- a/SRC/chprfs.f +++ b/SRC/chprfs.f @@ -273,7 +273,7 @@ SUBROUTINE CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -389,10 +389,11 @@ SUBROUTINE CHPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/chsein.f b/SRC/chsein.f index 73b477fd58..ff93fd566c 100644 --- a/SRC/chsein.f +++ b/SRC/chsein.f @@ -345,7 +345,7 @@ SUBROUTINE CHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, * UNFL = SLAMCH( 'Safe minimum' ) ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) * LDWORK = N * diff --git a/SRC/clantb.f b/SRC/clantb.f index 6d312ab225..613ed118b7 100644 --- a/SRC/clantb.f +++ b/SRC/clantb.f @@ -320,7 +320,7 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) IF( K.GT.0 ) THEN DO 280 J = 2, N CALL CLASSQ( MIN( J-1, K ), @@ -340,7 +340,7 @@ REAL FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, diff --git a/SRC/clantp.f b/SRC/clantp.f index 49de4d85ce..e359e4e970 100644 --- a/SRC/clantp.f +++ b/SRC/clantp.f @@ -316,7 +316,7 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) K = 2 DO 280 J = 2, N CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM ) @@ -334,7 +334,7 @@ REAL FUNCTION CLANTP( NORM, UPLO, DIAG, N, AP, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) K = 2 DO 300 J = 1, N - 1 CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM ) diff --git a/SRC/clantr.f b/SRC/clantr.f index a98e7e60d1..944e0afbd7 100644 --- a/SRC/clantr.f +++ b/SRC/clantr.f @@ -321,7 +321,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 290 J = 2, N CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, $ SUM ) @@ -337,7 +337,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 310 J = 1, N CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) diff --git a/SRC/claqz0.f b/SRC/claqz0.f index 276f6c364d..4621644142 100644 --- a/SRC/claqz0.f +++ b/SRC/claqz0.f @@ -414,7 +414,8 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, NSR = MAX( 2, NSR-MOD( NSR, 2 ) ) RCOST = ILAENV( 17, 'CLAQZ0', JBCMPZ, N, ILO, IHI, LWORK ) - ITEMP1 = INT( NSR/SQRT( 1+2*NSR/( REAL( RCOST )/100*N ) ) ) + ITEMP1 = INT( REAL( NSR )/SQRT( 1+2*REAL( NSR )/ + $ ( REAL( RCOST )/100*REAL( N ) ) ) ) ITEMP1 = ( ( ITEMP1-1 )/4 )*4+4 NBR = NSR+ITEMP1 diff --git a/SRC/claqz2.f b/SRC/claqz2.f index b1c9fc8260..b6afcf3d20 100644 --- a/SRC/claqz2.f +++ b/SRC/claqz2.f @@ -285,7 +285,7 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, LWORKREQ = MAX( LWORKREQ, N*NW, 2*NW**2+N ) IF ( LWORK .EQ.-1 ) THEN * workspace query, quick return - WORK( 1 ) = LWORKREQ + WORK( 1 ) = CMPLX( LWORKREQ ) RETURN ELSE IF ( LWORK .LT. LWORKREQ ) THEN INFO = -26 diff --git a/SRC/claqz3.f b/SRC/claqz3.f index 1c8002306b..447839fb12 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -241,7 +241,7 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, END IF IF ( LWORK .EQ.-1 ) THEN * workspace query, quick return - WORK( 1 ) = N*NBLOCK_DESIRED + WORK( 1 ) = CMPLX( N*NBLOCK_DESIRED ) RETURN ELSE IF ( LWORK .LT. N*NBLOCK_DESIRED ) THEN INFO = -25 diff --git a/SRC/cpbrfs.f b/SRC/cpbrfs.f index 8f0ce4700e..567640d64c 100644 --- a/SRC/cpbrfs.f +++ b/SRC/cpbrfs.f @@ -286,7 +286,7 @@ SUBROUTINE CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, NZ = MIN( N+1, 2*KD+2 ) EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -398,10 +398,11 @@ SUBROUTINE CPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cporfs.f b/SRC/cporfs.f index aa93f070a8..2d7befd4ab 100644 --- a/SRC/cporfs.f +++ b/SRC/cporfs.f @@ -278,7 +278,7 @@ SUBROUTINE CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -387,10 +387,11 @@ SUBROUTINE CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cpprfs.f b/SRC/cpprfs.f index 90805c0cb4..73ea8245d2 100644 --- a/SRC/cpprfs.f +++ b/SRC/cpprfs.f @@ -263,7 +263,7 @@ SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -380,10 +380,11 @@ SUBROUTINE CPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cpstf2.f b/SRC/cpstf2.f index 205ef2a1b7..ff6c5441c5 100644 --- a/SRC/cpstf2.f +++ b/SRC/cpstf2.f @@ -228,7 +228,7 @@ SUBROUTINE CPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, * Compute stopping value if not supplied * IF( TOL.LT.ZERO ) THEN - SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ + SSTOP = REAL( N ) * SLAMCH( 'Epsilon' ) * AJJ ELSE SSTOP = TOL END IF diff --git a/SRC/cpstrf.f b/SRC/cpstrf.f index 66328d2d38..f51565789f 100644 --- a/SRC/cpstrf.f +++ b/SRC/cpstrf.f @@ -243,7 +243,7 @@ SUBROUTINE CPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, * Compute stopping value if not supplied * IF( TOL.LT.ZERO ) THEN - SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ + SSTOP = REAL( N ) * SLAMCH( 'Epsilon' ) * AJJ ELSE SSTOP = TOL END IF diff --git a/SRC/cptrfs.f b/SRC/cptrfs.f index 86cd723216..43c4892848 100644 --- a/SRC/cptrfs.f +++ b/SRC/cptrfs.f @@ -272,7 +272,7 @@ SUBROUTINE CPTRFS( UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, NZ = 4 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -410,10 +410,11 @@ SUBROUTINE CPTRFS( UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, * DO 60 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 60 CONTINUE IX = ISAMAX( N, RWORK, 1 ) diff --git a/SRC/csprfs.f b/SRC/csprfs.f index 84df8de346..22b2265a0c 100644 --- a/SRC/csprfs.f +++ b/SRC/csprfs.f @@ -273,7 +273,7 @@ SUBROUTINE CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -388,10 +388,11 @@ SUBROUTINE CSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/cstein.f b/SRC/cstein.f index 9859842bc8..c873528de9 100644 --- a/SRC/cstein.f +++ b/SRC/cstein.f @@ -319,7 +319,7 @@ SUBROUTINE CSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, 50 CONTINUE ORTOL = ODM3*ONENRM * - STPCRT = SQRT( ODM1 / BLKSIZ ) + STPCRT = SQRT( ODM1 / REAL( BLKSIZ ) ) * * Loop through eigenvalues of block nblk. * @@ -382,7 +382,7 @@ SUBROUTINE CSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Normalize and scale the righthand side vector Pb. * JMAX = ISAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 ) - SCL = BLKSIZ*ONENRM*MAX( EPS, + SCL = REAL( BLKSIZ )*ONENRM*MAX( EPS, $ ABS( WORK( INDRV4+BLKSIZ ) ) ) / $ ABS( WORK( INDRV1+JMAX ) ) CALL SSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 ) diff --git a/SRC/cstemr.f b/SRC/cstemr.f index b8f92e0490..b75bfd7982 100644 --- a/SRC/cstemr.f +++ b/SRC/cstemr.f @@ -479,7 +479,7 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NZCMIN = 0 ENDIF IF( ZQUERY .AND. INFO.EQ.0 ) THEN - Z( 1,1 ) = NZCMIN + Z( 1,1 ) = CMPLX( NZCMIN ) ELSE IF( NZC.LT.NZCMIN .AND. .NOT.ZQUERY ) THEN INFO = -14 END IF diff --git a/SRC/csyequb.f b/SRC/csyequb.f index 34c11879ff..b3d9850180 100644 --- a/SRC/csyequb.f +++ b/SRC/csyequb.f @@ -236,7 +236,7 @@ SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, S( J ) = 1.0 / S( J ) END DO - TOL = ONE / SQRT( 2.0E0 * N ) + TOL = ONE / SQRT( 2.0E0 * REAL( N ) ) DO ITER = 1, MAX_ITER SCALE = 0.0E0 @@ -268,23 +268,23 @@ SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, DO I = 1, N AVG = AVG + REAL( S( I )*WORK( I ) ) END DO - AVG = AVG / N + AVG = AVG / REAL( N ) STD = 0.0E0 DO I = N+1, 2*N WORK( I ) = S( I-N ) * WORK( I-N ) - AVG END DO CALL CLASSQ( N, WORK( N+1 ), 1, SCALE, SUMSQ ) - STD = SCALE * SQRT( SUMSQ / N ) + STD = SCALE * SQRT( SUMSQ / REAL( N ) ) IF ( STD .LT. TOL * AVG ) GOTO 999 DO I = 1, N T = CABS1( A( I, I ) ) SI = S( I ) - C2 = ( N-1 ) * T + C2 = REAL( N-1 ) * T C1 = REAL( N-2 ) * ( REAL( WORK( I ) ) - T*SI ) - C0 = -(T*SI)*SI + 2 * REAL( WORK( I ) ) * SI - N*AVG + C0 = -(T*SI)*SI + 2 * REAL( WORK( I ) ) * SI - REAL( N )*AVG D = C1*C1 - 4*C0*C2 IF ( D .LE. 0 ) THEN @@ -319,7 +319,7 @@ SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, END DO END IF - AVG = AVG + ( U + REAL( WORK( I ) ) ) * D / N + AVG = AVG + ( U + REAL( WORK( I ) ) ) * D / REAL( N ) S( I ) = SI END DO END DO diff --git a/SRC/csyrfs.f b/SRC/csyrfs.f index 600decbfda..12a4e9063a 100644 --- a/SRC/csyrfs.f +++ b/SRC/csyrfs.f @@ -289,7 +289,7 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -398,10 +398,11 @@ SUBROUTINE CSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * DO 90 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/csytrf_aa_2stage.f b/SRC/csytrf_aa_2stage.f index e352bb1cc2..9051e84c12 100644 --- a/SRC/csytrf_aa_2stage.f +++ b/SRC/csytrf_aa_2stage.f @@ -230,7 +230,7 @@ SUBROUTINE CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, NB = ILAENV( 1, 'CSYTRF_AA_2STAGE', UPLO, N, -1, -1, -1 ) IF( INFO.EQ.0 ) THEN IF( TQUERY ) THEN - TB( 1 ) = (3*NB+1)*N + TB( 1 ) = CMPLX( (3*NB+1)*N ) END IF IF( WQUERY ) THEN WORK( 1 ) = SROUNDUP_LWORK(N*NB) @@ -270,7 +270,7 @@ SUBROUTINE CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Save NB * - TB( 1 ) = NB + TB( 1 ) = CMPLX( NB ) * IF( UPPER ) THEN * diff --git a/SRC/csytri2.f b/SRC/csytri2.f index 17a51035e8..c4dc1f0534 100644 --- a/SRC/csytri2.f +++ b/SRC/csytri2.f @@ -185,7 +185,7 @@ SUBROUTINE CSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) CALL XERBLA( 'CSYTRI2', -INFO ) RETURN ELSE IF( LQUERY ) THEN - WORK(1)=MINSIZE + WORK(1)=CMPLX( MINSIZE ) RETURN END IF IF( N.EQ.0 ) diff --git a/SRC/ctbrfs.f b/SRC/ctbrfs.f index af37f84f65..7af7d5f743 100644 --- a/SRC/ctbrfs.f +++ b/SRC/ctbrfs.f @@ -294,7 +294,7 @@ SUBROUTINE CTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, NZ = KD + 2 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -445,10 +445,11 @@ SUBROUTINE CTBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * DO 200 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/ctgevc.f b/SRC/ctgevc.f index fd26ec07e5..033dd9f659 100644 --- a/SRC/ctgevc.f +++ b/SRC/ctgevc.f @@ -369,9 +369,9 @@ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, SAFMIN = SLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) - SMALL = SAFMIN*N / ULP + SMALL = SAFMIN*REAL( N ) / ULP BIG = ONE / SMALL - BIGNUM = ONE / ( SAFMIN*N ) + BIGNUM = ONE / ( SAFMIN*REAL( N ) ) * * Compute the 1-norm of each column of the strictly upper triangular * part of A and B to check for possible overflow in the triangular diff --git a/SRC/ctprfs.f b/SRC/ctprfs.f index f15743b17b..dc5dc2efaf 100644 --- a/SRC/ctprfs.f +++ b/SRC/ctprfs.f @@ -276,7 +276,7 @@ SUBROUTINE CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -435,10 +435,11 @@ SUBROUTINE CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, * DO 200 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/ctrevc.f b/SRC/ctrevc.f index 108aa05572..047774d9a6 100644 --- a/SRC/ctrevc.f +++ b/SRC/ctrevc.f @@ -323,7 +323,7 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) * * Store the diagonal elements of T in working array WORK. * diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index b0a13e1df5..ac9ffeecda 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -376,7 +376,7 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) * * Store the diagonal elements of T in working array WORK. * diff --git a/SRC/ctrrfs.f b/SRC/ctrrfs.f index 0e3b109a0c..8bd0c882af 100644 --- a/SRC/ctrrfs.f +++ b/SRC/ctrrfs.f @@ -287,7 +287,7 @@ SUBROUTINE CTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -430,10 +430,11 @@ SUBROUTINE CTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * DO 200 I = 1, N IF( RWORK( I ).GT.SAFE2 ) THEN - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) ELSE - RWORK( I ) = CABS1( WORK( I ) ) + NZ*EPS*RWORK( I ) + - $ SAFE1 + RWORK( I ) = CABS1( WORK( I ) ) + REAL( NZ )* + $ EPS*RWORK( I ) + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/ctrsyl.f b/SRC/ctrsyl.f index 99ac5c7da6..9627687a42 100644 --- a/SRC/ctrsyl.f +++ b/SRC/ctrsyl.f @@ -243,7 +243,7 @@ SUBROUTINE CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, BIGNUM = ONE / SMLNUM SMIN = MAX( SMLNUM, EPS*CLANGE( 'M', M, M, A, LDA, DUM ), $ EPS*CLANGE( 'M', N, N, B, LDB, DUM ) ) - SGN = ISGN + SGN = REAL( ISGN ) * IF( NOTRNA .AND. NOTRNB ) THEN * diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index 45ee5826cc..e32ef9cfba 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -219,8 +219,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, LQUERY = ( LDSWORK.EQ.-1 ) IF( LQUERY ) THEN LDSWORK = 2 - SWORK(1,1) = MAX( NBA, NBB ) - SWORK(2,1) = 2 * NBB + NBA + SWORK(1,1) = REAL( MAX( NBA, NBB ) ) + SWORK(2,1) = REAL( 2 * NBB + NBA ) END IF * * Test the input arguments @@ -1072,8 +1072,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * form (1/SCALE)*X if SCALE is REAL. Set SCALE to * zero and give up. * - SWORK(1,1) = MAX( NBA, NBB ) - SWORK(2,1) = 2 * NBB + NBA + SWORK(1,1) = REAL( MAX( NBA, NBB ) ) + SWORK(2,1) = REAL( 2 * NBB + NBA ) RETURN END IF * @@ -1136,8 +1136,8 @@ SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * * Restore workspace dimensions * - SWORK(1,1) = MAX( NBA, NBB ) - SWORK(2,1) = 2 * NBB + NBA + SWORK(1,1) = REAL( MAX( NBA, NBB ) ) + SWORK(2,1) = REAL( 2 * NBB + NBA ) * RETURN * diff --git a/SRC/cunbdb6.f b/SRC/cunbdb6.f index 50da70cf5f..6c88ad9780 100644 --- a/SRC/cunbdb6.f +++ b/SRC/cunbdb6.f @@ -267,7 +267,7 @@ SUBROUTINE CUNBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, RETURN END IF * - IF( NORM_NEW .LE. N * EPS * NORM ) THEN + IF( NORM_NEW .LE. REAL( N ) * EPS * NORM ) THEN DO IX = 1, 1 + (M1-1)*INCX1, INCX1 X1( IX ) = ZERO END DO diff --git a/SRC/cuncsd.f b/SRC/cuncsd.f index db35565df9..f3c55b1f1b 100644 --- a/SRC/cuncsd.f +++ b/SRC/cuncsd.f @@ -481,7 +481,7 @@ RECURSIVE SUBROUTINE CUNCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, LBBCSDWORKMIN = LBBCSDWORKOPT LRWORKOPT = IBBCSD + LBBCSDWORKOPT - 1 LRWORKMIN = IBBCSD + LBBCSDWORKMIN - 1 - RWORK(1) = LRWORKOPT + RWORK(1) = REAL( LRWORKOPT ) * * Complex workspace * diff --git a/SRC/cuncsd2by1.f b/SRC/cuncsd2by1.f index 231efed63a..2618e3e244 100644 --- a/SRC/cuncsd2by1.f +++ b/SRC/cuncsd2by1.f @@ -512,7 +512,7 @@ SUBROUTINE CUNCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, END IF LRWORKMIN = IBBCSD+LBBCSD-1 LRWORKOPT = LRWORKMIN - RWORK(1) = LRWORKOPT + RWORK(1) = REAL( LRWORKOPT ) LWORKMIN = MAX( IORBDB+LORBDB-1, $ IORGQR+LORGQRMIN-1, $ IORGLQ+LORGLQMIN-1 ) diff --git a/SRC/cungql.f b/SRC/cungql.f index 21a7616876..383bb2b5a4 100644 --- a/SRC/cungql.f +++ b/SRC/cungql.f @@ -288,7 +288,7 @@ SUBROUTINE CUNGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) 50 CONTINUE END IF * - WORK( 1 ) = IWS + WORK( 1 ) = CMPLX( IWS ) RETURN * * End of CUNGQL diff --git a/SRC/sbbcsd.f b/SRC/sbbcsd.f index a347bc7de3..80a673a06e 100644 --- a/SRC/sbbcsd.f +++ b/SRC/sbbcsd.f @@ -420,7 +420,7 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, * IF( INFO .EQ. 0 .AND. Q .EQ. 0 ) THEN LWORKMIN = 1 - WORK(1) = LWORKMIN + WORK(1) = REAL( LWORKMIN ) RETURN END IF * @@ -437,7 +437,7 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, IV2TSN = IV2TCS + Q LWORKOPT = IV2TSN + Q - 1 LWORKMIN = LWORKOPT - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN INFO = -28 END IF @@ -456,7 +456,7 @@ SUBROUTINE SBBCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS, M, P, UNFL = SLAMCH( 'Safe minimum' ) TOLMUL = MAX( TEN, MIN( HUNDRED, EPS**MEIGHTH ) ) TOL = TOLMUL*EPS - THRESH = MAX( TOL, MAXITR*Q*Q*UNFL ) + THRESH = MAX( TOL, REAL( MAXITR*Q*Q )*UNFL ) * * Test for negligible sines or cosines * diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index 6c379e20b0..6c0b897daa 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -411,12 +411,13 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, 40 CONTINUE 50 CONTINUE SMINOA = SMINOA / SQRT( REAL( N ) ) - THRESH = MAX( TOL*SMINOA, MAXITR*(N*(N*UNFL)) ) + THRESH = MAX( TOL*SMINOA, MAXITR*(REAL( N )*(REAL( N )*UNFL)) ) ELSE * * Absolute accuracy desired * - THRESH = MAX( ABS( TOL )*SMAX, MAXITR*(N*(N*UNFL)) ) + THRESH = MAX( ABS( TOL )*SMAX, MAXITR*(REAL( N )* + $ (REAL( N )*UNFL)) ) END IF * * Prepare for main iteration loop for the singular values @@ -590,7 +591,7 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * Compute shift. First, test if shifting would ruin relative * accuracy, and if so set the shift to zero. * - IF( TOL.GE.ZERO .AND. N*TOL*( SMIN / SMAX ).LE. + IF( TOL.GE.ZERO .AND. REAL( N )*TOL*( SMIN / SMAX ).LE. $ MAX( EPS, HNDRTH*TOL ) ) THEN * * Use a zero shift to avoid loss of relative accuracy diff --git a/SRC/sbdsvdx.f b/SRC/sbdsvdx.f index 5e30c8b36d..4dc9b94a0c 100644 --- a/SRC/sbdsvdx.f +++ b/SRC/sbdsvdx.f @@ -448,7 +448,7 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ VLTGK, VLTGK, ILTGK, ILTGK, ABSTOL, NS, S, $ Z, LDZ, WORK( ITEMP ), IWORK( IIWORK ), $ IWORK( IIFAIL ), INFO ) - VLTGK = S( 1 ) - FUDGE*SMAX*ULP*N + VLTGK = S( 1 ) - FUDGE*SMAX*ULP*REAL( N ) WORK( IDTGK:IDTGK+2*N-1 ) = ZERO CALL SCOPY( N, D, 1, WORK( IETGK ), 2 ) CALL SCOPY( N-1, E, 1, WORK( IETGK+1 ), 2 ) @@ -456,7 +456,7 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ VUTGK, VUTGK, IUTGK, IUTGK, ABSTOL, NS, S, $ Z, LDZ, WORK( ITEMP ), IWORK( IIWORK ), $ IWORK( IIFAIL ), INFO ) - VUTGK = S( 1 ) + FUDGE*SMAX*ULP*N + VUTGK = S( 1 ) + FUDGE*SMAX*ULP*REAL( N ) VUTGK = MIN( VUTGK, ZERO ) * * If VLTGK=VUTGK, SSTEVX returns an error message, diff --git a/SRC/sgbrfs.f b/SRC/sgbrfs.f index 1d53c99d51..5db769aff8 100644 --- a/SRC/sgbrfs.f +++ b/SRC/sgbrfs.f @@ -306,7 +306,7 @@ SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, NZ = MIN( KL+KU+2, N+1 ) EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -414,9 +414,10 @@ SUBROUTINE SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/sgebal.f b/SRC/sgebal.f index e62c33fbdd..6f8851b03e 100644 --- a/SRC/sgebal.f +++ b/SRC/sgebal.f @@ -263,7 +263,7 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) END DO * IF( CANSWAP ) THEN - SCALE( L ) = I + SCALE( L ) = REAL( I ) IF( I.NE.L ) THEN CALL SSWAP( L, A( 1, I ), 1, A( 1, L ), 1 ) CALL SSWAP( N-K+1, A( I, K ), LDA, A( L, K ), @@ -299,7 +299,7 @@ SUBROUTINE SGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) END DO * IF( CANSWAP ) THEN - SCALE( K ) = J + SCALE( K ) = REAL( J ) IF( J.NE.K ) THEN CALL SSWAP( L, A( 1, J ), 1, A( 1, K ), 1 ) CALL SSWAP( N-K+1, A( J, K ), LDA, A( K, K ), diff --git a/SRC/sgelq.f b/SRC/sgelq.f index fd35859b1c..b9dd5e5e15 100644 --- a/SRC/sgelq.f +++ b/SRC/sgelq.f @@ -289,12 +289,12 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, * IF( INFO.EQ.0 ) THEN IF( MINT ) THEN - T( 1 ) = MINTSZ + T( 1 ) = REAL( MINTSZ ) ELSE - T( 1 ) = MB*M*NBLCKS + 5 + T( 1 ) = REAL( MB*M*NBLCKS + 5 ) END IF - T( 2 ) = MB - T( 3 ) = NB + T( 2 ) = REAL( MB ) + T( 3 ) = REAL( NB ) IF( MINW ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index dfe6776577..e3ab726a97 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -359,7 +359,7 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, * CALL SGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), $ LWORK-MN, INFO ) - WSIZE = MN + WORK( MN+1 ) + WSIZE = REAL( MN ) + WORK( MN+1 ) * * workspace: MN+2*N+NB*(N+1). * Details of Householder rotations stored in WORK(1:MN). @@ -420,7 +420,7 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, $ WORK( 1 ), $ B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO ) - WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) ) + WSIZE = MAX( WSIZE, REAL( 2*MN )+WORK( 2*MN+1 ) ) * * workspace: 2*MN+NB*NRHS. * diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f index 5b3418ea05..3893696a31 100644 --- a/SRC/sgeqr.f +++ b/SRC/sgeqr.f @@ -282,12 +282,12 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, * IF( INFO.EQ.0 ) THEN IF( MINT ) THEN - T( 1 ) = MINTSZ + T( 1 ) = REAL( MINTSZ ) ELSE - T( 1 ) = NB*N*NBLCKS + 5 + T( 1 ) = REAL( NB*N*NBLCKS + 5 ) END IF - T( 2 ) = MB - T( 3 ) = NB + T( 2 ) = REAL( MB ) + T( 3 ) = REAL( NB ) IF( MINW ) THEN WORK( 1 ) = SROUNDUP_LWORK( LWMIN ) ELSE diff --git a/SRC/sgerfs.f b/SRC/sgerfs.f index d327f95551..573b7d1ab9 100644 --- a/SRC/sgerfs.f +++ b/SRC/sgerfs.f @@ -282,7 +282,7 @@ SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -387,9 +387,10 @@ SUBROUTINE SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/sgesdd.f b/SRC/sgesdd.f index f75f83c9a4..37d10a2847 100644 --- a/SRC/sgesdd.f +++ b/SRC/sgesdd.f @@ -310,7 +310,7 @@ SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, MINWRK = 1 MAXWRK = 1 BDSPAC = 0 - MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) + MNTHR = INT( REAL( MINMN )*11.0E0 / 6.0E0 ) IF( M.GE.N .AND. MINMN.GT.0 ) THEN * * Compute space needed for SBDSDC diff --git a/SRC/sgesvdq.f b/SRC/sgesvdq.f index 8f5e0c6d5d..0195d3d7fa 100644 --- a/SRC/sgesvdq.f +++ b/SRC/sgesvdq.f @@ -738,9 +738,9 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, * Return optimal workspace * IWORK(1) = IMINWRK - WORK(1) = OPTWRK - WORK(2) = MINWRK - RWORK(1) = RMINWRK + WORK(1) = REAL( OPTWRK ) + WORK(2) = REAL( MINWRK ) + RWORK(1) = REAL( RMINWRK ) RETURN END IF * @@ -1393,7 +1393,7 @@ SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, IF ( ASCALED ) $ CALL SLASCL( 'G',0,0, ONE,SQRT(REAL(M)), NR,1, S, N, IERR ) IF ( CONDA ) RWORK(1) = SCONDA - RWORK(2) = p - NR + RWORK(2) = REAL( p - NR ) * .. p-NR is the number of singular values that are computed as * exact zeros in SGESVD() applied to the (possibly truncated) * full row rank triangular (trapezoidal) factor of A. diff --git a/SRC/sggbal.f b/SRC/sggbal.f index bdbf591f90..f7ec6b737e 100644 --- a/SRC/sggbal.f +++ b/SRC/sggbal.f @@ -340,7 +340,7 @@ SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Permute rows M and I * 160 CONTINUE - LSCALE( M ) = I + LSCALE( M ) = REAL( I ) IF( I.EQ.M ) $ GO TO 170 CALL SSWAP( N-K+1, A( I, K ), LDA, A( M, K ), LDA ) @@ -349,7 +349,7 @@ SUBROUTINE SGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, * Permute columns M and J * 170 CONTINUE - RSCALE( M ) = J + RSCALE( M ) = REAL( J ) IF( J.EQ.M ) $ GO TO 180 CALL SSWAP( L, A( 1, J ), 1, A( 1, M ), 1 ) diff --git a/SRC/sggglm.f b/SRC/sggglm.f index 46c4595f94..b7ba43ac81 100644 --- a/SRC/sggglm.f +++ b/SRC/sggglm.f @@ -348,7 +348,7 @@ SUBROUTINE SGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, CALL SORMRQ( 'Left', 'Transpose', P, 1, NP, $ B( MAX( 1, N-P+1 ), 1 ), LDB, WORK( M+1 ), Y, $ MAX( 1, P ), WORK( M+NP+1 ), LWORK-M-NP, INFO ) - WORK( 1 ) = M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) ) + WORK( 1 ) = REAL( M + NP + MAX( LOPT, INT( WORK( M+NP+1 ) ) ) ) * RETURN * diff --git a/SRC/sgglse.f b/SRC/sgglse.f index 5ec6517612..2dd9362b9c 100644 --- a/SRC/sgglse.f +++ b/SRC/sgglse.f @@ -350,7 +350,7 @@ SUBROUTINE SGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, CALL SORMRQ( 'Left', 'Transpose', N, 1, P, B, LDB, WORK( 1 ), $ X, $ N, WORK( P+MN+1 ), LWORK-P-MN, INFO ) - WORK( 1 ) = P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) + WORK( 1 ) = REAL( P + MN + MAX( LOPT, INT( WORK( P+MN+1 ) ) ) ) * RETURN * diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index d9239e0645..e78d6a3041 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -452,8 +452,8 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * ULP = SLAMCH( 'Precision' ) UNFL = SLAMCH( 'Safe Minimum' ) - TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP - TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP + TOLA = REAL( MAX( M, N ) )*MAX( ANORM, UNFL )*ULP + TOLB = REAL( MAX( P, N ) )*MAX( BNORM, UNFL )*ULP * * Preprocessing * diff --git a/SRC/sgtrfs.f b/SRC/sgtrfs.f index dc39771468..5bb8783bff 100644 --- a/SRC/sgtrfs.f +++ b/SRC/sgtrfs.f @@ -303,7 +303,7 @@ SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, NZ = 4 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -424,9 +424,10 @@ SUBROUTINE SGTRFS( TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, * DO 60 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 60 CONTINUE * diff --git a/SRC/shgeqz.f b/SRC/shgeqz.f index d6d9e818f7..9665cfe853 100644 --- a/SRC/shgeqz.f +++ b/SRC/shgeqz.f @@ -403,7 +403,7 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, * Check Argument Values * INFO = 0 - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = REAL( MAX( 1, N ) ) LQUERY = ( LWORK.EQ.-1 ) IF( ISCHUR.EQ.0 ) THEN INFO = -1 diff --git a/SRC/shsein.f b/SRC/shsein.f index 6850adbd42..620723cc01 100644 --- a/SRC/shsein.f +++ b/SRC/shsein.f @@ -368,7 +368,7 @@ SUBROUTINE SHSEIN( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, * UNFL = SLAMCH( 'Safe minimum' ) ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM * LDWORK = N + 1 diff --git a/SRC/slantb.f b/SRC/slantb.f index fb91b300e8..699504bcde 100644 --- a/SRC/slantb.f +++ b/SRC/slantb.f @@ -318,7 +318,7 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) IF( K.GT.0 ) THEN DO 280 J = 2, N CALL SLASSQ( MIN( J-1, K ), @@ -338,7 +338,7 @@ REAL FUNCTION SLANTB( NORM, UPLO, DIAG, N, K, AB, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, diff --git a/SRC/slantp.f b/SRC/slantp.f index a98201ea0e..669997886f 100644 --- a/SRC/slantp.f +++ b/SRC/slantp.f @@ -314,7 +314,7 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) K = 2 DO 280 J = 2, N CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM ) @@ -332,7 +332,7 @@ REAL FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = N + SUM = REAL( N ) K = 2 DO 300 J = 1, N - 1 CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM ) diff --git a/SRC/slantr.f b/SRC/slantr.f index 5f04d6d5ea..b7dd34b7bc 100644 --- a/SRC/slantr.f +++ b/SRC/slantr.f @@ -319,7 +319,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 290 J = 2, N CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, $ SUM ) @@ -335,7 +335,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 310 J = 1, N CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) diff --git a/SRC/slaqz0.f b/SRC/slaqz0.f index 3e841a5fe0..0c1e56b7e2 100644 --- a/SRC/slaqz0.f +++ b/SRC/slaqz0.f @@ -433,7 +433,8 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, NSR = MAX( 2, NSR-MOD( NSR, 2 ) ) RCOST = ILAENV( 17, 'SLAQZ0', JBCMPZ, N, ILO, IHI, LWORK ) - ITEMP1 = INT( NSR/SQRT( 1+2*NSR/( REAL( RCOST )/100*N ) ) ) + ITEMP1 = INT( REAL( NSR )/SQRT( 1+2*REAL( NSR )/ + $ ( REAL( RCOST )/100*REAL( N ) ) ) ) ITEMP1 = ( ( ITEMP1-1 )/4 )*4+4 NBR = NSR+ITEMP1 diff --git a/SRC/slarrd.f b/SRC/slarrd.f index 1526fed4b8..ab77f996ce 100644 --- a/SRC/slarrd.f +++ b/SRC/slarrd.f @@ -467,8 +467,8 @@ SUBROUTINE SLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS, 5 CONTINUE * Compute global Gerschgorin bounds and spectral diameter TNORM = MAX( ABS( GL ), ABS( GU ) ) - GL = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN - GU = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN + GL = GL - FUDGE*TNORM*EPS*REAL( N ) - FUDGE*TWO*PIVMIN + GU = GU + FUDGE*TNORM*EPS*REAL( N ) + FUDGE*TWO*PIVMIN * [JAN/28/2009] remove the line below since SPDIAM variable not use * SPDIAM = GU - GL * Input arguments for SLAEBZ: @@ -641,8 +641,8 @@ SUBROUTINE SLARRD( RANGE, ORDER, N, VL, VU, IL, IU, GERS, * SPDIAM = GU - GL * GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN * GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN - GL = GL - FUDGE*TNORM*EPS*IN - FUDGE*PIVMIN - GU = GU + FUDGE*TNORM*EPS*IN + FUDGE*PIVMIN + GL = GL - FUDGE*TNORM*EPS*REAL( IN ) - FUDGE*PIVMIN + GU = GU + FUDGE*TNORM*EPS*REAL( IN ) + FUDGE*PIVMIN * IF( IRANGE.GT.1 ) THEN IF( GU.LT.WL ) THEN diff --git a/SRC/slarre.f b/SRC/slarre.f index 9fe5a019d5..8847860e6e 100644 --- a/SRC/slarre.f +++ b/SRC/slarre.f @@ -555,7 +555,8 @@ SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, ELSE * Decide whether dqds or bisection is more efficient - USEDQD = ( (MB .GT. FAC*IN) .AND. (.NOT.FORCEB) ) + USEDQD = ( (REAL( MB ) .GT. FAC*REAL( IN )) .AND. + $ (.NOT.FORCEB) ) WEND = WBEGIN + MB - 1 * Calculate gaps for the current block * In later stages, when representations for individual @@ -684,7 +685,7 @@ SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, IF( USEDQD ) THEN * The initial SIGMA was to the outer end of the spectrum * the matrix is definite and we need not retreat. - TAU = SPDIAM*EPS*N + TWO*PIVMIN + TAU = SPDIAM*EPS*REAL( N ) + TWO*PIVMIN TAU = MAX( TAU,TWO*EPS*ABS(SIGMA) ) ELSE IF(MB.GT.1) THEN @@ -741,10 +742,12 @@ SUBROUTINE SLARRE( RANGE, N, VL, VU, IL, IU, D, E, E2, IF( SGNDEF.EQ.ONE ) THEN * The fudged Gerschgorin shift should succeed SIGMA = - $ GL - FUDGE*SPDIAM*EPS*N - FUDGE*TWO*PIVMIN + $ GL - FUDGE*SPDIAM*EPS*REAL( N ) - + $ FUDGE*TWO*PIVMIN ELSE SIGMA = - $ GU + FUDGE*SPDIAM*EPS*N + FUDGE*TWO*PIVMIN + $ GU + FUDGE*SPDIAM*EPS*REAL( N ) + + $ FUDGE*TWO*PIVMIN END IF ELSE SIGMA = SIGMA - SGNDEF * TAU diff --git a/SRC/slarrk.f b/SRC/slarrk.f index bf8f74d5ba..382fe60281 100644 --- a/SRC/slarrk.f +++ b/SRC/slarrk.f @@ -196,8 +196,8 @@ SUBROUTINE SLARRK( N, IW, GL, GU, INFO = -1 - LEFT = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN - RIGHT = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN + LEFT = GL - FUDGE*TNORM*EPS*REAL( N ) - FUDGE*TWO*PIVMIN + RIGHT = GU + FUDGE*TNORM*EPS*REAL( N ) + FUDGE*TWO*PIVMIN IT = 0 10 CONTINUE diff --git a/SRC/slasq2.f b/SRC/slasq2.f index f1b112ab78..653298dadf 100644 --- a/SRC/slasq2.f +++ b/SRC/slasq2.f @@ -586,7 +586,7 @@ SUBROUTINE SLASQ2( N, Z, INFO ) Z( 2*N+2 ) = E Z( 2*N+3 ) = REAL( ITER ) Z( 2*N+4 ) = REAL( NDIV ) / REAL( N**2 ) - Z( 2*N+5 ) = HUNDRD*NFAIL / REAL( ITER ) + Z( 2*N+5 ) = HUNDRD*REAL( NFAIL / ITER ) RETURN * * End of SLASQ2 diff --git a/SRC/slasy2.f b/SRC/slasy2.f index c781ed979f..10710b76ba 100644 --- a/SRC/slasy2.f +++ b/SRC/slasy2.f @@ -239,7 +239,7 @@ SUBROUTINE SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, * EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS - SGN = ISGN + SGN = REAL( ISGN ) * K = N1 + N1 + N2 - 2 GO TO ( 10, 20, 30, 50 )K diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index 116cbd03a0..4d7e942cfe 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -377,7 +377,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, IF( INFO .EQ. 0 ) THEN LWORKOPT = M - Q LWORKMIN = M - Q - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN INFO = -21 END IF diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index 74acf67ebe..c7ffdaf0f4 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -267,7 +267,7 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, LORBDB5 = Q-2 LWORKOPT = MAX( ILARF+LLARF-1, IORBDB5+LORBDB5-1 ) LWORKMIN = LWORKOPT - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -14 END IF diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index 332a9ce6e4..eac7a7c051 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -265,7 +265,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, LORBDB5 = Q-1 LWORKOPT = MAX( ILARF+LLARF-1, IORBDB5+LORBDB5-1 ) LWORKMIN = LWORKOPT - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -14 END IF diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index d0283f5bec..e443fb578f 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -266,7 +266,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, LORBDB5 = Q-1 LWORKOPT = MAX( ILARF+LLARF-1, IORBDB5+LORBDB5-1 ) LWORKMIN = LWORKOPT - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -14 END IF diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index 983f254074..417179b9c2 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -279,7 +279,7 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LWORKOPT = ILARF + LLARF - 1 LWORKOPT = MAX( LWORKOPT, IORBDB5 + LORBDB5 - 1 ) LWORKMIN = LWORKOPT - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -14 END IF diff --git a/SRC/sorbdb6.f b/SRC/sorbdb6.f index c58b6342a2..ef2784df54 100644 --- a/SRC/sorbdb6.f +++ b/SRC/sorbdb6.f @@ -266,7 +266,7 @@ SUBROUTINE SORBDB6( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, RETURN END IF * - IF( NORM_NEW .LE. N * EPS * NORM ) THEN + IF( NORM_NEW .LE. REAL( N ) * EPS * NORM ) THEN DO IX = 1, 1 + (M1-1)*INCX1, INCX1 X1( IX ) = ZERO END DO diff --git a/SRC/sorcsd.f b/SRC/sorcsd.f index b81aeb13e0..381fe2e67f 100644 --- a/SRC/sorcsd.f +++ b/SRC/sorcsd.f @@ -479,7 +479,7 @@ RECURSIVE SUBROUTINE SORCSD( JOBU1, JOBU2, JOBV1T, JOBV2T, $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKOPT ) - 1 LWORKMIN = MAX( IORGQR + LORGQRWORKMIN, IORGLQ + LORGLQWORKMIN, $ IORBDB + LORBDBWORKOPT, IBBCSD + LBBCSDWORKMIN ) - 1 - WORK(1) = MAX(LWORKOPT,LWORKMIN) + WORK(1) = REAL( MAX(LWORKOPT,LWORKMIN) ) * IF( LWORK .LT. LWORKMIN .AND. .NOT. LQUERY ) THEN INFO = -22 diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f index e6e65a99b7..11e0a9872e 100644 --- a/SRC/sorcsd2by1.f +++ b/SRC/sorcsd2by1.f @@ -477,7 +477,7 @@ SUBROUTINE SORCSD2BY1( JOBU1, JOBU2, JOBV1T, M, P, Q, X11, $ IORGQR+LORGQROPT-1, $ IORGLQ+LORGLQOPT-1, $ IBBCSD+LBBCSD-1 ) - WORK(1) = LWORKOPT + WORK(1) = REAL( LWORKOPT ) IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN INFO = -19 END IF diff --git a/SRC/spbrfs.f b/SRC/spbrfs.f index 8f3180fc7d..9d4f2e4ac8 100644 --- a/SRC/spbrfs.f +++ b/SRC/spbrfs.f @@ -279,7 +279,7 @@ SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, NZ = MIN( N+1, 2*KD+2 ) EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -391,9 +391,10 @@ SUBROUTINE SPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/sporfs.f b/SRC/sporfs.f index 825ade7258..e7a9e161c7 100644 --- a/SRC/sporfs.f +++ b/SRC/sporfs.f @@ -271,7 +271,7 @@ SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -380,9 +380,10 @@ SUBROUTINE SPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/spprfs.f b/SRC/spprfs.f index 218d5b5549..599b9b7083 100644 --- a/SRC/spprfs.f +++ b/SRC/spprfs.f @@ -256,7 +256,7 @@ SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -373,9 +373,10 @@ SUBROUTINE SPPRFS( UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/spstf2.f b/SRC/spstf2.f index acb33f1584..c970f4a537 100644 --- a/SRC/spstf2.f +++ b/SRC/spstf2.f @@ -225,7 +225,7 @@ SUBROUTINE SPSTF2( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, * Compute stopping value if not supplied * IF( TOL.LT.ZERO ) THEN - SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ + SSTOP = REAL( N ) * SLAMCH( 'Epsilon' ) * AJJ ELSE SSTOP = TOL END IF diff --git a/SRC/spstrf.f b/SRC/spstrf.f index 689f1343d3..c7140f541c 100644 --- a/SRC/spstrf.f +++ b/SRC/spstrf.f @@ -240,7 +240,7 @@ SUBROUTINE SPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, * Compute stopping value if not supplied * IF( TOL.LT.ZERO ) THEN - SSTOP = N * SLAMCH( 'Epsilon' ) * AJJ + SSTOP = REAL( N ) * SLAMCH( 'Epsilon' ) * AJJ ELSE SSTOP = TOL END IF diff --git a/SRC/sptrfs.f b/SRC/sptrfs.f index 68ab1e351b..1e1b615ca4 100644 --- a/SRC/sptrfs.f +++ b/SRC/sptrfs.f @@ -239,7 +239,7 @@ SUBROUTINE SPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, NZ = 4 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -339,9 +339,10 @@ SUBROUTINE SPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, * DO 50 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 50 CONTINUE IX = ISAMAX( N, WORK, 1 ) diff --git a/SRC/ssprfs.f b/SRC/ssprfs.f index 07e5653a65..fd82cd59dd 100644 --- a/SRC/ssprfs.f +++ b/SRC/ssprfs.f @@ -264,7 +264,7 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -382,9 +382,10 @@ SUBROUTINE SSPRFS( UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/sstebz.f b/SRC/sstebz.f index 3f79b5b713..3849546216 100644 --- a/SRC/sstebz.f +++ b/SRC/sstebz.f @@ -456,8 +456,8 @@ SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, GU = MAX( GU, D( N )+TMP1 ) GL = MIN( GL, D( N )-TMP1 ) TNORM = MAX( ABS( GL ), ABS( GU ) ) - GL = GL - FUDGE*TNORM*ULP*N - FUDGE*TWO*PIVMIN - GU = GU + FUDGE*TNORM*ULP*N + FUDGE*PIVMIN + GL = GL - FUDGE*TNORM*ULP*REAL( N ) - FUDGE*TWO*PIVMIN + GU = GU + FUDGE*TNORM*ULP*REAL( N ) + FUDGE*PIVMIN * * Compute Iteration parameters * @@ -585,8 +585,8 @@ SUBROUTINE SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, GU = MAX( GU, D( IEND )+TMP1 ) GL = MIN( GL, D( IEND )-TMP1 ) BNORM = MAX( ABS( GL ), ABS( GU ) ) - GL = GL - FUDGE*BNORM*ULP*IN - FUDGE*PIVMIN - GU = GU + FUDGE*BNORM*ULP*IN + FUDGE*PIVMIN + GL = GL - FUDGE*BNORM*ULP*REAL( IN ) - FUDGE*PIVMIN + GU = GU + FUDGE*BNORM*ULP*REAL( IN ) + FUDGE*PIVMIN * * Compute ATOLI for the current submatrix * diff --git a/SRC/sstein.f b/SRC/sstein.f index 5e861ac652..333d381e6b 100644 --- a/SRC/sstein.f +++ b/SRC/sstein.f @@ -308,7 +308,7 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, 50 CONTINUE ORTOL = ODM3*ONENRM * - STPCRT = SQRT( ODM1 / BLKSIZ ) + STPCRT = SQRT( ODM1 / REAL( BLKSIZ ) ) * * Loop through eigenvalues of block nblk. * @@ -371,7 +371,7 @@ SUBROUTINE SSTEIN( N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, * Normalize and scale the righthand side vector Pb. * JMAX = ISAMAX( BLKSIZ, WORK( INDRV1+1 ), 1 ) - SCL = BLKSIZ*ONENRM*MAX( EPS, + SCL = REAL( BLKSIZ )*ONENRM*MAX( EPS, $ ABS( WORK( INDRV4+BLKSIZ ) ) ) / $ ABS( WORK( INDRV1+JMAX ) ) CALL SSCAL( BLKSIZ, SCL, WORK( INDRV1+1 ), 1 ) diff --git a/SRC/sstemr.f b/SRC/sstemr.f index eb310d9354..346d5b00d9 100644 --- a/SRC/sstemr.f +++ b/SRC/sstemr.f @@ -460,7 +460,7 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NZCMIN = 0 ENDIF IF( ZQUERY .AND. INFO.EQ.0 ) THEN - Z( 1,1 ) = NZCMIN + Z( 1,1 ) = REAL( NZCMIN ) ELSE IF( NZC.LT.NZCMIN .AND. .NOT.ZQUERY ) THEN INFO = -14 END IF diff --git a/SRC/sstevr.f b/SRC/sstevr.f index 0eff542cdb..f5bd9ef09c 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -500,7 +500,7 @@ SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, CALL SSTERF( N, W, WORK, INFO ) ELSE CALL SCOPY( N, D, 1, WORK( N+1 ), 1 ) - IF (ABSTOL .LE. TWO*N*EPS) THEN + IF (ABSTOL .LE. TWO*REAL( N )*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. diff --git a/SRC/ssyequb.f b/SRC/ssyequb.f index 6f24b3ae93..260384afb1 100644 --- a/SRC/ssyequb.f +++ b/SRC/ssyequb.f @@ -227,7 +227,7 @@ SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, S( J ) = 1.0E0 / S( J ) END DO - TOL = ONE / SQRT( 2.0E0 * N ) + TOL = ONE / SQRT( 2.0E0 * REAL( N ) ) DO ITER = 1, MAX_ITER SCALE = 0.0E0 @@ -259,23 +259,23 @@ SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, DO I = 1, N AVG = AVG + S( I )*WORK( I ) END DO - AVG = AVG / N + AVG = AVG / REAL( N ) STD = 0.0E0 DO I = N+1, 2*N WORK( I ) = S( I-N ) * WORK( I-N ) - AVG END DO CALL SLASSQ( N, WORK( N+1 ), 1, SCALE, SUMSQ ) - STD = SCALE * SQRT( SUMSQ / N ) + STD = SCALE * SQRT( SUMSQ / REAL( N ) ) IF ( STD .LT. TOL * AVG ) GOTO 999 DO I = 1, N T = ABS( A( I, I ) ) SI = S( I ) - C2 = ( N-1 ) * T - C1 = ( N-2 ) * ( WORK( I ) - T*SI ) - C0 = -(T*SI)*SI + 2*WORK( I )*SI - N*AVG + C2 = REAL( N-1 ) * T + C1 = REAL( N-2 ) * ( WORK( I ) - T*SI ) + C0 = -(T*SI)*SI + 2*WORK( I )*SI - REAL( N )*AVG D = C1*C1 - 4*C0*C2 IF ( D .LE. 0 ) THEN @@ -310,7 +310,7 @@ SUBROUTINE SSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, END DO END IF - AVG = AVG + ( U + WORK( I ) ) * D / N + AVG = AVG + ( U + WORK( I ) ) * D / REAL( N ) S( I ) = SI END DO END DO diff --git a/SRC/ssyev_2stage.f b/SRC/ssyev_2stage.f index f2dd5ee7b1..9278cad296 100644 --- a/SRC/ssyev_2stage.f +++ b/SRC/ssyev_2stage.f @@ -253,7 +253,7 @@ SUBROUTINE SSYEV_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, $ -1 ) LWMIN = 2*N + LHTRD + LWTRD - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) $ INFO = -8 diff --git a/SRC/ssyevd_2stage.f b/SRC/ssyevd_2stage.f index 9dc0f85927..986deac2ac 100644 --- a/SRC/ssyevd_2stage.f +++ b/SRC/ssyevd_2stage.f @@ -305,7 +305,7 @@ SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, LWMIN = 2*N + 1 + LHTRD + LWTRD END IF END IF - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -394,7 +394,7 @@ SUBROUTINE SSYEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, IF( ISCALE.EQ.1 ) $ CALL SSCAL( N, ONE / SIGMA, W, 1 ) * - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 65df90a01f..453682fd86 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -585,7 +585,7 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) * - IF (ABSTOL .LE. TWO*N*EPS) THEN + IF (ABSTOL .LE. TWO*REAL( N )*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 2f08184803..9a0b949831 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -641,7 +641,7 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, CALL SCOPY( N-1, WORK( INDE ), 1, WORK( INDEE ), 1 ) CALL SCOPY( N, WORK( INDD ), 1, WORK( INDDD ), 1 ) * - IF (ABSTOL .LE. TWO*N*EPS) THEN + IF (ABSTOL .LE. TWO*REAL( N )*EPS) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. diff --git a/SRC/ssyevx_2stage.f b/SRC/ssyevx_2stage.f index 7638962249..8a32da15f8 100644 --- a/SRC/ssyevx_2stage.f +++ b/SRC/ssyevx_2stage.f @@ -402,7 +402,7 @@ SUBROUTINE SSYEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, $ N, KD, IB, -1 ) LWMIN = MAX( 8*N, 3*N + LHTRD + LWTRD ) - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) END IF * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) diff --git a/SRC/ssygv_2stage.f b/SRC/ssygv_2stage.f index 79c4dd4dc5..ac2dfcbab4 100644 --- a/SRC/ssygv_2stage.f +++ b/SRC/ssygv_2stage.f @@ -298,7 +298,7 @@ SUBROUTINE SSYGV_2STAGE( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, $ -1 ) LWMIN = 2*N + LHTRD + LWTRD - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -11 diff --git a/SRC/ssyrfs.f b/SRC/ssyrfs.f index 9a960b0572..06d500e6a5 100644 --- a/SRC/ssyrfs.f +++ b/SRC/ssyrfs.f @@ -280,7 +280,7 @@ SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -390,9 +390,10 @@ SUBROUTINE SSYRFS( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, * DO 90 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 90 CONTINUE * diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f index c2892764ed..ecf668df6c 100644 --- a/SRC/ssytrd_2stage.f +++ b/SRC/ssytrd_2stage.f @@ -293,8 +293,8 @@ SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * IF( INFO.EQ.0 ) THEN - HOUS2( 1 ) = LHMIN - WORK( 1 ) = LWMIN + HOUS2( 1 ) = REAL( LHMIN ) + WORK( 1 ) = REAL( LWMIN ) END IF * IF( INFO.NE.0 ) THEN diff --git a/SRC/ssytrf_aa_2stage.f b/SRC/ssytrf_aa_2stage.f index 024f6e7ef5..f4721edb8a 100644 --- a/SRC/ssytrf_aa_2stage.f +++ b/SRC/ssytrf_aa_2stage.f @@ -269,7 +269,7 @@ SUBROUTINE SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, * * Save NB * - TB( 1 ) = NB + TB( 1 ) = REAL( NB ) * IF( UPPER ) THEN * diff --git a/SRC/stbrfs.f b/SRC/stbrfs.f index 9c2a274de3..e0c267a22d 100644 --- a/SRC/stbrfs.f +++ b/SRC/stbrfs.f @@ -285,7 +285,7 @@ SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, NZ = KD + 2 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -433,9 +433,10 @@ SUBROUTINE STBRFS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, * DO 200 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/stgevc.f b/SRC/stgevc.f index 4db97ca9a7..141345e779 100644 --- a/SRC/stgevc.f +++ b/SRC/stgevc.f @@ -466,9 +466,9 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, SAFMIN = SLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) - SMALL = SAFMIN*N / ULP + SMALL = SAFMIN*REAL( N ) / ULP BIG = ONE / SMALL - BIGNUM = ONE / ( SAFMIN*N ) + BIGNUM = ONE / ( SAFMIN*REAL( N ) ) * * Compute the 1-norm of each column of the strictly upper triangular * part (i.e., excluding all elements belonging to the diagonal diff --git a/SRC/stgex2.f b/SRC/stgex2.f index 836067974d..b48667d2ec 100644 --- a/SRC/stgex2.f +++ b/SRC/stgex2.f @@ -289,7 +289,7 @@ SUBROUTINE STGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, M = N1 + N2 IF( LWORK.LT.MAX( N*M, M*M*2 ) ) THEN INFO = -16 - WORK( 1 ) = MAX( N*M, M*M*2 ) + WORK( 1 ) = REAL( MAX( N*M, M*M*2 ) ) RETURN END IF * diff --git a/SRC/stgexc.f b/SRC/stgexc.f index 682d03d753..a046cc600c 100644 --- a/SRC/stgexc.f +++ b/SRC/stgexc.f @@ -280,7 +280,7 @@ SUBROUTINE STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, ELSE LWMIN = 4*N + 16 END IF - WORK(1) = LWMIN + WORK(1) = REAL( LWMIN ) * IF (LWORK.LT.LWMIN .AND. .NOT.LQUERY) THEN INFO = -15 diff --git a/SRC/stprfs.f b/SRC/stprfs.f index 7ff59c6714..92b5b6d691 100644 --- a/SRC/stprfs.f +++ b/SRC/stprfs.f @@ -269,7 +269,7 @@ SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -424,9 +424,10 @@ SUBROUTINE STPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, * DO 200 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/strevc.f b/SRC/strevc.f index 519ec82ed0..b88fff34bd 100644 --- a/SRC/strevc.f +++ b/SRC/strevc.f @@ -344,7 +344,7 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM * * Compute 1-norm of each column of strictly upper triangular diff --git a/SRC/strevc3.f b/SRC/strevc3.f index a58e2c64c6..da445df368 100644 --- a/SRC/strevc3.f +++ b/SRC/strevc3.f @@ -301,7 +301,7 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, INFO = 0 NB = ILAENV( 1, 'STREVC', SIDE // HOWMNY, N, -1, -1, -1 ) MAXWRK = MAX( 1, N + 2*N*NB ) - WORK(1) = MAXWRK + WORK( 1 ) = REAL( MAXWRK ) LQUERY = ( LWORK.EQ.-1 ) IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -1 @@ -384,7 +384,7 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL ULP = SLAMCH( 'Precision' ) - SMLNUM = UNFL*( N / ULP ) + SMLNUM = UNFL*( REAL( N ) / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM * * Compute 1-norm of each column of strictly upper triangular diff --git a/SRC/strrfs.f b/SRC/strrfs.f index b1914ce922..b47f8fb1ae 100644 --- a/SRC/strrfs.f +++ b/SRC/strrfs.f @@ -278,7 +278,7 @@ SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, NZ = N + 1 EPS = SLAMCH( 'Epsilon' ) SAFMIN = SLAMCH( 'Safe minimum' ) - SAFE1 = NZ*SAFMIN + SAFE1 = REAL( NZ )*SAFMIN SAFE2 = SAFE1 / EPS * * Do for each right hand side @@ -421,9 +421,10 @@ SUBROUTINE STRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, * DO 200 I = 1, N IF( WORK( I ).GT.SAFE2 ) THEN - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) ELSE - WORK( I ) = ABS( WORK( N+I ) ) + NZ*EPS*WORK( I ) + SAFE1 + WORK( I ) = ABS( WORK( N+I ) ) + REAL( NZ )*EPS*WORK( I ) + $ + SAFE1 END IF 200 CONTINUE * diff --git a/SRC/strsyl.f b/SRC/strsyl.f index b0fdfe3a38..938cc33a61 100644 --- a/SRC/strsyl.f +++ b/SRC/strsyl.f @@ -251,7 +251,7 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, SMIN = MAX( SMLNUM, EPS*SLANGE( 'M', M, M, A, LDA, DUM ), $ EPS*SLANGE( 'M', N, N, B, LDB, DUM ) ) * - SGN = ISGN + SGN = REAL( ISGN ) * IF( NOTRNA .AND. NOTRNB ) THEN * diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index fd2c83572a..505a0a2fbf 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -244,8 +244,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, IWORK( 1 ) = NBA + NBB + 2 IF( LQUERY ) THEN LDSWORK = 2 - SWORK( 1, 1 ) = MAX( NBA, NBB ) - SWORK( 2, 1 ) = 2 * NBB + NBA + SWORK( 1, 1 ) = REAL( MAX( NBA, NBB ) ) + SWORK( 2, 1 ) = REAL( 2 * NBB + NBA ) END IF * * Test the input arguments @@ -1175,8 +1175,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * form (1/SCALE)*X if SCALE is REAL. Set SCALE to zero and give up. * IWORK(1) = NBA + NBB + 2 - SWORK(1,1) = MAX( NBA, NBB ) - SWORK(2,1) = 2 * NBB + NBA + SWORK(1,1) = REAL( MAX( NBA, NBB ) ) + SWORK(2,1) = REAL( 2 * NBB + NBA ) RETURN END IF * @@ -1239,8 +1239,8 @@ SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, * Restore workspace dimensions * IWORK(1) = NBA + NBB + 2 - SWORK(1,1) = MAX( NBA, NBB ) - SWORK(2,1) = 2 * NBB + NBA + SWORK(1,1) = REAL( MAX( NBA, NBB ) ) + SWORK(2,1) = REAL( 2 * NBB + NBA ) * RETURN * From fe3e793c163ec579d31d0b6a309485fdeefe0288 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 22 Aug 2023 16:34:52 -0700 Subject: [PATCH 047/206] Remove unused lapack_64.h from la_constants --- SRC/la_constants.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/SRC/la_constants.f90 b/SRC/la_constants.f90 index 9f0ee99cc5..3970e3a055 100644 --- a/SRC/la_constants.f90 +++ b/SRC/la_constants.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b LA_CONSTANTS is a module for the scaling constants for the compiled Fortran single and double precisions ! ! =========== DOCUMENTATION =========== From ee213a3ed3ab15f892c49954fa0d0d46c0af63f7 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Wed, 27 Dec 2023 17:41:00 -0800 Subject: [PATCH 048/206] resolve conflicts after rebasing --- LAPACKE/include/lapacke_64.h | 105 ++++++++++++++++++----------------- SRC/cgees.f | 3 +- SRC/cgeesx.f | 3 +- SRC/cgeev.f | 13 +++-- SRC/cgeevx.f | 15 +++-- SRC/cgelsd.f | 3 +- SRC/cgelss.f | 3 +- SRC/cgelst.f | 9 ++- SRC/cgeqp3rk.f | 4 +- SRC/cgesvd.f | 3 +- SRC/cgesvdx.f | 3 +- SRC/cgetsls.f | 3 +- SRC/cgges.f | 3 +- SRC/cgges3.f | 3 +- SRC/cggesx.f | 3 +- SRC/cggev.f | 3 +- SRC/cggev3.f | 3 +- SRC/cggevx.f | 3 +- SRC/chbevd.f | 7 ++- SRC/chbgvd.f | 4 +- SRC/cheev.f | 3 +- SRC/cheevd.f | 3 +- SRC/cheevr.f | 3 +- SRC/cheevr_2stage.f | 14 +++-- SRC/cheevx.f | 3 +- SRC/chegvd.f | 4 +- SRC/chesvx.f | 3 +- SRC/chetrf_aa.f | 3 +- SRC/chpevd.f | 7 ++- SRC/chpgvd.f | 4 +- SRC/claqp2rk.f | 1 + SRC/claqp3rk.f | 1 + SRC/clatrs3.f | 5 +- SRC/cstedc.f | 7 ++- SRC/cstemr.f | 3 +- SRC/csysvx.f | 3 +- SRC/ctgsna.f | 6 +- SRC/ctrevc3.f | 2 +- SRC/cunbdb5.f | 2 +- SRC/dgeqp3rk.f | 4 +- SRC/dggev3.f | 11 ++-- SRC/dlaqp2rk.f | 1 + SRC/dlaqp3rk.f | 1 + SRC/dsyevr_2stage.f | 12 ++-- SRC/dsysv_aa.f | 3 +- SRC/dsytrd_2stage.f | 12 ++-- SRC/dsytrd_sy2sb.f | 3 +- SRC/dsytrf_aa.f | 3 +- SRC/lapack_64.h | 12 ++++ SRC/sgees.f | 3 +- SRC/sgeesx.f | 3 +- SRC/sgeev.f | 13 +++-- SRC/sgeevx.f | 6 +- SRC/sgels.f | 3 +- SRC/sgelsd.f | 3 +- SRC/sgelss.f | 3 +- SRC/sgelst.f | 3 +- SRC/sgelsy.f | 3 +- SRC/sgeqp3rk.f | 4 +- SRC/sgesvd.f | 3 +- SRC/sgesvdx.f | 3 +- SRC/sgetsls.f | 3 +- SRC/sgges.f | 3 +- SRC/sgges3.f | 3 +- SRC/sggesx.f | 3 +- SRC/sggev.f | 3 +- SRC/sggev3.f | 29 ++++++---- SRC/sggevx.f | 3 +- SRC/sggsvd3.f | 3 +- SRC/shgeqz.f | 7 ++- SRC/slaqp2rk.f | 1 + SRC/slaqp3rk.f | 1 + SRC/sorbdb5.f | 2 +- SRC/ssbevd.f | 3 +- SRC/sspevd.f | 3 +- SRC/sstedc.f | 3 +- SRC/sstevd.f | 3 +- SRC/sstevr.f | 3 +- SRC/ssyev.f | 3 +- SRC/ssyevd.f | 3 +- SRC/ssyevr.f | 3 +- SRC/ssyevr_2stage.f | 15 +++-- SRC/ssyevx.f | 3 +- SRC/ssysv_aa.f | 3 +- SRC/ssysvx.f | 3 +- SRC/ssytrd_2stage.f | 14 +++-- SRC/ssytrf_aa.f | 3 +- SRC/stgsna.f | 10 ++-- SRC/zgeqp3rk.f | 4 +- SRC/zgesvj.f | 2 +- SRC/zhbevd.f | 4 +- SRC/zhbevd_2stage.f | 4 +- SRC/zhbgvd.f | 4 +- SRC/zheevd.f | 4 +- SRC/zheevd_2stage.f | 4 +- SRC/zheevr.f | 4 +- SRC/zheevr_2stage.f | 16 ++++-- SRC/zhegvd.f | 4 +- SRC/zhesv_aa.f | 3 +- SRC/zhetrd_2stage.f | 12 ++-- SRC/zhetrf_aa.f | 3 +- SRC/zhpevd.f | 4 +- SRC/zhpgvd.f | 4 +- SRC/zlaqp2rk.f | 1 + SRC/zlaqp3rk.f | 1 + SRC/zstedc.f | 4 +- 106 files changed, 375 insertions(+), 228 deletions(-) diff --git a/LAPACKE/include/lapacke_64.h b/LAPACKE/include/lapacke_64.h index 0e3900e45c..c8d3c552af 100644 --- a/LAPACKE/include/lapacke_64.h +++ b/LAPACKE/include/lapacke_64.h @@ -5694,55 +5694,59 @@ int64_t LAPACKE_zgesdd_work_64( int matrix_layout, char jobz, int64_t m, double* rwork, int64_t* iwork ); int64_t LAPACKE_sgedmd_work_64( int matrix_layout, char jobs, char jobz, - char jobf, int64_t whtsvd, int64_t m, - int64_t n, float* x, int64_t ldx, - float* y, int64_t ldy, int64_t k, - float* reig, float* imeig, float* z, - int64_t ldz, float* res, float* b, - int64_t ldb, float* w, int64_t ldw, - float* s, int64_t lds, float* work, - int64_t lwork, int64_t* iwork, - int64_t liwork ); + char jobr, char jobf, int64_t whtsvd, + int64_t m, int64_t n, float* x, + int64_t ldx, float* y, int64_t ldy, + int64_t nrnk, float* tol, int64_t k, + float* reig, float* imeig, + float* z, int64_t ldz, float* res, + float* b, int64_t ldb, float* w, + int64_t ldw, float* s, int64_t lds, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); int64_t LAPACKE_dgedmd_work_64( int matrix_layout, char jobs, char jobz, - char jobf, int64_t whtsvd, int64_t m, - int64_t n, double* x, int64_t ldx, - double* y, int64_t ldy, int64_t k, - double* reig, double* imeig, double* z, - int64_t ldz, double* res, double* b, - int64_t ldb, double* w, int64_t ldw, - double* s, int64_t lds, double* work, - int64_t lwork, int64_t* iwork, - int64_t liwork ); + char jobr, char jobf, int64_t whtsvd, + int64_t m, int64_t n, double* x, + int64_t ldx, double* y, int64_t ldy, + int64_t nrnk, double* tol, int64_t k, + double* reig, double *imeig, + double* z, int64_t ldz, double* res, + double* b, int64_t ldb, double* w, + int64_t ldw, double* s, int64_t lds, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork ); int64_t LAPACKE_cgedmd_work_64( int matrix_layout, char jobs, char jobz, - char jobf, int64_t whtsvd, int64_t m, - int64_t n, lapack_complex_float* x, - int64_t ldx, lapack_complex_float* y, - int64_t ldy, int64_t k, - lapack_complex_float* reig, - lapack_complex_float* imeig, + char jobr, char jobf, int64_t whtsvd, + int64_t m, int64_t n, + lapack_complex_float* x, int64_t ldx, + lapack_complex_float* y, int64_t ldy, + int64_t nrnk, float* tol, int64_t k, + lapack_complex_float* eigs, lapack_complex_float* z, int64_t ldz, - lapack_complex_float* res, + float* res, lapack_complex_float* b, int64_t ldb, lapack_complex_float* w, int64_t ldw, lapack_complex_float* s, int64_t lds, - lapack_complex_float* work, int64_t lwork, + lapack_complex_float* zwork, int64_t lzwork, + float* work, int64_t lwork, int64_t* iwork, int64_t liwork ); int64_t LAPACKE_zgedmd_work_64( int matrix_layout, char jobs, char jobz, - char jobf, int64_t whtsvd, int64_t m, - int64_t n, lapack_complex_double* x, - int64_t ldx, lapack_complex_double* y, - int64_t ldy, int64_t k, - lapack_complex_double* reig, - lapack_complex_double* imeig, + char jobr, char jobf, int64_t whtsvd, + int64_t m, int64_t n, + lapack_complex_double* x, int64_t ldx, + lapack_complex_double* y, int64_t ldy, + int64_t nrnk, double* tol, int64_t k, + lapack_complex_double* eigs, lapack_complex_double* z, int64_t ldz, - lapack_complex_double* res, + double* res, lapack_complex_double* b, int64_t ldb, lapack_complex_double* w, int64_t ldw, lapack_complex_double* s, int64_t lds, - lapack_complex_double* work, int64_t lwork, + lapack_complex_double* zwork, int64_t lzwork, + double* work, int64_t lwork, int64_t* iwork, int64_t liwork ); int64_t LAPACKE_sgedmdq_work_64( int matrix_layout, char jobs, char jobz, @@ -5750,8 +5754,8 @@ int64_t LAPACKE_sgedmdq_work_64( int matrix_layout, char jobs, char jobz, int64_t whtsvd, int64_t m, int64_t n, float* f, int64_t ldf, float* x, int64_t ldx, float* y, int64_t ldy, - int64_t nrnk, float tol, int64_t k, - float* reig, float* imeig, float* z, + int64_t nrnk, float* tol, int64_t k, + float* reig, float *imeig, float* z, int64_t ldz, float* res, float* b, int64_t ldb, float* v, int64_t ldv, float* s, int64_t lds, float* work, @@ -5763,7 +5767,7 @@ int64_t LAPACKE_dgedmdq_work_64( int matrix_layout, char jobs, char jobz, int64_t whtsvd, int64_t m, int64_t n, double* f, int64_t ldf, double* x, int64_t ldx, double* y, int64_t ldy, - int64_t nrnk, double tol, int64_t k, + int64_t nrnk, double* tol, int64_t k, double* reig, double* imeig, double* z, int64_t ldz, double* res, double* b, int64_t ldb, double* v, int64_t ldv, @@ -5777,17 +5781,16 @@ int64_t LAPACKE_cgedmdq_work_64( int matrix_layout, char jobs, char jobz, lapack_complex_float* f, int64_t ldf, lapack_complex_float* x, int64_t ldx, lapack_complex_float* y, int64_t ldy, - int64_t nrnk, float tol, int64_t k, - lapack_complex_float* reig, - lapack_complex_float* imeig, + int64_t nrnk, float* tol, int64_t k, + lapack_complex_float* eigs, lapack_complex_float* z, int64_t ldz, - lapack_complex_float* res, + float* res, lapack_complex_float* b, int64_t ldb, lapack_complex_float* v, int64_t ldv, lapack_complex_float* s, int64_t lds, - lapack_complex_float* work, int64_t lwork, - int64_t* iwork, - int64_t liwork ); + lapack_complex_float* zwork, int64_t lzwork, + float* work, int64_t lwork, + int64_t* iwork, int64_t liwork); int64_t LAPACKE_zgedmdq_work_64( int matrix_layout, char jobs, char jobz, char jobr, char jobq, char jobt, char jobf, @@ -5795,17 +5798,17 @@ int64_t LAPACKE_zgedmdq_work_64( int matrix_layout, char jobs, char jobz, lapack_complex_double* f, int64_t ldf, lapack_complex_double* x, int64_t ldx, lapack_complex_double* y, int64_t ldy, - int64_t nrnk, double tol, int64_t k, - lapack_complex_double* reig, - lapack_complex_double* imeig, + int64_t nrnk, double* tol, int64_t k, + lapack_complex_double* eigs, lapack_complex_double* z, int64_t ldz, - lapack_complex_double* res, + double* res, lapack_complex_double* b, int64_t ldb, lapack_complex_double* v, int64_t ldv, lapack_complex_double* s, int64_t lds, - lapack_complex_double* work, int64_t lwork, - int64_t* iwork, - int64_t liwork ); + lapack_complex_double* zwork, int64_t lzwork, + double* work, int64_t lwork, + int64_t* iwork, int64_t liwork); + int64_t LAPACKE_sgesv_work_64( int matrix_layout, int64_t n, int64_t nrhs, float* a, int64_t lda, int64_t* ipiv, diff --git a/SRC/cgees.f b/SRC/cgees.f index eea96744fa..b7a4d03124 100644 --- a/SRC/cgees.f +++ b/SRC/cgees.f @@ -238,7 +238,8 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, + $ SLAMCH, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index d09028d7c2..3fdf632907 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -283,7 +283,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/cgeev.f b/SRC/cgeev.f index 0789a785a3..42dc5e2dfc 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -214,15 +214,18 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, CSSCAL, CGEBAK, CGEBAL, - $ CGEHRD, - $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR + EXTERNAL XERBLA, CSSCAL, CGEBAK, + $ CGEBAL, CGEHRD, CHSEQR, + $ CLACPY, CLASCL, CSCAL, + $ CTREVC3, CUNGHR * .. * .. External Functions .. LOGICAL LSAME INTEGER ISAMAX, ILAENV - REAL SLAMCH, SCNRM2, CLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE, + REAL SLAMCH, SCNRM2, CLANGE, + $ SROUNDUP_LWORK + EXTERNAL LSAME, ISAMAX, ILAENV, + $ SLAMCH, SCNRM2, CLANGE, $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index 335df7e3a4..b0fa8c5dc5 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -325,16 +325,19 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SLASCL, XERBLA, CSSCAL, CGEBAK, - $ CGEBAL, - $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, - $ CTRSNA, CUNGHR + EXTERNAL SLASCL, XERBLA, CSSCAL, + $ CGEBAK, CGEBAL, CGEHRD, + $ CHSEQR, CLACPY, CLASCL, + $ CSCAL, CTREVC3, CTRSNA, + $ CUNGHR * .. * .. External Functions .. LOGICAL LSAME INTEGER ISAMAX, ILAENV - REAL SLAMCH, SCNRM2, CLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE, + REAL SLAMCH, SCNRM2, CLANGE, + $ SROUNDUP_LWORK + EXTERNAL LSAME, ISAMAX, ILAENV, + $ SLAMCH, SCNRM2, CLANGE, $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index 8e96a3fa63..b29327280c 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -256,7 +256,8 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. External Functions .. INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL CLANGE, SLAMCH, ILAENV, SROUNDUP_LWORK + EXTERNAL CLANGE, SLAMCH, ILAENV, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC INT, LOG, MAX, MIN, REAL diff --git a/SRC/cgelss.f b/SRC/cgelss.f index 35a6f0a4a5..4ff56efe81 100644 --- a/SRC/cgelss.f +++ b/SRC/cgelss.f @@ -221,7 +221,8 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. External Functions .. INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN diff --git a/SRC/cgelst.f b/SRC/cgelst.f index 138bd41bb1..2528e798ef 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -227,7 +227,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, CLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CGELQT, CGEQRT, CGEMLQT, CGEMQRT, @@ -287,7 +288,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, * Quick return if possible * IF( MIN( M, N, NRHS ).EQ.0 ) THEN - CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, + $ B, LDB ) WORK( 1 ) = SROUNDUP_LWORK( LWOPT ) RETURN END IF @@ -335,7 +337,8 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, * * Matrix all zero. Return zero solution. * - CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, B, LDB ) + CALL CLASET( 'Full', MAX( M, N ), NRHS, CZERO, CZERO, + $ B, LDB ) WORK( 1 ) = SROUNDUP_LWORK( LWOPT ) RETURN END IF diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f index 731c44edb4..8813484cfb 100644 --- a/SRC/cgeqp3rk.f +++ b/SRC/cgeqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== @@ -893,7 +894,8 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Determine when to cross over from blocked to unblocked code. * (for N less than NX, unblocked code should be used). * - NX = MAX( 0, ILAENV( IXOVER, 'CGEQP3RK', ' ', M, N, -1, -1 ) ) + NX = MAX( 0, ILAENV( IXOVER, 'CGEQP3RK', ' ', M, N, -1, + $ -1 ) ) * IF( NX.LT.MINMN ) THEN * diff --git a/SRC/cgesvd.f b/SRC/cgesvd.f index 45d0837244..ff365b3937 100644 --- a/SRC/cgesvd.f +++ b/SRC/cgesvd.f @@ -263,7 +263,8 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index 362e1ded1c..1200af71a1 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -315,7 +315,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, CLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ CLANGE, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index c8012e42e7..9c3d6a20c1 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -193,7 +193,8 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, CLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, CLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, CLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CGEQR, CGEMQR, CLASCL, CLASET, diff --git a/SRC/cgges.f b/SRC/cgges.f index b466d92e5b..2a95ed83d0 100644 --- a/SRC/cgges.f +++ b/SRC/cgges.f @@ -321,7 +321,8 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/cgges3.f b/SRC/cgges3.f index 15955929fa..f231020d9b 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -319,7 +319,8 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * .. External Functions .. LOGICAL LSAME REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/cggesx.f b/SRC/cggesx.f index 47bc54a79d..cf61def12b 100644 --- a/SRC/cggesx.f +++ b/SRC/cggesx.f @@ -382,7 +382,8 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/cggev.f b/SRC/cggev.f index 7d5af2949a..cacc627c3a 100644 --- a/SRC/cggev.f +++ b/SRC/cggev.f @@ -262,7 +262,8 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL, SQRT diff --git a/SRC/cggev3.f b/SRC/cggev3.f index 403d9074dd..7645d8c652 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -262,7 +262,8 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, * .. External Functions .. LOGICAL LSAME REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL, SQRT diff --git a/SRC/cggevx.f b/SRC/cggevx.f index 9009f201bb..08f514690c 100644 --- a/SRC/cggevx.f +++ b/SRC/cggevx.f @@ -425,7 +425,8 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LOGICAL LSAME INTEGER ILAENV REAL CLANGE, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANGE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL, SQRT diff --git a/SRC/chbevd.f b/SRC/chbevd.f index e23d0038c7..c1bc46c2a4 100644 --- a/SRC/chbevd.f +++ b/SRC/chbevd.f @@ -242,7 +242,8 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, * .. External Functions .. LOGICAL LSAME REAL CLANHB, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, CLANHB, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANHB, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CGEMM, CHBTRD, CLACPY, CLASCL, CSTEDC, @@ -292,7 +293,7 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -389,7 +390,7 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF * WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/chbgvd.f b/SRC/chbgvd.f index 064227b840..cb8aef714a 100644 --- a/SRC/chbgvd.f +++ b/SRC/chbgvd.f @@ -327,7 +327,7 @@ SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -394,7 +394,7 @@ SUBROUTINE CHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, END IF * WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/cheev.f b/SRC/cheev.f index 6ddee5e16d..cf0c0e3906 100644 --- a/SRC/cheev.f +++ b/SRC/cheev.f @@ -171,7 +171,8 @@ SUBROUTINE CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LOGICAL LSAME INTEGER ILAENV REAL CLANHE, SLAMCH, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, CLANHE, + $ SLAMCH, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHETRD, CLASCL, CSTEQR, CUNGTR, SSCAL, diff --git a/SRC/cheevd.f b/SRC/cheevd.f index d2e2cad248..366ba1d5a4 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -232,7 +232,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, LOGICAL LSAME INTEGER ILAENV REAL CLANHE, SLAMCH, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHETRD, CLACPY, CLASCL, CSTEDC, CUNMTR, diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 383f4c4f2b..20ecda5ee5 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -398,7 +398,8 @@ SUBROUTINE CHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, LOGICAL LSAME INTEGER ILAENV REAL CLANSY, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, CLANSY, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, CLANSY, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHETRD, CSSCAL, CSTEMR, CSTEIN, CSWAP, diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index 2bca767dc7..d0999bf10d 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -474,10 +474,14 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. $ ( LIWORK.EQ.-1 ) ) * - KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'CHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'CHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'CHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) * IF( N.LE.1 ) THEN LWMIN = 1 @@ -679,7 +683,7 @@ SUBROUTINE CHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 ) CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 ) * - IF ( ABSTOL .LE. TWO*N*EPS ) THEN + IF ( ABSTOL .LE. TWO*REAL( N )*EPS ) THEN TRYRAC = .TRUE. ELSE TRYRAC = .FALSE. diff --git a/SRC/cheevx.f b/SRC/cheevx.f index 805b05e8a4..ad6c2e1d49 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -297,7 +297,8 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, CLANHE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, CLANHE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ CLANHE, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTERF, XERBLA, diff --git a/SRC/chegvd.f b/SRC/chegvd.f index 6c412b4742..865e406a75 100644 --- a/SRC/chegvd.f +++ b/SRC/chegvd.f @@ -321,7 +321,7 @@ SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = SROUNDUP_LWORK(LOPT) - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -398,7 +398,7 @@ SUBROUTINE CHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * WORK( 1 ) = SROUNDUP_LWORK(LOPT) - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/SRC/chesvx.f b/SRC/chesvx.f index 43b4953f30..9d1a204218 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -316,7 +316,8 @@ SUBROUTINE CHESVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, LOGICAL LSAME INTEGER ILAENV REAL CLANHE, SLAMCH, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, CLANHE, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHECON, CHERFS, CHETRF, CHETRS, CLACPY, diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index aa0243f576..a7737b93de 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -131,7 +131,8 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, + $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/chpevd.f b/SRC/chpevd.f index 70614f659e..339f3b8ceb 100644 --- a/SRC/chpevd.f +++ b/SRC/chpevd.f @@ -225,7 +225,8 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, * .. External Functions .. LOGICAL LSAME REAL CLANHP, SLAMCH, SROUNDUP_LWORK - EXTERNAL LSAME, CLANHP, SLAMCH, SROUNDUP_LWORK + EXTERNAL LSAME, CLANHP, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CHPTRD, CSSCAL, CSTEDC, CUPMTR, SSCAL, @@ -272,7 +273,7 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF END IF WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -365,7 +366,7 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF * WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/chpgvd.f b/SRC/chpgvd.f index 23f2de5c47..655269e740 100644 --- a/SRC/chpgvd.f +++ b/SRC/chpgvd.f @@ -297,7 +297,7 @@ SUBROUTINE CHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, END IF * WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -11 @@ -379,7 +379,7 @@ SUBROUTINE CHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, END IF * WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/claqp2rk.f b/SRC/claqp2rk.f index 0501c50bb4..d5e9cb60a8 100644 --- a/SRC/claqp2rk.f +++ b/SRC/claqp2rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqp3rk.f b/SRC/claqp3rk.f index a381c53f88..52d8dd1b06 100644 --- a/SRC/claqp3rk.f +++ b/SRC/claqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b CLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index 357dfae198..95fc743337 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -270,9 +270,10 @@ SUBROUTINE CLATRS3( UPLO, TRANS, DIAG, NORMIN, N, NRHS, A, LDA, * .. External Functions .. LOGICAL LSAME INTEGER ILAENV - REAL SLAMCH, CLANGE, SLARMM, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, CLANGE, SLARMM, + REAL SLAMCH, CLANGE, SLARMM, $ SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, + $ CLANGE, SLARMM, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLATRS, CSSCAL, XERBLA diff --git a/SRC/cstedc.f b/SRC/cstedc.f index 23448b0ea7..aecd2ba909 100644 --- a/SRC/cstedc.f +++ b/SRC/cstedc.f @@ -235,7 +235,8 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANST, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL XERBLA, CLACPY, CLACRM, CLAED0, CSTEQR, @@ -298,7 +299,7 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LIWMIN = 3 + 5*N END IF WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -474,7 +475,7 @@ SUBROUTINE CSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * 70 CONTINUE WORK( 1 ) = SROUNDUP_LWORK(LWMIN) - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/cstemr.f b/SRC/cstemr.f index b75bfd7982..b673307b71 100644 --- a/SRC/cstemr.f +++ b/SRC/cstemr.f @@ -378,7 +378,8 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANST, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANST, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANST, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLARRV, CSWAP, SCOPY, SLAE2, SLAEV2, diff --git a/SRC/csysvx.f b/SRC/csysvx.f index 65c7989d32..5b1a1bdd9a 100644 --- a/SRC/csysvx.f +++ b/SRC/csysvx.f @@ -316,7 +316,8 @@ SUBROUTINE CSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, LOGICAL LSAME INTEGER ILAENV REAL CLANSY, SLAMCH, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, CLANSY, SLAMCH, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, CLANSY, SLAMCH, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL CLACPY, CSYCON, CSYRFS, CSYTRF, CSYTRS, diff --git a/SRC/ctgsna.f b/SRC/ctgsna.f index 2543788305..e78f05094a 100644 --- a/SRC/ctgsna.f +++ b/SRC/ctgsna.f @@ -344,9 +344,11 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * .. * .. External Functions .. LOGICAL LSAME - REAL SCNRM2, SLAMCH, SLAPY2, SROUNDUP_LWORK + REAL SCNRM2, SLAMCH, SLAPY2, + $ SROUNDUP_LWORK COMPLEX CDOTC - EXTERNAL LSAME, SCNRM2, SLAMCH, SLAPY2, SROUNDUP_LWORK, + EXTERNAL LSAME, SCNRM2, SLAMCH, + $ SLAPY2, SROUNDUP_LWORK, $ CDOTC * .. * .. External Subroutines .. diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index ac9ffeecda..ea1154eeca 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -327,7 +327,7 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, NB = ILAENV( 1, 'CTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) MAXWRK = MAX( 1, N + 2*N*NB ) WORK(1) = SROUNDUP_LWORK(MAXWRK) - RWORK(1) = MAX( 1, N ) + RWORK(1) = REAL( MAX( 1, N ) ) LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN INFO = -1 diff --git a/SRC/cunbdb5.f b/SRC/cunbdb5.f index a4b3a12c28..1924ebc129 100644 --- a/SRC/cunbdb5.f +++ b/SRC/cunbdb5.f @@ -228,7 +228,7 @@ SUBROUTINE CUNBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, CALL CLASSQ( M2, X2, INCX2, SCL, SSQ ) NORM = SCL * SQRT( SSQ ) * - IF( NORM .GT. N * EPS ) THEN + IF( NORM .GT. REAL( N ) * EPS ) THEN * Scale vector to unit norm to avoid problems in the caller code. * Computing the reciprocal is undesirable but * * xLASCL cannot be used because of the vector increments and diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f index b8e41b39cd..a9601eca2d 100644 --- a/SRC/dgeqp3rk.f +++ b/SRC/dgeqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== @@ -886,7 +887,8 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Determine when to cross over from blocked to unblocked code. * (for N less than NX, unblocked code should be used). * - NX = MAX( 0, ILAENV( IXOVER, 'DGEQP3RK', ' ', M, N, -1, -1 )) + NX = MAX( 0, ILAENV( IXOVER, 'DGEQP3RK', ' ', M, N, -1, + $ -1 )) * IF( NX.LT.MINMN ) THEN * diff --git a/SRC/dggev3.f b/SRC/dggev3.f index fed1c66696..d113f30bca 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -260,9 +260,10 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, - $ DLACPY, - $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, + $ DGGHD3, DLAQZ0, DLACPY, + $ DLASCL, DLASET, DORGQR, + $ DORMQR, DTGEVC, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -327,8 +328,8 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, IF( INFO.EQ.0 ) THEN CALL DGEQRF( N, N, B, LDB, WORK, WORK, -1, IERR ) LWKOPT = MAX( LWKMIN, 3*N+INT( WORK( 1 ) ) ) - CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, -1, - $ IERR ) + CALL DORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, + $ WORK, -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) IF( ILVL ) THEN CALL DORGQR( N, N, N, VL, LDVL, WORK, WORK, -1, IERR ) diff --git a/SRC/dlaqp2rk.f b/SRC/dlaqp2rk.f index aecd6bb69c..61bca6e919 100644 --- a/SRC/dlaqp2rk.f +++ b/SRC/dlaqp2rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqp3rk.f b/SRC/dlaqp3rk.f index 73926ebd37..8e28ee1282 100644 --- a/SRC/dlaqp3rk.f +++ b/SRC/dlaqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b DLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 5eb29cbed1..23f334f3b1 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -445,10 +445,14 @@ SUBROUTINE DSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) * - KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) * IF( N.LE.1 ) THEN LWMIN = 1 diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f index f12f603d8b..80f8cbf218 100644 --- a/SRC/dsysv_aa.f +++ b/SRC/dsysv_aa.f @@ -198,7 +198,8 @@ SUBROUTINE DSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = 0 LQUERY = ( LWORK.EQ.-1 ) LWKMIN = MAX( 1, 2*N, 3*N-2 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/dsytrd_2stage.f b/SRC/dsytrd_2stage.f index e68282cade..53715502b0 100644 --- a/SRC/dsytrd_2stage.f +++ b/SRC/dsytrd_2stage.f @@ -269,14 +269,18 @@ SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * * Determine the block size, the workspace size and the hous size. * - KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 ) + KD = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, + $ -1 ) IF( N.EQ.0 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index dd74b0990a..7dfec7ae04 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -300,7 +300,8 @@ SUBROUTINE DSYTRD_SY2SB( UPLO, N, KD, A, LDA, AB, LDAB, TAU, IF( N.LE.KD+1 ) THEN LWMIN = 1 ELSE - LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', ' ', N, KD, -1, -1 ) + LWMIN = ILAENV2STAGE( 4, 'DSYTRD_SY2SB', ' ', N, KD, -1, + $ -1 ) END IF * IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 1fe87c1ff1..07bec951b6 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -131,7 +131,8 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE DSYTRF_AA( UPLO, N, A, LDA, IPIV, + $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 38b6dac3c4..199037c41f 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -73,6 +73,7 @@ #define CGEQL2 CGEQL2_64 #define CGEQLF CGEQLF_64 #define CGEQP3 CGEQP3_64 +#define CGEQP3RK CGEQP3RK_64 #define CGEQPF CGEQPF_64 #define CGEQR CGEQR_64 #define CGEQR2 CGEQR2_64 @@ -304,6 +305,8 @@ #define CLAQHE CLAQHE_64 #define CLAQHP CLAQHP_64 #define CLAQP2 CLAQP2_64 +#define CLAQP2RK CLAQP2RK_64 +#define CLAQP3RK CLAQP3RK_64 #define CLAQPS CLAQPS_64 #define CLAQR0 CLAQR0_64 #define CLAQR1 CLAQR1_64 @@ -624,6 +627,7 @@ #define DGEQL2 DGEQL2_64 #define DGEQLF DGEQLF_64 #define DGEQP3 DGEQP3_64 +#define DGEQP3RK DGEQP3RK_64 #define DGEQPF DGEQPF_64 #define DGEQR DGEQR_64 #define DGEQR2 DGEQR2_64 @@ -769,6 +773,8 @@ #define DLAQGB DLAQGB_64 #define DLAQGE DLAQGE_64 #define DLAQP2 DLAQP2_64 +#define DLAQP2RK DLAQP2RK_64 +#define DLAQP3RK DLAQP3RK_64 #define DLAQPS DLAQPS_64 #define DLAQR0 DLAQR0_64 #define DLAQR1 DLAQR1_64 @@ -1209,6 +1215,7 @@ #define SGEQL2 SGEQL2_64 #define SGEQLF SGEQLF_64 #define SGEQP3 SGEQP3_64 +#define SGEQP3RK SGEQP3RK_64 #define SGEQPF SGEQPF_64 #define SGEQR SGEQR_64 #define SGEQR2 SGEQR2_64 @@ -1354,6 +1361,8 @@ #define SLAQGB SLAQGB_64 #define SLAQGE SLAQGE_64 #define SLAQP2 SLAQP2_64 +#define SLAQP2RK SLAQP2RK_64 +#define SLAQP3RK SLAQP3RK_64 #define SLAQPS SLAQPS_64 #define SLAQR0 SLAQR0_64 #define SLAQR1 SLAQR1_64 @@ -1763,6 +1772,7 @@ #define ZGEQL2 ZGEQL2_64 #define ZGEQLF ZGEQLF_64 #define ZGEQP3 ZGEQP3_64 +#define ZGEQP3RK ZGEQP3RK_64 #define ZGEQPF ZGEQPF_64 #define ZGEQR ZGEQR_64 #define ZGEQR2 ZGEQR2_64 @@ -1993,6 +2003,8 @@ #define ZLAQHE ZLAQHE_64 #define ZLAQHP ZLAQHP_64 #define ZLAQP2 ZLAQP2_64 +#define ZLAQP2RK ZLAQP2RK_64 +#define ZLAQP3RK ZLAQP3RK_64 #define ZLAQPS ZLAQPS_64 #define ZLAQR0 ZLAQR0_64 #define ZLAQR1 ZLAQR1_64 diff --git a/SRC/sgees.f b/SRC/sgees.f index cb6306aa26..9765c4f874 100644 --- a/SRC/sgees.f +++ b/SRC/sgees.f @@ -259,7 +259,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index 0b7c5789e7..3ec6fe8eac 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -326,7 +326,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ SLANGE, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT diff --git a/SRC/sgeev.f b/SRC/sgeev.f index d891359a1b..ca0b279a18 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -225,15 +225,18 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, - $ SLARTG, - $ SLASCL, SORGHR, SROT, SSCAL, STREVC3, XERBLA + EXTERNAL SGEBAK, SGEBAL, SGEHRD, + $ SHSEQR, SLACPY, SLARTG, + $ SLASCL, SORGHR, SROT, + $ SSCAL, STREVC3, XERBLA * .. * .. External Functions .. LOGICAL LSAME INTEGER ISAMAX, ILAENV - REAL SLAMCH, SLANGE, SLAPY2, SNRM2, SROUNDUP_LWORK - EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, + REAL SLAMCH, SLANGE, SLAPY2, SNRM2, + $ SROUNDUP_LWORK + EXTERNAL LSAME, ISAMAX, ILAENV, + $ SLAMCH, SLANGE, SLAPY2, $ SNRM2, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index 347465dd92..892029e179 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -351,8 +351,10 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, * .. External Functions .. LOGICAL LSAME INTEGER ISAMAX, ILAENV - REAL SLAMCH, SLANGE, SLAPY2, SNRM2, SROUNDUP_LWORK - EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, + REAL SLAMCH, SLANGE, SLAPY2, + $ SNRM2, SROUNDUP_LWORK + EXTERNAL LSAME, ISAMAX, ILAENV, + $ SLAMCH, SLANGE, SLAPY2, $ SNRM2, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. diff --git a/SRC/sgels.f b/SRC/sgels.f index 41f0ab5190..82944f44e4 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -213,7 +213,8 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGELQF, SGEQRF, SLASCL, SLASET, diff --git a/SRC/sgelsd.f b/SRC/sgelsd.f index 0e3b6e7f3d..2c19d8b553 100644 --- a/SRC/sgelsd.f +++ b/SRC/sgelsd.f @@ -237,7 +237,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, * .. External Functions .. INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL SLAMCH, SLANGE, ILAENV, SROUNDUP_LWORK + EXTERNAL SLAMCH, SLANGE, ILAENV, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC INT, LOG, MAX, MIN, REAL diff --git a/SRC/sgelss.f b/SRC/sgelss.f index 8193fda754..0d5de672f1 100644 --- a/SRC/sgelss.f +++ b/SRC/sgelss.f @@ -210,7 +210,8 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. External Functions .. INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN diff --git a/SRC/sgelst.f b/SRC/sgelst.f index 8c2d7dbff9..c8e2f327bd 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -225,7 +225,8 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGELQT, SGEQRT, SGEMLQT, SGEMQRT, diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index e3ab726a97..df19eed37a 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -237,7 +237,8 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, * .. External Functions .. INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SGEQP3, SLAIC1, SLASCL, diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f index d3a335b88e..74cb689e68 100644 --- a/SRC/sgeqp3rk.f +++ b/SRC/sgeqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== @@ -887,7 +888,8 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Determine when to cross over from blocked to unblocked code. * (for N less than NX, unblocked code should be used). * - NX = MAX( 0, ILAENV( IXOVER, 'SGEQP3RK', ' ', M, N, -1, -1 )) + NX = MAX( 0, ILAENV( IXOVER, 'SGEQP3RK', ' ', M, N, -1, + $ -1 )) * IF( NX.LT.MINMN ) THEN * diff --git a/SRC/sgesvd.f b/SRC/sgesvd.f index 6f3e837454..7a86794848 100644 --- a/SRC/sgesvd.f +++ b/SRC/sgesvd.f @@ -255,7 +255,8 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT diff --git a/SRC/sgesvdx.f b/SRC/sgesvdx.f index e1ac33f52d..994cc54171 100644 --- a/SRC/sgesvdx.f +++ b/SRC/sgesvdx.f @@ -304,7 +304,8 @@ SUBROUTINE SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index c34edfff9c..43cbe225c8 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -190,7 +190,8 @@ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEQR, SGEMQR, SLASCL, SLASET, diff --git a/SRC/sgges.f b/SRC/sgges.f index fd32e85e50..1696df7e4c 100644 --- a/SRC/sgges.f +++ b/SRC/sgges.f @@ -331,7 +331,8 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT diff --git a/SRC/sgges3.f b/SRC/sgges3.f index e75cb79d5b..74b2617fbc 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -329,7 +329,8 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT diff --git a/SRC/sggesx.f b/SRC/sggesx.f index 44cfd45727..8c19cd1a1a 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -415,7 +415,8 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT diff --git a/SRC/sggev.f b/SRC/sggev.f index 0261a30b3d..6b97110f35 100644 --- a/SRC/sggev.f +++ b/SRC/sggev.f @@ -267,7 +267,8 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ SLANGE, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT diff --git a/SRC/sggev3.f b/SRC/sggev3.f index a26e73e40a..758cadabe7 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -260,14 +260,16 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, - $ SLACPY, - $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC + EXTERNAL SGEQRF, SGGBAK, SGGBAL, + $ SGGHD3, SLAQZ0, SLACPY, + $ SLASCL, SLASET, SORGQR, + $ SORMQR, STGEVC * .. * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -330,7 +332,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, CALL SORMQR( 'L', 'T', N, N, N, B, LDB, WORK, A, LDA, WORK, $ -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) - CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, B, LDB, VL, LDVL, + CALL SGGHD3( JOBVL, JOBVR, N, 1, N, A, LDA, + $ B, LDB, VL, LDVL, $ VR, LDVR, WORK, -1, IERR ) LWKOPT = MAX( LWKOPT, 3*N+INT( WORK( 1 ) ) ) IF( ILVL ) THEN @@ -433,7 +436,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, IF( ILVL ) THEN CALL SLASET( 'Full', N, N, ZERO, ONE, VL, LDVL ) IF( IROWS.GT.1 ) THEN - CALL SLACPY( 'L', IROWS-1, IROWS-1, B( ILO+1, ILO ), LDB, + CALL SLACPY( 'L', IROWS-1, IROWS-1, + $ B( ILO+1, ILO ), LDB, $ VL( ILO+1, ILO ), LDVL ) END IF CALL SORGQR( IROWS, IROWS, IROWS, VL( ILO, ILO ), LDVL, @@ -451,11 +455,16 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, * * Eigenvectors requested -- work on whole matrix. * - CALL SGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL, - $ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR ) + CALL SGGHD3( JOBVL, JOBVR, N, ILO, IHI, + $ A, LDA, + $ B, LDB, VL, + $ LDVL, VR, LDVR, + $ WORK( IWRK ), LWORK+1-IWRK, IERR ) ELSE - CALL SGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA, - $ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, + CALL SGGHD3( 'N', 'N', IROWS, 1, IROWS, + $ A( ILO, ILO ), LDA, + $ B( ILO, ILO ), LDB, VL, + $ LDVL, VR, LDVR, $ WORK( IWRK ), LWORK+1-IWRK, IERR ) END IF * diff --git a/SRC/sggevx.f b/SRC/sggevx.f index 6bd5f92f0b..52362c236e 100644 --- a/SRC/sggevx.f +++ b/SRC/sggevx.f @@ -438,7 +438,8 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ SLANGE, SROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index e78d6a3041..ce398ed5af 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -374,7 +374,8 @@ SUBROUTINE SGGSVD3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANGE, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANGE, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SGGSVP3, STGSJA, XERBLA diff --git a/SRC/shgeqz.f b/SRC/shgeqz.f index 9665cfe853..5084bbf6ce 100644 --- a/SRC/shgeqz.f +++ b/SRC/shgeqz.f @@ -348,9 +348,10 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, * .. * .. External Functions .. LOGICAL LSAME - REAL SLAMCH, SLANHS, SLAPY2, SLAPY3, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANHS, SLAPY2, SLAPY3, - $ SROUNDUP_LWORK + REAL SLAMCH, SLANHS, SLAPY2, + $ SLAPY3, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANHS, + $ SLAPY2, SLAPY3, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SLAG2, SLARFG, SLARTG, SLASET, SLASV2, diff --git a/SRC/slaqp2rk.f b/SRC/slaqp2rk.f index f88b0ce909..f1c5724103 100644 --- a/SRC/slaqp2rk.f +++ b/SRC/slaqp2rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqp3rk.f b/SRC/slaqp3rk.f index 08b8bfcbdd..4e912a4744 100644 --- a/SRC/slaqp3rk.f +++ b/SRC/slaqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b SLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb5.f b/SRC/sorbdb5.f index 525189888b..7dd03aaf6f 100644 --- a/SRC/sorbdb5.f +++ b/SRC/sorbdb5.f @@ -228,7 +228,7 @@ SUBROUTINE SORBDB5( M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, CALL SLASSQ( M2, X2, INCX2, SCL, SSQ ) NORM = SCL * SQRT( SSQ ) * - IF( NORM .GT. N * EPS ) THEN + IF( NORM .GT. REAL( N ) * EPS ) THEN * Scale vector to unit norm to avoid problems in the caller code. * Computing the reciprocal is undesirable but * * xLASCL cannot be used because of the vector increments and diff --git a/SRC/ssbevd.f b/SRC/ssbevd.f index 909832b792..e1b7818cbf 100644 --- a/SRC/ssbevd.f +++ b/SRC/ssbevd.f @@ -216,7 +216,8 @@ SUBROUTINE SSBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANSB, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANSB, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANSB, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEMM, SLACPY, SLASCL, SSBTRD, SSCAL, diff --git a/SRC/sspevd.f b/SRC/sspevd.f index 0044ec8e5f..5fa0c86ad8 100644 --- a/SRC/sspevd.f +++ b/SRC/sspevd.f @@ -200,7 +200,8 @@ SUBROUTINE SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANSP, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANSP, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANSP, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SOPMTR, SSCAL, SSPTRD, SSTEDC, SSTERF, diff --git a/SRC/sstedc.f b/SRC/sstedc.f index 0f854e9e1f..c8d16c63ce 100644 --- a/SRC/sstedc.f +++ b/SRC/sstedc.f @@ -210,7 +210,8 @@ SUBROUTINE SSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANST, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, SLANST, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SGEMM, SLACPY, SLAED0, SLASCL, SLASET, diff --git a/SRC/sstevd.f b/SRC/sstevd.f index 676f44120b..690304c945 100644 --- a/SRC/sstevd.f +++ b/SRC/sstevd.f @@ -184,7 +184,8 @@ SUBROUTINE SSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANST, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANST, SROUNDUP_LWORK + EXTERNAL LSAME, SLAMCH, SLANST, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SSCAL, SSTEDC, SSTERF, XERBLA diff --git a/SRC/sstevr.f b/SRC/sstevr.f index f5bd9ef09c..c34c0904b1 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -339,7 +339,8 @@ SUBROUTINE SSTEVR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANST, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANST, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, SLANST, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SSCAL, SSTEBZ, SSTEMR, SSTEIN, diff --git a/SRC/ssyev.f b/SRC/ssyev.f index b23d3ad94d..dd0700610f 100644 --- a/SRC/ssyev.f +++ b/SRC/ssyev.f @@ -160,7 +160,8 @@ SUBROUTINE SSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, + $ SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SLASCL, SORGTR, SSCAL, SSTEQR, SSTERF, diff --git a/SRC/ssyevd.f b/SRC/ssyevd.f index 5b511d9513..9141d29155 100644 --- a/SRC/ssyevd.f +++ b/SRC/ssyevd.f @@ -206,7 +206,8 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, + $ SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SLACPY, SLASCL, SORMTR, SSCAL, SSTEDC, diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 453682fd86..87d59add43 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -373,7 +373,8 @@ SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SORMTR, SSCAL, SSTEBZ, SSTEMR, diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 9a0b949831..2a98d46d7a 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -420,7 +420,8 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LOGICAL LSAME INTEGER ILAENV, ILAENV2STAGE REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK, ILAENV, + EXTERNAL LSAME, SLAMCH, SLANSY, + $ SROUNDUP_LWORK, ILAENV, $ ILAENV2STAGE * .. * .. External Subroutines .. @@ -445,10 +446,14 @@ SUBROUTINE SSYEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LIWORK.EQ.-1 ) ) * - KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) * IF( N.LE.1 ) THEN LWMIN = 1 diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index 35ffb1366d..bac5620ff0 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -288,7 +288,8 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL LSAME, ILAENV, SLAMCH, SLANSY, SROUNDUP_LWORK + EXTERNAL LSAME, ILAENV, SLAMCH, + $ SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SCOPY, SLACPY, SORGTR, SORMTR, SSCAL, diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f index 7e3a7f8dd8..d95e854577 100644 --- a/SRC/ssysv_aa.f +++ b/SRC/ssysv_aa.f @@ -199,7 +199,8 @@ SUBROUTINE SSYSV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = 0 LQUERY = ( LWORK.EQ.-1 ) LWKMIN = MAX( 1, 2*N, 3*N-2 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/ssysvx.f b/SRC/ssysvx.f index e809e9101d..7734a31a08 100644 --- a/SRC/ssysvx.f +++ b/SRC/ssysvx.f @@ -314,7 +314,8 @@ SUBROUTINE SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, LOGICAL LSAME INTEGER ILAENV REAL SLAMCH, SLANSY, SROUNDUP_LWORK - EXTERNAL ILAENV, LSAME, SLAMCH, SLANSY, SROUNDUP_LWORK + EXTERNAL ILAENV, LSAME, SLAMCH, + $ SLANSY, SROUNDUP_LWORK * .. * .. External Subroutines .. EXTERNAL SLACPY, SSYCON, SSYRFS, SSYTRF, SSYTRS, diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f index ecf668df6c..45e990c1ae 100644 --- a/SRC/ssytrd_2stage.f +++ b/SRC/ssytrd_2stage.f @@ -268,14 +268,18 @@ SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * * Determine the block size, the workspace size and the hous size. * - KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', VECT, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', VECT, N, KD, -1, -1 ) + KD = ILAENV2STAGE( 1, 'SSYTRD_2STAGE', VECT, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'SSYTRD_2STAGE', VECT, N, KD, -1, + $ -1 ) IF( N.EQ.0 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'SSYTRD_2STAGE', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'SSYTRD_2STAGE', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN @@ -332,7 +336,7 @@ SUBROUTINE SSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, END IF * * - WORK( 1 ) = LWMIN + WORK( 1 ) = REAL( LWMIN ) RETURN * * End of SSYTRD_2STAGE diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index 3fc35d7c1c..1d106d830d 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -131,7 +131,8 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE SSYTRF_AA( UPLO, N, A, LDA, IPIV, + $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/stgsna.f b/SRC/stgsna.f index d8580bbf4b..d7ff2592af 100644 --- a/SRC/stgsna.f +++ b/SRC/stgsna.f @@ -417,13 +417,15 @@ SUBROUTINE STGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, * .. * .. External Functions .. LOGICAL LSAME - REAL SDOT, SLAMCH, SLAPY2, SNRM2, SROUNDUP_LWORK - EXTERNAL LSAME, SDOT, SLAMCH, SLAPY2, SNRM2, + REAL SDOT, SLAMCH, SLAPY2, + $ SNRM2, SROUNDUP_LWORK + EXTERNAL LSAME, SDOT, SLAMCH, + $ SLAPY2, SNRM2, $ SROUNDUP_LWORK * .. * .. External Subroutines .. - EXTERNAL SGEMV, SLACPY, SLAG2, STGEXC, STGSYL, - $ XERBLA + EXTERNAL SGEMV, SLACPY, SLAG2, + $ STGEXC, STGSYL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, SQRT diff --git a/SRC/zgeqp3rk.f b/SRC/zgeqp3rk.f index 01dcce0ded..92e5995f51 100644 --- a/SRC/zgeqp3rk.f +++ b/SRC/zgeqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== @@ -892,7 +893,8 @@ SUBROUTINE ZGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Determine when to cross over from blocked to unblocked code. * (for N less than NX, unblocked code should be used). * - NX = MAX( 0, ILAENV( IXOVER, 'ZGEQP3RK', ' ', M, N, -1, -1 ) ) + NX = MAX( 0, ILAENV( IXOVER, 'ZGEQP3RK', ' ', M, N, -1, + $ -1 ) ) * IF( NX.LT.MINMN ) THEN * diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index eceaf2b9b3..47338710fb 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -477,7 +477,7 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, RETURN ELSE IF( LQUERY ) THEN CWORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) RETURN END IF * diff --git a/SRC/zhbevd.f b/SRC/zhbevd.f index 74e8cf8925..e7cc945de5 100644 --- a/SRC/zhbevd.f +++ b/SRC/zhbevd.f @@ -292,7 +292,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -389,7 +389,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/zhbevd_2stage.f b/SRC/zhbevd_2stage.f index 3201c41f19..bcf6375d98 100644 --- a/SRC/zhbevd_2stage.f +++ b/SRC/zhbevd_2stage.f @@ -347,7 +347,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -449,7 +449,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/zhbgvd.f b/SRC/zhbgvd.f index 781850d83b..9324b892d2 100644 --- a/SRC/zhbgvd.f +++ b/SRC/zhbgvd.f @@ -326,7 +326,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -393,7 +393,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/zheevd.f b/SRC/zheevd.f index 2a6a4c8e41..be776df585 100644 --- a/SRC/zheevd.f +++ b/SRC/zheevd.f @@ -286,7 +286,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, LIOPT = LIWMIN END IF WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -382,7 +382,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, END IF * WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/SRC/zheevd_2stage.f b/SRC/zheevd_2stage.f index 094babbf73..781255eb30 100644 --- a/SRC/zheevd_2stage.f +++ b/SRC/zheevd_2stage.f @@ -340,7 +340,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, END IF END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -439,7 +439,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 8d9fc10dac..16382d8969 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -467,7 +467,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) ) LWKOPT = MAX( ( NB+1 )*N, LWMIN ) WORK( 1 ) = LWKOPT - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -724,7 +724,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, * Set WORK(1) to optimal workspace size. * WORK( 1 ) = LWKOPT - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index 09b8c58999..5cb32e637b 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -474,10 +474,14 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, LQUERY = ( ( LWORK.EQ.-1 ) .OR. ( LRWORK.EQ.-1 ) .OR. $ ( LIWORK.EQ.-1 ) ) * - KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, -1 ) - LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) - LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, -1 ) + KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', JOBZ, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', JOBZ, N, KD, -1, + $ -1 ) + LHTRD = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) + LWTRD = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', JOBZ, N, KD, IB, + $ -1 ) * IF( N.LE.1 ) THEN LWMIN = 1 @@ -520,7 +524,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -780,7 +784,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, * Set WORK(1) to optimal workspace size. * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN diff --git a/SRC/zhegvd.f b/SRC/zhegvd.f index 34767c36a1..a4033115cf 100644 --- a/SRC/zhegvd.f +++ b/SRC/zhegvd.f @@ -320,7 +320,7 @@ SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, * IF( INFO.EQ.0 ) THEN WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -397,7 +397,7 @@ SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, END IF * WORK( 1 ) = LOPT - RWORK( 1 ) = LROPT + RWORK( 1 ) = REAL( LROPT ) IWORK( 1 ) = LIOPT * RETURN diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f index 6eb2dff814..2165625803 100644 --- a/SRC/zhesv_aa.f +++ b/SRC/zhesv_aa.f @@ -198,7 +198,8 @@ SUBROUTINE ZHESV_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO = 0 LQUERY = ( LWORK.EQ.-1 ) LWKMIN = MAX( 1, 2*N, 3*N-2 ) - IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN + IF( .NOT.LSAME( UPLO, 'U' ) .AND. + $ .NOT.LSAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 diff --git a/SRC/zhetrd_2stage.f b/SRC/zhetrd_2stage.f index 39bdd5e100..8163b18133 100644 --- a/SRC/zhetrd_2stage.f +++ b/SRC/zhetrd_2stage.f @@ -269,14 +269,18 @@ SUBROUTINE ZHETRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, * * Determine the block size, the workspace size and the hous size. * - KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, -1 ) - IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, -1 ) + KD = ILAENV2STAGE( 1, 'ZHETRD_2STAGE', VECT, N, -1, -1, + $ -1 ) + IB = ILAENV2STAGE( 2, 'ZHETRD_2STAGE', VECT, N, KD, -1, + $ -1 ) IF( N.EQ.0 ) THEN LHMIN = 1 LWMIN = 1 ELSE - LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) - LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, -1 ) + LHMIN = ILAENV2STAGE( 3, 'ZHETRD_2STAGE', VECT, N, KD, IB, + $ -1 ) + LWMIN = ILAENV2STAGE( 4, 'ZHETRD_2STAGE', VECT, N, KD, IB, + $ -1 ) END IF * IF( .NOT.LSAME( VECT, 'N' ) ) THEN diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index e27908afa1..d1b2264e18 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -131,7 +131,8 @@ *> \ingroup hetrf_aa * * ===================================================================== - SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) + SUBROUTINE ZHETRF_AA( UPLO, N, A, LDA, IPIV, + $ WORK, LWORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/zhpevd.f b/SRC/zhpevd.f index 4e47b3dd27..468974dc1c 100644 --- a/SRC/zhpevd.f +++ b/SRC/zhpevd.f @@ -272,7 +272,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -365,7 +365,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/zhpgvd.f b/SRC/zhpgvd.f index b73cdda1ef..21b7a18a04 100644 --- a/SRC/zhpgvd.f +++ b/SRC/zhpgvd.f @@ -296,7 +296,7 @@ SUBROUTINE ZHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN INFO = -11 @@ -378,7 +378,7 @@ SUBROUTINE ZHPGVD( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, END IF * WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN RETURN * diff --git a/SRC/zlaqp2rk.f b/SRC/zlaqp2rk.f index f6bf555c26..035799b3d2 100644 --- a/SRC/zlaqp2rk.f +++ b/SRC/zlaqp2rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqp3rk.f b/SRC/zlaqp3rk.f index 28bc517c3c..df56bcffed 100644 --- a/SRC/zlaqp3rk.f +++ b/SRC/zlaqp3rk.f @@ -1,3 +1,4 @@ +#include "lapack_64.h" *> \brief \b ZLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/zstedc.f b/SRC/zstedc.f index ab6e3f1568..e148dde235 100644 --- a/SRC/zstedc.f +++ b/SRC/zstedc.f @@ -298,7 +298,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LIWMIN = 3 + 5*N END IF WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN @@ -474,7 +474,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, * 70 CONTINUE WORK( 1 ) = LWMIN - RWORK( 1 ) = LRWMIN + RWORK( 1 ) = REAL( LRWMIN ) IWORK( 1 ) = LIWMIN * RETURN From 40ca7a2713677af81b05a55db3fb82ef4b011323 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 2 Jan 2024 17:03:05 -0800 Subject: [PATCH 049/206] Include lapack_64.h only during the build --- INSTALL/dlamch.f | 1 - INSTALL/droundup_lwork.f | 1 - INSTALL/ilaver.f | 1 - INSTALL/lsame.f | 1 - INSTALL/slamch.f | 1 - INSTALL/sroundup_lwork.f | 1 - SRC/CMakeLists.txt | 13 ++++++++++--- SRC/cbbcsd.f | 1 - SRC/cbdsqr.f | 1 - SRC/cgbbrd.f | 1 - SRC/cgbcon.f | 1 - SRC/cgbequ.f | 1 - SRC/cgbequb.f | 1 - SRC/cgbrfs.f | 1 - SRC/cgbrfsx.f | 1 - SRC/cgbsv.f | 1 - SRC/cgbsvx.f | 1 - SRC/cgbsvxx.f | 1 - SRC/cgbtf2.f | 1 - SRC/cgbtrf.f | 1 - SRC/cgbtrs.f | 1 - SRC/cgebak.f | 1 - SRC/cgebal.f | 1 - SRC/cgebd2.f | 1 - SRC/cgebrd.f | 1 - SRC/cgecon.f | 1 - SRC/cgedmd.f90 | 1 - SRC/cgedmdq.f90 | 1 - SRC/cgeequ.f | 1 - SRC/cgeequb.f | 1 - SRC/cgees.f | 1 - SRC/cgeesx.f | 1 - SRC/cgeev.f | 1 - SRC/cgeevx.f | 1 - SRC/cgehd2.f | 1 - SRC/cgehrd.f | 1 - SRC/cgejsv.f | 1 - SRC/cgelq.f | 1 - SRC/cgelq2.f | 1 - SRC/cgelqf.f | 1 - SRC/cgelqt.f | 1 - SRC/cgelqt3.f | 1 - SRC/cgels.f | 1 - SRC/cgelsd.f | 1 - SRC/cgelss.f | 1 - SRC/cgelst.f | 1 - SRC/cgelsy.f | 1 - SRC/cgemlq.f | 1 - SRC/cgemlqt.f | 1 - SRC/cgemqr.f | 1 - SRC/cgemqrt.f | 1 - SRC/cgeql2.f | 1 - SRC/cgeqlf.f | 1 - SRC/cgeqp3.f | 1 - SRC/cgeqp3rk.f | 1 - SRC/cgeqr.f | 1 - SRC/cgeqr2.f | 1 - SRC/cgeqr2p.f | 1 - SRC/cgeqrf.f | 1 - SRC/cgeqrfp.f | 1 - SRC/cgeqrt.f | 1 - SRC/cgeqrt2.f | 1 - SRC/cgeqrt3.f | 1 - SRC/cgerfs.f | 1 - SRC/cgerfsx.f | 1 - SRC/cgerq2.f | 1 - SRC/cgerqf.f | 1 - SRC/cgesc2.f | 1 - SRC/cgesdd.f | 1 - SRC/cgesv.f | 1 - SRC/cgesvd.f | 1 - SRC/cgesvdq.f | 1 - SRC/cgesvdx.f | 1 - SRC/cgesvj.f | 1 - SRC/cgesvx.f | 1 - SRC/cgesvxx.f | 1 - SRC/cgetc2.f | 1 - SRC/cgetf2.f | 1 - SRC/cgetrf.f | 1 - SRC/cgetrf2.f | 1 - SRC/cgetri.f | 1 - SRC/cgetrs.f | 1 - SRC/cgetsls.f | 1 - SRC/cgetsqrhrt.f | 1 - SRC/cggbak.f | 1 - SRC/cggbal.f | 1 - SRC/cgges.f | 1 - SRC/cgges3.f | 1 - SRC/cggesx.f | 1 - SRC/cggev.f | 1 - SRC/cggev3.f | 1 - SRC/cggevx.f | 1 - SRC/cggglm.f | 1 - SRC/cgghd3.f | 1 - SRC/cgghrd.f | 1 - SRC/cgglse.f | 1 - SRC/cggqrf.f | 1 - SRC/cggrqf.f | 1 - SRC/cggsvd3.f | 1 - SRC/cggsvp3.f | 1 - SRC/cgsvj0.f | 1 - SRC/cgsvj1.f | 1 - SRC/cgtcon.f | 1 - SRC/cgtrfs.f | 1 - SRC/cgtsv.f | 1 - SRC/cgtsvx.f | 1 - SRC/cgttrf.f | 1 - SRC/cgttrs.f | 1 - SRC/cgtts2.f | 1 - SRC/chb2st_kernels.f | 1 - SRC/chbev.f | 1 - SRC/chbev_2stage.f | 1 - SRC/chbevd.f | 1 - SRC/chbevd_2stage.f | 1 - SRC/chbevx.f | 1 - SRC/chbevx_2stage.f | 1 - SRC/chbgst.f | 1 - SRC/chbgv.f | 1 - SRC/chbgvd.f | 1 - SRC/chbgvx.f | 1 - SRC/chbtrd.f | 1 - SRC/checon.f | 1 - SRC/checon_3.f | 1 - SRC/checon_rook.f | 1 - SRC/cheequb.f | 1 - SRC/cheev.f | 1 - SRC/cheev_2stage.f | 1 - SRC/cheevd.f | 1 - SRC/cheevd_2stage.f | 1 - SRC/cheevr.f | 1 - SRC/cheevr_2stage.f | 1 - SRC/cheevx.f | 1 - SRC/cheevx_2stage.f | 1 - SRC/chegs2.f | 1 - SRC/chegst.f | 1 - SRC/chegv.f | 1 - SRC/chegv_2stage.f | 1 - SRC/chegvd.f | 1 - SRC/chegvx.f | 1 - SRC/cherfs.f | 1 - SRC/cherfsx.f | 1 - SRC/chesv.f | 1 - SRC/chesv_aa.f | 1 - SRC/chesv_aa_2stage.f | 1 - SRC/chesv_rk.f | 1 - SRC/chesv_rook.f | 1 - SRC/chesvx.f | 1 - SRC/chesvxx.f | 1 - SRC/cheswapr.f | 1 - SRC/chetd2.f | 1 - SRC/chetf2.f | 1 - SRC/chetf2_rk.f | 1 - SRC/chetf2_rook.f | 1 - SRC/chetrd.f | 1 - SRC/chetrd_2stage.f | 1 - SRC/chetrd_he2hb.f | 1 - SRC/chetrf.f | 1 - SRC/chetrf_aa.f | 1 - SRC/chetrf_aa_2stage.f | 1 - SRC/chetrf_rk.f | 1 - SRC/chetrf_rook.f | 1 - SRC/chetri.f | 1 - SRC/chetri2.f | 1 - SRC/chetri2x.f | 1 - SRC/chetri_3.f | 1 - SRC/chetri_3x.f | 1 - SRC/chetri_rook.f | 1 - SRC/chetrs.f | 1 - SRC/chetrs2.f | 1 - SRC/chetrs_3.f | 1 - SRC/chetrs_aa.f | 1 - SRC/chetrs_aa_2stage.f | 1 - SRC/chetrs_rook.f | 1 - SRC/chfrk.f | 1 - SRC/chgeqz.f | 1 - SRC/chla_transtype.f | 1 - SRC/chpcon.f | 1 - SRC/chpev.f | 1 - SRC/chpevd.f | 1 - SRC/chpevx.f | 1 - SRC/chpgst.f | 1 - SRC/chpgv.f | 1 - SRC/chpgvd.f | 1 - SRC/chpgvx.f | 1 - SRC/chprfs.f | 1 - SRC/chpsv.f | 1 - SRC/chpsvx.f | 1 - SRC/chptrd.f | 1 - SRC/chptrf.f | 1 - SRC/chptri.f | 1 - SRC/chptrs.f | 1 - SRC/chsein.f | 1 - SRC/chseqr.f | 1 - SRC/cla_gbamv.f | 1 - SRC/cla_gbrcond_c.f | 1 - SRC/cla_gbrcond_x.f | 1 - SRC/cla_gbrfsx_extended.f | 1 - SRC/cla_gbrpvgrw.f | 1 - SRC/cla_geamv.f | 1 - SRC/cla_gercond_c.f | 1 - SRC/cla_gercond_x.f | 1 - SRC/cla_gerfsx_extended.f | 1 - SRC/cla_gerpvgrw.f | 1 - SRC/cla_heamv.f | 1 - SRC/cla_hercond_c.f | 1 - SRC/cla_hercond_x.f | 1 - SRC/cla_herfsx_extended.f | 1 - SRC/cla_herpvgrw.f | 1 - SRC/cla_lin_berr.f | 1 - SRC/cla_porcond_c.f | 1 - SRC/cla_porcond_x.f | 1 - SRC/cla_porfsx_extended.f | 1 - SRC/cla_porpvgrw.f | 1 - SRC/cla_syamv.f | 1 - SRC/cla_syrcond_c.f | 1 - SRC/cla_syrcond_x.f | 1 - SRC/cla_syrfsx_extended.f | 1 - SRC/cla_syrpvgrw.f | 1 - SRC/cla_wwaddw.f | 1 - SRC/clabrd.f | 1 - SRC/clacgv.f | 1 - SRC/clacn2.f | 1 - SRC/clacon.f | 1 - SRC/clacp2.f | 1 - SRC/clacpy.f | 1 - SRC/clacrm.f | 1 - SRC/clacrt.f | 1 - SRC/cladiv.f | 1 - SRC/claed0.f | 1 - SRC/claed7.f | 1 - SRC/claed8.f | 1 - SRC/claein.f | 1 - SRC/claesy.f | 1 - SRC/claev2.f | 1 - SRC/clag2z.f | 1 - SRC/clags2.f | 1 - SRC/clagtm.f | 1 - SRC/clahef.f | 1 - SRC/clahef_aa.f | 1 - SRC/clahef_rk.f | 1 - SRC/clahef_rook.f | 1 - SRC/clahqr.f | 1 - SRC/clahr2.f | 1 - SRC/claic1.f | 1 - SRC/clals0.f | 1 - SRC/clalsa.f | 1 - SRC/clalsd.f | 1 - SRC/clamswlq.f | 1 - SRC/clamtsqr.f | 1 - SRC/clangb.f | 1 - SRC/clange.f | 1 - SRC/clangt.f | 1 - SRC/clanhb.f | 1 - SRC/clanhe.f | 1 - SRC/clanhf.f | 1 - SRC/clanhp.f | 1 - SRC/clanhs.f | 1 - SRC/clanht.f | 1 - SRC/clansb.f | 1 - SRC/clansp.f | 1 - SRC/clansy.f | 1 - SRC/clantb.f | 1 - SRC/clantp.f | 1 - SRC/clantr.f | 1 - SRC/clapll.f | 1 - SRC/clapmr.f | 1 - SRC/clapmt.f | 1 - SRC/claqgb.f | 1 - SRC/claqge.f | 1 - SRC/claqhb.f | 1 - SRC/claqhe.f | 1 - SRC/claqhp.f | 1 - SRC/claqp2.f | 1 - SRC/claqp2rk.f | 1 - SRC/claqp3rk.f | 1 - SRC/claqps.f | 1 - SRC/claqr0.f | 1 - SRC/claqr1.f | 1 - SRC/claqr2.f | 1 - SRC/claqr3.f | 1 - SRC/claqr4.f | 1 - SRC/claqr5.f | 1 - SRC/claqsb.f | 1 - SRC/claqsp.f | 1 - SRC/claqsy.f | 1 - SRC/claqz0.f | 1 - SRC/claqz1.f | 1 - SRC/claqz2.f | 1 - SRC/claqz3.f | 1 - SRC/clar1v.f | 1 - SRC/clar2v.f | 1 - SRC/clarcm.f | 1 - SRC/clarf.f | 1 - SRC/clarfb.f | 1 - SRC/clarfb_gett.f | 1 - SRC/clarfg.f | 1 - SRC/clarfgp.f | 1 - SRC/clarft.f | 1 - SRC/clarfx.f | 1 - SRC/clarfy.f | 1 - SRC/clargv.f | 1 - SRC/clarnv.f | 1 - SRC/clarrv.f | 1 - SRC/clarscl2.f | 1 - SRC/clartg.f90 | 1 - SRC/clartv.f | 1 - SRC/clarz.f | 1 - SRC/clarzb.f | 1 - SRC/clarzt.f | 1 - SRC/clascl.f | 1 - SRC/clascl2.f | 1 - SRC/claset.f | 1 - SRC/clasr.f | 1 - SRC/classq.f90 | 1 - SRC/claswlq.f | 1 - SRC/claswp.f | 1 - SRC/clasyf.f | 1 - SRC/clasyf_aa.f | 1 - SRC/clasyf_rk.f | 1 - SRC/clasyf_rook.f | 1 - SRC/clatbs.f | 1 - SRC/clatdf.f | 1 - SRC/clatps.f | 1 - SRC/clatrd.f | 1 - SRC/clatrs.f | 1 - SRC/clatrs3.f | 1 - SRC/clatrz.f | 1 - SRC/clatsqr.f | 1 - SRC/claunhr_col_getrfnp.f | 1 - SRC/claunhr_col_getrfnp2.f | 1 - SRC/clauu2.f | 1 - SRC/clauum.f | 1 - SRC/cpbcon.f | 1 - SRC/cpbequ.f | 1 - SRC/cpbrfs.f | 1 - SRC/cpbstf.f | 1 - SRC/cpbsv.f | 1 - SRC/cpbsvx.f | 1 - SRC/cpbtf2.f | 1 - SRC/cpbtrf.f | 1 - SRC/cpbtrs.f | 1 - SRC/cpftrf.f | 1 - SRC/cpftri.f | 1 - SRC/cpftrs.f | 1 - SRC/cpocon.f | 1 - SRC/cpoequ.f | 1 - SRC/cpoequb.f | 1 - SRC/cporfs.f | 1 - SRC/cporfsx.f | 1 - SRC/cposv.f | 1 - SRC/cposvx.f | 1 - SRC/cposvxx.f | 1 - SRC/cpotf2.f | 1 - SRC/cpotrf.f | 1 - SRC/cpotrf2.f | 1 - SRC/cpotri.f | 1 - SRC/cpotrs.f | 1 - SRC/cppcon.f | 1 - SRC/cppequ.f | 1 - SRC/cpprfs.f | 1 - SRC/cppsv.f | 1 - SRC/cppsvx.f | 1 - SRC/cpptrf.f | 1 - SRC/cpptri.f | 1 - SRC/cpptrs.f | 1 - SRC/cpstf2.f | 1 - SRC/cpstrf.f | 1 - SRC/cptcon.f | 1 - SRC/cpteqr.f | 1 - SRC/cptrfs.f | 1 - SRC/cptsv.f | 1 - SRC/cptsvx.f | 1 - SRC/cpttrf.f | 1 - SRC/cpttrs.f | 1 - SRC/cptts2.f | 1 - SRC/crot.f | 1 - SRC/crscl.f | 1 - SRC/cspcon.f | 1 - SRC/cspmv.f | 1 - SRC/cspr.f | 1 - SRC/csprfs.f | 1 - SRC/cspsv.f | 1 - SRC/cspsvx.f | 1 - SRC/csptrf.f | 1 - SRC/csptri.f | 1 - SRC/csptrs.f | 1 - SRC/csrscl.f | 1 - SRC/cstedc.f | 1 - SRC/cstegr.f | 1 - SRC/cstein.f | 1 - SRC/cstemr.f | 1 - SRC/csteqr.f | 1 - SRC/csycon.f | 1 - SRC/csycon_3.f | 1 - SRC/csycon_rook.f | 1 - SRC/csyconv.f | 1 - SRC/csyconvf.f | 1 - SRC/csyconvf_rook.f | 1 - SRC/csyequb.f | 1 - SRC/csymv.f | 1 - SRC/csyr.f | 1 - SRC/csyrfs.f | 1 - SRC/csyrfsx.f | 1 - SRC/csysv.f | 1 - SRC/csysv_aa.f | 1 - SRC/csysv_aa_2stage.f | 1 - SRC/csysv_rk.f | 1 - SRC/csysv_rook.f | 1 - SRC/csysvx.f | 1 - SRC/csysvxx.f | 1 - SRC/csyswapr.f | 1 - SRC/csytf2.f | 1 - SRC/csytf2_rk.f | 1 - SRC/csytf2_rook.f | 1 - SRC/csytrf.f | 1 - SRC/csytrf_aa.f | 1 - SRC/csytrf_aa_2stage.f | 1 - SRC/csytrf_rk.f | 1 - SRC/csytrf_rook.f | 1 - SRC/csytri.f | 1 - SRC/csytri2.f | 1 - SRC/csytri2x.f | 1 - SRC/csytri_3.f | 1 - SRC/csytri_3x.f | 1 - SRC/csytri_rook.f | 1 - SRC/csytrs.f | 1 - SRC/csytrs2.f | 1 - SRC/csytrs_3.f | 1 - SRC/csytrs_aa.f | 1 - SRC/csytrs_aa_2stage.f | 1 - SRC/csytrs_rook.f | 1 - SRC/ctbcon.f | 1 - SRC/ctbrfs.f | 1 - SRC/ctbtrs.f | 1 - SRC/ctfsm.f | 1 - SRC/ctftri.f | 1 - SRC/ctfttp.f | 1 - SRC/ctfttr.f | 1 - SRC/ctgevc.f | 1 - SRC/ctgex2.f | 1 - SRC/ctgexc.f | 1 - SRC/ctgsen.f | 1 - SRC/ctgsja.f | 1 - SRC/ctgsna.f | 1 - SRC/ctgsy2.f | 1 - SRC/ctgsyl.f | 1 - SRC/ctpcon.f | 1 - SRC/ctplqt.f | 1 - SRC/ctplqt2.f | 1 - SRC/ctpmlqt.f | 1 - SRC/ctpmqrt.f | 1 - SRC/ctpqrt.f | 1 - SRC/ctpqrt2.f | 1 - SRC/ctprfb.f | 1 - SRC/ctprfs.f | 1 - SRC/ctptri.f | 1 - SRC/ctptrs.f | 1 - SRC/ctpttf.f | 1 - SRC/ctpttr.f | 1 - SRC/ctrcon.f | 1 - SRC/ctrevc.f | 1 - SRC/ctrevc3.f | 1 - SRC/ctrexc.f | 1 - SRC/ctrrfs.f | 1 - SRC/ctrsen.f | 1 - SRC/ctrsna.f | 1 - SRC/ctrsyl.f | 1 - SRC/ctrsyl3.f | 1 - SRC/ctrti2.f | 1 - SRC/ctrtri.f | 1 - SRC/ctrtrs.f | 1 - SRC/ctrttf.f | 1 - SRC/ctrttp.f | 1 - SRC/ctzrzf.f | 1 - SRC/cunbdb.f | 1 - SRC/cunbdb1.f | 1 - SRC/cunbdb2.f | 1 - SRC/cunbdb3.f | 1 - SRC/cunbdb4.f | 1 - SRC/cunbdb5.f | 1 - SRC/cunbdb6.f | 1 - SRC/cuncsd.f | 1 - SRC/cuncsd2by1.f | 1 - SRC/cung2l.f | 1 - SRC/cung2r.f | 1 - SRC/cungbr.f | 1 - SRC/cunghr.f | 1 - SRC/cungl2.f | 1 - SRC/cunglq.f | 1 - SRC/cungql.f | 1 - SRC/cungqr.f | 1 - SRC/cungr2.f | 1 - SRC/cungrq.f | 1 - SRC/cungtr.f | 1 - SRC/cungtsqr.f | 1 - SRC/cungtsqr_row.f | 1 - SRC/cunhr_col.f | 1 - SRC/cunm22.f | 1 - SRC/cunm2l.f | 1 - SRC/cunm2r.f | 1 - SRC/cunmbr.f | 1 - SRC/cunmhr.f | 1 - SRC/cunml2.f | 1 - SRC/cunmlq.f | 1 - SRC/cunmql.f | 1 - SRC/cunmqr.f | 1 - SRC/cunmr2.f | 1 - SRC/cunmr3.f | 1 - SRC/cunmrq.f | 1 - SRC/cunmrz.f | 1 - SRC/cunmtr.f | 1 - SRC/cupgtr.f | 1 - SRC/cupmtr.f | 1 - SRC/dbbcsd.f | 1 - SRC/dbdsdc.f | 1 - SRC/dbdsqr.f | 1 - SRC/dbdsvdx.f | 1 - SRC/ddisna.f | 1 - SRC/dgbbrd.f | 1 - SRC/dgbcon.f | 1 - SRC/dgbequ.f | 1 - SRC/dgbequb.f | 1 - SRC/dgbrfs.f | 1 - SRC/dgbrfsx.f | 1 - SRC/dgbsv.f | 1 - SRC/dgbsvx.f | 1 - SRC/dgbsvxx.f | 1 - SRC/dgbtf2.f | 1 - SRC/dgbtrf.f | 1 - SRC/dgbtrs.f | 1 - SRC/dgebak.f | 1 - SRC/dgebal.f | 1 - SRC/dgebd2.f | 1 - SRC/dgebrd.f | 1 - SRC/dgecon.f | 1 - SRC/dgedmd.f90 | 1 - SRC/dgedmdq.f90 | 1 - SRC/dgeequ.f | 1 - SRC/dgeequb.f | 1 - SRC/dgees.f | 1 - SRC/dgeesx.f | 1 - SRC/dgeev.f | 1 - SRC/dgeevx.f | 1 - SRC/dgehd2.f | 1 - SRC/dgehrd.f | 1 - SRC/dgejsv.f | 1 - SRC/dgelq.f | 1 - SRC/dgelq2.f | 1 - SRC/dgelqf.f | 1 - SRC/dgelqt.f | 1 - SRC/dgelqt3.f | 1 - SRC/dgels.f | 1 - SRC/dgelsd.f | 1 - SRC/dgelss.f | 1 - SRC/dgelst.f | 1 - SRC/dgelsy.f | 1 - SRC/dgemlq.f | 1 - SRC/dgemlqt.f | 1 - SRC/dgemqr.f | 1 - SRC/dgemqrt.f | 1 - SRC/dgeql2.f | 1 - SRC/dgeqlf.f | 1 - SRC/dgeqp3.f | 1 - SRC/dgeqp3rk.f | 1 - SRC/dgeqr.f | 1 - SRC/dgeqr2.f | 1 - SRC/dgeqr2p.f | 1 - SRC/dgeqrf.f | 1 - SRC/dgeqrfp.f | 1 - SRC/dgeqrt.f | 1 - SRC/dgeqrt2.f | 1 - SRC/dgeqrt3.f | 1 - SRC/dgerfs.f | 1 - SRC/dgerfsx.f | 1 - SRC/dgerq2.f | 1 - SRC/dgerqf.f | 1 - SRC/dgesc2.f | 1 - SRC/dgesdd.f | 1 - SRC/dgesv.f | 1 - SRC/dgesvd.f | 1 - SRC/dgesvdq.f | 1 - SRC/dgesvdx.f | 1 - SRC/dgesvj.f | 1 - SRC/dgesvx.f | 1 - SRC/dgesvxx.f | 1 - SRC/dgetc2.f | 1 - SRC/dgetf2.f | 1 - SRC/dgetrf.f | 1 - SRC/dgetrf2.f | 1 - SRC/dgetri.f | 1 - SRC/dgetrs.f | 1 - SRC/dgetsls.f | 1 - SRC/dgetsqrhrt.f | 1 - SRC/dggbak.f | 1 - SRC/dggbal.f | 1 - SRC/dgges.f | 1 - SRC/dgges3.f | 1 - SRC/dggesx.f | 1 - SRC/dggev.f | 1 - SRC/dggev3.f | 1 - SRC/dggevx.f | 1 - SRC/dggglm.f | 1 - SRC/dgghd3.f | 1 - SRC/dgghrd.f | 1 - SRC/dgglse.f | 1 - SRC/dggqrf.f | 1 - SRC/dggrqf.f | 1 - SRC/dggsvd3.f | 1 - SRC/dggsvp3.f | 1 - SRC/dgsvj0.f | 1 - SRC/dgsvj1.f | 1 - SRC/dgtcon.f | 1 - SRC/dgtrfs.f | 1 - SRC/dgtsv.f | 1 - SRC/dgtsvx.f | 1 - SRC/dgttrf.f | 1 - SRC/dgttrs.f | 1 - SRC/dgtts2.f | 1 - SRC/dhgeqz.f | 1 - SRC/dhsein.f | 1 - SRC/dhseqr.f | 1 - SRC/disnan.f | 1 - SRC/dla_gbamv.f | 1 - SRC/dla_gbrcond.f | 1 - SRC/dla_gbrfsx_extended.f | 1 - SRC/dla_gbrpvgrw.f | 1 - SRC/dla_geamv.f | 1 - SRC/dla_gercond.f | 1 - SRC/dla_gerfsx_extended.f | 1 - SRC/dla_gerpvgrw.f | 1 - SRC/dla_lin_berr.f | 1 - SRC/dla_porcond.f | 1 - SRC/dla_porfsx_extended.f | 1 - SRC/dla_porpvgrw.f | 1 - SRC/dla_syamv.f | 1 - SRC/dla_syrcond.f | 1 - SRC/dla_syrfsx_extended.f | 1 - SRC/dla_syrpvgrw.f | 1 - SRC/dla_wwaddw.f | 1 - SRC/dlabad.f | 1 - SRC/dlabrd.f | 1 - SRC/dlacn2.f | 1 - SRC/dlacon.f | 1 - SRC/dlacpy.f | 1 - SRC/dladiv.f | 1 - SRC/dlae2.f | 1 - SRC/dlaebz.f | 1 - SRC/dlaed0.f | 1 - SRC/dlaed1.f | 1 - SRC/dlaed2.f | 1 - SRC/dlaed3.f | 1 - SRC/dlaed4.f | 1 - SRC/dlaed5.f | 1 - SRC/dlaed6.f | 1 - SRC/dlaed7.f | 1 - SRC/dlaed8.f | 1 - SRC/dlaed9.f | 1 - SRC/dlaeda.f | 1 - SRC/dlaein.f | 1 - SRC/dlaev2.f | 1 - SRC/dlaexc.f | 1 - SRC/dlag2.f | 1 - SRC/dlag2s.f | 1 - SRC/dlags2.f | 1 - SRC/dlagtf.f | 1 - SRC/dlagtm.f | 1 - SRC/dlagts.f | 1 - SRC/dlagv2.f | 1 - SRC/dlahqr.f | 1 - SRC/dlahr2.f | 1 - SRC/dlaic1.f | 1 - SRC/dlaisnan.f | 1 - SRC/dlaln2.f | 1 - SRC/dlals0.f | 1 - SRC/dlalsa.f | 1 - SRC/dlalsd.f | 1 - SRC/dlamrg.f | 1 - SRC/dlamswlq.f | 1 - SRC/dlamtsqr.f | 1 - SRC/dlaneg.f | 1 - SRC/dlangb.f | 1 - SRC/dlange.f | 1 - SRC/dlangt.f | 1 - SRC/dlanhs.f | 1 - SRC/dlansb.f | 1 - SRC/dlansf.f | 1 - SRC/dlansp.f | 1 - SRC/dlanst.f | 1 - SRC/dlansy.f | 1 - SRC/dlantb.f | 1 - SRC/dlantp.f | 1 - SRC/dlantr.f | 1 - SRC/dlanv2.f | 1 - SRC/dlaorhr_col_getrfnp.f | 1 - SRC/dlaorhr_col_getrfnp2.f | 1 - SRC/dlapll.f | 1 - SRC/dlapmr.f | 1 - SRC/dlapmt.f | 1 - SRC/dlapy2.f | 1 - SRC/dlapy3.f | 1 - SRC/dlaqgb.f | 1 - SRC/dlaqge.f | 1 - SRC/dlaqp2.f | 1 - SRC/dlaqp2rk.f | 1 - SRC/dlaqp3rk.f | 1 - SRC/dlaqps.f | 1 - SRC/dlaqr0.f | 1 - SRC/dlaqr1.f | 1 - SRC/dlaqr2.f | 1 - SRC/dlaqr3.f | 1 - SRC/dlaqr4.f | 1 - SRC/dlaqr5.f | 1 - SRC/dlaqsb.f | 1 - SRC/dlaqsp.f | 1 - SRC/dlaqsy.f | 1 - SRC/dlaqtr.f | 1 - SRC/dlaqz0.f | 1 - SRC/dlaqz1.f | 1 - SRC/dlaqz2.f | 1 - SRC/dlaqz3.f | 1 - SRC/dlaqz4.f | 1 - SRC/dlar1v.f | 1 - SRC/dlar2v.f | 1 - SRC/dlarf.f | 1 - SRC/dlarfb.f | 1 - SRC/dlarfb_gett.f | 1 - SRC/dlarfg.f | 1 - SRC/dlarfgp.f | 1 - SRC/dlarft.f | 1 - SRC/dlarfx.f | 1 - SRC/dlarfy.f | 1 - SRC/dlargv.f | 1 - SRC/dlarmm.f | 1 - SRC/dlarnv.f | 1 - SRC/dlarra.f | 1 - SRC/dlarrb.f | 1 - SRC/dlarrc.f | 1 - SRC/dlarrd.f | 1 - SRC/dlarre.f | 1 - SRC/dlarrf.f | 1 - SRC/dlarrj.f | 1 - SRC/dlarrk.f | 1 - SRC/dlarrr.f | 1 - SRC/dlarrv.f | 1 - SRC/dlarscl2.f | 1 - SRC/dlartg.f90 | 1 - SRC/dlartgp.f | 1 - SRC/dlartgs.f | 1 - SRC/dlartv.f | 1 - SRC/dlaruv.f | 1 - SRC/dlarz.f | 1 - SRC/dlarzb.f | 1 - SRC/dlarzt.f | 1 - SRC/dlas2.f | 1 - SRC/dlascl.f | 1 - SRC/dlascl2.f | 1 - SRC/dlasd0.f | 1 - SRC/dlasd1.f | 1 - SRC/dlasd2.f | 1 - SRC/dlasd3.f | 1 - SRC/dlasd4.f | 1 - SRC/dlasd5.f | 1 - SRC/dlasd6.f | 1 - SRC/dlasd7.f | 1 - SRC/dlasd8.f | 1 - SRC/dlasda.f | 1 - SRC/dlasdq.f | 1 - SRC/dlasdt.f | 1 - SRC/dlaset.f | 1 - SRC/dlasq1.f | 1 - SRC/dlasq2.f | 1 - SRC/dlasq3.f | 1 - SRC/dlasq4.f | 1 - SRC/dlasq5.f | 1 - SRC/dlasq6.f | 1 - SRC/dlasr.f | 1 - SRC/dlasrt.f | 1 - SRC/dlassq.f90 | 1 - SRC/dlasv2.f | 1 - SRC/dlaswlq.f | 1 - SRC/dlaswp.f | 1 - SRC/dlasy2.f | 1 - SRC/dlasyf.f | 1 - SRC/dlasyf_aa.f | 1 - SRC/dlasyf_rk.f | 1 - SRC/dlasyf_rook.f | 1 - SRC/dlat2s.f | 1 - SRC/dlatbs.f | 1 - SRC/dlatdf.f | 1 - SRC/dlatps.f | 1 - SRC/dlatrd.f | 1 - SRC/dlatrs.f | 1 - SRC/dlatrs3.f | 1 - SRC/dlatrz.f | 1 - SRC/dlatsqr.f | 1 - SRC/dlauu2.f | 1 - SRC/dlauum.f | 1 - SRC/dopgtr.f | 1 - SRC/dopmtr.f | 1 - SRC/dorbdb.f | 1 - SRC/dorbdb1.f | 1 - SRC/dorbdb2.f | 1 - SRC/dorbdb3.f | 1 - SRC/dorbdb4.f | 1 - SRC/dorbdb5.f | 1 - SRC/dorbdb6.f | 1 - SRC/dorcsd.f | 1 - SRC/dorcsd2by1.f | 1 - SRC/dorg2l.f | 1 - SRC/dorg2r.f | 1 - SRC/dorgbr.f | 1 - SRC/dorghr.f | 1 - SRC/dorgl2.f | 1 - SRC/dorglq.f | 1 - SRC/dorgql.f | 1 - SRC/dorgqr.f | 1 - SRC/dorgr2.f | 1 - SRC/dorgrq.f | 1 - SRC/dorgtr.f | 1 - SRC/dorgtsqr.f | 1 - SRC/dorgtsqr_row.f | 1 - SRC/dorhr_col.f | 1 - SRC/dorm22.f | 1 - SRC/dorm2l.f | 1 - SRC/dorm2r.f | 1 - SRC/dormbr.f | 1 - SRC/dormhr.f | 1 - SRC/dorml2.f | 1 - SRC/dormlq.f | 1 - SRC/dormql.f | 1 - SRC/dormqr.f | 1 - SRC/dormr2.f | 1 - SRC/dormr3.f | 1 - SRC/dormrq.f | 1 - SRC/dormrz.f | 1 - SRC/dormtr.f | 1 - SRC/dpbcon.f | 1 - SRC/dpbequ.f | 1 - SRC/dpbrfs.f | 1 - SRC/dpbstf.f | 1 - SRC/dpbsv.f | 1 - SRC/dpbsvx.f | 1 - SRC/dpbtf2.f | 1 - SRC/dpbtrf.f | 1 - SRC/dpbtrs.f | 1 - SRC/dpftrf.f | 1 - SRC/dpftri.f | 1 - SRC/dpftrs.f | 1 - SRC/dpocon.f | 1 - SRC/dpoequ.f | 1 - SRC/dpoequb.f | 1 - SRC/dporfs.f | 1 - SRC/dporfsx.f | 1 - SRC/dposv.f | 1 - SRC/dposvx.f | 1 - SRC/dposvxx.f | 1 - SRC/dpotf2.f | 1 - SRC/dpotrf.f | 1 - SRC/dpotrf2.f | 1 - SRC/dpotri.f | 1 - SRC/dpotrs.f | 1 - SRC/dppcon.f | 1 - SRC/dppequ.f | 1 - SRC/dpprfs.f | 1 - SRC/dppsv.f | 1 - SRC/dppsvx.f | 1 - SRC/dpptrf.f | 1 - SRC/dpptri.f | 1 - SRC/dpptrs.f | 1 - SRC/dpstf2.f | 1 - SRC/dpstrf.f | 1 - SRC/dptcon.f | 1 - SRC/dpteqr.f | 1 - SRC/dptrfs.f | 1 - SRC/dptsv.f | 1 - SRC/dptsvx.f | 1 - SRC/dpttrf.f | 1 - SRC/dpttrs.f | 1 - SRC/dptts2.f | 1 - SRC/drscl.f | 1 - SRC/dsb2st_kernels.f | 1 - SRC/dsbev.f | 1 - SRC/dsbev_2stage.f | 1 - SRC/dsbevd.f | 1 - SRC/dsbevd_2stage.f | 1 - SRC/dsbevx.f | 1 - SRC/dsbevx_2stage.f | 1 - SRC/dsbgst.f | 1 - SRC/dsbgv.f | 1 - SRC/dsbgvd.f | 1 - SRC/dsbgvx.f | 1 - SRC/dsbtrd.f | 1 - SRC/dsfrk.f | 1 - SRC/dsgesv.f | 1 - SRC/dspcon.f | 1 - SRC/dspev.f | 1 - SRC/dspevd.f | 1 - SRC/dspevx.f | 1 - SRC/dspgst.f | 1 - SRC/dspgv.f | 1 - SRC/dspgvd.f | 1 - SRC/dspgvx.f | 1 - SRC/dsposv.f | 1 - SRC/dsprfs.f | 1 - SRC/dspsv.f | 1 - SRC/dspsvx.f | 1 - SRC/dsptrd.f | 1 - SRC/dsptrf.f | 1 - SRC/dsptri.f | 1 - SRC/dsptrs.f | 1 - SRC/dstebz.f | 1 - SRC/dstedc.f | 1 - SRC/dstegr.f | 1 - SRC/dstein.f | 1 - SRC/dstemr.f | 1 - SRC/dsteqr.f | 1 - SRC/dsterf.f | 1 - SRC/dstev.f | 1 - SRC/dstevd.f | 1 - SRC/dstevr.f | 1 - SRC/dstevx.f | 1 - SRC/dsycon.f | 1 - SRC/dsycon_3.f | 1 - SRC/dsycon_rook.f | 1 - SRC/dsyconv.f | 1 - SRC/dsyconvf.f | 1 - SRC/dsyconvf_rook.f | 1 - SRC/dsyequb.f | 1 - SRC/dsyev.f | 1 - SRC/dsyev_2stage.f | 1 - SRC/dsyevd.f | 1 - SRC/dsyevd_2stage.f | 1 - SRC/dsyevr.f | 1 - SRC/dsyevr_2stage.f | 1 - SRC/dsyevx.f | 1 - SRC/dsyevx_2stage.f | 1 - SRC/dsygs2.f | 1 - SRC/dsygst.f | 1 - SRC/dsygv.f | 1 - SRC/dsygv_2stage.f | 1 - SRC/dsygvd.f | 1 - SRC/dsygvx.f | 1 - SRC/dsyrfs.f | 1 - SRC/dsyrfsx.f | 1 - SRC/dsysv.f | 1 - SRC/dsysv_aa.f | 1 - SRC/dsysv_aa_2stage.f | 1 - SRC/dsysv_rk.f | 1 - SRC/dsysv_rook.f | 1 - SRC/dsysvx.f | 1 - SRC/dsysvxx.f | 1 - SRC/dsyswapr.f | 1 - SRC/dsytd2.f | 1 - SRC/dsytf2.f | 1 - SRC/dsytf2_rk.f | 1 - SRC/dsytf2_rook.f | 1 - SRC/dsytrd.f | 1 - SRC/dsytrd_2stage.f | 1 - SRC/dsytrd_sb2st.F | 1 - SRC/dsytrd_sy2sb.f | 1 - SRC/dsytrf.f | 1 - SRC/dsytrf_aa.f | 1 - SRC/dsytrf_aa_2stage.f | 1 - SRC/dsytrf_rk.f | 1 - SRC/dsytrf_rook.f | 1 - SRC/dsytri.f | 1 - SRC/dsytri2.f | 1 - SRC/dsytri2x.f | 1 - SRC/dsytri_3.f | 1 - SRC/dsytri_3x.f | 1 - SRC/dsytri_rook.f | 1 - SRC/dsytrs.f | 1 - SRC/dsytrs2.f | 1 - SRC/dsytrs_3.f | 1 - SRC/dsytrs_aa.f | 1 - SRC/dsytrs_aa_2stage.f | 1 - SRC/dsytrs_rook.f | 1 - SRC/dtbcon.f | 1 - SRC/dtbrfs.f | 1 - SRC/dtbtrs.f | 1 - SRC/dtfsm.f | 1 - SRC/dtftri.f | 1 - SRC/dtfttp.f | 1 - SRC/dtfttr.f | 1 - SRC/dtgevc.f | 1 - SRC/dtgex2.f | 1 - SRC/dtgexc.f | 1 - SRC/dtgsen.f | 1 - SRC/dtgsja.f | 1 - SRC/dtgsna.f | 1 - SRC/dtgsy2.f | 1 - SRC/dtgsyl.f | 1 - SRC/dtpcon.f | 1 - SRC/dtplqt.f | 1 - SRC/dtplqt2.f | 1 - SRC/dtpmlqt.f | 1 - SRC/dtpmqrt.f | 1 - SRC/dtpqrt.f | 1 - SRC/dtpqrt2.f | 1 - SRC/dtprfb.f | 1 - SRC/dtprfs.f | 1 - SRC/dtptri.f | 1 - SRC/dtptrs.f | 1 - SRC/dtpttf.f | 1 - SRC/dtpttr.f | 1 - SRC/dtrcon.f | 1 - SRC/dtrevc.f | 1 - SRC/dtrevc3.f | 1 - SRC/dtrexc.f | 1 - SRC/dtrrfs.f | 1 - SRC/dtrsen.f | 1 - SRC/dtrsna.f | 1 - SRC/dtrsyl.f | 1 - SRC/dtrsyl3.f | 1 - SRC/dtrti2.f | 1 - SRC/dtrtri.f | 1 - SRC/dtrtrs.f | 1 - SRC/dtrttf.f | 1 - SRC/dtrttp.f | 1 - SRC/dtzrzf.f | 1 - SRC/dzsum1.f | 1 - SRC/icmax1.f | 1 - SRC/ieeeck.f | 1 - SRC/ilaclc.f | 1 - SRC/ilaclr.f | 1 - SRC/iladiag.f | 1 - SRC/iladlc.f | 1 - SRC/iladlr.f | 1 - SRC/ilaenv.f | 1 - SRC/ilaenv2stage.f | 1 - SRC/ilaprec.f | 1 - SRC/ilaslc.f | 1 - SRC/ilaslr.f | 1 - SRC/ilatrans.f | 1 - SRC/ilauplo.f | 1 - SRC/ilazlc.f | 1 - SRC/ilazlr.f | 1 - SRC/iparmq.f | 1 - SRC/izmax1.f | 1 - SRC/lapack_64.h | 2 ++ SRC/lsamen.f | 1 - SRC/sbbcsd.f | 1 - SRC/sbdsdc.f | 1 - SRC/sbdsqr.f | 1 - SRC/sbdsvdx.f | 1 - SRC/scsum1.f | 1 - SRC/sdisna.f | 1 - SRC/sgbbrd.f | 1 - SRC/sgbcon.f | 1 - SRC/sgbequ.f | 1 - SRC/sgbequb.f | 1 - SRC/sgbrfs.f | 1 - SRC/sgbrfsx.f | 1 - SRC/sgbsv.f | 1 - SRC/sgbsvx.f | 1 - SRC/sgbsvxx.f | 1 - SRC/sgbtf2.f | 1 - SRC/sgbtrf.f | 1 - SRC/sgbtrs.f | 1 - SRC/sgebak.f | 1 - SRC/sgebal.f | 1 - SRC/sgebd2.f | 1 - SRC/sgebrd.f | 1 - SRC/sgecon.f | 1 - SRC/sgedmd.f90 | 1 - SRC/sgedmdq.f90 | 1 - SRC/sgeequ.f | 1 - SRC/sgeequb.f | 1 - SRC/sgees.f | 1 - SRC/sgeesx.f | 1 - SRC/sgeev.f | 1 - SRC/sgeevx.f | 1 - SRC/sgehd2.f | 1 - SRC/sgehrd.f | 1 - SRC/sgejsv.f | 1 - SRC/sgelq.f | 1 - SRC/sgelq2.f | 1 - SRC/sgelqf.f | 1 - SRC/sgelqt.f | 1 - SRC/sgelqt3.f | 1 - SRC/sgels.f | 1 - SRC/sgelsd.f | 1 - SRC/sgelss.f | 1 - SRC/sgelst.f | 1 - SRC/sgelsy.f | 1 - SRC/sgemlq.f | 1 - SRC/sgemlqt.f | 1 - SRC/sgemqr.f | 1 - SRC/sgemqrt.f | 1 - SRC/sgeql2.f | 1 - SRC/sgeqlf.f | 1 - SRC/sgeqp3.f | 1 - SRC/sgeqp3rk.f | 1 - SRC/sgeqr.f | 1 - SRC/sgeqr2.f | 1 - SRC/sgeqr2p.f | 1 - SRC/sgeqrf.f | 1 - SRC/sgeqrfp.f | 1 - SRC/sgeqrt.f | 1 - SRC/sgeqrt2.f | 1 - SRC/sgeqrt3.f | 1 - SRC/sgerfs.f | 1 - SRC/sgerfsx.f | 1 - SRC/sgerq2.f | 1 - SRC/sgerqf.f | 1 - SRC/sgesc2.f | 1 - SRC/sgesdd.f | 1 - SRC/sgesv.f | 1 - SRC/sgesvd.f | 1 - SRC/sgesvdq.f | 1 - SRC/sgesvdx.f | 1 - SRC/sgesvj.f | 1 - SRC/sgesvx.f | 1 - SRC/sgesvxx.f | 1 - SRC/sgetc2.f | 1 - SRC/sgetf2.f | 1 - SRC/sgetrf.f | 1 - SRC/sgetrf2.f | 1 - SRC/sgetri.f | 1 - SRC/sgetrs.f | 1 - SRC/sgetsls.f | 1 - SRC/sgetsqrhrt.f | 1 - SRC/sggbak.f | 1 - SRC/sggbal.f | 1 - SRC/sgges.f | 1 - SRC/sgges3.f | 1 - SRC/sggesx.f | 1 - SRC/sggev.f | 1 - SRC/sggev3.f | 1 - SRC/sggevx.f | 1 - SRC/sggglm.f | 1 - SRC/sgghd3.f | 1 - SRC/sgghrd.f | 1 - SRC/sgglse.f | 1 - SRC/sggqrf.f | 1 - SRC/sggrqf.f | 1 - SRC/sggsvd3.f | 1 - SRC/sggsvp3.f | 1 - SRC/sgsvj0.f | 1 - SRC/sgsvj1.f | 1 - SRC/sgtcon.f | 1 - SRC/sgtrfs.f | 1 - SRC/sgtsv.f | 1 - SRC/sgtsvx.f | 1 - SRC/sgttrf.f | 1 - SRC/sgttrs.f | 1 - SRC/sgtts2.f | 1 - SRC/shgeqz.f | 1 - SRC/shsein.f | 1 - SRC/shseqr.f | 1 - SRC/sisnan.f | 1 - SRC/sla_gbamv.f | 1 - SRC/sla_gbrcond.f | 1 - SRC/sla_gbrfsx_extended.f | 1 - SRC/sla_gbrpvgrw.f | 1 - SRC/sla_geamv.f | 1 - SRC/sla_gercond.f | 1 - SRC/sla_gerfsx_extended.f | 1 - SRC/sla_gerpvgrw.f | 1 - SRC/sla_lin_berr.f | 1 - SRC/sla_porcond.f | 1 - SRC/sla_porfsx_extended.f | 1 - SRC/sla_porpvgrw.f | 1 - SRC/sla_syamv.f | 1 - SRC/sla_syrcond.f | 1 - SRC/sla_syrfsx_extended.f | 1 - SRC/sla_syrpvgrw.f | 1 - SRC/sla_wwaddw.f | 1 - SRC/slabad.f | 1 - SRC/slabrd.f | 1 - SRC/slacn2.f | 1 - SRC/slacon.f | 1 - SRC/slacpy.f | 1 - SRC/sladiv.f | 1 - SRC/slae2.f | 1 - SRC/slaebz.f | 1 - SRC/slaed0.f | 1 - SRC/slaed1.f | 1 - SRC/slaed2.f | 1 - SRC/slaed3.f | 1 - SRC/slaed4.f | 1 - SRC/slaed5.f | 1 - SRC/slaed6.f | 1 - SRC/slaed7.f | 1 - SRC/slaed8.f | 1 - SRC/slaed9.f | 1 - SRC/slaeda.f | 1 - SRC/slaein.f | 1 - SRC/slaev2.f | 1 - SRC/slaexc.f | 1 - SRC/slag2.f | 1 - SRC/slag2d.f | 1 - SRC/slags2.f | 1 - SRC/slagtf.f | 1 - SRC/slagtm.f | 1 - SRC/slagts.f | 1 - SRC/slagv2.f | 1 - SRC/slahqr.f | 1 - SRC/slahr2.f | 1 - SRC/slaic1.f | 1 - SRC/slaisnan.f | 1 - SRC/slaln2.f | 1 - SRC/slals0.f | 1 - SRC/slalsa.f | 1 - SRC/slalsd.f | 1 - SRC/slamrg.f | 1 - SRC/slamswlq.f | 1 - SRC/slamtsqr.f | 1 - SRC/slaneg.f | 1 - SRC/slangb.f | 1 - SRC/slange.f | 1 - SRC/slangt.f | 1 - SRC/slanhs.f | 1 - SRC/slansb.f | 1 - SRC/slansf.f | 1 - SRC/slansp.f | 1 - SRC/slanst.f | 1 - SRC/slansy.f | 1 - SRC/slantb.f | 1 - SRC/slantp.f | 1 - SRC/slantr.f | 1 - SRC/slanv2.f | 1 - SRC/slaorhr_col_getrfnp.f | 1 - SRC/slaorhr_col_getrfnp2.f | 1 - SRC/slapll.f | 1 - SRC/slapmr.f | 1 - SRC/slapmt.f | 1 - SRC/slapy2.f | 1 - SRC/slapy3.f | 1 - SRC/slaqgb.f | 1 - SRC/slaqge.f | 1 - SRC/slaqp2.f | 1 - SRC/slaqp2rk.f | 1 - SRC/slaqp3rk.f | 1 - SRC/slaqps.f | 1 - SRC/slaqr0.f | 1 - SRC/slaqr1.f | 1 - SRC/slaqr2.f | 1 - SRC/slaqr3.f | 1 - SRC/slaqr4.f | 1 - SRC/slaqr5.f | 1 - SRC/slaqsb.f | 1 - SRC/slaqsp.f | 1 - SRC/slaqsy.f | 1 - SRC/slaqtr.f | 1 - SRC/slaqz0.f | 1 - SRC/slaqz1.f | 1 - SRC/slaqz2.f | 1 - SRC/slaqz3.f | 1 - SRC/slaqz4.f | 1 - SRC/slar1v.f | 1 - SRC/slar2v.f | 1 - SRC/slarf.f | 1 - SRC/slarfb.f | 1 - SRC/slarfb_gett.f | 1 - SRC/slarfg.f | 1 - SRC/slarfgp.f | 1 - SRC/slarft.f | 1 - SRC/slarfx.f | 1 - SRC/slarfy.f | 1 - SRC/slargv.f | 1 - SRC/slarmm.f | 1 - SRC/slarnv.f | 1 - SRC/slarra.f | 1 - SRC/slarrb.f | 1 - SRC/slarrc.f | 1 - SRC/slarrd.f | 1 - SRC/slarre.f | 1 - SRC/slarrf.f | 1 - SRC/slarrj.f | 1 - SRC/slarrk.f | 1 - SRC/slarrr.f | 1 - SRC/slarrv.f | 1 - SRC/slarscl2.f | 1 - SRC/slartg.f90 | 1 - SRC/slartgp.f | 1 - SRC/slartgs.f | 1 - SRC/slartv.f | 1 - SRC/slaruv.f | 1 - SRC/slarz.f | 1 - SRC/slarzb.f | 1 - SRC/slarzt.f | 1 - SRC/slas2.f | 1 - SRC/slascl.f | 1 - SRC/slascl2.f | 1 - SRC/slasd0.f | 1 - SRC/slasd1.f | 1 - SRC/slasd2.f | 1 - SRC/slasd3.f | 1 - SRC/slasd4.f | 1 - SRC/slasd5.f | 1 - SRC/slasd6.f | 1 - SRC/slasd7.f | 1 - SRC/slasd8.f | 1 - SRC/slasda.f | 1 - SRC/slasdq.f | 1 - SRC/slasdt.f | 1 - SRC/slaset.f | 1 - SRC/slasq1.f | 1 - SRC/slasq2.f | 1 - SRC/slasq3.f | 1 - SRC/slasq4.f | 1 - SRC/slasq5.f | 1 - SRC/slasq6.f | 1 - SRC/slasr.f | 1 - SRC/slasrt.f | 1 - SRC/slassq.f90 | 1 - SRC/slasv2.f | 1 - SRC/slaswlq.f | 1 - SRC/slaswp.f | 1 - SRC/slasy2.f | 1 - SRC/slasyf.f | 1 - SRC/slasyf_aa.f | 1 - SRC/slasyf_rk.f | 1 - SRC/slasyf_rook.f | 1 - SRC/slatbs.f | 1 - SRC/slatdf.f | 1 - SRC/slatps.f | 1 - SRC/slatrd.f | 1 - SRC/slatrs.f | 1 - SRC/slatrs3.f | 1 - SRC/slatrz.f | 1 - SRC/slatsqr.f | 1 - SRC/slauu2.f | 1 - SRC/slauum.f | 1 - SRC/sopgtr.f | 1 - SRC/sopmtr.f | 1 - SRC/sorbdb.f | 1 - SRC/sorbdb1.f | 1 - SRC/sorbdb2.f | 1 - SRC/sorbdb3.f | 1 - SRC/sorbdb4.f | 1 - SRC/sorbdb5.f | 1 - SRC/sorbdb6.f | 1 - SRC/sorcsd.f | 1 - SRC/sorcsd2by1.f | 1 - SRC/sorg2l.f | 1 - SRC/sorg2r.f | 1 - SRC/sorgbr.f | 1 - SRC/sorghr.f | 1 - SRC/sorgl2.f | 1 - SRC/sorglq.f | 1 - SRC/sorgql.f | 1 - SRC/sorgqr.f | 1 - SRC/sorgr2.f | 1 - SRC/sorgrq.f | 1 - SRC/sorgtr.f | 1 - SRC/sorgtsqr.f | 1 - SRC/sorgtsqr_row.f | 1 - SRC/sorhr_col.f | 1 - SRC/sorm22.f | 1 - SRC/sorm2l.f | 1 - SRC/sorm2r.f | 1 - SRC/sormbr.f | 1 - SRC/sormhr.f | 1 - SRC/sorml2.f | 1 - SRC/sormlq.f | 1 - SRC/sormql.f | 1 - SRC/sormqr.f | 1 - SRC/sormr2.f | 1 - SRC/sormr3.f | 1 - SRC/sormrq.f | 1 - SRC/sormrz.f | 1 - SRC/sormtr.f | 1 - SRC/spbcon.f | 1 - SRC/spbequ.f | 1 - SRC/spbrfs.f | 1 - SRC/spbstf.f | 1 - SRC/spbsv.f | 1 - SRC/spbsvx.f | 1 - SRC/spbtf2.f | 1 - SRC/spbtrf.f | 1 - SRC/spbtrs.f | 1 - SRC/spftrf.f | 1 - SRC/spftri.f | 1 - SRC/spftrs.f | 1 - SRC/spocon.f | 1 - SRC/spoequ.f | 1 - SRC/spoequb.f | 1 - SRC/sporfs.f | 1 - SRC/sporfsx.f | 1 - SRC/sposv.f | 1 - SRC/sposvx.f | 1 - SRC/sposvxx.f | 1 - SRC/spotf2.f | 1 - SRC/spotrf.f | 1 - SRC/spotrf2.f | 1 - SRC/spotri.f | 1 - SRC/spotrs.f | 1 - SRC/sppcon.f | 1 - SRC/sppequ.f | 1 - SRC/spprfs.f | 1 - SRC/sppsv.f | 1 - SRC/sppsvx.f | 1 - SRC/spptrf.f | 1 - SRC/spptri.f | 1 - SRC/spptrs.f | 1 - SRC/spstf2.f | 1 - SRC/spstrf.f | 1 - SRC/sptcon.f | 1 - SRC/spteqr.f | 1 - SRC/sptrfs.f | 1 - SRC/sptsv.f | 1 - SRC/sptsvx.f | 1 - SRC/spttrf.f | 1 - SRC/spttrs.f | 1 - SRC/sptts2.f | 1 - SRC/srscl.f | 1 - SRC/ssb2st_kernels.f | 1 - SRC/ssbev.f | 1 - SRC/ssbev_2stage.f | 1 - SRC/ssbevd.f | 1 - SRC/ssbevd_2stage.f | 1 - SRC/ssbevx.f | 1 - SRC/ssbevx_2stage.f | 1 - SRC/ssbgst.f | 1 - SRC/ssbgv.f | 1 - SRC/ssbgvd.f | 1 - SRC/ssbgvx.f | 1 - SRC/ssbtrd.f | 1 - SRC/ssfrk.f | 1 - SRC/sspcon.f | 1 - SRC/sspev.f | 1 - SRC/sspevd.f | 1 - SRC/sspevx.f | 1 - SRC/sspgst.f | 1 - SRC/sspgv.f | 1 - SRC/sspgvd.f | 1 - SRC/sspgvx.f | 1 - SRC/ssprfs.f | 1 - SRC/sspsv.f | 1 - SRC/sspsvx.f | 1 - SRC/ssptrd.f | 1 - SRC/ssptrf.f | 1 - SRC/ssptri.f | 1 - SRC/ssptrs.f | 1 - SRC/sstebz.f | 1 - SRC/sstedc.f | 1 - SRC/sstegr.f | 1 - SRC/sstein.f | 1 - SRC/sstemr.f | 1 - SRC/ssteqr.f | 1 - SRC/ssterf.f | 1 - SRC/sstev.f | 1 - SRC/sstevd.f | 1 - SRC/sstevr.f | 1 - SRC/sstevx.f | 1 - SRC/ssycon.f | 1 - SRC/ssycon_3.f | 1 - SRC/ssycon_rook.f | 1 - SRC/ssyconv.f | 1 - SRC/ssyconvf.f | 1 - SRC/ssyconvf_rook.f | 1 - SRC/ssyequb.f | 1 - SRC/ssyev.f | 1 - SRC/ssyev_2stage.f | 1 - SRC/ssyevd.f | 1 - SRC/ssyevd_2stage.f | 1 - SRC/ssyevr.f | 1 - SRC/ssyevr_2stage.f | 1 - SRC/ssyevx.f | 1 - SRC/ssyevx_2stage.f | 1 - SRC/ssygs2.f | 1 - SRC/ssygst.f | 1 - SRC/ssygv.f | 1 - SRC/ssygv_2stage.f | 1 - SRC/ssygvd.f | 1 - SRC/ssygvx.f | 1 - SRC/ssyrfs.f | 1 - SRC/ssyrfsx.f | 1 - SRC/ssysv.f | 1 - SRC/ssysv_aa.f | 1 - SRC/ssysv_aa_2stage.f | 1 - SRC/ssysv_rk.f | 1 - SRC/ssysv_rook.f | 1 - SRC/ssysvx.f | 1 - SRC/ssysvxx.f | 1 - SRC/ssyswapr.f | 1 - SRC/ssytd2.f | 1 - SRC/ssytf2.f | 1 - SRC/ssytf2_rk.f | 1 - SRC/ssytf2_rook.f | 1 - SRC/ssytrd.f | 1 - SRC/ssytrd_2stage.f | 1 - SRC/ssytrd_sy2sb.f | 1 - SRC/ssytrf.f | 1 - SRC/ssytrf_aa.f | 1 - SRC/ssytrf_aa_2stage.f | 1 - SRC/ssytrf_rk.f | 1 - SRC/ssytrf_rook.f | 1 - SRC/ssytri.f | 1 - SRC/ssytri2.f | 1 - SRC/ssytri2x.f | 1 - SRC/ssytri_3.f | 1 - SRC/ssytri_3x.f | 1 - SRC/ssytri_rook.f | 1 - SRC/ssytrs.f | 1 - SRC/ssytrs2.f | 1 - SRC/ssytrs_3.f | 1 - SRC/ssytrs_aa.f | 1 - SRC/ssytrs_aa_2stage.f | 1 - SRC/ssytrs_rook.f | 1 - SRC/stbcon.f | 1 - SRC/stbrfs.f | 1 - SRC/stbtrs.f | 1 - SRC/stfsm.f | 1 - SRC/stftri.f | 1 - SRC/stfttp.f | 1 - SRC/stfttr.f | 1 - SRC/stgevc.f | 1 - SRC/stgex2.f | 1 - SRC/stgexc.f | 1 - SRC/stgsen.f | 1 - SRC/stgsja.f | 1 - SRC/stgsna.f | 1 - SRC/stgsy2.f | 1 - SRC/stgsyl.f | 1 - SRC/stpcon.f | 1 - SRC/stplqt.f | 1 - SRC/stplqt2.f | 1 - SRC/stpmlqt.f | 1 - SRC/stpmqrt.f | 1 - SRC/stpqrt.f | 1 - SRC/stpqrt2.f | 1 - SRC/stprfb.f | 1 - SRC/stprfs.f | 1 - SRC/stptri.f | 1 - SRC/stptrs.f | 1 - SRC/stpttf.f | 1 - SRC/stpttr.f | 1 - SRC/strcon.f | 1 - SRC/strevc.f | 1 - SRC/strevc3.f | 1 - SRC/strexc.f | 1 - SRC/strrfs.f | 1 - SRC/strsen.f | 1 - SRC/strsna.f | 1 - SRC/strsyl.f | 1 - SRC/strsyl3.f | 1 - SRC/strti2.f | 1 - SRC/strtri.f | 1 - SRC/strtrs.f | 1 - SRC/strttf.f | 1 - SRC/strttp.f | 1 - SRC/stzrzf.f | 1 - SRC/xerbla.f | 1 - SRC/xerbla_array.f | 1 - SRC/zbbcsd.f | 1 - SRC/zbdsqr.f | 1 - SRC/zcgesv.f | 1 - SRC/zcposv.f | 1 - SRC/zdrscl.f | 1 - SRC/zgbbrd.f | 1 - SRC/zgbcon.f | 1 - SRC/zgbequ.f | 1 - SRC/zgbequb.f | 1 - SRC/zgbrfs.f | 1 - SRC/zgbrfsx.f | 1 - SRC/zgbsv.f | 1 - SRC/zgbsvx.f | 1 - SRC/zgbsvxx.f | 1 - SRC/zgbtf2.f | 1 - SRC/zgbtrf.f | 1 - SRC/zgbtrs.f | 1 - SRC/zgebak.f | 1 - SRC/zgebal.f | 1 - SRC/zgebd2.f | 1 - SRC/zgebrd.f | 1 - SRC/zgecon.f | 1 - SRC/zgedmd.f90 | 1 - SRC/zgedmdq.f90 | 1 - SRC/zgeequ.f | 1 - SRC/zgeequb.f | 1 - SRC/zgees.f | 1 - SRC/zgeesx.f | 1 - SRC/zgeev.f | 1 - SRC/zgeevx.f | 1 - SRC/zgehd2.f | 1 - SRC/zgehrd.f | 1 - SRC/zgejsv.f | 1 - SRC/zgelq.f | 1 - SRC/zgelq2.f | 1 - SRC/zgelqf.f | 1 - SRC/zgelqt.f | 1 - SRC/zgelqt3.f | 1 - SRC/zgels.f | 1 - SRC/zgelsd.f | 1 - SRC/zgelss.f | 1 - SRC/zgelst.f | 1 - SRC/zgelsy.f | 1 - SRC/zgemlq.f | 1 - SRC/zgemlqt.f | 1 - SRC/zgemqr.f | 1 - SRC/zgemqrt.f | 1 - SRC/zgeql2.f | 1 - SRC/zgeqlf.f | 1 - SRC/zgeqp3.f | 1 - SRC/zgeqp3rk.f | 1 - SRC/zgeqr.f | 1 - SRC/zgeqr2.f | 1 - SRC/zgeqr2p.f | 1 - SRC/zgeqrf.f | 1 - SRC/zgeqrfp.f | 1 - SRC/zgeqrt.f | 1 - SRC/zgeqrt2.f | 1 - SRC/zgeqrt3.f | 1 - SRC/zgerfs.f | 1 - SRC/zgerfsx.f | 1 - SRC/zgerq2.f | 1 - SRC/zgerqf.f | 1 - SRC/zgesc2.f | 1 - SRC/zgesdd.f | 1 - SRC/zgesv.f | 1 - SRC/zgesvd.f | 1 - SRC/zgesvdq.f | 1 - SRC/zgesvdx.f | 1 - SRC/zgesvj.f | 1 - SRC/zgesvx.f | 1 - SRC/zgesvxx.f | 1 - SRC/zgetc2.f | 1 - SRC/zgetf2.f | 1 - SRC/zgetrf.f | 1 - SRC/zgetrf2.f | 1 - SRC/zgetri.f | 1 - SRC/zgetrs.f | 1 - SRC/zgetsls.f | 1 - SRC/zgetsqrhrt.f | 1 - SRC/zggbak.f | 1 - SRC/zggbal.f | 1 - SRC/zgges.f | 1 - SRC/zgges3.f | 1 - SRC/zggesx.f | 1 - SRC/zggev.f | 1 - SRC/zggev3.f | 1 - SRC/zggevx.f | 1 - SRC/zggglm.f | 1 - SRC/zgghd3.f | 1 - SRC/zgghrd.f | 1 - SRC/zgglse.f | 1 - SRC/zggqrf.f | 1 - SRC/zggrqf.f | 1 - SRC/zggsvd3.f | 1 - SRC/zggsvp3.f | 1 - SRC/zgsvj0.f | 1 - SRC/zgsvj1.f | 1 - SRC/zgtcon.f | 1 - SRC/zgtrfs.f | 1 - SRC/zgtsv.f | 1 - SRC/zgtsvx.f | 1 - SRC/zgttrf.f | 1 - SRC/zgttrs.f | 1 - SRC/zgtts2.f | 1 - SRC/zhb2st_kernels.f | 1 - SRC/zhbev.f | 1 - SRC/zhbev_2stage.f | 1 - SRC/zhbevd.f | 1 - SRC/zhbevd_2stage.f | 1 - SRC/zhbevx.f | 1 - SRC/zhbevx_2stage.f | 1 - SRC/zhbgst.f | 1 - SRC/zhbgv.f | 1 - SRC/zhbgvd.f | 1 - SRC/zhbgvx.f | 1 - SRC/zhbtrd.f | 1 - SRC/zhecon.f | 1 - SRC/zhecon_3.f | 1 - SRC/zhecon_rook.f | 1 - SRC/zheequb.f | 1 - SRC/zheev.f | 1 - SRC/zheev_2stage.f | 1 - SRC/zheevd.f | 1 - SRC/zheevd_2stage.f | 1 - SRC/zheevr.f | 1 - SRC/zheevr_2stage.f | 1 - SRC/zheevx.f | 1 - SRC/zheevx_2stage.f | 1 - SRC/zhegs2.f | 1 - SRC/zhegst.f | 1 - SRC/zhegv.f | 1 - SRC/zhegv_2stage.f | 1 - SRC/zhegvd.f | 1 - SRC/zhegvx.f | 1 - SRC/zherfs.f | 1 - SRC/zherfsx.f | 1 - SRC/zhesv.f | 1 - SRC/zhesv_aa.f | 1 - SRC/zhesv_aa_2stage.f | 1 - SRC/zhesv_rk.f | 1 - SRC/zhesv_rook.f | 1 - SRC/zhesvx.f | 1 - SRC/zhesvxx.f | 1 - SRC/zheswapr.f | 1 - SRC/zhetd2.f | 1 - SRC/zhetf2.f | 1 - SRC/zhetf2_rk.f | 1 - SRC/zhetf2_rook.f | 1 - SRC/zhetrd.f | 1 - SRC/zhetrd_2stage.f | 1 - SRC/zhetrd_he2hb.f | 1 - SRC/zhetrf.f | 1 - SRC/zhetrf_aa.f | 1 - SRC/zhetrf_aa_2stage.f | 1 - SRC/zhetrf_rk.f | 1 - SRC/zhetrf_rook.f | 1 - SRC/zhetri.f | 1 - SRC/zhetri2.f | 1 - SRC/zhetri2x.f | 1 - SRC/zhetri_3.f | 1 - SRC/zhetri_3x.f | 1 - SRC/zhetri_rook.f | 1 - SRC/zhetrs.f | 1 - SRC/zhetrs2.f | 1 - SRC/zhetrs_3.f | 1 - SRC/zhetrs_aa.f | 1 - SRC/zhetrs_aa_2stage.f | 1 - SRC/zhetrs_rook.f | 1 - SRC/zhfrk.f | 1 - SRC/zhgeqz.f | 1 - SRC/zhpcon.f | 1 - SRC/zhpev.f | 1 - SRC/zhpevd.f | 1 - SRC/zhpevx.f | 1 - SRC/zhpgst.f | 1 - SRC/zhpgv.f | 1 - SRC/zhpgvd.f | 1 - SRC/zhpgvx.f | 1 - SRC/zhprfs.f | 1 - SRC/zhpsv.f | 1 - SRC/zhpsvx.f | 1 - SRC/zhptrd.f | 1 - SRC/zhptrf.f | 1 - SRC/zhptri.f | 1 - SRC/zhptrs.f | 1 - SRC/zhsein.f | 1 - SRC/zhseqr.f | 1 - SRC/zla_gbamv.f | 1 - SRC/zla_gbrcond_c.f | 1 - SRC/zla_gbrcond_x.f | 1 - SRC/zla_gbrfsx_extended.f | 1 - SRC/zla_gbrpvgrw.f | 1 - SRC/zla_geamv.f | 1 - SRC/zla_gercond_c.f | 1 - SRC/zla_gercond_x.f | 1 - SRC/zla_gerfsx_extended.f | 1 - SRC/zla_gerpvgrw.f | 1 - SRC/zla_heamv.f | 1 - SRC/zla_hercond_c.f | 1 - SRC/zla_hercond_x.f | 1 - SRC/zla_herfsx_extended.f | 1 - SRC/zla_herpvgrw.f | 1 - SRC/zla_lin_berr.f | 1 - SRC/zla_porcond_c.f | 1 - SRC/zla_porcond_x.f | 1 - SRC/zla_porfsx_extended.f | 1 - SRC/zla_porpvgrw.f | 1 - SRC/zla_syamv.f | 1 - SRC/zla_syrcond_c.f | 1 - SRC/zla_syrcond_x.f | 1 - SRC/zla_syrfsx_extended.f | 1 - SRC/zla_syrpvgrw.f | 1 - SRC/zla_wwaddw.f | 1 - SRC/zlabrd.f | 1 - SRC/zlacgv.f | 1 - SRC/zlacn2.f | 1 - SRC/zlacon.f | 1 - SRC/zlacp2.f | 1 - SRC/zlacpy.f | 1 - SRC/zlacrm.f | 1 - SRC/zlacrt.f | 1 - SRC/zladiv.f | 1 - SRC/zlaed0.f | 1 - SRC/zlaed7.f | 1 - SRC/zlaed8.f | 1 - SRC/zlaein.f | 1 - SRC/zlaesy.f | 1 - SRC/zlaev2.f | 1 - SRC/zlag2c.f | 1 - SRC/zlags2.f | 1 - SRC/zlagtm.f | 1 - SRC/zlahef.f | 1 - SRC/zlahef_aa.f | 1 - SRC/zlahef_rk.f | 1 - SRC/zlahef_rook.f | 1 - SRC/zlahqr.f | 1 - SRC/zlahr2.f | 1 - SRC/zlaic1.f | 1 - SRC/zlals0.f | 1 - SRC/zlalsa.f | 1 - SRC/zlalsd.f | 1 - SRC/zlamswlq.f | 1 - SRC/zlamtsqr.f | 1 - SRC/zlangb.f | 1 - SRC/zlange.f | 1 - SRC/zlangt.f | 1 - SRC/zlanhb.f | 1 - SRC/zlanhe.f | 1 - SRC/zlanhf.f | 1 - SRC/zlanhp.f | 1 - SRC/zlanhs.f | 1 - SRC/zlanht.f | 1 - SRC/zlansb.f | 1 - SRC/zlansp.f | 1 - SRC/zlansy.f | 1 - SRC/zlantb.f | 1 - SRC/zlantp.f | 1 - SRC/zlantr.f | 1 - SRC/zlapll.f | 1 - SRC/zlapmr.f | 1 - SRC/zlapmt.f | 1 - SRC/zlaqgb.f | 1 - SRC/zlaqge.f | 1 - SRC/zlaqhb.f | 1 - SRC/zlaqhe.f | 1 - SRC/zlaqhp.f | 1 - SRC/zlaqp2.f | 1 - SRC/zlaqp2rk.f | 1 - SRC/zlaqp3rk.f | 1 - SRC/zlaqps.f | 1 - SRC/zlaqr0.f | 1 - SRC/zlaqr1.f | 1 - SRC/zlaqr2.f | 1 - SRC/zlaqr3.f | 1 - SRC/zlaqr4.f | 1 - SRC/zlaqr5.f | 1 - SRC/zlaqsb.f | 1 - SRC/zlaqsp.f | 1 - SRC/zlaqsy.f | 1 - SRC/zlaqz0.f | 1 - SRC/zlaqz1.f | 1 - SRC/zlaqz2.f | 1 - SRC/zlaqz3.f | 1 - SRC/zlar1v.f | 1 - SRC/zlar2v.f | 1 - SRC/zlarcm.f | 1 - SRC/zlarf.f | 1 - SRC/zlarfb.f | 1 - SRC/zlarfb_gett.f | 1 - SRC/zlarfg.f | 1 - SRC/zlarfgp.f | 1 - SRC/zlarft.f | 1 - SRC/zlarfx.f | 1 - SRC/zlarfy.f | 1 - SRC/zlargv.f | 1 - SRC/zlarnv.f | 1 - SRC/zlarrv.f | 1 - SRC/zlarscl2.f | 1 - SRC/zlartg.f90 | 1 - SRC/zlartv.f | 1 - SRC/zlarz.f | 1 - SRC/zlarzb.f | 1 - SRC/zlarzt.f | 1 - SRC/zlascl.f | 1 - SRC/zlascl2.f | 1 - SRC/zlaset.f | 1 - SRC/zlasr.f | 1 - SRC/zlassq.f90 | 1 - SRC/zlaswlq.f | 1 - SRC/zlaswp.f | 1 - SRC/zlasyf.f | 1 - SRC/zlasyf_aa.f | 1 - SRC/zlasyf_rk.f | 1 - SRC/zlasyf_rook.f | 1 - SRC/zlat2c.f | 1 - SRC/zlatbs.f | 1 - SRC/zlatdf.f | 1 - SRC/zlatps.f | 1 - SRC/zlatrd.f | 1 - SRC/zlatrs.f | 1 - SRC/zlatrs3.f | 1 - SRC/zlatrz.f | 1 - SRC/zlatsqr.f | 1 - SRC/zlaunhr_col_getrfnp.f | 1 - SRC/zlaunhr_col_getrfnp2.f | 1 - SRC/zlauu2.f | 1 - SRC/zlauum.f | 1 - SRC/zpbcon.f | 1 - SRC/zpbequ.f | 1 - SRC/zpbrfs.f | 1 - SRC/zpbstf.f | 1 - SRC/zpbsv.f | 1 - SRC/zpbsvx.f | 1 - SRC/zpbtf2.f | 1 - SRC/zpbtrf.f | 1 - SRC/zpbtrs.f | 1 - SRC/zpftrf.f | 1 - SRC/zpftri.f | 1 - SRC/zpftrs.f | 1 - SRC/zpocon.f | 1 - SRC/zpoequ.f | 1 - SRC/zpoequb.f | 1 - SRC/zporfs.f | 1 - SRC/zporfsx.f | 1 - SRC/zposv.f | 1 - SRC/zposvx.f | 1 - SRC/zposvxx.f | 1 - SRC/zpotf2.f | 1 - SRC/zpotrf.f | 1 - SRC/zpotrf2.f | 1 - SRC/zpotri.f | 1 - SRC/zpotrs.f | 1 - SRC/zppcon.f | 1 - SRC/zppequ.f | 1 - SRC/zpprfs.f | 1 - SRC/zppsv.f | 1 - SRC/zppsvx.f | 1 - SRC/zpptrf.f | 1 - SRC/zpptri.f | 1 - SRC/zpptrs.f | 1 - SRC/zpstf2.f | 1 - SRC/zpstrf.f | 1 - SRC/zptcon.f | 1 - SRC/zpteqr.f | 1 - SRC/zptrfs.f | 1 - SRC/zptsv.f | 1 - SRC/zptsvx.f | 1 - SRC/zpttrf.f | 1 - SRC/zpttrs.f | 1 - SRC/zptts2.f | 1 - SRC/zrot.f | 1 - SRC/zrscl.f | 1 - SRC/zspcon.f | 1 - SRC/zspmv.f | 1 - SRC/zspr.f | 1 - SRC/zsprfs.f | 1 - SRC/zspsv.f | 1 - SRC/zspsvx.f | 1 - SRC/zsptrf.f | 1 - SRC/zsptri.f | 1 - SRC/zsptrs.f | 1 - SRC/zstedc.f | 1 - SRC/zstegr.f | 1 - SRC/zstein.f | 1 - SRC/zstemr.f | 1 - SRC/zsteqr.f | 1 - SRC/zsycon.f | 1 - SRC/zsycon_3.f | 1 - SRC/zsycon_rook.f | 1 - SRC/zsyconv.f | 1 - SRC/zsyconvf.f | 1 - SRC/zsyconvf_rook.f | 1 - SRC/zsyequb.f | 1 - SRC/zsymv.f | 1 - SRC/zsyr.f | 1 - SRC/zsyrfs.f | 1 - SRC/zsyrfsx.f | 1 - SRC/zsysv.f | 1 - SRC/zsysv_aa.f | 1 - SRC/zsysv_aa_2stage.f | 1 - SRC/zsysv_rk.f | 1 - SRC/zsysv_rook.f | 1 - SRC/zsysvx.f | 1 - SRC/zsysvxx.f | 1 - SRC/zsyswapr.f | 1 - SRC/zsytf2.f | 1 - SRC/zsytf2_rk.f | 1 - SRC/zsytf2_rook.f | 1 - SRC/zsytrf.f | 1 - SRC/zsytrf_aa.f | 1 - SRC/zsytrf_aa_2stage.f | 1 - SRC/zsytrf_rk.f | 1 - SRC/zsytrf_rook.f | 1 - SRC/zsytri.f | 1 - SRC/zsytri2.f | 1 - SRC/zsytri2x.f | 1 - SRC/zsytri_3.f | 1 - SRC/zsytri_3x.f | 1 - SRC/zsytri_rook.f | 1 - SRC/zsytrs.f | 1 - SRC/zsytrs2.f | 1 - SRC/zsytrs_3.f | 1 - SRC/zsytrs_aa.f | 1 - SRC/zsytrs_aa_2stage.f | 1 - SRC/zsytrs_rook.f | 1 - SRC/ztbcon.f | 1 - SRC/ztbrfs.f | 1 - SRC/ztbtrs.f | 1 - SRC/ztfsm.f | 1 - SRC/ztftri.f | 1 - SRC/ztfttp.f | 1 - SRC/ztfttr.f | 1 - SRC/ztgevc.f | 1 - SRC/ztgex2.f | 1 - SRC/ztgexc.f | 1 - SRC/ztgsen.f | 1 - SRC/ztgsja.f | 1 - SRC/ztgsna.f | 1 - SRC/ztgsy2.f | 1 - SRC/ztgsyl.f | 1 - SRC/ztpcon.f | 1 - SRC/ztplqt.f | 1 - SRC/ztplqt2.f | 1 - SRC/ztpmlqt.f | 1 - SRC/ztpmqrt.f | 1 - SRC/ztpqrt.f | 1 - SRC/ztpqrt2.f | 1 - SRC/ztprfb.f | 1 - SRC/ztprfs.f | 1 - SRC/ztptri.f | 1 - SRC/ztptrs.f | 1 - SRC/ztpttf.f | 1 - SRC/ztpttr.f | 1 - SRC/ztrcon.f | 1 - SRC/ztrevc.f | 1 - SRC/ztrevc3.f | 1 - SRC/ztrexc.f | 1 - SRC/ztrrfs.f | 1 - SRC/ztrsen.f | 1 - SRC/ztrsna.f | 1 - SRC/ztrsyl.f | 1 - SRC/ztrsyl3.f | 1 - SRC/ztrti2.f | 1 - SRC/ztrtri.f | 1 - SRC/ztrtrs.f | 1 - SRC/ztrttf.f | 1 - SRC/ztrttp.f | 1 - SRC/ztzrzf.f | 1 - SRC/zunbdb.f | 1 - SRC/zunbdb1.f | 1 - SRC/zunbdb2.f | 1 - SRC/zunbdb3.f | 1 - SRC/zunbdb4.f | 1 - SRC/zunbdb5.f | 1 - SRC/zunbdb6.f | 1 - SRC/zuncsd.f | 1 - SRC/zuncsd2by1.f | 1 - SRC/zung2l.f | 1 - SRC/zung2r.f | 1 - SRC/zungbr.f | 1 - SRC/zunghr.f | 1 - SRC/zungl2.f | 1 - SRC/zunglq.f | 1 - SRC/zungql.f | 1 - SRC/zungqr.f | 1 - SRC/zungr2.f | 1 - SRC/zungrq.f | 1 - SRC/zungtr.f | 1 - SRC/zungtsqr.f | 1 - SRC/zungtsqr_row.f | 1 - SRC/zunhr_col.f | 1 - SRC/zunm22.f | 1 - SRC/zunm2l.f | 1 - SRC/zunm2r.f | 1 - SRC/zunmbr.f | 1 - SRC/zunmhr.f | 1 - SRC/zunml2.f | 1 - SRC/zunmlq.f | 1 - SRC/zunmql.f | 1 - SRC/zunmqr.f | 1 - SRC/zunmr2.f | 1 - SRC/zunmr3.f | 1 - SRC/zunmrq.f | 1 - SRC/zunmrz.f | 1 - SRC/zunmtr.f | 1 - SRC/zupgtr.f | 1 - SRC/zupmtr.f | 1 - 2055 files changed, 12 insertions(+), 2056 deletions(-) diff --git a/INSTALL/dlamch.f b/INSTALL/dlamch.f index ae327134b2..c3a7b61581 100644 --- a/INSTALL/dlamch.f +++ b/INSTALL/dlamch.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b DLAMCH * * =========== DOCUMENTATION =========== diff --git a/INSTALL/droundup_lwork.f b/INSTALL/droundup_lwork.f index 28ec970f7a..8df68b0ef5 100644 --- a/INSTALL/droundup_lwork.f +++ b/INSTALL/droundup_lwork.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b DROUNDUP_LWORK * * =========== DOCUMENTATION =========== diff --git a/INSTALL/ilaver.f b/INSTALL/ilaver.f index db6f81c40c..ced58e6b0f 100644 --- a/INSTALL/ilaver.f +++ b/INSTALL/ilaver.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b ILAVER returns the LAPACK version. ** * =========== DOCUMENTATION =========== diff --git a/INSTALL/lsame.f b/INSTALL/lsame.f index e47cfac9bc..7bb7315dcb 100644 --- a/INSTALL/lsame.f +++ b/INSTALL/lsame.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b LSAME * * =========== DOCUMENTATION =========== diff --git a/INSTALL/slamch.f b/INSTALL/slamch.f index 37ae246aeb..cfe0770a85 100644 --- a/INSTALL/slamch.f +++ b/INSTALL/slamch.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b SLAMCH * * =========== DOCUMENTATION =========== diff --git a/INSTALL/sroundup_lwork.f b/INSTALL/sroundup_lwork.f index bfe57ee238..7056ea3117 100644 --- a/INSTALL/sroundup_lwork.f +++ b/INSTALL/sroundup_lwork.f @@ -1,4 +1,3 @@ -#include "../SRC/lapack_64.h" *> \brief \b SROUNDUP_LWORK * * =========== DOCUMENTATION =========== diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index d73cdec28a..8642ca511e 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -536,10 +536,17 @@ set_target_properties( if(BUILD_INDEX64_EXT_API) set(SOURCES_64) - list(APPEND SOURCES_64 ${SOURCES}) + file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) + file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) + file(GLOB SOURCES_64 ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj/*.*) list(REMOVE_ITEM SOURCES_64 la_xisnan.F90) - list(REMOVE_ITEM SOURCES_64 ${SECOND_SRC}) - list(REMOVE_ITEM SOURCES_64 ${DSECOND_SRC}) + foreach(F IN LISTS SOURCES_64) + set(FFILE "") + file(READ ${F} FFILE) + file(WRITE ${F} "#include \"lapack_64.h\"\n") + file(APPEND ${F} "${FFILE}") + endforeach() + file(COPY lapack_64.h DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) add_library(${LAPACKLIB}_64_obj OBJECT ${SOURCES_64}) target_link_libraries(${LAPACKLIB}_64_obj mod_files) target_compile_options(${LAPACKLIB}_64_obj PRIVATE ${FOPT_ILP64} -DLAPACK_64) diff --git a/SRC/cbbcsd.f b/SRC/cbbcsd.f index 68228c6246..39f4d5aa00 100644 --- a/SRC/cbbcsd.f +++ b/SRC/cbbcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index ed985b0759..5c94c0cccb 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbbrd.f b/SRC/cgbbrd.f index f02ab881e3..3b2c24817a 100644 --- a/SRC/cgbbrd.f +++ b/SRC/cgbbrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbcon.f b/SRC/cgbcon.f index 0fa4ce3bfa..b18b7aebc5 100644 --- a/SRC/cgbcon.f +++ b/SRC/cgbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbequ.f b/SRC/cgbequ.f index fb749583f6..e3c30d5418 100644 --- a/SRC/cgbequ.f +++ b/SRC/cgbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbequb.f b/SRC/cgbequb.f index e625d3f706..7dd23d00e3 100644 --- a/SRC/cgbequb.f +++ b/SRC/cgbequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbrfs.f b/SRC/cgbrfs.f index e294788ac8..6cce4f172c 100644 --- a/SRC/cgbrfs.f +++ b/SRC/cgbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbrfsx.f b/SRC/cgbrfsx.f index 0d6949a3cd..d458c2c797 100644 --- a/SRC/cgbrfsx.f +++ b/SRC/cgbrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsv.f b/SRC/cgbsv.f index 68635a8498..f96704b6c4 100644 --- a/SRC/cgbsv.f +++ b/SRC/cgbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsvx.f b/SRC/cgbsvx.f index 8a39944121..efa00f211b 100644 --- a/SRC/cgbsvx.f +++ b/SRC/cgbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbsvxx.f b/SRC/cgbsvxx.f index a52e38beb1..de001be1f3 100644 --- a/SRC/cgbsvxx.f +++ b/SRC/cgbsvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtf2.f b/SRC/cgbtf2.f index 156cddf11c..878dd62a60 100644 --- a/SRC/cgbtf2.f +++ b/SRC/cgbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtrf.f b/SRC/cgbtrf.f index 8d9930d557..b90ea74930 100644 --- a/SRC/cgbtrf.f +++ b/SRC/cgbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgbtrs.f b/SRC/cgbtrs.f index 2b813a8f78..c392f85141 100644 --- a/SRC/cgbtrs.f +++ b/SRC/cgbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebak.f b/SRC/cgebak.f index c0e64a1c4f..4581b62e9f 100644 --- a/SRC/cgebak.f +++ b/SRC/cgebak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebal.f b/SRC/cgebal.f index 16ea928124..f40c008791 100644 --- a/SRC/cgebal.f +++ b/SRC/cgebal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebd2.f b/SRC/cgebd2.f index fdc1885cca..5175d9e845 100644 --- a/SRC/cgebd2.f +++ b/SRC/cgebd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgebrd.f b/SRC/cgebrd.f index cfb7476400..39b73c5c4b 100644 --- a/SRC/cgebrd.f +++ b/SRC/cgebrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgecon.f b/SRC/cgecon.f index 917d7fea39..7bf27beec8 100644 --- a/SRC/cgecon.f +++ b/SRC/cgecon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index d3badc9a19..87e92eeb4c 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b CGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index d294760c0d..dd70a34a9e 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b CGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/cgeequ.f b/SRC/cgeequ.f index 7ae1cf12f5..9b4e19d2bd 100644 --- a/SRC/cgeequ.f +++ b/SRC/cgeequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeequb.f b/SRC/cgeequb.f index 939c816548..60ce07d9c7 100644 --- a/SRC/cgeequb.f +++ b/SRC/cgeequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cgees.f b/SRC/cgees.f index b7a4d03124..69189adbb1 100644 --- a/SRC/cgees.f +++ b/SRC/cgees.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index 3fdf632907..4d0f81e537 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeev.f b/SRC/cgeev.f index 42dc5e2dfc..0264a60410 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index b0fa8c5dc5..46f9a123bd 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgehd2.f b/SRC/cgehd2.f index 513b731b1f..2502d38b9a 100644 --- a/SRC/cgehd2.f +++ b/SRC/cgehd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index d646898ccf..f2a7d042ae 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f index 1dd4b1c608..8940c4ca4f 100644 --- a/SRC/cgejsv.f +++ b/SRC/cgejsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelq.f b/SRC/cgelq.f index 69dd97af5c..ab947b34bd 100644 --- a/SRC/cgelq.f +++ b/SRC/cgelq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGELQ * * Definition: diff --git a/SRC/cgelq2.f b/SRC/cgelq2.f index 441ac0518a..bf7d669a13 100644 --- a/SRC/cgelq2.f +++ b/SRC/cgelq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelqf.f b/SRC/cgelqf.f index e7535b4b4e..f6eca3c5d8 100644 --- a/SRC/cgelqf.f +++ b/SRC/cgelqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelqt.f b/SRC/cgelqt.f index 557373a2b9..5f4bb59063 100644 --- a/SRC/cgelqt.f +++ b/SRC/cgelqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGELQT * * Definition: diff --git a/SRC/cgelqt3.f b/SRC/cgelqt3.f index 600db841d9..fe56b576c4 100644 --- a/SRC/cgelqt3.f +++ b/SRC/cgelqt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGELQT3 * * Definition: diff --git a/SRC/cgels.f b/SRC/cgels.f index ce455c25b7..740bac890e 100644 --- a/SRC/cgels.f +++ b/SRC/cgels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index b29327280c..b4315ddfd0 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelss.f b/SRC/cgelss.f index 4ff56efe81..802b038af3 100644 --- a/SRC/cgelss.f +++ b/SRC/cgelss.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelst.f b/SRC/cgelst.f index 2528e798ef..0178c53dcb 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgelsy.f b/SRC/cgelsy.f index cadc382044..9a9a01b175 100644 --- a/SRC/cgelsy.f +++ b/SRC/cgelsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f index b180671a5c..e5b02b6693 100644 --- a/SRC/cgemlq.f +++ b/SRC/cgemlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEMLQ * * Definition: diff --git a/SRC/cgemlqt.f b/SRC/cgemlqt.f index 3b8fdf9f9b..5e43f0b600 100644 --- a/SRC/cgemlqt.f +++ b/SRC/cgemlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEMLQT * * Definition: diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f index 2d848a808e..0b7dd9dd71 100644 --- a/SRC/cgemqr.f +++ b/SRC/cgemqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEMQR * * Definition: diff --git a/SRC/cgemqrt.f b/SRC/cgemqrt.f index 73e46559c5..bf7d99632a 100644 --- a/SRC/cgemqrt.f +++ b/SRC/cgemqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeql2.f b/SRC/cgeql2.f index de570d0941..c55c6d76ad 100644 --- a/SRC/cgeql2.f +++ b/SRC/cgeql2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqlf.f b/SRC/cgeqlf.f index ee289d6c98..7ec9df0238 100644 --- a/SRC/cgeqlf.f +++ b/SRC/cgeqlf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqp3.f b/SRC/cgeqp3.f index f0ffce6223..17fdd22863 100644 --- a/SRC/cgeqp3.f +++ b/SRC/cgeqp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f index 8813484cfb..656c01ef89 100644 --- a/SRC/cgeqp3rk.f +++ b/SRC/cgeqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index 7c08393a07..3f286acd02 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQR * * Definition: diff --git a/SRC/cgeqr2.f b/SRC/cgeqr2.f index a0572bcf13..29dddb2085 100644 --- a/SRC/cgeqr2.f +++ b/SRC/cgeqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqr2p.f b/SRC/cgeqr2p.f index 812860f92a..fb5012b49a 100644 --- a/SRC/cgeqr2p.f +++ b/SRC/cgeqr2p.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrf.f b/SRC/cgeqrf.f index db7fbcc502..bf22a2cd3b 100644 --- a/SRC/cgeqrf.f +++ b/SRC/cgeqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrfp.f b/SRC/cgeqrfp.f index 58d8fd1899..5b6226c67b 100644 --- a/SRC/cgeqrfp.f +++ b/SRC/cgeqrfp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt.f b/SRC/cgeqrt.f index c3571873bb..3d94d56443 100644 --- a/SRC/cgeqrt.f +++ b/SRC/cgeqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt2.f b/SRC/cgeqrt2.f index 1b801b5444..dc7c2045b0 100644 --- a/SRC/cgeqrt2.f +++ b/SRC/cgeqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgeqrt3.f b/SRC/cgeqrt3.f index de24ef607f..f3bb4ab67e 100644 --- a/SRC/cgeqrt3.f +++ b/SRC/cgeqrt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerfs.f b/SRC/cgerfs.f index 900853f0ad..44c4793b3e 100644 --- a/SRC/cgerfs.f +++ b/SRC/cgerfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerfsx.f b/SRC/cgerfsx.f index 4513492ad6..fdbf8829a8 100644 --- a/SRC/cgerfsx.f +++ b/SRC/cgerfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerq2.f b/SRC/cgerq2.f index 5ef9ec1253..ac1217118d 100644 --- a/SRC/cgerq2.f +++ b/SRC/cgerq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgerqf.f b/SRC/cgerqf.f index aaf3b1dc98..fa0ec26308 100644 --- a/SRC/cgerqf.f +++ b/SRC/cgerqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesc2.f b/SRC/cgesc2.f index 5fe420a2a2..677a0ac408 100644 --- a/SRC/cgesc2.f +++ b/SRC/cgesc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesdd.f b/SRC/cgesdd.f index a58f3b4414..8ef628fa50 100644 --- a/SRC/cgesdd.f +++ b/SRC/cgesdd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesv.f b/SRC/cgesv.f index eb63b38354..ef4ef6631f 100644 --- a/SRC/cgesv.f +++ b/SRC/cgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \addtogroup gesv *> *> \brief CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/cgesvd.f b/SRC/cgesvd.f index ff365b3937..a7701b4aef 100644 --- a/SRC/cgesvd.f +++ b/SRC/cgesvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvdq.f b/SRC/cgesvdq.f index 70aab395a7..d15e5ddf8e 100644 --- a/SRC/cgesvdq.f +++ b/SRC/cgesvdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f index 1200af71a1..c8272b4775 100644 --- a/SRC/cgesvdx.f +++ b/SRC/cgesvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvj.f b/SRC/cgesvj.f index 98fac0c288..5a5b0d4e21 100644 --- a/SRC/cgesvj.f +++ b/SRC/cgesvj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvx.f b/SRC/cgesvx.f index f6303603dc..b1d7abc504 100644 --- a/SRC/cgesvx.f +++ b/SRC/cgesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgesvxx.f b/SRC/cgesvxx.f index c6cf636fea..45ef286b17 100644 --- a/SRC/cgesvxx.f +++ b/SRC/cgesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetc2.f b/SRC/cgetc2.f index e7446ee172..c452aa0670 100644 --- a/SRC/cgetc2.f +++ b/SRC/cgetc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetf2.f b/SRC/cgetf2.f index e36afaa915..995ee40ece 100644 --- a/SRC/cgetf2.f +++ b/SRC/cgetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrf.f b/SRC/cgetrf.f index b503826959..7402065da8 100644 --- a/SRC/cgetrf.f +++ b/SRC/cgetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrf2.f b/SRC/cgetrf2.f index 771e68cae8..8622918d3a 100644 --- a/SRC/cgetrf2.f +++ b/SRC/cgetrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetri.f b/SRC/cgetri.f index 6cc7357037..9c4ae10a09 100644 --- a/SRC/cgetri.f +++ b/SRC/cgetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetrs.f b/SRC/cgetrs.f index 978ea4b129..fc8fdfd822 100644 --- a/SRC/cgetrs.f +++ b/SRC/cgetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index 9c3d6a20c1..606e814374 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETSLS * * Definition: diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 1e854d76d5..9134014c72 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/cggbak.f b/SRC/cggbak.f index e4463f53a6..ec508ad93d 100644 --- a/SRC/cggbak.f +++ b/SRC/cggbak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/cggbal.f b/SRC/cggbal.f index 17c4db95c1..b6fdad9190 100644 --- a/SRC/cggbal.f +++ b/SRC/cggbal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/cgges.f b/SRC/cgges.f index 2a95ed83d0..f6aeb45dbf 100644 --- a/SRC/cgges.f +++ b/SRC/cgges.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgges3.f b/SRC/cgges3.f index f231020d9b..039e17d34a 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/cggesx.f b/SRC/cggesx.f index cf61def12b..b96c64153e 100644 --- a/SRC/cggesx.f +++ b/SRC/cggesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggev.f b/SRC/cggev.f index cacc627c3a..23335ea13a 100644 --- a/SRC/cggev.f +++ b/SRC/cggev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggev3.f b/SRC/cggev3.f index 7645d8c652..a1200848ab 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/cggevx.f b/SRC/cggevx.f index 08f514690c..275e57ecdd 100644 --- a/SRC/cggevx.f +++ b/SRC/cggevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggglm.f b/SRC/cggglm.f index 5d2f018d0d..60828cf687 100644 --- a/SRC/cggglm.f +++ b/SRC/cggglm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f index 7174eab955..9966ff1b1c 100644 --- a/SRC/cgghd3.f +++ b/SRC/cgghd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgghrd.f b/SRC/cgghrd.f index 4a6115226c..ad0caa1573 100644 --- a/SRC/cgghrd.f +++ b/SRC/cgghrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/cgglse.f b/SRC/cgglse.f index 2b5bef4bcb..6fbd71d1ba 100644 --- a/SRC/cgglse.f +++ b/SRC/cgglse.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f index 6b9de0278e..0ad3da8bfe 100644 --- a/SRC/cggqrf.f +++ b/SRC/cggqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cggrqf.f b/SRC/cggrqf.f index ed09da5e2b..8470a1ce22 100644 --- a/SRC/cggrqf.f +++ b/SRC/cggrqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/cggsvd3.f b/SRC/cggsvd3.f index a465f08aa8..bbad2feda5 100644 --- a/SRC/cggsvd3.f +++ b/SRC/cggsvd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cggsvp3.f b/SRC/cggsvp3.f index ba22e45d54..0310c7393e 100644 --- a/SRC/cggsvp3.f +++ b/SRC/cggsvp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cgsvj0.f b/SRC/cgsvj0.f index 3c29318727..3348e3d69c 100644 --- a/SRC/cgsvj0.f +++ b/SRC/cgsvj0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGSVJ0 pre-processor for the routine cgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgsvj1.f b/SRC/cgsvj1.f index 9d0580fb20..291bf7f93f 100644 --- a/SRC/cgsvj1.f +++ b/SRC/cgsvj1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGSVJ1 pre-processor for the routine cgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtcon.f b/SRC/cgtcon.f index 70267d0ff2..517ed48f36 100644 --- a/SRC/cgtcon.f +++ b/SRC/cgtcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtrfs.f b/SRC/cgtrfs.f index 7857504560..a54d94b5fa 100644 --- a/SRC/cgtrfs.f +++ b/SRC/cgtrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtsv.f b/SRC/cgtsv.f index 30c774fece..5b4d651a83 100644 --- a/SRC/cgtsv.f +++ b/SRC/cgtsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtsvx.f b/SRC/cgtsvx.f index 6e186e36a6..d2646778aa 100644 --- a/SRC/cgtsvx.f +++ b/SRC/cgtsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cgttrf.f b/SRC/cgttrf.f index 7c79106a4b..c825fa3f6a 100644 --- a/SRC/cgttrf.f +++ b/SRC/cgttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cgttrs.f b/SRC/cgttrs.f index f79eda21f6..511ca0616c 100644 --- a/SRC/cgttrs.f +++ b/SRC/cgttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cgtts2.f b/SRC/cgtts2.f index cfd164bcd8..d66fe1bd1b 100644 --- a/SRC/cgtts2.f +++ b/SRC/cgtts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f index 2573273999..8c8a970452 100644 --- a/SRC/chb2st_kernels.f +++ b/SRC/chb2st_kernels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> c, Wed Dec 7 08:22:40 2016 diff --git a/SRC/chbev.f b/SRC/chbev.f index dc4f4de8ef..f8713d28e3 100644 --- a/SRC/chbev.f +++ b/SRC/chbev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbev_2stage.f b/SRC/chbev_2stage.f index 81e59003bd..9e1174df4b 100644 --- a/SRC/chbev_2stage.f +++ b/SRC/chbev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbev_2stage.f, fortran z -> c, Sat Nov 5 23:18:20 2016 diff --git a/SRC/chbevd.f b/SRC/chbevd.f index c1bc46c2a4..f54c0c963c 100644 --- a/SRC/chbevd.f +++ b/SRC/chbevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbevd_2stage.f b/SRC/chbevd_2stage.f index ce09a1244d..2361255e9a 100644 --- a/SRC/chbevd_2stage.f +++ b/SRC/chbevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbevd_2stage.f, fortran z -> c, Sat Nov 5 23:18:17 2016 diff --git a/SRC/chbevx.f b/SRC/chbevx.f index 821beccb00..cde356a514 100644 --- a/SRC/chbevx.f +++ b/SRC/chbevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chbevx_2stage.f b/SRC/chbevx_2stage.f index 88ced7b1ca..72b2098893 100644 --- a/SRC/chbevx_2stage.f +++ b/SRC/chbevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from zhbevx_2stage.f, fortran z -> c, Sat Nov 5 23:18:22 2016 diff --git a/SRC/chbgst.f b/SRC/chbgst.f index 6fde73e0b7..c3ba7dfa64 100644 --- a/SRC/chbgst.f +++ b/SRC/chbgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgv.f b/SRC/chbgv.f index 99ff043131..ab1dd274a6 100644 --- a/SRC/chbgv.f +++ b/SRC/chbgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgvd.f b/SRC/chbgvd.f index cb8aef714a..e573a6296c 100644 --- a/SRC/chbgvd.f +++ b/SRC/chbgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chbgvx.f b/SRC/chbgvx.f index b2566040fa..7856cbbc9e 100644 --- a/SRC/chbgvx.f +++ b/SRC/chbgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/chbtrd.f b/SRC/chbtrd.f index b834843ebc..4ba770dac6 100644 --- a/SRC/chbtrd.f +++ b/SRC/chbtrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/checon.f b/SRC/checon.f index 0156823cee..7cc6ab0187 100644 --- a/SRC/checon.f +++ b/SRC/checon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHECON * * =========== DOCUMENTATION =========== diff --git a/SRC/checon_3.f b/SRC/checon_3.f index ee10bf375e..2bf524c077 100644 --- a/SRC/checon_3.f +++ b/SRC/checon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHECON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/checon_rook.f b/SRC/checon_rook.f index 31a141f049..e60fdddb20 100644 --- a/SRC/checon_rook.f +++ b/SRC/checon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/cheequb.f b/SRC/cheequb.f index 5b122c7933..dbad1fa151 100644 --- a/SRC/cheequb.f +++ b/SRC/cheequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cheev.f b/SRC/cheev.f index cf0c0e3906..9f0e9579de 100644 --- a/SRC/cheev.f +++ b/SRC/cheev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheev_2stage.f b/SRC/cheev_2stage.f index db522ba7db..6f434020fc 100644 --- a/SRC/cheev_2stage.f +++ b/SRC/cheev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheev_2stage.f, fortran z -> c, Sat Nov 5 23:18:06 2016 diff --git a/SRC/cheevd.f b/SRC/cheevd.f index 366ba1d5a4..0367a33ba4 100644 --- a/SRC/cheevd.f +++ b/SRC/cheevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevd_2stage.f b/SRC/cheevd_2stage.f index af8998a001..042dbaf3f2 100644 --- a/SRC/cheevd_2stage.f +++ b/SRC/cheevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevd_2stage.f, fortran z -> c, Sat Nov 5 23:18:14 2016 diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 20ecda5ee5..162c8cd87e 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevr_2stage.f b/SRC/cheevr_2stage.f index d0999bf10d..480cc2a8d0 100644 --- a/SRC/cheevr_2stage.f +++ b/SRC/cheevr_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevr_2stage.f, fortran z -> c, Sat Nov 5 23:18:11 2016 diff --git a/SRC/cheevx.f b/SRC/cheevx.f index ad6c2e1d49..bf2e308849 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheevx_2stage.f b/SRC/cheevx_2stage.f index 3793e37445..621f91295c 100644 --- a/SRC/cheevx_2stage.f +++ b/SRC/cheevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @generated from zheevx_2stage.f, fortran z -> c, Sat Nov 5 23:18:09 2016 diff --git a/SRC/chegs2.f b/SRC/chegs2.f index eca69665d3..97af778c35 100644 --- a/SRC/chegs2.f +++ b/SRC/chegs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorization results obtained from cpotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chegst.f b/SRC/chegst.f index d5790df95a..240a372583 100644 --- a/SRC/chegst.f +++ b/SRC/chegst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chegv.f b/SRC/chegv.f index 8c5804e7ed..fbb97d60cf 100644 --- a/SRC/chegv.f +++ b/SRC/chegv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chegv_2stage.f b/SRC/chegv_2stage.f index d7afd1548a..67b897237f 100644 --- a/SRC/chegv_2stage.f +++ b/SRC/chegv_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGV_2STAGE * * @generated from zhegv_2stage.f, fortran z -> c, Sun Nov 6 13:09:52 2016 diff --git a/SRC/chegvd.f b/SRC/chegvd.f index 865e406a75..8f2e2e2f2d 100644 --- a/SRC/chegvd.f +++ b/SRC/chegvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chegvx.f b/SRC/chegvx.f index 3f548649ac..98fc518bb3 100644 --- a/SRC/chegvx.f +++ b/SRC/chegvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHEGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/cherfs.f b/SRC/cherfs.f index e43ad33d68..3a3b61b56d 100644 --- a/SRC/cherfs.f +++ b/SRC/cherfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cherfsx.f b/SRC/cherfsx.f index 71a1073b60..dcb786bc94 100644 --- a/SRC/cherfsx.f +++ b/SRC/cherfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv.f b/SRC/chesv.f index 4c11b53c5d..b2d7e59cfc 100644 --- a/SRC/chesv.f +++ b/SRC/chesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESV computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_aa.f b/SRC/chesv_aa.f index a3daf79050..ca87ba42b2 100644 --- a/SRC/chesv_aa.f +++ b/SRC/chesv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESV_AA computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_aa_2stage.f b/SRC/chesv_aa_2stage.f index fe9110c292..05ebd9253a 100644 --- a/SRC/chesv_aa_2stage.f +++ b/SRC/chesv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_rk.f b/SRC/chesv_rk.f index 4cb3989c09..1eb3af8504 100644 --- a/SRC/chesv_rk.f +++ b/SRC/chesv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesv_rook.f b/SRC/chesv_rook.f index 88859b0b18..b18527509c 100644 --- a/SRC/chesv_rook.f +++ b/SRC/chesv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the bounded Bunch-Kaufman ("rook") diagonal pivoting method * * =========== DOCUMENTATION =========== diff --git a/SRC/chesvx.f b/SRC/chesvx.f index 9d1a204218..68b84c2893 100644 --- a/SRC/chesvx.f +++ b/SRC/chesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESVX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chesvxx.f b/SRC/chesvxx.f index 4318bc5d9b..86e76a15b7 100644 --- a/SRC/chesvxx.f +++ b/SRC/chesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHESVXX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cheswapr.f b/SRC/cheswapr.f index 5734df94f3..a6161df5e6 100644 --- a/SRC/cheswapr.f +++ b/SRC/cheswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/chetd2.f b/SRC/chetd2.f index a7e33fbbf8..d250dd4688 100644 --- a/SRC/chetd2.f +++ b/SRC/chetd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2.f b/SRC/chetf2.f index 7f25b3dd76..9089f35fc0 100644 --- a/SRC/chetf2.f +++ b/SRC/chetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (unblocked algorithm calling Level 2 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2_rk.f b/SRC/chetf2_rk.f index 66c7d3e6e7..9dab85d7a0 100644 --- a/SRC/chetf2_rk.f +++ b/SRC/chetf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetf2_rook.f b/SRC/chetf2_rook.f index a810700d32..766f9c4aec 100644 --- a/SRC/chetf2_rook.f +++ b/SRC/chetf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrd.f b/SRC/chetrd.f index f225a5134a..15ea04b9fc 100644 --- a/SRC/chetrd.f +++ b/SRC/chetrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRD * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrd_2stage.f b/SRC/chetrd_2stage.f index d3cb67b001..b0c17cc4d3 100644 --- a/SRC/chetrd_2stage.f +++ b/SRC/chetrd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> c, Sun Nov 6 19:34:06 2016 diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 33360ce332..848eb0c208 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRD_HE2HB * * @generated from zhetrd_he2hb.f, fortran z -> c, Wed Dec 7 08:22:40 2016 diff --git a/SRC/chetrf.f b/SRC/chetrf.f index 8504495c07..74484b662e 100644 --- a/SRC/chetrf.f +++ b/SRC/chetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_aa.f b/SRC/chetrf_aa.f index a7737b93de..21b89e4855 100644 --- a/SRC/chetrf_aa.f +++ b/SRC/chetrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_aa_2stage.f b/SRC/chetrf_aa_2stage.f index c23a552194..b8049d3b24 100644 --- a/SRC/chetrf_aa_2stage.f +++ b/SRC/chetrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f index 2174afe2f1..e38f9eb3c3 100644 --- a/SRC/chetrf_rk.f +++ b/SRC/chetrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrf_rook.f b/SRC/chetrf_rook.f index 0f076e647a..c316c08cd5 100644 --- a/SRC/chetrf_rook.f +++ b/SRC/chetrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri.f b/SRC/chetri.f index 3ff1e8656f..5549211217 100644 --- a/SRC/chetri.f +++ b/SRC/chetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri2.f b/SRC/chetri2.f index 2456f788fb..f15065ae7d 100644 --- a/SRC/chetri2.f +++ b/SRC/chetri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri2x.f b/SRC/chetri2x.f index d0e393a857..2c1bd174bf 100644 --- a/SRC/chetri2x.f +++ b/SRC/chetri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_3.f b/SRC/chetri_3.f index 4847ab9513..ccfce5070b 100644 --- a/SRC/chetri_3.f +++ b/SRC/chetri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_3x.f b/SRC/chetri_3x.f index 57c1b9b77a..92b971945a 100644 --- a/SRC/chetri_3x.f +++ b/SRC/chetri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/chetri_rook.f b/SRC/chetri_rook.f index 989cbba3bc..16e72f039f 100644 --- a/SRC/chetri_rook.f +++ b/SRC/chetri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs.f b/SRC/chetrs.f index f71a4e83fe..f65b9bee72 100644 --- a/SRC/chetrs.f +++ b/SRC/chetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs2.f b/SRC/chetrs2.f index 7197c6b23d..d711e73779 100644 --- a/SRC/chetrs2.f +++ b/SRC/chetrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_3.f b/SRC/chetrs_3.f index 583f86f5f8..8dee2f0da1 100644 --- a/SRC/chetrs_3.f +++ b/SRC/chetrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f index e2a9c54232..d93d87fac1 100644 --- a/SRC/chetrs_aa.f +++ b/SRC/chetrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/chetrs_aa_2stage.f b/SRC/chetrs_aa_2stage.f index 468285ef08..4d8b848734 100644 --- a/SRC/chetrs_aa_2stage.f +++ b/SRC/chetrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS_AA_2STAGE * * @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017 diff --git a/SRC/chetrs_rook.f b/SRC/chetrs_rook.f index e65e881a53..5dc628742c 100644 --- a/SRC/chetrs_rook.f +++ b/SRC/chetrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/chfrk.f b/SRC/chfrk.f index 9c5df53638..c5ddaeec83 100644 --- a/SRC/chfrk.f +++ b/SRC/chfrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHFRK performs a Hermitian rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/chgeqz.f b/SRC/chgeqz.f index 9d419be327..d35e4f1686 100644 --- a/SRC/chgeqz.f +++ b/SRC/chgeqz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/chla_transtype.f b/SRC/chla_transtype.f index 01364a83e3..170a4e2b10 100644 --- a/SRC/chla_transtype.f +++ b/SRC/chla_transtype.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHLA_TRANSTYPE * * =========== DOCUMENTATION =========== diff --git a/SRC/chpcon.f b/SRC/chpcon.f index 13f7c64097..2f81e92b2f 100644 --- a/SRC/chpcon.f +++ b/SRC/chpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/chpev.f b/SRC/chpev.f index 8919baf877..2637c59f82 100644 --- a/SRC/chpev.f +++ b/SRC/chpev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpevd.f b/SRC/chpevd.f index 339f3b8ceb..7b21d69e23 100644 --- a/SRC/chpevd.f +++ b/SRC/chpevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpevx.f b/SRC/chpevx.f index 1123595fb3..766a04fdaa 100644 --- a/SRC/chpevx.f +++ b/SRC/chpevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgst.f b/SRC/chpgst.f index 6b56a97148..c74e7b831c 100644 --- a/SRC/chpgst.f +++ b/SRC/chpgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgv.f b/SRC/chpgv.f index 1cd4bb3ba1..55fc32ee52 100644 --- a/SRC/chpgv.f +++ b/SRC/chpgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgvd.f b/SRC/chpgvd.f index 655269e740..812d40e4e6 100644 --- a/SRC/chpgvd.f +++ b/SRC/chpgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/chpgvx.f b/SRC/chpgvx.f index 8b5bafdf70..6b2f570865 100644 --- a/SRC/chpgvx.f +++ b/SRC/chpgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/chprfs.f b/SRC/chprfs.f index 833a7db858..6df45b7a72 100644 --- a/SRC/chprfs.f +++ b/SRC/chprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/chpsv.f b/SRC/chpsv.f index eb1cc706fb..c5f09b9747 100644 --- a/SRC/chpsv.f +++ b/SRC/chpsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chpsvx.f b/SRC/chpsvx.f index 496e0e3db7..c435ac7965 100644 --- a/SRC/chpsvx.f +++ b/SRC/chpsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrd.f b/SRC/chptrd.f index 4cfcc48d7d..0122fd437a 100644 --- a/SRC/chptrd.f +++ b/SRC/chptrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrf.f b/SRC/chptrf.f index 7e7d1a1719..da8ed85c58 100644 --- a/SRC/chptrf.f +++ b/SRC/chptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/chptri.f b/SRC/chptri.f index 8bf10ccd67..bb958380f6 100644 --- a/SRC/chptri.f +++ b/SRC/chptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/chptrs.f b/SRC/chptrs.f index 51359ad129..b706825139 100644 --- a/SRC/chptrs.f +++ b/SRC/chptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/chsein.f b/SRC/chsein.f index ff93fd566c..69bf038c60 100644 --- a/SRC/chsein.f +++ b/SRC/chsein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/chseqr.f b/SRC/chseqr.f index 1f14ab2994..cb19756e75 100644 --- a/SRC/chseqr.f +++ b/SRC/chseqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbamv.f b/SRC/cla_gbamv.f index a8b0ca2980..c652e65ecb 100644 --- a/SRC/cla_gbamv.f +++ b/SRC/cla_gbamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrcond_c.f b/SRC/cla_gbrcond_c.f index 271aeeb004..011ff50971 100644 --- a/SRC/cla_gbrcond_c.f +++ b/SRC/cla_gbrcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GBRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrcond_x.f b/SRC/cla_gbrcond_x.f index 96a06b5b25..f14c1cea85 100644 --- a/SRC/cla_gbrcond_x.f +++ b/SRC/cla_gbrcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrfsx_extended.f b/SRC/cla_gbrfsx_extended.f index 788b4a9d63..855e2153ea 100644 --- a/SRC/cla_gbrfsx_extended.f +++ b/SRC/cla_gbrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gbrpvgrw.f b/SRC/cla_gbrpvgrw.f index 0037590ff7..e779e7ef5b 100644 --- a/SRC/cla_gbrpvgrw.f +++ b/SRC/cla_gbrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_geamv.f b/SRC/cla_geamv.f index 7c03b0e6f4..c00d2943d7 100644 --- a/SRC/cla_geamv.f +++ b/SRC/cla_geamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gercond_c.f b/SRC/cla_gercond_c.f index 8845a901fc..ba20174e0c 100644 --- a/SRC/cla_gercond_c.f +++ b/SRC/cla_gercond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gercond_x.f b/SRC/cla_gercond_x.f index 2aad9e3b53..a48c93c16a 100644 --- a/SRC/cla_gercond_x.f +++ b/SRC/cla_gercond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gerfsx_extended.f b/SRC/cla_gerfsx_extended.f index 7cf40b45f5..2e03fc807c 100644 --- a/SRC/cla_gerfsx_extended.f +++ b/SRC/cla_gerfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GERFSX_EXTENDED * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_gerpvgrw.f b/SRC/cla_gerpvgrw.f index 4ed992b335..26442ab4bf 100644 --- a/SRC/cla_gerpvgrw.f +++ b/SRC/cla_gerpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_GERPVGRW multiplies a square real matrix by a complex matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_heamv.f b/SRC/cla_heamv.f index 85cca0b553..5be2f9cb95 100644 --- a/SRC/cla_heamv.f +++ b/SRC/cla_heamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_hercond_c.f b/SRC/cla_hercond_c.f index 22aac12b7b..4b7e6e22dc 100644 --- a/SRC/cla_hercond_c.f +++ b/SRC/cla_hercond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_hercond_x.f b/SRC/cla_hercond_x.f index c53f40fe6d..ba8247bf17 100644 --- a/SRC/cla_hercond_x.f +++ b/SRC/cla_hercond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_herfsx_extended.f b/SRC/cla_herfsx_extended.f index 78540b5596..64aaa0f989 100644 --- a/SRC/cla_herfsx_extended.f +++ b/SRC/cla_herfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_HERFSX_EXTENDED improves the computed solution to a system of linear equations for Hermitian indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_herpvgrw.f b/SRC/cla_herpvgrw.f index 40f69dc5d5..3cab63e22b 100644 --- a/SRC/cla_herpvgrw.f +++ b/SRC/cla_herpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_HERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_lin_berr.f b/SRC/cla_lin_berr.f index e86906ed7f..38cbff6144 100644 --- a/SRC/cla_lin_berr.f +++ b/SRC/cla_lin_berr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porcond_c.f b/SRC/cla_porcond_c.f index 6a7a4fe7e1..7f08ade337 100644 --- a/SRC/cla_porcond_c.f +++ b/SRC/cla_porcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porcond_x.f b/SRC/cla_porcond_x.f index 3a9a36b446..328ab607a4 100644 --- a/SRC/cla_porcond_x.f +++ b/SRC/cla_porcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_PORCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porfsx_extended.f b/SRC/cla_porfsx_extended.f index 67bd93e587..8010f3d67e 100644 --- a/SRC/cla_porfsx_extended.f +++ b/SRC/cla_porfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_porpvgrw.f b/SRC/cla_porpvgrw.f index c5e0e73528..b00d1df83e 100644 --- a/SRC/cla_porpvgrw.f +++ b/SRC/cla_porpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syamv.f b/SRC/cla_syamv.f index 860c150564..fbf8be9920 100644 --- a/SRC/cla_syamv.f +++ b/SRC/cla_syamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrcond_c.f b/SRC/cla_syrcond_c.f index 98729f0792..4973ec634a 100644 --- a/SRC/cla_syrcond_c.f +++ b/SRC/cla_syrcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrcond_x.f b/SRC/cla_syrcond_x.f index 831f6db320..7fd7c5a014 100644 --- a/SRC/cla_syrcond_x.f +++ b/SRC/cla_syrcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrfsx_extended.f b/SRC/cla_syrfsx_extended.f index 2567675a27..1a5de80cc0 100644 --- a/SRC/cla_syrfsx_extended.f +++ b/SRC/cla_syrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_syrpvgrw.f b/SRC/cla_syrpvgrw.f index 9434437401..c56e659e57 100644 --- a/SRC/cla_syrpvgrw.f +++ b/SRC/cla_syrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cla_wwaddw.f b/SRC/cla_wwaddw.f index 2777cd987c..b767942431 100644 --- a/SRC/cla_wwaddw.f +++ b/SRC/cla_wwaddw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clabrd.f b/SRC/clabrd.f index e9ca7e4baa..0be8342b47 100644 --- a/SRC/clabrd.f +++ b/SRC/clabrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacgv.f b/SRC/clacgv.f index 8eed5e7313..27d8b48475 100644 --- a/SRC/clacgv.f +++ b/SRC/clacgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACGV conjugates a complex vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacn2.f b/SRC/clacn2.f index 61a1f99403..f253f7c187 100644 --- a/SRC/clacn2.f +++ b/SRC/clacn2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacon.f b/SRC/clacon.f index bc0d44ada9..13c2ed1f67 100644 --- a/SRC/clacon.f +++ b/SRC/clacon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacp2.f b/SRC/clacp2.f index 41c0da32e0..92a9f26642 100644 --- a/SRC/clacp2.f +++ b/SRC/clacp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACP2 copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacpy.f b/SRC/clacpy.f index 950d4b6b63..b365d92bfe 100644 --- a/SRC/clacpy.f +++ b/SRC/clacpy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacrm.f b/SRC/clacrm.f index 8f35905ca8..cca6e40aac 100644 --- a/SRC/clacrm.f +++ b/SRC/clacrm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACRM multiplies a complex matrix by a square real matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clacrt.f b/SRC/clacrt.f index 0df69036cd..666009aad4 100644 --- a/SRC/clacrt.f +++ b/SRC/clacrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLACRT performs a linear transformation of a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/cladiv.f b/SRC/cladiv.f index 23dd6ceb47..9d80831074 100644 --- a/SRC/cladiv.f +++ b/SRC/cladiv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed0.f b/SRC/claed0.f index b44fefc5db..42225ecf3d 100644 --- a/SRC/claed0.f +++ b/SRC/claed0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAED0 used by CSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed7.f b/SRC/claed7.f index 635857df13..1f47924d8c 100644 --- a/SRC/claed7.f +++ b/SRC/claed7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAED7 used by CSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/claed8.f b/SRC/claed8.f index 3466a49c4f..d4ad2a95fc 100644 --- a/SRC/claed8.f +++ b/SRC/claed8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAED8 used by CSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/claein.f b/SRC/claein.f index 7d4272566d..55ec299bd1 100644 --- a/SRC/claein.f +++ b/SRC/claein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/claesy.f b/SRC/claesy.f index 95d67a4e48..c6d8a3a0cf 100644 --- a/SRC/claesy.f +++ b/SRC/claesy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAESY computes the eigenvalues and eigenvectors of a 2-by-2 complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claev2.f b/SRC/claev2.f index d0d67cae68..e6178e471c 100644 --- a/SRC/claev2.f +++ b/SRC/claev2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clag2z.f b/SRC/clag2z.f index eb22f8aea3..5cf9dcc420 100644 --- a/SRC/clag2z.f +++ b/SRC/clag2z.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAG2Z converts a complex single precision matrix to a complex double precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clags2.f b/SRC/clags2.f index 13a6a043f6..203c4b2ef5 100644 --- a/SRC/clags2.f +++ b/SRC/clags2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAGS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/clagtm.f b/SRC/clagtm.f index 8ef5d5bcca..5741e01bbb 100644 --- a/SRC/clagtm.f +++ b/SRC/clagtm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef.f b/SRC/clahef.f index bd961dd7b0..1372673027 100644 --- a/SRC/clahef.f +++ b/SRC/clahef.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAHEF computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kaufman diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_aa.f b/SRC/clahef_aa.f index dd490c50d0..be6ecd0d24 100644 --- a/SRC/clahef_aa.f +++ b/SRC/clahef_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAHEF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_rk.f b/SRC/clahef_rk.f index 0dfa86e845..b97d68b14a 100644 --- a/SRC/clahef_rk.f +++ b/SRC/clahef_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahef_rook.f b/SRC/clahef_rook.f index 22efb1ff2b..2a0e76219e 100644 --- a/SRC/clahef_rook.f +++ b/SRC/clahef_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" * \brief \b CLAHEF_ROOK computes a partial factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/clahqr.f b/SRC/clahqr.f index 00b8a1196d..64fec186a9 100644 --- a/SRC/clahqr.f +++ b/SRC/clahqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/clahr2.f b/SRC/clahr2.f index d123ae1948..afceedf309 100644 --- a/SRC/clahr2.f +++ b/SRC/clahr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/claic1.f b/SRC/claic1.f index 01e14a8f77..43f63b026f 100644 --- a/SRC/claic1.f +++ b/SRC/claic1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/clals0.f b/SRC/clals0.f index 36b6db1315..36fc8419a4 100644 --- a/SRC/clals0.f +++ b/SRC/clals0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/clalsa.f b/SRC/clalsa.f index 68df81d60a..95afaabbc2 100644 --- a/SRC/clalsa.f +++ b/SRC/clalsa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/clalsd.f b/SRC/clalsd.f index be0972f3bd..a671e88ee4 100644 --- a/SRC/clalsd.f +++ b/SRC/clalsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index a80ca8b52c..8f474a3abb 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAMSWLQ * * Definition: diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f index 387f982a59..13625087f0 100644 --- a/SRC/clamtsqr.f +++ b/SRC/clamtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAMTSQR * * Definition: diff --git a/SRC/clangb.f b/SRC/clangb.f index 5232c2efb8..1f61b2d873 100644 --- a/SRC/clangb.f +++ b/SRC/clangb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clange.f b/SRC/clange.f index bca5b3ed59..758d00b50a 100644 --- a/SRC/clange.f +++ b/SRC/clange.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clangt.f b/SRC/clangt.f index d567570fe5..194eb3aa8d 100644 --- a/SRC/clangt.f +++ b/SRC/clangt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhb.f b/SRC/clanhb.f index 73d5fb0a14..f6298d88a4 100644 --- a/SRC/clanhb.f +++ b/SRC/clanhb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhe.f b/SRC/clanhe.f index f0d4be6ab9..7c4ed981a8 100644 --- a/SRC/clanhe.f +++ b/SRC/clanhe.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhf.f b/SRC/clanhf.f index 90557e5334..5844864def 100644 --- a/SRC/clanhf.f +++ b/SRC/clanhf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhp.f b/SRC/clanhp.f index ceade7760b..8399a7a748 100644 --- a/SRC/clanhp.f +++ b/SRC/clanhp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanhs.f b/SRC/clanhs.f index 40166f3b95..74a8c486c7 100644 --- a/SRC/clanhs.f +++ b/SRC/clanhs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clanht.f b/SRC/clanht.f index cc67b27d78..5db01999a3 100644 --- a/SRC/clanht.f +++ b/SRC/clanht.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansb.f b/SRC/clansb.f index d692b8c5d8..8aa1cd3ddc 100644 --- a/SRC/clansb.f +++ b/SRC/clansb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansp.f b/SRC/clansp.f index f18fa18dd9..4b1a3ab7da 100644 --- a/SRC/clansp.f +++ b/SRC/clansp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clansy.f b/SRC/clansy.f index d7714868f3..d6b7788d63 100644 --- a/SRC/clansy.f +++ b/SRC/clansy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantb.f b/SRC/clantb.f index 613ed118b7..f91e366437 100644 --- a/SRC/clantb.f +++ b/SRC/clantb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantp.f b/SRC/clantp.f index e359e4e970..482d5e8532 100644 --- a/SRC/clantp.f +++ b/SRC/clantp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/clantr.f b/SRC/clantr.f index 944e0afbd7..2b568eea32 100644 --- a/SRC/clantr.f +++ b/SRC/clantr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapll.f b/SRC/clapll.f index 112f54b2c4..5bb450871b 100644 --- a/SRC/clapll.f +++ b/SRC/clapll.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapmr.f b/SRC/clapmr.f index d95c2c20d0..1c9535896a 100644 --- a/SRC/clapmr.f +++ b/SRC/clapmr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/clapmt.f b/SRC/clapmt.f index ab430d402d..a6edcb2539 100644 --- a/SRC/clapmt.f +++ b/SRC/clapmt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqgb.f b/SRC/claqgb.f index 020b5a67a9..4b71c46ee3 100644 --- a/SRC/claqgb.f +++ b/SRC/claqgb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqge.f b/SRC/claqge.f index 3cc36e68cf..c0cb8a750f 100644 --- a/SRC/claqge.f +++ b/SRC/claqge.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhb.f b/SRC/claqhb.f index fe2d590878..5a77ac5367 100644 --- a/SRC/claqhb.f +++ b/SRC/claqhb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhe.f b/SRC/claqhe.f index 6f3ebbf829..7a243ab2b4 100644 --- a/SRC/claqhe.f +++ b/SRC/claqhe.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQHE scales a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqhp.f b/SRC/claqhp.f index d181963698..34cc74c6c7 100644 --- a/SRC/claqhp.f +++ b/SRC/claqhp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQHP scales a Hermitian matrix stored in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqp2.f b/SRC/claqp2.f index c555de0c4f..544ddabc97 100644 --- a/SRC/claqp2.f +++ b/SRC/claqp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqp2rk.f b/SRC/claqp2rk.f index d5e9cb60a8..0501c50bb4 100644 --- a/SRC/claqp2rk.f +++ b/SRC/claqp2rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqp3rk.f b/SRC/claqp3rk.f index 52d8dd1b06..a381c53f88 100644 --- a/SRC/claqp3rk.f +++ b/SRC/claqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqps.f b/SRC/claqps.f index edbb2937b2..418fe664c1 100644 --- a/SRC/claqps.f +++ b/SRC/claqps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr0.f b/SRC/claqr0.f index 2042a6852b..d981be379a 100644 --- a/SRC/claqr0.f +++ b/SRC/claqr0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr1.f b/SRC/claqr1.f index 0a6624faef..f25a8ab281 100644 --- a/SRC/claqr1.f +++ b/SRC/claqr1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 7d56de0396..6abdb615e5 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR2 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr3.f b/SRC/claqr3.f index 763c10eb73..f516e5cfde 100644 --- a/SRC/claqr3.f +++ b/SRC/claqr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR3 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr4.f b/SRC/claqr4.f index a8f43a3247..278621871b 100644 --- a/SRC/claqr4.f +++ b/SRC/claqr4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqr5.f b/SRC/claqr5.f index 820d723174..ee7577f0d4 100644 --- a/SRC/claqr5.f +++ b/SRC/claqr5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsb.f b/SRC/claqsb.f index 4589fce84f..613a05b070 100644 --- a/SRC/claqsb.f +++ b/SRC/claqsb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsp.f b/SRC/claqsp.f index dc2431d73c..c59606b19c 100644 --- a/SRC/claqsp.f +++ b/SRC/claqsp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqsy.f b/SRC/claqsy.f index 5eb9b80eaf..11d1444e77 100644 --- a/SRC/claqsy.f +++ b/SRC/claqsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz0.f b/SRC/claqz0.f index 4621644142..706401caa3 100644 --- a/SRC/claqz0.f +++ b/SRC/claqz0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz1.f b/SRC/claqz1.f index e99040995d..a4edd5caca 100644 --- a/SRC/claqz1.f +++ b/SRC/claqz1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz2.f b/SRC/claqz2.f index b6afcf3d20..d021699c92 100644 --- a/SRC/claqz2.f +++ b/SRC/claqz2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/claqz3.f b/SRC/claqz3.f index 447839fb12..a26c22c40c 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/clar1v.f b/SRC/clar1v.f index 954da8b0bd..60183d2728 100644 --- a/SRC/clar1v.f +++ b/SRC/clar1v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/clar2v.f b/SRC/clar2v.f index 63d7d8aa1a..4f6a29cf80 100644 --- a/SRC/clar2v.f +++ b/SRC/clar2v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAR2V applies a vector of plane rotations with real cosines and complex sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarcm.f b/SRC/clarcm.f index a6fca0adca..0ee10399a1 100644 --- a/SRC/clarcm.f +++ b/SRC/clarcm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARCM copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarf.f b/SRC/clarf.f index 9cb07198fa..3c09960811 100644 --- a/SRC/clarf.f +++ b/SRC/clarf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfb.f b/SRC/clarfb.f index fc8052d79a..8abf14f652 100644 --- a/SRC/clarfb.f +++ b/SRC/clarfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfb_gett.f b/SRC/clarfb_gett.f index 6fbbef8027..5f078ab788 100644 --- a/SRC/clarfb_gett.f +++ b/SRC/clarfb_gett.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfg.f b/SRC/clarfg.f index 8ee459ce05..e335e0fd63 100644 --- a/SRC/clarfg.f +++ b/SRC/clarfg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f index 4f08a65e72..f1a24f52d2 100644 --- a/SRC/clarfgp.f +++ b/SRC/clarfgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarft.f b/SRC/clarft.f index 2740658511..9e2e4503e3 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfx.f b/SRC/clarfx.f index 53c90d8fd1..fdfc5a3f1f 100644 --- a/SRC/clarfx.f +++ b/SRC/clarfx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarfy.f b/SRC/clarfy.f index bbda28283a..f01ba7c0e0 100644 --- a/SRC/clarfy.f +++ b/SRC/clarfy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/clargv.f b/SRC/clargv.f index 0732178d0f..47a46f72ee 100644 --- a/SRC/clargv.f +++ b/SRC/clargv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARGV generates a vector of plane rotations with real cosines and complex sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarnv.f b/SRC/clarnv.f index 5d0586abf4..efef3a7b3a 100644 --- a/SRC/clarnv.f +++ b/SRC/clarnv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarrv.f b/SRC/clarrv.f index 5ac74a3d46..ddb1f5643c 100644 --- a/SRC/clarrv.f +++ b/SRC/clarrv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarscl2.f b/SRC/clarscl2.f index d128e8e699..3253b435ac 100644 --- a/SRC/clarscl2.f +++ b/SRC/clarscl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clartg.f90 b/SRC/clartg.f90 index b022ec6752..ffcf2b3e25 100644 --- a/SRC/clartg.f90 +++ b/SRC/clartg.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b CLARTG generates a plane rotation with real cosine and complex sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/clartv.f b/SRC/clartv.f index a4f5918523..987d809879 100644 --- a/SRC/clartv.f +++ b/SRC/clartv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARTV applies a vector of plane rotations with real cosines and complex sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarz.f b/SRC/clarz.f index 9ecb540e58..d242ac1faf 100644 --- a/SRC/clarz.f +++ b/SRC/clarz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarzb.f b/SRC/clarzb.f index 6f6ff22adf..6012a8e110 100644 --- a/SRC/clarzb.f +++ b/SRC/clarzb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARZB applies a block reflector or its conjugate-transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clarzt.f b/SRC/clarzt.f index 8cdf0ecdf3..9ecf3d853a 100644 --- a/SRC/clarzt.f +++ b/SRC/clarzt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/clascl.f b/SRC/clascl.f index c8061e0908..373e39091b 100644 --- a/SRC/clascl.f +++ b/SRC/clascl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/clascl2.f b/SRC/clascl2.f index 6d02512c4d..afcbef6b3d 100644 --- a/SRC/clascl2.f +++ b/SRC/clascl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/claset.f b/SRC/claset.f index 6fec8ed33e..4d7ac6d19a 100644 --- a/SRC/claset.f +++ b/SRC/claset.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasr.f b/SRC/clasr.f index 5dfce6084c..baa1f223db 100644 --- a/SRC/clasr.f +++ b/SRC/clasr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/classq.f90 b/SRC/classq.f90 index 680e3d04c9..c5f793cc0b 100644 --- a/SRC/classq.f90 +++ b/SRC/classq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b CLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/claswlq.f b/SRC/claswlq.f index bd394a68ff..2044e055cc 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASWLQ * * Definition: diff --git a/SRC/claswp.f b/SRC/claswp.f index cf83f089b2..1fdc07186c 100644 --- a/SRC/claswp.f +++ b/SRC/claswp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf.f b/SRC/clasyf.f index abacbc5c43..4de35fa3a4 100644 --- a/SRC/clasyf.f +++ b/SRC/clasyf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASYF computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_aa.f b/SRC/clasyf_aa.f index f5d1e4d3be..b51b978169 100644 --- a/SRC/clasyf_aa.f +++ b/SRC/clasyf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_rk.f b/SRC/clasyf_rk.f index 9f059b7126..654d0f0cce 100644 --- a/SRC/clasyf_rk.f +++ b/SRC/clasyf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clasyf_rook.f b/SRC/clasyf_rook.f index 3c9ea16616..3b76c09e15 100644 --- a/SRC/clasyf_rook.f +++ b/SRC/clasyf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLASYF_ROOK computes a partial factorization of a complex symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatbs.f b/SRC/clatbs.f index efe553ff87..ea58cdfe5d 100644 --- a/SRC/clatbs.f +++ b/SRC/clatbs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatdf.f b/SRC/clatdf.f index 9afc8c7250..413d330a61 100644 --- a/SRC/clatdf.f +++ b/SRC/clatdf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatps.f b/SRC/clatps.f index 662b5dc761..664613c0b1 100644 --- a/SRC/clatps.f +++ b/SRC/clatps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrd.f b/SRC/clatrd.f index 7efc611945..1367d00fe5 100644 --- a/SRC/clatrd.f +++ b/SRC/clatrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an unitary similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrs.f b/SRC/clatrs.f index 373d1990d4..b39d35cc37 100644 --- a/SRC/clatrs.f +++ b/SRC/clatrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatrs3.f b/SRC/clatrs3.f index 95fc743337..1e2d11a178 100644 --- a/SRC/clatrs3.f +++ b/SRC/clatrs3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/clatrz.f b/SRC/clatrz.f index 9afbc3f519..5354007641 100644 --- a/SRC/clatrz.f +++ b/SRC/clatrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATRZ factors an upper trapezoidal matrix by means of unitary transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f index fe964de5ec..67403693f8 100644 --- a/SRC/clatsqr.f +++ b/SRC/clatsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLATSQR * * Definition: diff --git a/SRC/claunhr_col_getrfnp.f b/SRC/claunhr_col_getrfnp.f index 5296645a08..17dacd5605 100644 --- a/SRC/claunhr_col_getrfnp.f +++ b/SRC/claunhr_col_getrfnp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAUNHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/claunhr_col_getrfnp2.f b/SRC/claunhr_col_getrfnp2.f index 90cdba4f6e..972bb2fbef 100644 --- a/SRC/claunhr_col_getrfnp2.f +++ b/SRC/claunhr_col_getrfnp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAUNHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/clauu2.f b/SRC/clauu2.f index ef54512bb7..20b6de30f4 100644 --- a/SRC/clauu2.f +++ b/SRC/clauu2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/clauum.f b/SRC/clauum.f index 50634d5551..6df76c3b8e 100644 --- a/SRC/clauum.f +++ b/SRC/clauum.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbcon.f b/SRC/cpbcon.f index 04e595500e..358b9aa168 100644 --- a/SRC/cpbcon.f +++ b/SRC/cpbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbequ.f b/SRC/cpbequ.f index 2e04954bc0..bc2a8decad 100644 --- a/SRC/cpbequ.f +++ b/SRC/cpbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbrfs.f b/SRC/cpbrfs.f index 567640d64c..aa7c6b0642 100644 --- a/SRC/cpbrfs.f +++ b/SRC/cpbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbstf.f b/SRC/cpbstf.f index 55c848b230..6b20f08fc8 100644 --- a/SRC/cpbstf.f +++ b/SRC/cpbstf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbsv.f b/SRC/cpbsv.f index 37ae4ce37e..ab4912534c 100644 --- a/SRC/cpbsv.f +++ b/SRC/cpbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbsvx.f b/SRC/cpbsvx.f index 1829fde26e..0a678b23b6 100644 --- a/SRC/cpbsvx.f +++ b/SRC/cpbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtf2.f b/SRC/cpbtf2.f index 525bde4473..815d6fa952 100644 --- a/SRC/cpbtf2.f +++ b/SRC/cpbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtrf.f b/SRC/cpbtrf.f index f2bfa98f36..75edc200d5 100644 --- a/SRC/cpbtrf.f +++ b/SRC/cpbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpbtrs.f b/SRC/cpbtrs.f index f157c6173e..adfa54298d 100644 --- a/SRC/cpbtrs.f +++ b/SRC/cpbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftrf.f b/SRC/cpftrf.f index bdd2c3d413..249ed49ebe 100644 --- a/SRC/cpftrf.f +++ b/SRC/cpftrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftri.f b/SRC/cpftri.f index 9b1b4e5cdf..8cd9df6f7b 100644 --- a/SRC/cpftri.f +++ b/SRC/cpftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpftrs.f b/SRC/cpftrs.f index 95788dd47f..810086027a 100644 --- a/SRC/cpftrs.f +++ b/SRC/cpftrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpocon.f b/SRC/cpocon.f index a163add2d7..f17e809220 100644 --- a/SRC/cpocon.f +++ b/SRC/cpocon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpoequ.f b/SRC/cpoequ.f index 801b8054cf..7ca95f2d2b 100644 --- a/SRC/cpoequ.f +++ b/SRC/cpoequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpoequb.f b/SRC/cpoequb.f index 4042fba8cb..198671200b 100644 --- a/SRC/cpoequb.f +++ b/SRC/cpoequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/cporfs.f b/SRC/cporfs.f index 2d7befd4ab..dd5946365b 100644 --- a/SRC/cporfs.f +++ b/SRC/cporfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cporfsx.f b/SRC/cporfsx.f index 59dd1dba35..c6f032765e 100644 --- a/SRC/cporfsx.f +++ b/SRC/cporfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/cposv.f b/SRC/cposv.f index 7dca052cc2..fb75d98614 100644 --- a/SRC/cposv.f +++ b/SRC/cposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cposvx.f b/SRC/cposvx.f index 5217d45779..e835dd704d 100644 --- a/SRC/cposvx.f +++ b/SRC/cposvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cposvxx.f b/SRC/cposvxx.f index 181033ced4..05171244de 100644 --- a/SRC/cposvxx.f +++ b/SRC/cposvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotf2.f b/SRC/cpotf2.f index a349020011..00e2f0a9eb 100644 --- a/SRC/cpotf2.f +++ b/SRC/cpotf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrf.f b/SRC/cpotrf.f index c9c77d750c..ee10c675aa 100644 --- a/SRC/cpotrf.f +++ b/SRC/cpotrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrf2.f b/SRC/cpotrf2.f index fe9f02c498..fa016f13c1 100644 --- a/SRC/cpotrf2.f +++ b/SRC/cpotrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotri.f b/SRC/cpotri.f index abbd7da3d5..08fc957a40 100644 --- a/SRC/cpotri.f +++ b/SRC/cpotri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpotrs.f b/SRC/cpotrs.f index 1e8939f989..a21f44631b 100644 --- a/SRC/cpotrs.f +++ b/SRC/cpotrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cppcon.f b/SRC/cppcon.f index 837fa2f16a..a6d99d5ddc 100644 --- a/SRC/cppcon.f +++ b/SRC/cppcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cppequ.f b/SRC/cppequ.f index 1a7b86b130..40673b9b01 100644 --- a/SRC/cppequ.f +++ b/SRC/cppequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/cpprfs.f b/SRC/cpprfs.f index 73ea8245d2..0337c46269 100644 --- a/SRC/cpprfs.f +++ b/SRC/cpprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cppsv.f b/SRC/cppsv.f index 0646a8ddf9..00923ae0a2 100644 --- a/SRC/cppsv.f +++ b/SRC/cppsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cppsvx.f b/SRC/cppsvx.f index 4f59fbc94f..5149839426 100644 --- a/SRC/cppsvx.f +++ b/SRC/cppsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptrf.f b/SRC/cpptrf.f index 9f91fcb61b..be92639e9f 100644 --- a/SRC/cpptrf.f +++ b/SRC/cpptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptri.f b/SRC/cpptri.f index 8676440e92..665b512568 100644 --- a/SRC/cpptri.f +++ b/SRC/cpptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/cpptrs.f b/SRC/cpptrs.f index f283f69dab..c96130e3e6 100644 --- a/SRC/cpptrs.f +++ b/SRC/cpptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cpstf2.f b/SRC/cpstf2.f index ff6c5441c5..33eb05318a 100644 --- a/SRC/cpstf2.f +++ b/SRC/cpstf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPSTF2 computes the Cholesky factorization with complete pivoting of complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cpstrf.f b/SRC/cpstrf.f index f51565789f..f5a2f394de 100644 --- a/SRC/cpstrf.f +++ b/SRC/cpstrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPSTRF computes the Cholesky factorization with complete pivoting of complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cptcon.f b/SRC/cptcon.f index 757da055ea..671814fd4d 100644 --- a/SRC/cptcon.f +++ b/SRC/cptcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cpteqr.f b/SRC/cpteqr.f index a2f253517f..2dc9547074 100644 --- a/SRC/cpteqr.f +++ b/SRC/cpteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cptrfs.f b/SRC/cptrfs.f index 43c4892848..23e8022667 100644 --- a/SRC/cptrfs.f +++ b/SRC/cptrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cptsv.f b/SRC/cptsv.f index b87a2c7da8..020db58cce 100644 --- a/SRC/cptsv.f +++ b/SRC/cptsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cptsvx.f b/SRC/cptsvx.f index e098fe1c19..34320f710f 100644 --- a/SRC/cptsvx.f +++ b/SRC/cptsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cpttrf.f b/SRC/cpttrf.f index f9143802ce..20a321f0a0 100644 --- a/SRC/cpttrf.f +++ b/SRC/cpttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/cpttrs.f b/SRC/cpttrs.f index 9a86cc1856..d857a4b456 100644 --- a/SRC/cpttrs.f +++ b/SRC/cpttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/cptts2.f b/SRC/cptts2.f index a7a0528745..107d1c82dc 100644 --- a/SRC/cptts2.f +++ b/SRC/cptts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/crot.f b/SRC/crot.f index eedc9d387f..9c74e76c84 100644 --- a/SRC/crot.f +++ b/SRC/crot.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/crscl.f b/SRC/crscl.f index 5efed242a3..8ffab05f38 100644 --- a/SRC/crscl.f +++ b/SRC/crscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/cspcon.f b/SRC/cspcon.f index 96ee07f91b..d021979784 100644 --- a/SRC/cspcon.f +++ b/SRC/cspcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/cspmv.f b/SRC/cspmv.f index 9aaaa39679..8e48b04f6c 100644 --- a/SRC/cspmv.f +++ b/SRC/cspmv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix * * =========== DOCUMENTATION =========== diff --git a/SRC/cspr.f b/SRC/cspr.f index 221ccb885d..435a43c324 100644 --- a/SRC/cspr.f +++ b/SRC/cspr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csprfs.f b/SRC/csprfs.f index 22b2265a0c..eeb3cfd749 100644 --- a/SRC/csprfs.f +++ b/SRC/csprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/cspsv.f b/SRC/cspsv.f index dc6a3e5128..a3783804cc 100644 --- a/SRC/cspsv.f +++ b/SRC/cspsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/cspsvx.f b/SRC/cspsvx.f index 57c66a77bc..2b9199eb98 100644 --- a/SRC/cspsvx.f +++ b/SRC/cspsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csptrf.f b/SRC/csptrf.f index 235676534e..e9c068c1c0 100644 --- a/SRC/csptrf.f +++ b/SRC/csptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/csptri.f b/SRC/csptri.f index 61b96a3e52..3eb166fb5f 100644 --- a/SRC/csptri.f +++ b/SRC/csptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/csptrs.f b/SRC/csptrs.f index b3e9cf9d71..820ead3fe1 100644 --- a/SRC/csptrs.f +++ b/SRC/csptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/csrscl.f b/SRC/csrscl.f index a5ebf0d908..c26278a84a 100644 --- a/SRC/csrscl.f +++ b/SRC/csrscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/cstedc.f b/SRC/cstedc.f index aecd2ba909..b1cec3779b 100644 --- a/SRC/cstedc.f +++ b/SRC/cstedc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/cstegr.f b/SRC/cstegr.f index 827ed3873f..718161efe7 100644 --- a/SRC/cstegr.f +++ b/SRC/cstegr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/cstein.f b/SRC/cstein.f index c873528de9..7c74f987c0 100644 --- a/SRC/cstein.f +++ b/SRC/cstein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/cstemr.f b/SRC/cstemr.f index b673307b71..20b3ac9ef6 100644 --- a/SRC/cstemr.f +++ b/SRC/cstemr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/csteqr.f b/SRC/csteqr.f index 8731ceabc2..69c0167b97 100644 --- a/SRC/csteqr.f +++ b/SRC/csteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon.f b/SRC/csycon.f index e564866ab8..69a0a2b7d5 100644 --- a/SRC/csycon.f +++ b/SRC/csycon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon_3.f b/SRC/csycon_3.f index f810c3b242..75005d008d 100644 --- a/SRC/csycon_3.f +++ b/SRC/csycon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csycon_rook.f b/SRC/csycon_rook.f index e0f295b01d..c29d7745ab 100644 --- a/SRC/csycon_rook.f +++ b/SRC/csycon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconv.f b/SRC/csyconv.f index a6037ca307..974d12d84a 100644 --- a/SRC/csyconv.f +++ b/SRC/csyconv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconvf.f b/SRC/csyconvf.f index 8eedd24d6e..c977cfa8fb 100644 --- a/SRC/csyconvf.f +++ b/SRC/csyconvf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/csyconvf_rook.f b/SRC/csyconvf_rook.f index 3f5a6a6d4c..6ee7981707 100644 --- a/SRC/csyconvf_rook.f +++ b/SRC/csyconvf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csyequb.f b/SRC/csyequb.f index b3d9850180..b7af2aa395 100644 --- a/SRC/csyequb.f +++ b/SRC/csyequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/csymv.f b/SRC/csymv.f index 119dcbb480..9a129b812b 100644 --- a/SRC/csymv.f +++ b/SRC/csymv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYMV computes a matrix-vector product for a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csyr.f b/SRC/csyr.f index c24da1c219..5f34fa99b3 100644 --- a/SRC/csyr.f +++ b/SRC/csyr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYR performs the symmetric rank-1 update of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/csyrfs.f b/SRC/csyrfs.f index 12a4e9063a..bf7dff28af 100644 --- a/SRC/csyrfs.f +++ b/SRC/csyrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/csyrfsx.f b/SRC/csyrfsx.f index 5f266e25eb..51e09214a6 100644 --- a/SRC/csyrfsx.f +++ b/SRC/csyrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv.f b/SRC/csysv.f index ce863376b0..d1dd50a6a9 100644 --- a/SRC/csysv.f +++ b/SRC/csysv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_aa.f b/SRC/csysv_aa.f index 489fc47af1..02e70b9a62 100644 --- a/SRC/csysv_aa.f +++ b/SRC/csysv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_aa_2stage.f b/SRC/csysv_aa_2stage.f index a0c6b5520d..10119d8ba3 100644 --- a/SRC/csysv_aa_2stage.f +++ b/SRC/csysv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_rk.f b/SRC/csysv_rk.f index 397b4e5bf3..42b6990b76 100644 --- a/SRC/csysv_rk.f +++ b/SRC/csysv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysv_rook.f b/SRC/csysv_rook.f index 5d0d333a38..3dc96ae8a8 100644 --- a/SRC/csysv_rook.f +++ b/SRC/csysv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysvx.f b/SRC/csysvx.f index 5b1a1bdd9a..4ae3dd77f4 100644 --- a/SRC/csysvx.f +++ b/SRC/csysvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csysvxx.f b/SRC/csysvxx.f index c9c8564778..607c11ac16 100644 --- a/SRC/csysvxx.f +++ b/SRC/csysvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief CSYSVXX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/csyswapr.f b/SRC/csyswapr.f index 9c38b4c7dd..d8c547bead 100644 --- a/SRC/csyswapr.f +++ b/SRC/csyswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYSWAPR * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2.f b/SRC/csytf2.f index 6d2830b673..b855e42277 100644 --- a/SRC/csytf2.f +++ b/SRC/csytf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2_rk.f b/SRC/csytf2_rk.f index 933e45fa63..3ea4bbd8eb 100644 --- a/SRC/csytf2_rk.f +++ b/SRC/csytf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytf2_rook.f b/SRC/csytf2_rook.f index 17166c06e0..aa86938cb6 100644 --- a/SRC/csytf2_rook.f +++ b/SRC/csytf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf.f b/SRC/csytrf.f index 64148914b2..27e7541466 100644 --- a/SRC/csytrf.f +++ b/SRC/csytrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_aa.f b/SRC/csytrf_aa.f index a1e0833c23..938363aa94 100644 --- a/SRC/csytrf_aa.f +++ b/SRC/csytrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_aa_2stage.f b/SRC/csytrf_aa_2stage.f index 9051e84c12..941c13e3cd 100644 --- a/SRC/csytrf_aa_2stage.f +++ b/SRC/csytrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_rk.f b/SRC/csytrf_rk.f index a5929ae8f7..a1b4e5d3ef 100644 --- a/SRC/csytrf_rk.f +++ b/SRC/csytrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrf_rook.f b/SRC/csytrf_rook.f index 23b807df71..0b0bfb0465 100644 --- a/SRC/csytrf_rook.f +++ b/SRC/csytrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri.f b/SRC/csytri.f index 1cc9b3a016..4efdaeccdc 100644 --- a/SRC/csytri.f +++ b/SRC/csytri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri2.f b/SRC/csytri2.f index c4dc1f0534..0d3bba22cb 100644 --- a/SRC/csytri2.f +++ b/SRC/csytri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri2x.f b/SRC/csytri2x.f index 9b96e0b256..b13aa9f251 100644 --- a/SRC/csytri2x.f +++ b/SRC/csytri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_3.f b/SRC/csytri_3.f index be1f5a5232..604d84b213 100644 --- a/SRC/csytri_3.f +++ b/SRC/csytri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_3x.f b/SRC/csytri_3x.f index 00a928cd6a..7ca7d07a6d 100644 --- a/SRC/csytri_3x.f +++ b/SRC/csytri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/csytri_rook.f b/SRC/csytri_rook.f index 6371c2b8c2..b9c2425373 100644 --- a/SRC/csytri_rook.f +++ b/SRC/csytri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs.f b/SRC/csytrs.f index 78b886813a..00de081243 100644 --- a/SRC/csytrs.f +++ b/SRC/csytrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs2.f b/SRC/csytrs2.f index dc147c77e1..25c0926ca4 100644 --- a/SRC/csytrs2.f +++ b/SRC/csytrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_3.f b/SRC/csytrs_3.f index 94bf6ec904..91d29076b2 100644 --- a/SRC/csytrs_3.f +++ b/SRC/csytrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_aa.f b/SRC/csytrs_aa.f index 80861535e9..d4fa7fbd09 100644 --- a/SRC/csytrs_aa.f +++ b/SRC/csytrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_aa_2stage.f b/SRC/csytrs_aa_2stage.f index ee86c6d14f..caf5f4ff41 100644 --- a/SRC/csytrs_aa_2stage.f +++ b/SRC/csytrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/csytrs_rook.f b/SRC/csytrs_rook.f index 07ba193ee0..1b6398e3df 100644 --- a/SRC/csytrs_rook.f +++ b/SRC/csytrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbcon.f b/SRC/ctbcon.f index ac71328717..2c23f6bbf7 100644 --- a/SRC/ctbcon.f +++ b/SRC/ctbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbrfs.f b/SRC/ctbrfs.f index 7af7d5f743..7638b5bdd7 100644 --- a/SRC/ctbrfs.f +++ b/SRC/ctbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctbtrs.f b/SRC/ctbtrs.f index c8e04bc3bc..e5da1aeae8 100644 --- a/SRC/ctbtrs.f +++ b/SRC/ctbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfsm.f b/SRC/ctfsm.f index 70a6b30029..e381f476ac 100644 --- a/SRC/ctfsm.f +++ b/SRC/ctfsm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctftri.f b/SRC/ctftri.f index be9d9a24a8..1f1bf7c6bb 100644 --- a/SRC/ctftri.f +++ b/SRC/ctftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfttp.f b/SRC/ctfttp.f index 2f4421ada5..4254cc7cf0 100644 --- a/SRC/ctfttp.f +++ b/SRC/ctfttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctfttr.f b/SRC/ctfttr.f index bede02f249..13bfd770b8 100644 --- a/SRC/ctfttr.f +++ b/SRC/ctfttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgevc.f b/SRC/ctgevc.f index 033dd9f659..947f1c67e1 100644 --- a/SRC/ctgevc.f +++ b/SRC/ctgevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgex2.f b/SRC/ctgex2.f index c080f4b8f9..cc1723d7b9 100644 --- a/SRC/ctgex2.f +++ b/SRC/ctgex2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an unitary equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgexc.f b/SRC/ctgexc.f index a2c7417ad9..a85b8ea7aa 100644 --- a/SRC/ctgexc.f +++ b/SRC/ctgexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsen.f b/SRC/ctgsen.f index a62c3fb473..1944f8bab9 100644 --- a/SRC/ctgsen.f +++ b/SRC/ctgsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsja.f b/SRC/ctgsja.f index 6eadfa3bfe..195cf260de 100644 --- a/SRC/ctgsja.f +++ b/SRC/ctgsja.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsna.f b/SRC/ctgsna.f index e78f05094a..6e295377e8 100644 --- a/SRC/ctgsna.f +++ b/SRC/ctgsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsy2.f b/SRC/ctgsy2.f index 09adac05bf..f9af392cc7 100644 --- a/SRC/ctgsy2.f +++ b/SRC/ctgsy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctgsyl.f b/SRC/ctgsyl.f index c0427028e1..ecc3abc62c 100644 --- a/SRC/ctgsyl.f +++ b/SRC/ctgsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpcon.f b/SRC/ctpcon.f index 020395c855..0fc2805300 100644 --- a/SRC/ctpcon.f +++ b/SRC/ctpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctplqt.f b/SRC/ctplqt.f index 5e687ace51..a9f188526a 100644 --- a/SRC/ctplqt.f +++ b/SRC/ctplqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPLQT * * Definition: diff --git a/SRC/ctplqt2.f b/SRC/ctplqt2.f index f17f9f9f6d..e299fa53ea 100644 --- a/SRC/ctplqt2.f +++ b/SRC/ctplqt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPLQT2 * * Definition: diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f index 73b34b86af..d671510788 100644 --- a/SRC/ctpmlqt.f +++ b/SRC/ctpmlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPMLQT * * Definition: diff --git a/SRC/ctpmqrt.f b/SRC/ctpmqrt.f index 2a91c3bcbf..9caf86ae3d 100644 --- a/SRC/ctpmqrt.f +++ b/SRC/ctpmqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpqrt.f b/SRC/ctpqrt.f index 14d5343e8e..f20168eebd 100644 --- a/SRC/ctpqrt.f +++ b/SRC/ctpqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpqrt2.f b/SRC/ctpqrt2.f index c3178c62c8..581f2584f9 100644 --- a/SRC/ctpqrt2.f +++ b/SRC/ctpqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctprfb.f b/SRC/ctprfb.f index b099939b33..5b65e403eb 100644 --- a/SRC/ctprfb.f +++ b/SRC/ctprfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPRFB applies a complex "triangular-pentagonal" block reflector to a complex matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/ctprfs.f b/SRC/ctprfs.f index dc5dc2efaf..ed6c15950f 100644 --- a/SRC/ctprfs.f +++ b/SRC/ctprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctptri.f b/SRC/ctptri.f index f1f54729b6..928104684c 100644 --- a/SRC/ctptri.f +++ b/SRC/ctptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctptrs.f b/SRC/ctptrs.f index 18364c3e60..456e1b7824 100644 --- a/SRC/ctptrs.f +++ b/SRC/ctptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpttf.f b/SRC/ctpttf.f index 0c4abe4652..a1431a6093 100644 --- a/SRC/ctpttf.f +++ b/SRC/ctpttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctpttr.f b/SRC/ctpttr.f index 209a746bc2..628f7f246f 100644 --- a/SRC/ctpttr.f +++ b/SRC/ctpttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrcon.f b/SRC/ctrcon.f index 1167fc240a..68f2ac0b2c 100644 --- a/SRC/ctrcon.f +++ b/SRC/ctrcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrevc.f b/SRC/ctrevc.f index 047774d9a6..c1360ac4d6 100644 --- a/SRC/ctrevc.f +++ b/SRC/ctrevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index ea1154eeca..3e803067c6 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrexc.f b/SRC/ctrexc.f index 7b93df76f8..91c178edcb 100644 --- a/SRC/ctrexc.f +++ b/SRC/ctrexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrrfs.f b/SRC/ctrrfs.f index 8bd0c882af..e4ad022d5b 100644 --- a/SRC/ctrrfs.f +++ b/SRC/ctrrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsen.f b/SRC/ctrsen.f index fa18df71d2..fb30defa5c 100644 --- a/SRC/ctrsen.f +++ b/SRC/ctrsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsna.f b/SRC/ctrsna.f index ce5253251b..326f199965 100644 --- a/SRC/ctrsna.f +++ b/SRC/ctrsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsyl.f b/SRC/ctrsyl.f index 9627687a42..2cd5c33c41 100644 --- a/SRC/ctrsyl.f +++ b/SRC/ctrsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index e32ef9cfba..d2b8fd9ccd 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRSYL3 * * Definition: diff --git a/SRC/ctrti2.f b/SRC/ctrti2.f index 33aa8aa869..54681a3407 100644 --- a/SRC/ctrti2.f +++ b/SRC/ctrti2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrtri.f b/SRC/ctrtri.f index 32d46466db..a7d476cbae 100644 --- a/SRC/ctrtri.f +++ b/SRC/ctrtri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrtrs.f b/SRC/ctrtrs.f index be20233ac7..e17785402d 100644 --- a/SRC/ctrtrs.f +++ b/SRC/ctrtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrttf.f b/SRC/ctrttf.f index b6673b3c61..655b689687 100644 --- a/SRC/ctrttf.f +++ b/SRC/ctrttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctrttp.f b/SRC/ctrttp.f index c7bb9f68dc..e38f01e3d5 100644 --- a/SRC/ctrttp.f +++ b/SRC/ctrttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ctzrzf.f b/SRC/ctzrzf.f index 58fdf78456..1fb8982430 100644 --- a/SRC/ctzrzf.f +++ b/SRC/ctzrzf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index fac310500c..7abfb07d71 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb1.f b/SRC/cunbdb1.f index e1e32c19c3..1c096a4bd2 100644 --- a/SRC/cunbdb1.f +++ b/SRC/cunbdb1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f index d2159bbaac..737d0e773b 100644 --- a/SRC/cunbdb2.f +++ b/SRC/cunbdb2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb3.f b/SRC/cunbdb3.f index fa62579d11..91ae5f8954 100644 --- a/SRC/cunbdb3.f +++ b/SRC/cunbdb3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f index 572847b73f..71d35a7118 100644 --- a/SRC/cunbdb4.f +++ b/SRC/cunbdb4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb5.f b/SRC/cunbdb5.f index 1924ebc129..86f4012cd9 100644 --- a/SRC/cunbdb5.f +++ b/SRC/cunbdb5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/cunbdb6.f b/SRC/cunbdb6.f index 6c88ad9780..3ce4b121a5 100644 --- a/SRC/cunbdb6.f +++ b/SRC/cunbdb6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/cuncsd.f b/SRC/cuncsd.f index f3c55b1f1b..623380a12a 100644 --- a/SRC/cuncsd.f +++ b/SRC/cuncsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/cuncsd2by1.f b/SRC/cuncsd2by1.f index 2618e3e244..c9129a2bab 100644 --- a/SRC/cuncsd2by1.f +++ b/SRC/cuncsd2by1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/cung2l.f b/SRC/cung2l.f index 22658eb600..602f1c8ef9 100644 --- a/SRC/cung2l.f +++ b/SRC/cung2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cung2r.f b/SRC/cung2r.f index 6e86c4e507..d854ed437f 100644 --- a/SRC/cung2r.f +++ b/SRC/cung2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNG2R * * =========== DOCUMENTATION =========== diff --git a/SRC/cungbr.f b/SRC/cungbr.f index 1f90d107bb..a9994fc160 100644 --- a/SRC/cungbr.f +++ b/SRC/cungbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunghr.f b/SRC/cunghr.f index c69d72e5d6..5b1f1d17b8 100644 --- a/SRC/cunghr.f +++ b/SRC/cunghr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungl2.f b/SRC/cungl2.f index 3870b21cb7..4e5042b636 100644 --- a/SRC/cungl2.f +++ b/SRC/cungl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunglq.f b/SRC/cunglq.f index 39a0d9de42..8e784f411f 100644 --- a/SRC/cunglq.f +++ b/SRC/cunglq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cungql.f b/SRC/cungql.f index 383bb2b5a4..5570dabd64 100644 --- a/SRC/cungql.f +++ b/SRC/cungql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/cungqr.f b/SRC/cungqr.f index 1ede1bed5c..66f8cb1718 100644 --- a/SRC/cungqr.f +++ b/SRC/cungqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungr2.f b/SRC/cungr2.f index 28d114d4c8..1e99911121 100644 --- a/SRC/cungr2.f +++ b/SRC/cungr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cungrq.f b/SRC/cungrq.f index ce88afba95..bcca0c8ca4 100644 --- a/SRC/cungrq.f +++ b/SRC/cungrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtr.f b/SRC/cungtr.f index 40cfa649ed..ad165c3dd1 100644 --- a/SRC/cungtr.f +++ b/SRC/cungtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtsqr.f b/SRC/cungtsqr.f index 6457c6b6ef..22f21d5e6d 100644 --- a/SRC/cungtsqr.f +++ b/SRC/cungtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cungtsqr_row.f b/SRC/cungtsqr_row.f index 560325e453..4515440a16 100644 --- a/SRC/cungtsqr_row.f +++ b/SRC/cungtsqr_row.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/cunhr_col.f b/SRC/cunhr_col.f index 4cece20cf4..49bc3f5071 100644 --- a/SRC/cunhr_col.f +++ b/SRC/cunhr_col.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm22.f b/SRC/cunm22.f index 4028cae90b..efd557bfbd 100644 --- a/SRC/cunm22.f +++ b/SRC/cunm22.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNM22 multiplies a general matrix by a banded unitary matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm2l.f b/SRC/cunm2l.f index 8faadfde3e..238b73525e 100644 --- a/SRC/cunm2l.f +++ b/SRC/cunm2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index 12664df14b..0682381be3 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmbr.f b/SRC/cunmbr.f index 802a7799be..46ee1b53f2 100644 --- a/SRC/cunmbr.f +++ b/SRC/cunmbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmhr.f b/SRC/cunmhr.f index 850575f57e..39af6e1fad 100644 --- a/SRC/cunmhr.f +++ b/SRC/cunmhr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunml2.f b/SRC/cunml2.f index 8b54b6cb8a..a00ce5ff0c 100644 --- a/SRC/cunml2.f +++ b/SRC/cunml2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNML2 multiplies a general matrix by the unitary matrix from a LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmlq.f b/SRC/cunmlq.f index d6ba1443fc..fb8925c897 100644 --- a/SRC/cunmlq.f +++ b/SRC/cunmlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmql.f b/SRC/cunmql.f index a6d53081ae..fb2293b8e6 100644 --- a/SRC/cunmql.f +++ b/SRC/cunmql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmqr.f b/SRC/cunmqr.f index 9981217c62..e2e9fa6710 100644 --- a/SRC/cunmqr.f +++ b/SRC/cunmqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmr2.f b/SRC/cunmr2.f index 48a704fe21..69988e84ab 100644 --- a/SRC/cunmr2.f +++ b/SRC/cunmr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMR2 multiplies a general matrix by the unitary matrix from a RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmr3.f b/SRC/cunmr3.f index 7c0749dc6a..5a60f5c665 100644 --- a/SRC/cunmr3.f +++ b/SRC/cunmr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMR3 multiplies a general matrix by the unitary matrix from a RZ factorization determined by ctzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmrq.f b/SRC/cunmrq.f index f5be5e8b41..05548c5284 100644 --- a/SRC/cunmrq.f +++ b/SRC/cunmrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmrz.f b/SRC/cunmrz.f index 75787ebc01..703bfbcfb0 100644 --- a/SRC/cunmrz.f +++ b/SRC/cunmrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/cunmtr.f b/SRC/cunmtr.f index f3dc88a420..c24a363bc5 100644 --- a/SRC/cunmtr.f +++ b/SRC/cunmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUNMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cupgtr.f b/SRC/cupgtr.f index 70fe6b5d5b..4370cdeacf 100644 --- a/SRC/cupgtr.f +++ b/SRC/cupgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/cupmtr.f b/SRC/cupmtr.f index 904c88bdd2..6f82851911 100644 --- a/SRC/cupmtr.f +++ b/SRC/cupmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CUPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dbbcsd.f b/SRC/dbbcsd.f index 302b1856cb..8a6d7932f6 100644 --- a/SRC/dbbcsd.f +++ b/SRC/dbbcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsdc.f b/SRC/dbdsdc.f index ea9380a6de..204d67fb0c 100644 --- a/SRC/dbdsdc.f +++ b/SRC/dbdsdc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DBDSDC * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsqr.f b/SRC/dbdsqr.f index d72f4706be..1a6480e0c8 100644 --- a/SRC/dbdsqr.f +++ b/SRC/dbdsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dbdsvdx.f b/SRC/dbdsvdx.f index c025399e29..bc89ae62f3 100644 --- a/SRC/dbdsvdx.f +++ b/SRC/dbdsvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DBDSVDX * * =========== DOCUMENTATION =========== diff --git a/SRC/ddisna.f b/SRC/ddisna.f index 92e572cf98..0e026f55d1 100644 --- a/SRC/ddisna.f +++ b/SRC/ddisna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DDISNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbbrd.f b/SRC/dgbbrd.f index 534b4e31e4..25e8f5e4ce 100644 --- a/SRC/dgbbrd.f +++ b/SRC/dgbbrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbcon.f b/SRC/dgbcon.f index ce374fbc0a..1c7bd70077 100644 --- a/SRC/dgbcon.f +++ b/SRC/dgbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbequ.f b/SRC/dgbequ.f index 0718077756..2c5e11f3e8 100644 --- a/SRC/dgbequ.f +++ b/SRC/dgbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbequb.f b/SRC/dgbequb.f index 88c357e8cc..21325ba7d2 100644 --- a/SRC/dgbequb.f +++ b/SRC/dgbequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbrfs.f b/SRC/dgbrfs.f index fe529c0b57..13a59c932d 100644 --- a/SRC/dgbrfs.f +++ b/SRC/dgbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbrfsx.f b/SRC/dgbrfsx.f index b16162be43..c8cb62dd05 100644 --- a/SRC/dgbrfsx.f +++ b/SRC/dgbrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsv.f b/SRC/dgbsv.f index 939b61f0ac..a6de37009d 100644 --- a/SRC/dgbsv.f +++ b/SRC/dgbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsvx.f b/SRC/dgbsvx.f index 25aa917793..337ee352ac 100644 --- a/SRC/dgbsvx.f +++ b/SRC/dgbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbsvxx.f b/SRC/dgbsvxx.f index 6231620781..b9f0bb46ac 100644 --- a/SRC/dgbsvxx.f +++ b/SRC/dgbsvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtf2.f b/SRC/dgbtf2.f index 1b1e013517..10bc2ee878 100644 --- a/SRC/dgbtf2.f +++ b/SRC/dgbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtrf.f b/SRC/dgbtrf.f index ab635a5f70..88dc92427f 100644 --- a/SRC/dgbtrf.f +++ b/SRC/dgbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgbtrs.f b/SRC/dgbtrs.f index 0a520a3b72..5b6fb3603a 100644 --- a/SRC/dgbtrs.f +++ b/SRC/dgbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebak.f b/SRC/dgebak.f index 5b6401a5c8..a00e01e760 100644 --- a/SRC/dgebak.f +++ b/SRC/dgebak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebal.f b/SRC/dgebal.f index 1be3a072d5..77fe67923f 100644 --- a/SRC/dgebal.f +++ b/SRC/dgebal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebd2.f b/SRC/dgebd2.f index e05517ab81..98559fadee 100644 --- a/SRC/dgebd2.f +++ b/SRC/dgebd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgebrd.f b/SRC/dgebrd.f index 7458c162a5..d3a1ac1472 100644 --- a/SRC/dgebrd.f +++ b/SRC/dgebrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgecon.f b/SRC/dgecon.f index 71b3593227..d73c4b9207 100644 --- a/SRC/dgecon.f +++ b/SRC/dgecon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgedmd.f90 b/SRC/dgedmd.f90 index 9d43ded556..9c4afd182d 100644 --- a/SRC/dgedmd.f90 +++ b/SRC/dgedmd.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b DGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dgedmdq.f90 b/SRC/dgedmdq.f90 index f3596cdab2..b1fb62b44a 100644 --- a/SRC/dgedmdq.f90 +++ b/SRC/dgedmdq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b DGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dgeequ.f b/SRC/dgeequ.f index 520973c139..8306ae9d1a 100644 --- a/SRC/dgeequ.f +++ b/SRC/dgeequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeequb.f b/SRC/dgeequb.f index 49b46f5fc8..b0f40687a0 100644 --- a/SRC/dgeequb.f +++ b/SRC/dgeequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dgees.f b/SRC/dgees.f index f2d205cfba..1af82f1c88 100644 --- a/SRC/dgees.f +++ b/SRC/dgees.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeesx.f b/SRC/dgeesx.f index 2f30ab74d5..4d99b5ba46 100644 --- a/SRC/dgeesx.f +++ b/SRC/dgeesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 4ec789f749..311d2f7ab3 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index ed4f827e1d..43ddd5e798 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgehd2.f b/SRC/dgehd2.f index d777cc7b03..62417aa8c1 100644 --- a/SRC/dgehd2.f +++ b/SRC/dgehd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f index 75fcb74e44..7951e04b3e 100644 --- a/SRC/dgehrd.f +++ b/SRC/dgehrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f index caca9a6b9e..05a51e78d8 100644 --- a/SRC/dgejsv.f +++ b/SRC/dgejsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelq.f b/SRC/dgelq.f index c475b8c083..255e8732f2 100644 --- a/SRC/dgelq.f +++ b/SRC/dgelq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGELQ * * Definition: diff --git a/SRC/dgelq2.f b/SRC/dgelq2.f index 085288fe95..31dfc07a1d 100644 --- a/SRC/dgelq2.f +++ b/SRC/dgelq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 4f0544ba0c..03bbb8e1e3 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqt.f b/SRC/dgelqt.f index 2bab6db467..fa33f0d885 100644 --- a/SRC/dgelqt.f +++ b/SRC/dgelqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGELQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelqt3.f b/SRC/dgelqt3.f index df41bb3b54..857b1b71de 100644 --- a/SRC/dgelqt3.f +++ b/SRC/dgelqt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgels.f b/SRC/dgels.f index 7c71f9d144..90b2c91aa2 100644 --- a/SRC/dgels.f +++ b/SRC/dgels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelsd.f b/SRC/dgelsd.f index 1de3d83626..cc79987ade 100644 --- a/SRC/dgelsd.f +++ b/SRC/dgelsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelss.f b/SRC/dgelss.f index c5d1768465..685c7852cf 100644 --- a/SRC/dgelss.f +++ b/SRC/dgelss.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelst.f b/SRC/dgelst.f index 08b3f99e62..aadb5af57f 100644 --- a/SRC/dgelst.f +++ b/SRC/dgelst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgelsy.f b/SRC/dgelsy.f index f9ac62afc9..b97e7bcae1 100644 --- a/SRC/dgelsy.f +++ b/SRC/dgelsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f index 2f4afd40ba..757683f467 100644 --- a/SRC/dgemlq.f +++ b/SRC/dgemlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEMLQ * * Definition: diff --git a/SRC/dgemlqt.f b/SRC/dgemlqt.f index b71da1315c..e341343959 100644 --- a/SRC/dgemlqt.f +++ b/SRC/dgemlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f index ff662b3c7d..6088154837 100644 --- a/SRC/dgemqr.f +++ b/SRC/dgemqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEMQR * * Definition: diff --git a/SRC/dgemqrt.f b/SRC/dgemqrt.f index 705b97f718..bf7a0e001b 100644 --- a/SRC/dgemqrt.f +++ b/SRC/dgemqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeql2.f b/SRC/dgeql2.f index c1659f26e1..dfb08ff316 100644 --- a/SRC/dgeql2.f +++ b/SRC/dgeql2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index ed60071881..d472e3365e 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqp3.f b/SRC/dgeqp3.f index a2d611af8f..a49b0838ad 100644 --- a/SRC/dgeqp3.f +++ b/SRC/dgeqp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f index a9601eca2d..e14ea95c07 100644 --- a/SRC/dgeqp3rk.f +++ b/SRC/dgeqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f index 4f7b79d1ca..6ed8f211f1 100644 --- a/SRC/dgeqr.f +++ b/SRC/dgeqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQR * * Definition: diff --git a/SRC/dgeqr2.f b/SRC/dgeqr2.f index 645dc61227..bd4facfce7 100644 --- a/SRC/dgeqr2.f +++ b/SRC/dgeqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqr2p.f b/SRC/dgeqr2p.f index a3966474f1..b2f3188f3f 100644 --- a/SRC/dgeqr2p.f +++ b/SRC/dgeqr2p.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrf.f b/SRC/dgeqrf.f index ab1e68bab7..c005d47af5 100644 --- a/SRC/dgeqrf.f +++ b/SRC/dgeqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f index a78338e269..aa757e96cf 100644 --- a/SRC/dgeqrfp.f +++ b/SRC/dgeqrfp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt.f b/SRC/dgeqrt.f index a6b9d27863..a1af7dff53 100644 --- a/SRC/dgeqrt.f +++ b/SRC/dgeqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt2.f b/SRC/dgeqrt2.f index 1b78efe069..b200b5d1c9 100644 --- a/SRC/dgeqrt2.f +++ b/SRC/dgeqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgeqrt3.f b/SRC/dgeqrt3.f index 816084da86..d289aeff8f 100644 --- a/SRC/dgeqrt3.f +++ b/SRC/dgeqrt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerfs.f b/SRC/dgerfs.f index dd384e1817..c6443ea0b9 100644 --- a/SRC/dgerfs.f +++ b/SRC/dgerfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerfsx.f b/SRC/dgerfsx.f index 0b8eb98013..8ee57fa9da 100644 --- a/SRC/dgerfsx.f +++ b/SRC/dgerfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerq2.f b/SRC/dgerq2.f index 426bc567d4..a4ef46d854 100644 --- a/SRC/dgerq2.f +++ b/SRC/dgerq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 40037934f3..8cabdc36ee 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesc2.f b/SRC/dgesc2.f index 59ea9f9497..11f83ae9e6 100644 --- a/SRC/dgesc2.f +++ b/SRC/dgesc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesdd.f b/SRC/dgesdd.f index 1fe0c49d41..7e27f54500 100644 --- a/SRC/dgesdd.f +++ b/SRC/dgesdd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesv.f b/SRC/dgesv.f index ece84e2c8f..9bd574e5cc 100644 --- a/SRC/dgesv.f +++ b/SRC/dgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \addtogroup gesv *> *> \brief DGESV computes the solution to system of linear equations A * X = B for GE matrices diff --git a/SRC/dgesvd.f b/SRC/dgesvd.f index addc0f37d0..1e45365f91 100644 --- a/SRC/dgesvd.f +++ b/SRC/dgesvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvdq.f b/SRC/dgesvdq.f index 76be486e46..ebf9a1dbce 100644 --- a/SRC/dgesvdq.f +++ b/SRC/dgesvdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvdx.f b/SRC/dgesvdx.f index cb167b2be7..85f714321a 100644 --- a/SRC/dgesvdx.f +++ b/SRC/dgesvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvj.f b/SRC/dgesvj.f index c550c259c3..1fc3266b51 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvx.f b/SRC/dgesvx.f index e9b3fe4a94..7c0140541f 100644 --- a/SRC/dgesvx.f +++ b/SRC/dgesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgesvxx.f b/SRC/dgesvxx.f index b3b2b15196..a88b81cb27 100644 --- a/SRC/dgesvxx.f +++ b/SRC/dgesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetc2.f b/SRC/dgetc2.f index 79535ea54f..8ee83328c4 100644 --- a/SRC/dgetc2.f +++ b/SRC/dgetc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetf2.f b/SRC/dgetf2.f index 8d7c375729..6e6f32ff25 100644 --- a/SRC/dgetf2.f +++ b/SRC/dgetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrf.f b/SRC/dgetrf.f index 61dfbbd24b..7587891bdd 100644 --- a/SRC/dgetrf.f +++ b/SRC/dgetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrf2.f b/SRC/dgetrf2.f index ad7df02073..64b92030d2 100644 --- a/SRC/dgetrf2.f +++ b/SRC/dgetrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetri.f b/SRC/dgetri.f index a46743af2b..82598ab668 100644 --- a/SRC/dgetri.f +++ b/SRC/dgetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetrs.f b/SRC/dgetrs.f index 6bae94cba2..7a0f48513d 100644 --- a/SRC/dgetrs.f +++ b/SRC/dgetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index 7b35b0f20f..73b505ff7e 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETSLS * * Definition: diff --git a/SRC/dgetsqrhrt.f b/SRC/dgetsqrhrt.f index e475174ca8..cc4b045f78 100644 --- a/SRC/dgetsqrhrt.f +++ b/SRC/dgetsqrhrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dggbak.f b/SRC/dggbak.f index dcd2167ff0..223ae2e312 100644 --- a/SRC/dggbak.f +++ b/SRC/dggbak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/dggbal.f b/SRC/dggbal.f index cb01d1608f..38d187b340 100644 --- a/SRC/dggbal.f +++ b/SRC/dggbal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/dgges.f b/SRC/dgges.f index 3ee4aabc98..230ff0b5bd 100644 --- a/SRC/dgges.f +++ b/SRC/dgges.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgges3.f b/SRC/dgges3.f index 62b03d7d90..3425a8ab43 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/dggesx.f b/SRC/dggesx.f index e2425412e3..44e8b3dcac 100644 --- a/SRC/dggesx.f +++ b/SRC/dggesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggev.f b/SRC/dggev.f index 92c2159c9b..87d15a93ca 100644 --- a/SRC/dggev.f +++ b/SRC/dggev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggev3.f b/SRC/dggev3.f index d113f30bca..3290534797 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/dggevx.f b/SRC/dggevx.f index cf11ca72d8..a4d769ad51 100644 --- a/SRC/dggevx.f +++ b/SRC/dggevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggglm.f b/SRC/dggglm.f index 14ac002af5..56a168415f 100644 --- a/SRC/dggglm.f +++ b/SRC/dggglm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f index 54979efd17..ea46cc59b2 100644 --- a/SRC/dgghd3.f +++ b/SRC/dgghd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgghrd.f b/SRC/dgghrd.f index 6013910b17..5736ad837f 100644 --- a/SRC/dgghrd.f +++ b/SRC/dgghrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dgglse.f b/SRC/dgglse.f index a310da7579..45e89eebe4 100644 --- a/SRC/dgglse.f +++ b/SRC/dgglse.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggqrf.f b/SRC/dggqrf.f index d866252f2b..7e5f4c9aa8 100644 --- a/SRC/dggqrf.f +++ b/SRC/dggqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dggrqf.f b/SRC/dggrqf.f index df4b440636..3b1024c1cd 100644 --- a/SRC/dggrqf.f +++ b/SRC/dggrqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/dggsvd3.f b/SRC/dggsvd3.f index e7a292886e..1b4ee041b7 100644 --- a/SRC/dggsvd3.f +++ b/SRC/dggsvd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dggsvp3.f b/SRC/dggsvp3.f index b83fd761b7..cacae2d28f 100644 --- a/SRC/dggsvp3.f +++ b/SRC/dggsvp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dgsvj0.f b/SRC/dgsvj0.f index bac1e85343..bfcb4a3097 100644 --- a/SRC/dgsvj0.f +++ b/SRC/dgsvj0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGSVJ0 pre-processor for the routine dgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgsvj1.f b/SRC/dgsvj1.f index 8ecbf23a09..8831a219e4 100644 --- a/SRC/dgsvj1.f +++ b/SRC/dgsvj1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGSVJ1 pre-processor for the routine dgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtcon.f b/SRC/dgtcon.f index eda89a82da..afe9a0ee52 100644 --- a/SRC/dgtcon.f +++ b/SRC/dgtcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtrfs.f b/SRC/dgtrfs.f index 36bd6af34f..0fe07a6779 100644 --- a/SRC/dgtrfs.f +++ b/SRC/dgtrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtsv.f b/SRC/dgtsv.f index ec4311d94b..16168b8625 100644 --- a/SRC/dgtsv.f +++ b/SRC/dgtsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtsvx.f b/SRC/dgtsvx.f index 76882f1301..8367a05e75 100644 --- a/SRC/dgtsvx.f +++ b/SRC/dgtsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dgttrf.f b/SRC/dgttrf.f index 3bbd9a0cff..996a691d80 100644 --- a/SRC/dgttrf.f +++ b/SRC/dgttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dgttrs.f b/SRC/dgttrs.f index 221d2548a0..b257bee0e1 100644 --- a/SRC/dgttrs.f +++ b/SRC/dgttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dgtts2.f b/SRC/dgtts2.f index 3ef1c50272..7c065ef272 100644 --- a/SRC/dgtts2.f +++ b/SRC/dgtts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/dhgeqz.f b/SRC/dhgeqz.f index d745b06020..bbbe5c5f1a 100644 --- a/SRC/dhgeqz.f +++ b/SRC/dhgeqz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dhsein.f b/SRC/dhsein.f index 8d90d98e0d..4554ffb708 100644 --- a/SRC/dhsein.f +++ b/SRC/dhsein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/dhseqr.f b/SRC/dhseqr.f index 4a7f8b35e6..fe584dd81a 100644 --- a/SRC/dhseqr.f +++ b/SRC/dhseqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/disnan.f b/SRC/disnan.f index 6f66991733..fd59cfd5c1 100644 --- a/SRC/disnan.f +++ b/SRC/disnan.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DISNAN tests input for NaN. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbamv.f b/SRC/dla_gbamv.f index 2cf80df48d..5abeb4a146 100644 --- a/SRC/dla_gbamv.f +++ b/SRC/dla_gbamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrcond.f b/SRC/dla_gbrcond.f index 302edd592c..605eb5c0f6 100644 --- a/SRC/dla_gbrcond.f +++ b/SRC/dla_gbrcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GBRCOND estimates the Skeel condition number for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrfsx_extended.f b/SRC/dla_gbrfsx_extended.f index a33de3b0a6..559b0baad6 100644 --- a/SRC/dla_gbrfsx_extended.f +++ b/SRC/dla_gbrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gbrpvgrw.f b/SRC/dla_gbrpvgrw.f index 1dae92692d..8bc8dc2702 100644 --- a/SRC/dla_gbrpvgrw.f +++ b/SRC/dla_gbrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_geamv.f b/SRC/dla_geamv.f index 3d747502d6..faa08ef3eb 100644 --- a/SRC/dla_geamv.f +++ b/SRC/dla_geamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gercond.f b/SRC/dla_gercond.f index 8ff83f7e32..1c61604ed6 100644 --- a/SRC/dla_gercond.f +++ b/SRC/dla_gercond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GERCOND estimates the Skeel condition number for a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gerfsx_extended.f b/SRC/dla_gerfsx_extended.f index 874b908aa7..61083ef3d6 100644 --- a/SRC/dla_gerfsx_extended.f +++ b/SRC/dla_gerfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GERFSX_EXTENDED improves the computed solution to a system of linear equations for general matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_gerpvgrw.f b/SRC/dla_gerpvgrw.f index bbade21c3e..d0f7868766 100644 --- a/SRC/dla_gerpvgrw.f +++ b/SRC/dla_gerpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_GERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_lin_berr.f b/SRC/dla_lin_berr.f index dcf8eb285c..3b3891c7c4 100644 --- a/SRC/dla_lin_berr.f +++ b/SRC/dla_lin_berr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porcond.f b/SRC/dla_porcond.f index 0b2af24ffe..44b413ada1 100644 --- a/SRC/dla_porcond.f +++ b/SRC/dla_porcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porfsx_extended.f b/SRC/dla_porfsx_extended.f index 6c16d17562..58fde06b78 100644 --- a/SRC/dla_porfsx_extended.f +++ b/SRC/dla_porfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_porpvgrw.f b/SRC/dla_porpvgrw.f index 2f1681b143..b1e9d616c7 100644 --- a/SRC/dla_porpvgrw.f +++ b/SRC/dla_porpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syamv.f b/SRC/dla_syamv.f index 54f006c819..8172276064 100644 --- a/SRC/dla_syamv.f +++ b/SRC/dla_syamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrcond.f b/SRC/dla_syrcond.f index 9427122b30..869ae2bb8b 100644 --- a/SRC/dla_syrcond.f +++ b/SRC/dla_syrcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrfsx_extended.f b/SRC/dla_syrfsx_extended.f index 25663970df..b10fcc9aae 100644 --- a/SRC/dla_syrfsx_extended.f +++ b/SRC/dla_syrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_syrpvgrw.f b/SRC/dla_syrpvgrw.f index 9be3db416f..b74346a1fa 100644 --- a/SRC/dla_syrpvgrw.f +++ b/SRC/dla_syrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dla_wwaddw.f b/SRC/dla_wwaddw.f index 6d1c05b6d6..2acadad65f 100644 --- a/SRC/dla_wwaddw.f +++ b/SRC/dla_wwaddw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlabad.f b/SRC/dlabad.f index 6dac3c9fd2..da90494cc6 100644 --- a/SRC/dlabad.f +++ b/SRC/dlabad.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLABAD * * =========== DOCUMENTATION =========== diff --git a/SRC/dlabrd.f b/SRC/dlabrd.f index 5c63b0289a..2d0a97b6e0 100644 --- a/SRC/dlabrd.f +++ b/SRC/dlabrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacn2.f b/SRC/dlacn2.f index 5135875803..d6af03d8c9 100644 --- a/SRC/dlacn2.f +++ b/SRC/dlacn2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacon.f b/SRC/dlacon.f index 3447734c96..cfef6ba707 100644 --- a/SRC/dlacon.f +++ b/SRC/dlacon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlacpy.f b/SRC/dlacpy.f index bdda4bbaf5..c6abfc62a5 100644 --- a/SRC/dlacpy.f +++ b/SRC/dlacpy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/dladiv.f b/SRC/dladiv.f index d48bd85d05..a0fbe1a618 100644 --- a/SRC/dladiv.f +++ b/SRC/dladiv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlae2.f b/SRC/dlae2.f index 9a8f193f94..ab93c46d60 100644 --- a/SRC/dlae2.f +++ b/SRC/dlae2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaebz.f b/SRC/dlaebz.f index db94799317..9f86752d35 100644 --- a/SRC/dlaebz.f +++ b/SRC/dlaebz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed0.f b/SRC/dlaed0.f index 57f09131e2..368bf3e6c4 100644 --- a/SRC/dlaed0.f +++ b/SRC/dlaed0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED0 used by DSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed1.f b/SRC/dlaed1.f index 8ec033db3c..38a415cad0 100644 --- a/SRC/dlaed1.f +++ b/SRC/dlaed1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED1 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed2.f b/SRC/dlaed2.f index 07a81cf5d6..554f63be23 100644 --- a/SRC/dlaed2.f +++ b/SRC/dlaed2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED2 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed3.f b/SRC/dlaed3.f index db581bec3c..63578af84a 100644 --- a/SRC/dlaed3.f +++ b/SRC/dlaed3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED3 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed4.f b/SRC/dlaed4.f index b4d69b1cb5..f7145d1208 100644 --- a/SRC/dlaed4.f +++ b/SRC/dlaed4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED4 used by DSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed5.f b/SRC/dlaed5.f index d644e4f57d..29e4f707cd 100644 --- a/SRC/dlaed5.f +++ b/SRC/dlaed5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED5 used by DSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed6.f b/SRC/dlaed6.f index 1be6b11559..d4c560bd59 100644 --- a/SRC/dlaed6.f +++ b/SRC/dlaed6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED6 used by DSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed7.f b/SRC/dlaed7.f index 2438b4b212..72ea7f35c9 100644 --- a/SRC/dlaed7.f +++ b/SRC/dlaed7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED7 used by DSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed8.f b/SRC/dlaed8.f index c4eb03b8fa..0b0ba0fced 100644 --- a/SRC/dlaed8.f +++ b/SRC/dlaed8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED8 used by DSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaed9.f b/SRC/dlaed9.f index 3ce4f3ffb9..cd2dfdca89 100644 --- a/SRC/dlaed9.f +++ b/SRC/dlaed9.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAED9 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaeda.f b/SRC/dlaeda.f index 76e01e9079..d1094eadce 100644 --- a/SRC/dlaeda.f +++ b/SRC/dlaeda.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAEDA used by DSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaein.f b/SRC/dlaein.f index 5a79b21424..581763ea2d 100644 --- a/SRC/dlaein.f +++ b/SRC/dlaein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaev2.f b/SRC/dlaev2.f index be61d4cb24..f646f43299 100644 --- a/SRC/dlaev2.f +++ b/SRC/dlaev2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaexc.f b/SRC/dlaexc.f index aeb4d7753e..bab245f98d 100644 --- a/SRC/dlaexc.f +++ b/SRC/dlaexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlag2.f b/SRC/dlag2.f index 531ce8eb3f..a360cba629 100644 --- a/SRC/dlag2.f +++ b/SRC/dlag2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlag2s.f b/SRC/dlag2s.f index c84ca0e4ec..aea21fd46d 100644 --- a/SRC/dlag2s.f +++ b/SRC/dlag2s.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAG2S converts a double precision matrix to a single precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlags2.f b/SRC/dlags2.f index e00abb0b31..6b118c8b32 100644 --- a/SRC/dlags2.f +++ b/SRC/dlags2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagtf.f b/SRC/dlagtf.f index de1700272e..1270fbef21 100644 --- a/SRC/dlagtf.f +++ b/SRC/dlagtf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagtm.f b/SRC/dlagtm.f index e030635be7..2074674cf0 100644 --- a/SRC/dlagtm.f +++ b/SRC/dlagtm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlagts.f b/SRC/dlagts.f index 6578ac3af1..d22e1c04fe 100644 --- a/SRC/dlagts.f +++ b/SRC/dlagts.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAGTS solves the system of equations (T-λI)x = y *> or (T-λI)^Tx = y, where T is a general tridiagonal matrix *> and λ a scalar, using the LU factorization computed by slagtf. diff --git a/SRC/dlagv2.f b/SRC/dlagv2.f index 91cbceda26..8141cd906e 100644 --- a/SRC/dlagv2.f +++ b/SRC/dlagv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlahqr.f b/SRC/dlahqr.f index 5b3454740e..7b02e6528f 100644 --- a/SRC/dlahqr.f +++ b/SRC/dlahqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlahr2.f b/SRC/dlahr2.f index 6b3a147dfc..67ef57e618 100644 --- a/SRC/dlahr2.f +++ b/SRC/dlahr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaic1.f b/SRC/dlaic1.f index 9a650682b7..8adbcaf496 100644 --- a/SRC/dlaic1.f +++ b/SRC/dlaic1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaisnan.f b/SRC/dlaisnan.f index 70b8e19d77..d879d9e409 100644 --- a/SRC/dlaisnan.f +++ b/SRC/dlaisnan.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAISNAN tests input for NaN by comparing two arguments for inequality. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaln2.f b/SRC/dlaln2.f index 69f7cbf100..aa0f91ca77 100644 --- a/SRC/dlaln2.f +++ b/SRC/dlaln2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlals0.f b/SRC/dlals0.f index 610f7f4e5a..08d44cf4e3 100644 --- a/SRC/dlals0.f +++ b/SRC/dlals0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlalsa.f b/SRC/dlalsa.f index a7e1c6792a..d728497d99 100644 --- a/SRC/dlalsa.f +++ b/SRC/dlalsa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlalsd.f b/SRC/dlalsd.f index de82e520b4..e9f2d53f99 100644 --- a/SRC/dlalsd.f +++ b/SRC/dlalsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlamrg.f b/SRC/dlamrg.f index 4d34931ffb..8ecfcc6535 100644 --- a/SRC/dlamrg.f +++ b/SRC/dlamrg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f index 204a09429f..07ef1bd57d 100644 --- a/SRC/dlamswlq.f +++ b/SRC/dlamswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAMSWLQ * * Definition: diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f index 9e9ca4773d..023db5ac9b 100644 --- a/SRC/dlamtsqr.f +++ b/SRC/dlamtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAMTSQR * * Definition: diff --git a/SRC/dlaneg.f b/SRC/dlaneg.f index 455afdf4e0..437fe0f980 100644 --- a/SRC/dlaneg.f +++ b/SRC/dlaneg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANEG computes the Sturm count. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlangb.f b/SRC/dlangb.f index 935ae8f0bb..7e2d9c5e38 100644 --- a/SRC/dlangb.f +++ b/SRC/dlangb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlange.f b/SRC/dlange.f index 3c27c5dd07..2d5add720e 100644 --- a/SRC/dlange.f +++ b/SRC/dlange.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlangt.f b/SRC/dlangt.f index 08c4d84fb5..3b440d3556 100644 --- a/SRC/dlangt.f +++ b/SRC/dlangt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanhs.f b/SRC/dlanhs.f index d83ed9cd4d..81fec33526 100644 --- a/SRC/dlanhs.f +++ b/SRC/dlanhs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansb.f b/SRC/dlansb.f index d70328ca93..afb3a6b615 100644 --- a/SRC/dlansb.f +++ b/SRC/dlansb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansf.f b/SRC/dlansf.f index 2bc790229e..1537b6b4d6 100644 --- a/SRC/dlansf.f +++ b/SRC/dlansf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANSF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansp.f b/SRC/dlansp.f index 10a05d9edb..017668f877 100644 --- a/SRC/dlansp.f +++ b/SRC/dlansp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanst.f b/SRC/dlanst.f index ed08fbd7e5..8860dbf675 100644 --- a/SRC/dlanst.f +++ b/SRC/dlanst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlansy.f b/SRC/dlansy.f index 18ec5986f5..b6239929d9 100644 --- a/SRC/dlansy.f +++ b/SRC/dlansy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantb.f b/SRC/dlantb.f index aa8280bbae..c03964003a 100644 --- a/SRC/dlantb.f +++ b/SRC/dlantb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantp.f b/SRC/dlantp.f index 4db0325c95..7f8bbe901c 100644 --- a/SRC/dlantp.f +++ b/SRC/dlantp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlantr.f b/SRC/dlantr.f index e0e1550855..ce14a404d1 100644 --- a/SRC/dlantr.f +++ b/SRC/dlantr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlanv2.f b/SRC/dlanv2.f index 3d1a997c2f..c55b0ce510 100644 --- a/SRC/dlanv2.f +++ b/SRC/dlanv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaorhr_col_getrfnp.f b/SRC/dlaorhr_col_getrfnp.f index cdd3eb4179..92db32bf51 100644 --- a/SRC/dlaorhr_col_getrfnp.f +++ b/SRC/dlaorhr_col_getrfnp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAORHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaorhr_col_getrfnp2.f b/SRC/dlaorhr_col_getrfnp2.f index 17010ffe43..1754188f16 100644 --- a/SRC/dlaorhr_col_getrfnp2.f +++ b/SRC/dlaorhr_col_getrfnp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAORHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapll.f b/SRC/dlapll.f index 9d8b72ce56..417d621684 100644 --- a/SRC/dlapll.f +++ b/SRC/dlapll.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapmr.f b/SRC/dlapmr.f index 302e66b565..a00db4a753 100644 --- a/SRC/dlapmr.f +++ b/SRC/dlapmr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapmt.f b/SRC/dlapmt.f index f152ffe0aa..1ace07e47d 100644 --- a/SRC/dlapmt.f +++ b/SRC/dlapmt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapy2.f b/SRC/dlapy2.f index ddc37edb23..627cacc92d 100644 --- a/SRC/dlapy2.f +++ b/SRC/dlapy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAPY2 returns sqrt(x2+y2). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlapy3.f b/SRC/dlapy3.f index bdf2407aeb..b5974fb1c5 100644 --- a/SRC/dlapy3.f +++ b/SRC/dlapy3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAPY3 returns sqrt(x2+y2+z2). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqgb.f b/SRC/dlaqgb.f index 05ce392e09..d09e40d1bb 100644 --- a/SRC/dlaqgb.f +++ b/SRC/dlaqgb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqge.f b/SRC/dlaqge.f index ecba93d132..e9cad69a9e 100644 --- a/SRC/dlaqge.f +++ b/SRC/dlaqge.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqp2.f b/SRC/dlaqp2.f index 900071607a..5bfa967ee9 100644 --- a/SRC/dlaqp2.f +++ b/SRC/dlaqp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqp2rk.f b/SRC/dlaqp2rk.f index 61bca6e919..aecd6bb69c 100644 --- a/SRC/dlaqp2rk.f +++ b/SRC/dlaqp2rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqp3rk.f b/SRC/dlaqp3rk.f index 8e28ee1282..73926ebd37 100644 --- a/SRC/dlaqp3rk.f +++ b/SRC/dlaqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqps.f b/SRC/dlaqps.f index abf195c08d..cda9265717 100644 --- a/SRC/dlaqps.f +++ b/SRC/dlaqps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr0.f b/SRC/dlaqr0.f index 91027b4318..e1c5377773 100644 --- a/SRC/dlaqr0.f +++ b/SRC/dlaqr0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr1.f b/SRC/dlaqr1.f index fdc181a1af..157a73d6ed 100644 --- a/SRC/dlaqr1.f +++ b/SRC/dlaqr1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index c22812b6c1..8591d5d3be 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr3.f b/SRC/dlaqr3.f index 98bc4e171e..f8b0bc2665 100644 --- a/SRC/dlaqr3.f +++ b/SRC/dlaqr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr4.f b/SRC/dlaqr4.f index c57f53da15..b728a7f5f5 100644 --- a/SRC/dlaqr4.f +++ b/SRC/dlaqr4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqr5.f b/SRC/dlaqr5.f index e11de5b4ec..29b130b819 100644 --- a/SRC/dlaqr5.f +++ b/SRC/dlaqr5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsb.f b/SRC/dlaqsb.f index 625753f566..e8605c8126 100644 --- a/SRC/dlaqsb.f +++ b/SRC/dlaqsb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsp.f b/SRC/dlaqsp.f index 3ee6cde1b0..8c48e85b42 100644 --- a/SRC/dlaqsp.f +++ b/SRC/dlaqsp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqsy.f b/SRC/dlaqsy.f index aea09f8e4d..77eedaefe8 100644 --- a/SRC/dlaqsy.f +++ b/SRC/dlaqsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqtr.f b/SRC/dlaqtr.f index 04df2030b0..0465fe9ab4 100644 --- a/SRC/dlaqtr.f +++ b/SRC/dlaqtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz0.f b/SRC/dlaqz0.f index facefd29f5..829d414afd 100644 --- a/SRC/dlaqz0.f +++ b/SRC/dlaqz0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz1.f b/SRC/dlaqz1.f index ed6f859610..9c5f402648 100644 --- a/SRC/dlaqz1.f +++ b/SRC/dlaqz1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz2.f b/SRC/dlaqz2.f index 62e276892a..f91dcb38b2 100644 --- a/SRC/dlaqz2.f +++ b/SRC/dlaqz2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz3.f b/SRC/dlaqz3.f index 9c21b44cf0..1305bf0c4f 100644 --- a/SRC/dlaqz3.f +++ b/SRC/dlaqz3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaqz4.f b/SRC/dlaqz4.f index 0bcc7927df..462d47a7d1 100644 --- a/SRC/dlaqz4.f +++ b/SRC/dlaqz4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAQZ4 * * =========== DOCUMENTATION =========== diff --git a/SRC/dlar1v.f b/SRC/dlar1v.f index 166ee938f4..9cb9f9e548 100644 --- a/SRC/dlar1v.f +++ b/SRC/dlar1v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlar2v.f b/SRC/dlar2v.f index ae2bf44e47..8d6f861497 100644 --- a/SRC/dlar2v.f +++ b/SRC/dlar2v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarf.f b/SRC/dlarf.f index 0e2e654996..be7043c8cb 100644 --- a/SRC/dlarf.f +++ b/SRC/dlarf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfb.f b/SRC/dlarfb.f index aa51742cf3..a5298e7182 100644 --- a/SRC/dlarfb.f +++ b/SRC/dlarfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFB applies a block reflector or its transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfb_gett.f b/SRC/dlarfb_gett.f index c0b0a24c46..d8461064d4 100644 --- a/SRC/dlarfb_gett.f +++ b/SRC/dlarfb_gett.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfg.f b/SRC/dlarfg.f index 10574887c0..1d6fb6c8e5 100644 --- a/SRC/dlarfg.f +++ b/SRC/dlarfg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfgp.f b/SRC/dlarfgp.f index 2559178d61..a8cf1b31e3 100644 --- a/SRC/dlarfgp.f +++ b/SRC/dlarfgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 294e6928df..d9ef2f77b6 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfx.f b/SRC/dlarfx.f index e9931aa1b7..04c706d0b2 100644 --- a/SRC/dlarfx.f +++ b/SRC/dlarfx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarfy.f b/SRC/dlarfy.f index ede6f9d7d5..7972a62540 100644 --- a/SRC/dlarfy.f +++ b/SRC/dlarfy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/dlargv.f b/SRC/dlargv.f index f9af89c93b..83f522e72f 100644 --- a/SRC/dlargv.f +++ b/SRC/dlargv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARGV generates a vector of plane rotations with real cosines and real sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarmm.f b/SRC/dlarmm.f index 8707f2c230..f276df3655 100644 --- a/SRC/dlarmm.f +++ b/SRC/dlarmm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARMM * * Definition: diff --git a/SRC/dlarnv.f b/SRC/dlarnv.f index 43db3e77b7..30b76542e3 100644 --- a/SRC/dlarnv.f +++ b/SRC/dlarnv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarra.f b/SRC/dlarra.f index fc9d219dee..f325d725d5 100644 --- a/SRC/dlarra.f +++ b/SRC/dlarra.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRA computes the splitting points with the specified threshold. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrb.f b/SRC/dlarrb.f index 2578900cab..2ebdaeebd2 100644 --- a/SRC/dlarrb.f +++ b/SRC/dlarrb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRB provides limited bisection to locate eigenvalues for more accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrc.f b/SRC/dlarrc.f index f9fd1c7ceb..9f3eed0140 100644 --- a/SRC/dlarrc.f +++ b/SRC/dlarrc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrd.f b/SRC/dlarrd.f index a348614d26..077f187ce1 100644 --- a/SRC/dlarrd.f +++ b/SRC/dlarrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarre.f b/SRC/dlarre.f index 66eda0c3ef..9e7fad1227 100644 --- a/SRC/dlarre.f +++ b/SRC/dlarre.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrf.f b/SRC/dlarrf.f index 7478bb9e16..d7c6195e5b 100644 --- a/SRC/dlarrf.f +++ b/SRC/dlarrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrj.f b/SRC/dlarrj.f index 4875392e7c..5596af3725 100644 --- a/SRC/dlarrj.f +++ b/SRC/dlarrj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrk.f b/SRC/dlarrk.f index 08728d3da5..347ff0af3b 100644 --- a/SRC/dlarrk.f +++ b/SRC/dlarrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrr.f b/SRC/dlarrr.f index 87e262715a..23ab364642 100644 --- a/SRC/dlarrr.f +++ b/SRC/dlarrr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarrv.f b/SRC/dlarrv.f index c41b8d862d..ed26b19ebf 100644 --- a/SRC/dlarrv.f +++ b/SRC/dlarrv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarscl2.f b/SRC/dlarscl2.f index 33a9c4913e..3857447e6d 100644 --- a/SRC/dlarscl2.f +++ b/SRC/dlarscl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartg.f90 b/SRC/dlartg.f90 index 12b6e80eba..b96b8d49fc 100644 --- a/SRC/dlartg.f90 +++ b/SRC/dlartg.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b DLARTG generates a plane rotation with real cosine and real sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dlartgp.f b/SRC/dlartgp.f index b73be91073..d437039b77 100644 --- a/SRC/dlartgp.f +++ b/SRC/dlartgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARTGP generates a plane rotation so that the diagonal is nonnegative. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartgs.f b/SRC/dlartgs.f index d59290d91f..abfac6e65b 100644 --- a/SRC/dlartgs.f +++ b/SRC/dlartgs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlartv.f b/SRC/dlartv.f index 1b389aa261..18f2f9cfc6 100644 --- a/SRC/dlartv.f +++ b/SRC/dlartv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaruv.f b/SRC/dlaruv.f index 7ac862c9a9..1bacb0bb6f 100644 --- a/SRC/dlaruv.f +++ b/SRC/dlaruv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARUV returns a vector of n random real numbers from a uniform distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarz.f b/SRC/dlarz.f index d4e0b61e0c..fef71e933e 100644 --- a/SRC/dlarz.f +++ b/SRC/dlarz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarzb.f b/SRC/dlarzb.f index 8cda5cfb86..b1f64cd3c5 100644 --- a/SRC/dlarzb.f +++ b/SRC/dlarzb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARZB applies a block reflector or its transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlarzt.f b/SRC/dlarzt.f index 22698617a8..b7fa731d65 100644 --- a/SRC/dlarzt.f +++ b/SRC/dlarzt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlas2.f b/SRC/dlas2.f index 082e083173..11ae217cf1 100644 --- a/SRC/dlas2.f +++ b/SRC/dlas2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAS2 computes singular values of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlascl.f b/SRC/dlascl.f index 66780c52d5..5e9c8e9c5d 100644 --- a/SRC/dlascl.f +++ b/SRC/dlascl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlascl2.f b/SRC/dlascl2.f index 3151e671a5..edb816f0da 100644 --- a/SRC/dlascl2.f +++ b/SRC/dlascl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd0.f b/SRC/dlasd0.f index 19f46db2c1..8f71684c5e 100644 --- a/SRC/dlasd0.f +++ b/SRC/dlasd0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd1.f b/SRC/dlasd1.f index 237ccca4d8..93057d9a21 100644 --- a/SRC/dlasd1.f +++ b/SRC/dlasd1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd2.f b/SRC/dlasd2.f index dcc027149e..9104cbf2e2 100644 --- a/SRC/dlasd2.f +++ b/SRC/dlasd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd3.f b/SRC/dlasd3.f index f1b26066f5..f089ee8aa8 100644 --- a/SRC/dlasd3.f +++ b/SRC/dlasd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd4.f b/SRC/dlasd4.f index 2fda08d34a..45a85f476d 100644 --- a/SRC/dlasd4.f +++ b/SRC/dlasd4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by dbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd5.f b/SRC/dlasd5.f index 5e93b941c8..df508a60df 100644 --- a/SRC/dlasd5.f +++ b/SRC/dlasd5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd6.f b/SRC/dlasd6.f index 95a1e50ba0..c9e26b0de0 100644 --- a/SRC/dlasd6.f +++ b/SRC/dlasd6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd7.f b/SRC/dlasd7.f index 1e266607a1..807727756e 100644 --- a/SRC/dlasd7.f +++ b/SRC/dlasd7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasd8.f b/SRC/dlasd8.f index a84569bd20..75f89162d9 100644 --- a/SRC/dlasd8.f +++ b/SRC/dlasd8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasda.f b/SRC/dlasda.f index e0e44c599d..90ac8eea9c 100644 --- a/SRC/dlasda.f +++ b/SRC/dlasda.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasdq.f b/SRC/dlasdq.f index 3e99cbe838..a1a14eb03e 100644 --- a/SRC/dlasdq.f +++ b/SRC/dlasdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasdt.f b/SRC/dlasdt.f index a0048bc87e..9fc1b77e4f 100644 --- a/SRC/dlasdt.f +++ b/SRC/dlasdt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaset.f b/SRC/dlaset.f index 6bcbfc374d..e527d794b0 100644 --- a/SRC/dlaset.f +++ b/SRC/dlaset.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq1.f b/SRC/dlasq1.f index 869af8f60b..a260a0a990 100644 --- a/SRC/dlasq1.f +++ b/SRC/dlasq1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq2.f b/SRC/dlasq2.f index d62c364064..eb66c094bb 100644 --- a/SRC/dlasq2.f +++ b/SRC/dlasq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq3.f b/SRC/dlasq3.f index e20a883127..62b916061d 100644 --- a/SRC/dlasq3.f +++ b/SRC/dlasq3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq4.f b/SRC/dlasq4.f index f3eed0ab51..d96d51ab14 100644 --- a/SRC/dlasq4.f +++ b/SRC/dlasq4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq5.f b/SRC/dlasq5.f index e24b5d8357..0641f7948b 100644 --- a/SRC/dlasq5.f +++ b/SRC/dlasq5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasq6.f b/SRC/dlasq6.f index 15842def3b..7aff8f37c0 100644 --- a/SRC/dlasq6.f +++ b/SRC/dlasq6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasr.f b/SRC/dlasr.f index b2d9bce0f8..f8cece85c6 100644 --- a/SRC/dlasr.f +++ b/SRC/dlasr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasrt.f b/SRC/dlasrt.f index 888752c8cf..0232f64133 100644 --- a/SRC/dlasrt.f +++ b/SRC/dlasrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASRT sorts numbers in increasing or decreasing order. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlassq.f90 b/SRC/dlassq.f90 index 2a35ecaa2d..37626844b5 100644 --- a/SRC/dlassq.f90 +++ b/SRC/dlassq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b DLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/dlasv2.f b/SRC/dlasv2.f index de51d1b54a..4bd6b34a31 100644 --- a/SRC/dlasv2.f +++ b/SRC/dlasv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index c02c816c49..636c12dc87 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASWLQ * * Definition: diff --git a/SRC/dlaswp.f b/SRC/dlaswp.f index ce32e19ca9..43dcaf8d54 100644 --- a/SRC/dlaswp.f +++ b/SRC/dlaswp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasy2.f b/SRC/dlasy2.f index 68e900cc48..ba91ae454a 100644 --- a/SRC/dlasy2.f +++ b/SRC/dlasy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf.f b/SRC/dlasyf.f index bdc001f941..5b1ca4e564 100644 --- a/SRC/dlasyf.f +++ b/SRC/dlasyf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASYF computes a partial factorization of a real symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_aa.f b/SRC/dlasyf_aa.f index ea62f7c298..b6ded262bd 100644 --- a/SRC/dlasyf_aa.f +++ b/SRC/dlasyf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_rk.f b/SRC/dlasyf_rk.f index 9bd76b060f..3de5cdb7f1 100644 --- a/SRC/dlasyf_rk.f +++ b/SRC/dlasyf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlasyf_rook.f b/SRC/dlasyf_rook.f index 2e31ba04b1..f9d34c9a87 100644 --- a/SRC/dlasyf_rook.f +++ b/SRC/dlasyf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLASYF_ROOK *> DLASYF_ROOK computes a partial factorization of a real symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlat2s.f b/SRC/dlat2s.f index 9dc61b752d..5dc33838d8 100644 --- a/SRC/dlat2s.f +++ b/SRC/dlat2s.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAT2S converts a double-precision triangular matrix to a single-precision triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatbs.f b/SRC/dlatbs.f index bcbe7b0874..01a2152db2 100644 --- a/SRC/dlatbs.f +++ b/SRC/dlatbs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatdf.f b/SRC/dlatdf.f index 0d4435e02f..e01153868c 100644 --- a/SRC/dlatdf.f +++ b/SRC/dlatdf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatps.f b/SRC/dlatps.f index 65058b01e4..04dd04b0cf 100644 --- a/SRC/dlatps.f +++ b/SRC/dlatps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrd.f b/SRC/dlatrd.f index 6d1e4a4e87..e5737be058 100644 --- a/SRC/dlatrd.f +++ b/SRC/dlatrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrs.f b/SRC/dlatrs.f index 43a9df03c2..fb899e5ece 100644 --- a/SRC/dlatrs.f +++ b/SRC/dlatrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatrs3.f b/SRC/dlatrs3.f index eaf4980458..ae94b8dff1 100644 --- a/SRC/dlatrs3.f +++ b/SRC/dlatrs3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/dlatrz.f b/SRC/dlatrz.f index 02254f0b5d..dc94703970 100644 --- a/SRC/dlatrz.f +++ b/SRC/dlatrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f index d3c6a30d54..0000aab68c 100644 --- a/SRC/dlatsqr.f +++ b/SRC/dlatsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLATSQR * * Definition: diff --git a/SRC/dlauu2.f b/SRC/dlauu2.f index 8052edfc87..60cef3e9b8 100644 --- a/SRC/dlauu2.f +++ b/SRC/dlauu2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dlauum.f b/SRC/dlauum.f index 816f4dc2b0..3f2738583e 100644 --- a/SRC/dlauum.f +++ b/SRC/dlauum.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dopgtr.f b/SRC/dopgtr.f index 334d86604a..bf2f6c5fa3 100644 --- a/SRC/dopgtr.f +++ b/SRC/dopgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DOPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dopmtr.f b/SRC/dopmtr.f index 71be4395c2..fd2fd9c239 100644 --- a/SRC/dopmtr.f +++ b/SRC/dopmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DOPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f index b22875dcd2..f70813bdb3 100644 --- a/SRC/dorbdb.f +++ b/SRC/dorbdb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f index 588d47c08b..7dceca9bc1 100644 --- a/SRC/dorbdb1.f +++ b/SRC/dorbdb1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f index e17550fac8..e6b1b97107 100644 --- a/SRC/dorbdb2.f +++ b/SRC/dorbdb2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb3.f b/SRC/dorbdb3.f index 15bfb51c5e..1914ce496a 100644 --- a/SRC/dorbdb3.f +++ b/SRC/dorbdb3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f index f77083c488..c0150cb967 100644 --- a/SRC/dorbdb4.f +++ b/SRC/dorbdb4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb5.f b/SRC/dorbdb5.f index 9c1258e533..a46ce45d97 100644 --- a/SRC/dorbdb5.f +++ b/SRC/dorbdb5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorbdb6.f b/SRC/dorbdb6.f index 189ac3104d..8608dba340 100644 --- a/SRC/dorbdb6.f +++ b/SRC/dorbdb6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorcsd.f b/SRC/dorcsd.f index 20188c1acb..2087b1caea 100644 --- a/SRC/dorcsd.f +++ b/SRC/dorcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/dorcsd2by1.f b/SRC/dorcsd2by1.f index afb8b0c6e2..e96408c99d 100644 --- a/SRC/dorcsd2by1.f +++ b/SRC/dorcsd2by1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index 203cb133cf..af8831085b 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorg2r.f b/SRC/dorg2r.f index 03801ddf7e..221b52bb8c 100644 --- a/SRC/dorg2r.f +++ b/SRC/dorg2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgbr.f b/SRC/dorgbr.f index a965dd0b53..a71c4328c2 100644 --- a/SRC/dorgbr.f +++ b/SRC/dorgbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorghr.f b/SRC/dorghr.f index bbe3ce1e82..74e9896702 100644 --- a/SRC/dorghr.f +++ b/SRC/dorghr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgl2.f b/SRC/dorgl2.f index e0ce541a32..98128b25d5 100644 --- a/SRC/dorgl2.f +++ b/SRC/dorgl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGL2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dorglq.f b/SRC/dorglq.f index faff1ca523..c41367ced4 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgql.f b/SRC/dorgql.f index 2d8d1e4d39..f931f5a9c8 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f index bb3da27bdd..fd88519871 100644 --- a/SRC/dorgqr.f +++ b/SRC/dorgqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgr2.f b/SRC/dorgr2.f index 0daf7eb2bb..211db4f8db 100644 --- a/SRC/dorgr2.f +++ b/SRC/dorgr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index 9e9ae020f7..c805484578 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtr.f b/SRC/dorgtr.f index 4c8749f6a3..d19c305959 100644 --- a/SRC/dorgtr.f +++ b/SRC/dorgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtsqr.f b/SRC/dorgtsqr.f index ebecefc21f..323ffe0aab 100644 --- a/SRC/dorgtsqr.f +++ b/SRC/dorgtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorgtsqr_row.f b/SRC/dorgtsqr_row.f index 29742e4353..95cb02cc2e 100644 --- a/SRC/dorgtsqr_row.f +++ b/SRC/dorgtsqr_row.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/dorhr_col.f b/SRC/dorhr_col.f index 88048ef41f..c9fcb391cf 100644 --- a/SRC/dorhr_col.f +++ b/SRC/dorhr_col.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm22.f b/SRC/dorm22.f index 40c729477c..1fac2021ba 100644 --- a/SRC/dorm22.f +++ b/SRC/dorm22.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORM22 multiplies a general matrix by a banded orthogonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm2l.f b/SRC/dorm2l.f index 31a22cd655..b1a27ab21b 100644 --- a/SRC/dorm2l.f +++ b/SRC/dorm2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index 5bdc2ea18e..d894a806c3 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormbr.f b/SRC/dormbr.f index 46c617e5c0..c8bf9e70c6 100644 --- a/SRC/dormbr.f +++ b/SRC/dormbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/dormhr.f b/SRC/dormhr.f index 02e1a534a0..7ef5bb3e33 100644 --- a/SRC/dormhr.f +++ b/SRC/dormhr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/dorml2.f b/SRC/dorml2.f index 57f297aa73..fcdf5b1b13 100644 --- a/SRC/dorml2.f +++ b/SRC/dorml2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormlq.f b/SRC/dormlq.f index 1e42594707..85ca134737 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormql.f b/SRC/dormql.f index 8193e22bd7..11022d78c6 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/dormqr.f b/SRC/dormqr.f index 6e7a39b795..a9f8ba2279 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dormr2.f b/SRC/dormr2.f index 1ea570bc78..4d91aca411 100644 --- a/SRC/dormr2.f +++ b/SRC/dormr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormr3.f b/SRC/dormr3.f index a2f7adba10..668e970501 100644 --- a/SRC/dormr3.f +++ b/SRC/dormr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dormrq.f b/SRC/dormrq.f index a90e359f55..03159e4961 100644 --- a/SRC/dormrq.f +++ b/SRC/dormrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormrz.f b/SRC/dormrz.f index 4d6d4f5d21..754b69e9f6 100644 --- a/SRC/dormrz.f +++ b/SRC/dormrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dormtr.f b/SRC/dormtr.f index 3297cd322b..eb85afce72 100644 --- a/SRC/dormtr.f +++ b/SRC/dormtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DORMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbcon.f b/SRC/dpbcon.f index e003510220..2fd1c59bdb 100644 --- a/SRC/dpbcon.f +++ b/SRC/dpbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbequ.f b/SRC/dpbequ.f index 9013375d45..b684571c50 100644 --- a/SRC/dpbequ.f +++ b/SRC/dpbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbrfs.f b/SRC/dpbrfs.f index ce056e5207..cdebac2c3f 100644 --- a/SRC/dpbrfs.f +++ b/SRC/dpbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbstf.f b/SRC/dpbstf.f index 04a333620e..471ddf77d2 100644 --- a/SRC/dpbstf.f +++ b/SRC/dpbstf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbsv.f b/SRC/dpbsv.f index ca5ba38abb..69e051f6ba 100644 --- a/SRC/dpbsv.f +++ b/SRC/dpbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbsvx.f b/SRC/dpbsvx.f index e93b29543c..20387960d2 100644 --- a/SRC/dpbsvx.f +++ b/SRC/dpbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtf2.f b/SRC/dpbtf2.f index 3d1cf2b139..b2b4956110 100644 --- a/SRC/dpbtf2.f +++ b/SRC/dpbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtrf.f b/SRC/dpbtrf.f index bcd2042a1a..7872a263e0 100644 --- a/SRC/dpbtrf.f +++ b/SRC/dpbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpbtrs.f b/SRC/dpbtrs.f index 5f9d08a579..e017da3dc4 100644 --- a/SRC/dpbtrs.f +++ b/SRC/dpbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftrf.f b/SRC/dpftrf.f index 534190e66e..67771ff478 100644 --- a/SRC/dpftrf.f +++ b/SRC/dpftrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftri.f b/SRC/dpftri.f index e4de32f088..69a25dc1aa 100644 --- a/SRC/dpftri.f +++ b/SRC/dpftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpftrs.f b/SRC/dpftrs.f index b7fffe88fd..abbf0cc0f4 100644 --- a/SRC/dpftrs.f +++ b/SRC/dpftrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpocon.f b/SRC/dpocon.f index 31a74c1343..a7a328e802 100644 --- a/SRC/dpocon.f +++ b/SRC/dpocon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpoequ.f b/SRC/dpoequ.f index 140face34a..a04fb13277 100644 --- a/SRC/dpoequ.f +++ b/SRC/dpoequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpoequb.f b/SRC/dpoequb.f index 191656944c..d8936c4099 100644 --- a/SRC/dpoequb.f +++ b/SRC/dpoequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dporfs.f b/SRC/dporfs.f index ced7a6335b..7398bd8b11 100644 --- a/SRC/dporfs.f +++ b/SRC/dporfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dporfsx.f b/SRC/dporfsx.f index bb00fc22aa..b9fe29f986 100644 --- a/SRC/dporfsx.f +++ b/SRC/dporfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dposv.f b/SRC/dposv.f index 0487b1bd73..e25f284029 100644 --- a/SRC/dposv.f +++ b/SRC/dposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dposvx.f b/SRC/dposvx.f index 80f38b371c..4ff4907a38 100644 --- a/SRC/dposvx.f +++ b/SRC/dposvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dposvxx.f b/SRC/dposvxx.f index b5fecabcc3..881d21c99b 100644 --- a/SRC/dposvxx.f +++ b/SRC/dposvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotf2.f b/SRC/dpotf2.f index 1972387fda..441252b755 100644 --- a/SRC/dpotf2.f +++ b/SRC/dpotf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrf.f b/SRC/dpotrf.f index 027ab9dabe..d3e4f1d0f6 100644 --- a/SRC/dpotrf.f +++ b/SRC/dpotrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrf2.f b/SRC/dpotrf2.f index 9e19ee8acf..5f06352175 100644 --- a/SRC/dpotrf2.f +++ b/SRC/dpotrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotri.f b/SRC/dpotri.f index 520a9b6f3a..96592eda75 100644 --- a/SRC/dpotri.f +++ b/SRC/dpotri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpotrs.f b/SRC/dpotrs.f index 53fc026850..6edf60d1af 100644 --- a/SRC/dpotrs.f +++ b/SRC/dpotrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dppcon.f b/SRC/dppcon.f index fa4c1a2068..64b8dcdfb3 100644 --- a/SRC/dppcon.f +++ b/SRC/dppcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dppequ.f b/SRC/dppequ.f index 00fdb6778c..518dc7727a 100644 --- a/SRC/dppequ.f +++ b/SRC/dppequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/dpprfs.f b/SRC/dpprfs.f index c388a0ec7f..99b14f2c48 100644 --- a/SRC/dpprfs.f +++ b/SRC/dpprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dppsv.f b/SRC/dppsv.f index 6981a4aa8d..3e8d60c68d 100644 --- a/SRC/dppsv.f +++ b/SRC/dppsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dppsvx.f b/SRC/dppsvx.f index 29d64c52e6..90fd67c6d9 100644 --- a/SRC/dppsvx.f +++ b/SRC/dppsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptrf.f b/SRC/dpptrf.f index 354580c92e..0fb22c6dd5 100644 --- a/SRC/dpptrf.f +++ b/SRC/dpptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptri.f b/SRC/dpptri.f index 82367901a0..3ac5876c3c 100644 --- a/SRC/dpptri.f +++ b/SRC/dpptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dpptrs.f b/SRC/dpptrs.f index b021c5b9e3..21c71adedd 100644 --- a/SRC/dpptrs.f +++ b/SRC/dpptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dpstf2.f b/SRC/dpstf2.f index 6aef2e0387..403a7a0ca5 100644 --- a/SRC/dpstf2.f +++ b/SRC/dpstf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dpstrf.f b/SRC/dpstrf.f index ae70bca5e8..d548e021d4 100644 --- a/SRC/dpstrf.f +++ b/SRC/dpstrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * diff --git a/SRC/dptcon.f b/SRC/dptcon.f index 3cd557dcbf..094a5b49de 100644 --- a/SRC/dptcon.f +++ b/SRC/dptcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dpteqr.f b/SRC/dpteqr.f index 382509b78e..952a13f90c 100644 --- a/SRC/dpteqr.f +++ b/SRC/dpteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dptrfs.f b/SRC/dptrfs.f index 5afc530793..b94e76fb86 100644 --- a/SRC/dptrfs.f +++ b/SRC/dptrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dptsv.f b/SRC/dptsv.f index 9895f23321..25494833c2 100644 --- a/SRC/dptsv.f +++ b/SRC/dptsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dptsvx.f b/SRC/dptsvx.f index f474eca16f..f22cfec979 100644 --- a/SRC/dptsvx.f +++ b/SRC/dptsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dpttrf.f b/SRC/dpttrf.f index c08db2f601..66ec3a4b43 100644 --- a/SRC/dpttrf.f +++ b/SRC/dpttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dpttrs.f b/SRC/dpttrs.f index 6448392e7c..48244e63af 100644 --- a/SRC/dpttrs.f +++ b/SRC/dpttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dptts2.f b/SRC/dptts2.f index 50e2da9b02..f00f23bd6d 100644 --- a/SRC/dptts2.f +++ b/SRC/dptts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/drscl.f b/SRC/drscl.f index 7e10aa32fd..840957bbab 100644 --- a/SRC/drscl.f +++ b/SRC/drscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f index 9507b43c31..6fc48512c6 100644 --- a/SRC/dsb2st_kernels.f +++ b/SRC/dsb2st_kernels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec 7 08:22:39 2016 diff --git a/SRC/dsbev.f b/SRC/dsbev.f index 87a19dff0f..344a5dd0ae 100644 --- a/SRC/dsbev.f +++ b/SRC/dsbev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbev_2stage.f b/SRC/dsbev_2stage.f index b578c307cf..3552298fe2 100644 --- a/SRC/dsbev_2stage.f +++ b/SRC/dsbev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbevd.f b/SRC/dsbevd.f index bf464bc9e2..8a72fe0a1a 100644 --- a/SRC/dsbevd.f +++ b/SRC/dsbevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbevd_2stage.f b/SRC/dsbevd_2stage.f index 5365394134..421dc87577 100644 --- a/SRC/dsbevd_2stage.f +++ b/SRC/dsbevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbevx.f b/SRC/dsbevx.f index 275a3285dc..f9e15f5241 100644 --- a/SRC/dsbevx.f +++ b/SRC/dsbevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbevx_2stage.f b/SRC/dsbevx_2stage.f index 4796456e98..b6526e62e1 100644 --- a/SRC/dsbevx_2stage.f +++ b/SRC/dsbevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran d -> s diff --git a/SRC/dsbgst.f b/SRC/dsbgst.f index a7138c423f..805ed9bc66 100644 --- a/SRC/dsbgst.f +++ b/SRC/dsbgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgv.f b/SRC/dsbgv.f index ad82da1d8e..3636390d6a 100644 --- a/SRC/dsbgv.f +++ b/SRC/dsbgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgvd.f b/SRC/dsbgvd.f index d43d837578..5e13bd4587 100644 --- a/SRC/dsbgvd.f +++ b/SRC/dsbgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbgvx.f b/SRC/dsbgvx.f index ffceb9da74..5e7e3564b2 100644 --- a/SRC/dsbgvx.f +++ b/SRC/dsbgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsbtrd.f b/SRC/dsbtrd.f index e4f7a9de6d..a6709dbdaf 100644 --- a/SRC/dsbtrd.f +++ b/SRC/dsbtrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsfrk.f b/SRC/dsfrk.f index da26f70c00..6a99a1a014 100644 --- a/SRC/dsfrk.f +++ b/SRC/dsfrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSFRK performs a symmetric rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsgesv.f b/SRC/dsgesv.f index 9f221382a3..754d6451a0 100644 --- a/SRC/dsgesv.f +++ b/SRC/dsgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision with iterative refinement) * * =========== DOCUMENTATION =========== diff --git a/SRC/dspcon.f b/SRC/dspcon.f index 7b227d02b5..3f9f83115e 100644 --- a/SRC/dspcon.f +++ b/SRC/dspcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dspev.f b/SRC/dspev.f index e4adb00137..d58b059315 100644 --- a/SRC/dspev.f +++ b/SRC/dspev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspevd.f b/SRC/dspevd.f index 0df1c9d727..2f1f1429a8 100644 --- a/SRC/dspevd.f +++ b/SRC/dspevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspevx.f b/SRC/dspevx.f index 129a79e497..1dea63e710 100644 --- a/SRC/dspevx.f +++ b/SRC/dspevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgst.f b/SRC/dspgst.f index e9fe6c15fd..5860c4604d 100644 --- a/SRC/dspgst.f +++ b/SRC/dspgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgv.f b/SRC/dspgv.f index 77aba6acd7..85fe7c6bd4 100644 --- a/SRC/dspgv.f +++ b/SRC/dspgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgvd.f b/SRC/dspgvd.f index 42ca4de2c6..07e52e3b1f 100644 --- a/SRC/dspgvd.f +++ b/SRC/dspgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dspgvx.f b/SRC/dspgvx.f index 220918692d..a6002f14aa 100644 --- a/SRC/dspgvx.f +++ b/SRC/dspgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsposv.f b/SRC/dsposv.f index 3d5cb9f46c..2673364ee9 100644 --- a/SRC/dsposv.f +++ b/SRC/dsposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsprfs.f b/SRC/dsprfs.f index 961db78b5e..becd3292b4 100644 --- a/SRC/dsprfs.f +++ b/SRC/dsprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dspsv.f b/SRC/dspsv.f index 64a6b272e9..fd822e5b03 100644 --- a/SRC/dspsv.f +++ b/SRC/dspsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dspsvx.f b/SRC/dspsvx.f index 543654bfc9..ea16968de1 100644 --- a/SRC/dspsvx.f +++ b/SRC/dspsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrd.f b/SRC/dsptrd.f index 3054b7105f..fcfd940a26 100644 --- a/SRC/dsptrd.f +++ b/SRC/dsptrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrf.f b/SRC/dsptrf.f index 0d0f1ec4b0..c8a6c65953 100644 --- a/SRC/dsptrf.f +++ b/SRC/dsptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptri.f b/SRC/dsptri.f index 74c6122d95..a14004a1ad 100644 --- a/SRC/dsptri.f +++ b/SRC/dsptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dsptrs.f b/SRC/dsptrs.f index 733903b247..bab34fa2d9 100644 --- a/SRC/dsptrs.f +++ b/SRC/dsptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dstebz.f b/SRC/dstebz.f index 0c886beb1d..9588b0be20 100644 --- a/SRC/dstebz.f +++ b/SRC/dstebz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEBZ * * =========== DOCUMENTATION =========== diff --git a/SRC/dstedc.f b/SRC/dstedc.f index a1a1992ec6..1e0b44d4f5 100644 --- a/SRC/dstedc.f +++ b/SRC/dstedc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/dstegr.f b/SRC/dstegr.f index b1ada9d2b6..9688c69839 100644 --- a/SRC/dstegr.f +++ b/SRC/dstegr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/dstein.f b/SRC/dstein.f index d7499ab5bb..230351cc7e 100644 --- a/SRC/dstein.f +++ b/SRC/dstein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/dstemr.f b/SRC/dstemr.f index ec7728fc39..106f3f97d1 100644 --- a/SRC/dstemr.f +++ b/SRC/dstemr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/dsteqr.f b/SRC/dsteqr.f index dec5c3a14a..17df29bb9d 100644 --- a/SRC/dsteqr.f +++ b/SRC/dsteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/dsterf.f b/SRC/dsterf.f index 9f7f4ba950..4cc4e90e3f 100644 --- a/SRC/dsterf.f +++ b/SRC/dsterf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSTERF * * =========== DOCUMENTATION =========== diff --git a/SRC/dstev.f b/SRC/dstev.f index ba74b70784..bc0d4e5d73 100644 --- a/SRC/dstev.f +++ b/SRC/dstev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevd.f b/SRC/dstevd.f index 4c967099bb..225ad2b525 100644 --- a/SRC/dstevd.f +++ b/SRC/dstevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevr.f b/SRC/dstevr.f index 1ce3b2f4a8..b72e3b40da 100644 --- a/SRC/dstevr.f +++ b/SRC/dstevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dstevx.f b/SRC/dstevx.f index 7cd328d5e3..390ef92f57 100644 --- a/SRC/dstevx.f +++ b/SRC/dstevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon.f b/SRC/dsycon.f index 7beec0f6fb..4072dd4165 100644 --- a/SRC/dsycon.f +++ b/SRC/dsycon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon_3.f b/SRC/dsycon_3.f index 169cf12064..b4650c784f 100644 --- a/SRC/dsycon_3.f +++ b/SRC/dsycon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsycon_rook.f b/SRC/dsycon_rook.f index 727c226cb8..4165730947 100644 --- a/SRC/dsycon_rook.f +++ b/SRC/dsycon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconv.f b/SRC/dsyconv.f index c28da86552..e4c9b0f005 100644 --- a/SRC/dsyconv.f +++ b/SRC/dsyconv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconvf.f b/SRC/dsyconvf.f index 7e9adc07fc..b772d11a5b 100644 --- a/SRC/dsyconvf.f +++ b/SRC/dsyconvf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyconvf_rook.f b/SRC/dsyconvf_rook.f index a2ccbe313c..a8fcf90d82 100644 --- a/SRC/dsyconvf_rook.f +++ b/SRC/dsyconvf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyequb.f b/SRC/dsyequb.f index a6e0fc85a7..a777deebbc 100644 --- a/SRC/dsyequb.f +++ b/SRC/dsyequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyev.f b/SRC/dsyev.f index 23f9e7f173..e2d77b077d 100644 --- a/SRC/dsyev.f +++ b/SRC/dsyev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyev_2stage.f b/SRC/dsyev_2stage.f index 1cfe4f3266..9ef58a2e60 100644 --- a/SRC/dsyev_2stage.f +++ b/SRC/dsyev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevd.f b/SRC/dsyevd.f index daf0df848b..92c0d0b847 100644 --- a/SRC/dsyevd.f +++ b/SRC/dsyevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevd_2stage.f b/SRC/dsyevd_2stage.f index 8f4a5a3bef..c50617ec86 100644 --- a/SRC/dsyevd_2stage.f +++ b/SRC/dsyevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 9f22ffce4d..72dd32d99b 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevr_2stage.f b/SRC/dsyevr_2stage.f index 23f334f3b1..4ccf05f88a 100644 --- a/SRC/dsyevr_2stage.f +++ b/SRC/dsyevr_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsyevx.f b/SRC/dsyevx.f index 5dfee0980e..1f9954850f 100644 --- a/SRC/dsyevx.f +++ b/SRC/dsyevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyevx_2stage.f b/SRC/dsyevx_2stage.f index b92d61a657..26dd0e828a 100644 --- a/SRC/dsyevx_2stage.f +++ b/SRC/dsyevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @precisions fortran d -> s diff --git a/SRC/dsygs2.f b/SRC/dsygs2.f index bcf1463bbd..dc747fcc7a 100644 --- a/SRC/dsygs2.f +++ b/SRC/dsygs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygst.f b/SRC/dsygst.f index 75cb7ffa1d..eb48ee0907 100644 --- a/SRC/dsygst.f +++ b/SRC/dsygst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGST * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygv.f b/SRC/dsygv.f index 82e81654d9..b0085bda9d 100644 --- a/SRC/dsygv.f +++ b/SRC/dsygv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGV * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygv_2stage.f b/SRC/dsygv_2stage.f index ffd951319b..85c1611a4b 100644 --- a/SRC/dsygv_2stage.f +++ b/SRC/dsygv_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGV_2STAGE * * @precisions fortran d -> s diff --git a/SRC/dsygvd.f b/SRC/dsygvd.f index 80530a9a56..08e04a0094 100644 --- a/SRC/dsygvd.f +++ b/SRC/dsygvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsygvx.f b/SRC/dsygvx.f index 68cd289a17..91d85f784e 100644 --- a/SRC/dsygvx.f +++ b/SRC/dsygvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyrfs.f b/SRC/dsyrfs.f index 5e7a14d031..03475a689c 100644 --- a/SRC/dsyrfs.f +++ b/SRC/dsyrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyrfsx.f b/SRC/dsyrfsx.f index 716a0ff0d0..f458061a0a 100644 --- a/SRC/dsyrfsx.f +++ b/SRC/dsyrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv.f b/SRC/dsysv.f index 446991fd97..1d01c4ed80 100644 --- a/SRC/dsysv.f +++ b/SRC/dsysv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_aa.f b/SRC/dsysv_aa.f index 80f8cbf218..1e1f0f52cd 100644 --- a/SRC/dsysv_aa.f +++ b/SRC/dsysv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_aa_2stage.f b/SRC/dsysv_aa_2stage.f index 1730e2c4aa..90dd0a38ae 100644 --- a/SRC/dsysv_aa_2stage.f +++ b/SRC/dsysv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * @generated from SRC/chesv_aa_2stage.f, fortran c -> d, Tue Oct 31 11:22:31 2017 diff --git a/SRC/dsysv_rk.f b/SRC/dsysv_rk.f index e8ccba1cdb..38baadb560 100644 --- a/SRC/dsysv_rk.f +++ b/SRC/dsysv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysv_rook.f b/SRC/dsysv_rook.f index 3a6678f471..cc9de022db 100644 --- a/SRC/dsysv_rook.f +++ b/SRC/dsysv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysvx.f b/SRC/dsysvx.f index 7df4766084..6683472d18 100644 --- a/SRC/dsysvx.f +++ b/SRC/dsysvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief DSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/dsysvxx.f b/SRC/dsysvxx.f index 081bbd44b9..300fb1073e 100644 --- a/SRC/dsysvxx.f +++ b/SRC/dsysvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYSVXX * * =========== DOCUMENTATION =========== diff --git a/SRC/dsyswapr.f b/SRC/dsyswapr.f index d208610ee8..9048c0fc67 100644 --- a/SRC/dsyswapr.f +++ b/SRC/dsyswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytd2.f b/SRC/dsytd2.f index 83dd437106..e948496a12 100644 --- a/SRC/dsytd2.f +++ b/SRC/dsytd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2.f b/SRC/dsytf2.f index d1568daaca..d37b988bb1 100644 --- a/SRC/dsytf2.f +++ b/SRC/dsytf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2_rk.f b/SRC/dsytf2_rk.f index f4b87fe691..fdc836c9cf 100644 --- a/SRC/dsytf2_rk.f +++ b/SRC/dsytf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytf2_rook.f b/SRC/dsytf2_rook.f index 29a7a30c1a..edd342a199 100644 --- a/SRC/dsytf2_rook.f +++ b/SRC/dsytf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd.f b/SRC/dsytrd.f index 3a9b414227..2b56de494b 100644 --- a/SRC/dsytrd.f +++ b/SRC/dsytrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd_2stage.f b/SRC/dsytrd_2stage.f index 53715502b0..b53ce4412a 100644 --- a/SRC/dsytrd_2stage.f +++ b/SRC/dsytrd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> d, Sun Nov 6 19:34:06 2016 diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index db0aa588df..3889c2afa2 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index 7dfec7ae04..941d2f6964 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRD_SY2SB * * @generated from zhetrd_he2hb.f, fortran z -> d, Wed Dec 7 08:22:39 2016 diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f index 6cf5416d69..204f0ed0b1 100644 --- a/SRC/dsytrf.f +++ b/SRC/dsytrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_aa.f b/SRC/dsytrf_aa.f index 07bec951b6..c77208dd79 100644 --- a/SRC/dsytrf_aa.f +++ b/SRC/dsytrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_aa_2stage.f b/SRC/dsytrf_aa_2stage.f index 8f56296394..fae95bab24 100644 --- a/SRC/dsytrf_aa_2stage.f +++ b/SRC/dsytrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_rk.f b/SRC/dsytrf_rk.f index 1daff24bf3..b8e8f2cf39 100644 --- a/SRC/dsytrf_rk.f +++ b/SRC/dsytrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrf_rook.f b/SRC/dsytrf_rook.f index 717935d27f..1f6a7058e8 100644 --- a/SRC/dsytrf_rook.f +++ b/SRC/dsytrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri.f b/SRC/dsytri.f index 380018a126..47e76e5c2f 100644 --- a/SRC/dsytri.f +++ b/SRC/dsytri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f index 8aada0bfe3..5960d39928 100644 --- a/SRC/dsytri2.f +++ b/SRC/dsytri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri2x.f b/SRC/dsytri2x.f index 186cd21e37..056c41b45a 100644 --- a/SRC/dsytri2x.f +++ b/SRC/dsytri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_3.f b/SRC/dsytri_3.f index 29d7d53c7b..50834c605e 100644 --- a/SRC/dsytri_3.f +++ b/SRC/dsytri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_3x.f b/SRC/dsytri_3x.f index a7fe288fb0..dbc5ed7205 100644 --- a/SRC/dsytri_3x.f +++ b/SRC/dsytri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytri_rook.f b/SRC/dsytri_rook.f index cb33c92e50..2fb0442d2d 100644 --- a/SRC/dsytri_rook.f +++ b/SRC/dsytri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs.f b/SRC/dsytrs.f index 69b515520d..6d8fc66d7f 100644 --- a/SRC/dsytrs.f +++ b/SRC/dsytrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs2.f b/SRC/dsytrs2.f index 61b188f646..a9cc009dba 100644 --- a/SRC/dsytrs2.f +++ b/SRC/dsytrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_3.f b/SRC/dsytrs_3.f index 05e679124d..df73cac5e3 100644 --- a/SRC/dsytrs_3.f +++ b/SRC/dsytrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_aa.f b/SRC/dsytrs_aa.f index cb9361c146..1f25e5681e 100644 --- a/SRC/dsytrs_aa.f +++ b/SRC/dsytrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_aa_2stage.f b/SRC/dsytrs_aa_2stage.f index c29b2b1ff7..6255d4a92e 100644 --- a/SRC/dsytrs_aa_2stage.f +++ b/SRC/dsytrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/dsytrs_rook.f b/SRC/dsytrs_rook.f index 1f7494f88d..0846774791 100644 --- a/SRC/dsytrs_rook.f +++ b/SRC/dsytrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbcon.f b/SRC/dtbcon.f index 9e5d38abb6..21e752b5f4 100644 --- a/SRC/dtbcon.f +++ b/SRC/dtbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbrfs.f b/SRC/dtbrfs.f index c32383eeb7..b5c58575d6 100644 --- a/SRC/dtbrfs.f +++ b/SRC/dtbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtbtrs.f b/SRC/dtbtrs.f index b43e48ac17..166cd0dc33 100644 --- a/SRC/dtbtrs.f +++ b/SRC/dtbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfsm.f b/SRC/dtfsm.f index a770940337..7b75a8d285 100644 --- a/SRC/dtfsm.f +++ b/SRC/dtfsm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtftri.f b/SRC/dtftri.f index b48c4c138d..bce242b762 100644 --- a/SRC/dtftri.f +++ b/SRC/dtftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfttp.f b/SRC/dtfttp.f index 3dd092e577..fd7e44ae0c 100644 --- a/SRC/dtfttp.f +++ b/SRC/dtfttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtfttr.f b/SRC/dtfttr.f index 1f44f86665..9c68544ffb 100644 --- a/SRC/dtfttr.f +++ b/SRC/dtfttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgevc.f b/SRC/dtgevc.f index ca952a1d7f..7ee6710767 100644 --- a/SRC/dtgevc.f +++ b/SRC/dtgevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgex2.f b/SRC/dtgex2.f index f8b95db692..fc658df6ec 100644 --- a/SRC/dtgex2.f +++ b/SRC/dtgex2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgexc.f b/SRC/dtgexc.f index 66cdb071f6..5700537b75 100644 --- a/SRC/dtgexc.f +++ b/SRC/dtgexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsen.f b/SRC/dtgsen.f index 17dffa28db..0a7b209ac3 100644 --- a/SRC/dtgsen.f +++ b/SRC/dtgsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsja.f b/SRC/dtgsja.f index fbbf857df3..20a8cf66dd 100644 --- a/SRC/dtgsja.f +++ b/SRC/dtgsja.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsna.f b/SRC/dtgsna.f index 982814aa3b..c54fa1a0ed 100644 --- a/SRC/dtgsna.f +++ b/SRC/dtgsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsy2.f b/SRC/dtgsy2.f index c192a53e2e..77b2c470ad 100644 --- a/SRC/dtgsy2.f +++ b/SRC/dtgsy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtgsyl.f b/SRC/dtgsyl.f index 4f2b88df87..0586471e2b 100644 --- a/SRC/dtgsyl.f +++ b/SRC/dtgsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpcon.f b/SRC/dtpcon.f index 4dd5c8385f..b8be8aa0c7 100644 --- a/SRC/dtpcon.f +++ b/SRC/dtpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtplqt.f b/SRC/dtplqt.f index c16f7b56f3..e6a0556e0b 100644 --- a/SRC/dtplqt.f +++ b/SRC/dtplqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtplqt2.f b/SRC/dtplqt2.f index cb2671b3e1..fd25cbf415 100644 --- a/SRC/dtplqt2.f +++ b/SRC/dtplqt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f index 1b55433a4f..2ab5803224 100644 --- a/SRC/dtpmlqt.f +++ b/SRC/dtpmlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpmqrt.f b/SRC/dtpmqrt.f index 54bd6a806e..82e981db14 100644 --- a/SRC/dtpmqrt.f +++ b/SRC/dtpmqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpqrt.f b/SRC/dtpqrt.f index 251518414e..2ce21342e6 100644 --- a/SRC/dtpqrt.f +++ b/SRC/dtpqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpqrt2.f b/SRC/dtpqrt2.f index 9931648460..e38d462611 100644 --- a/SRC/dtpqrt2.f +++ b/SRC/dtpqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtprfb.f b/SRC/dtprfb.f index c38d7ea65d..c81b70e66d 100644 --- a/SRC/dtprfb.f +++ b/SRC/dtprfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPRFB applies a real "triangular-pentagonal" block reflector to a real matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/dtprfs.f b/SRC/dtprfs.f index 1f130f0619..101b329819 100644 --- a/SRC/dtprfs.f +++ b/SRC/dtprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtptri.f b/SRC/dtptri.f index 2396a564ae..34706941b3 100644 --- a/SRC/dtptri.f +++ b/SRC/dtptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtptrs.f b/SRC/dtptrs.f index ec2a785c4d..3b3a8906b3 100644 --- a/SRC/dtptrs.f +++ b/SRC/dtptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpttf.f b/SRC/dtpttf.f index 332fd1e11c..7764174af6 100644 --- a/SRC/dtpttf.f +++ b/SRC/dtpttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtpttr.f b/SRC/dtpttr.f index 3a1020573b..5599762e77 100644 --- a/SRC/dtpttr.f +++ b/SRC/dtpttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrcon.f b/SRC/dtrcon.f index bcd45434a3..949a28552c 100644 --- a/SRC/dtrcon.f +++ b/SRC/dtrcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrevc.f b/SRC/dtrevc.f index 0a143ed1ac..50c628d7cd 100644 --- a/SRC/dtrevc.f +++ b/SRC/dtrevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrevc3.f b/SRC/dtrevc3.f index ebed269b68..1a1992b650 100644 --- a/SRC/dtrevc3.f +++ b/SRC/dtrevc3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrexc.f b/SRC/dtrexc.f index 585de53005..8fc2b3730b 100644 --- a/SRC/dtrexc.f +++ b/SRC/dtrexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrrfs.f b/SRC/dtrrfs.f index 01debe1b38..2a5cfbdc1c 100644 --- a/SRC/dtrrfs.f +++ b/SRC/dtrrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsen.f b/SRC/dtrsen.f index 8adcbe4315..c24ec77eaf 100644 --- a/SRC/dtrsen.f +++ b/SRC/dtrsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsna.f b/SRC/dtrsna.f index b7bb7e78af..7f585652a4 100644 --- a/SRC/dtrsna.f +++ b/SRC/dtrsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsyl.f b/SRC/dtrsyl.f index 661f91a156..00a40f68f4 100644 --- a/SRC/dtrsyl.f +++ b/SRC/dtrsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index d599311308..78c262004f 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRSYL3 * * Definition: diff --git a/SRC/dtrti2.f b/SRC/dtrti2.f index 0f8da2b6a3..20fa063461 100644 --- a/SRC/dtrti2.f +++ b/SRC/dtrti2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrtri.f b/SRC/dtrtri.f index 3c2ade626a..9a09318920 100644 --- a/SRC/dtrtri.f +++ b/SRC/dtrtri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrtrs.f b/SRC/dtrtrs.f index bb796a8d67..184b213e6b 100644 --- a/SRC/dtrtrs.f +++ b/SRC/dtrtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrttf.f b/SRC/dtrttf.f index 311dd58be7..44be78a19c 100644 --- a/SRC/dtrttf.f +++ b/SRC/dtrttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtrttp.f b/SRC/dtrttp.f index 4a32f4241f..072fcc325d 100644 --- a/SRC/dtrttp.f +++ b/SRC/dtrttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/dtzrzf.f b/SRC/dtzrzf.f index b0ab574f64..a569a61b2b 100644 --- a/SRC/dtzrzf.f +++ b/SRC/dtzrzf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/dzsum1.f b/SRC/dzsum1.f index 83a5415ba8..4fc95d002b 100644 --- a/SRC/dzsum1.f +++ b/SRC/dzsum1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b DZSUM1 forms the 1-norm of the complex vector using the true absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/icmax1.f b/SRC/icmax1.f index 3ee188ff99..a17dbed86d 100644 --- a/SRC/icmax1.f +++ b/SRC/icmax1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ICMAX1 finds the index of the first vector element of maximum absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/ieeeck.f b/SRC/ieeeck.f index 216b90147f..9b9e8fabc4 100644 --- a/SRC/ieeeck.f +++ b/SRC/ieeeck.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b IEEECK * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaclc.f b/SRC/ilaclc.f index fa8169d990..fff4dda2f6 100644 --- a/SRC/ilaclc.f +++ b/SRC/ilaclc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILACLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaclr.f b/SRC/ilaclr.f index 58894d7e7c..a40bf57aec 100644 --- a/SRC/ilaclr.f +++ b/SRC/ilaclr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILACLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/iladiag.f b/SRC/iladiag.f index 340af2c601..2941f67ef5 100644 --- a/SRC/iladiag.f +++ b/SRC/iladiag.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILADIAG * * =========== DOCUMENTATION =========== diff --git a/SRC/iladlc.f b/SRC/iladlc.f index b0784db4cc..c5ef963c4b 100644 --- a/SRC/iladlc.f +++ b/SRC/iladlc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILADLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/iladlr.f b/SRC/iladlr.f index ece39b1007..900df1c1a7 100644 --- a/SRC/iladlr.f +++ b/SRC/iladlr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILADLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaenv.f b/SRC/ilaenv.f index cc1ab4df2d..e74a2b35ec 100644 --- a/SRC/ilaenv.f +++ b/SRC/ilaenv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAENV * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaenv2stage.f b/SRC/ilaenv2stage.f index a66fb8e6e6..61da0980e4 100644 --- a/SRC/ilaenv2stage.f +++ b/SRC/ilaenv2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAENV2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaprec.f b/SRC/ilaprec.f index d19778ddb9..d9bfe1ebef 100644 --- a/SRC/ilaprec.f +++ b/SRC/ilaprec.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAPREC * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaslc.f b/SRC/ilaslc.f index 8fdabd2b6c..791d49c35f 100644 --- a/SRC/ilaslc.f +++ b/SRC/ilaslc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILASLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilaslr.f b/SRC/ilaslr.f index cd7787e784..db37d2a539 100644 --- a/SRC/ilaslr.f +++ b/SRC/ilaslr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILASLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilatrans.f b/SRC/ilatrans.f index 8f38046880..183757485d 100644 --- a/SRC/ilatrans.f +++ b/SRC/ilatrans.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILATRANS * * =========== DOCUMENTATION =========== diff --git a/SRC/ilauplo.f b/SRC/ilauplo.f index b23396a4ce..af23a0218f 100644 --- a/SRC/ilauplo.f +++ b/SRC/ilauplo.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAUPLO * * =========== DOCUMENTATION =========== diff --git a/SRC/ilazlc.f b/SRC/ilazlc.f index dccd84385f..359f0ae2d3 100644 --- a/SRC/ilazlc.f +++ b/SRC/ilazlc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAZLC scans a matrix for its last non-zero column. * * =========== DOCUMENTATION =========== diff --git a/SRC/ilazlr.f b/SRC/ilazlr.f index e152d2f949..f4359bd56e 100644 --- a/SRC/ilazlr.f +++ b/SRC/ilazlr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ILAZLR scans a matrix for its last non-zero row. * * =========== DOCUMENTATION =========== diff --git a/SRC/iparmq.f b/SRC/iparmq.f index 88376c21eb..4bd2c3300b 100644 --- a/SRC/iparmq.f +++ b/SRC/iparmq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b IPARMQ * * =========== DOCUMENTATION =========== diff --git a/SRC/izmax1.f b/SRC/izmax1.f index f76df1f4d5..6474711e13 100644 --- a/SRC/izmax1.f +++ b/SRC/izmax1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b IZMAX1 finds the index of the first vector element of maximum absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 199037c41f..8576805b2e 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -975,6 +975,7 @@ #define DSBMV DSBMV_64 #define DSBTRD DSBTRD_64 #define DSCAL DSCAL_64 +#define DSECND DSECND_64 #define DSFRK DSFRK_64 #define DSGESV DSGESV_64 #define DSPCON DSPCON_64 @@ -1163,6 +1164,7 @@ #define SCSUM1 SCSUM1_64 #define SDISNA SDISNA_64 #define SDOT SDOT_64 +#define SECOND SECOND_64 #define SGBBRD SGBBRD_64 #define SGBCON SGBCON_64 #define SGBEQU SGBEQU_64 diff --git a/SRC/lsamen.f b/SRC/lsamen.f index 440eefa7e3..91447b4101 100644 --- a/SRC/lsamen.f +++ b/SRC/lsamen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b LSAMEN * * =========== DOCUMENTATION =========== diff --git a/SRC/sbbcsd.f b/SRC/sbbcsd.f index 80a673a06e..5b442afffd 100644 --- a/SRC/sbbcsd.f +++ b/SRC/sbbcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsdc.f b/SRC/sbdsdc.f index 0c0401b7f3..3099594d99 100644 --- a/SRC/sbdsdc.f +++ b/SRC/sbdsdc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SBDSDC * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index 6c0b897daa..2d78c65a81 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sbdsvdx.f b/SRC/sbdsvdx.f index 4dc9b94a0c..508cc4dc96 100644 --- a/SRC/sbdsvdx.f +++ b/SRC/sbdsvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SBDSVDX * * =========== DOCUMENTATION =========== diff --git a/SRC/scsum1.f b/SRC/scsum1.f index 4d09fc6eef..d93baf233d 100644 --- a/SRC/scsum1.f +++ b/SRC/scsum1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SCSUM1 forms the 1-norm of the complex vector using the true absolute value. * * =========== DOCUMENTATION =========== diff --git a/SRC/sdisna.f b/SRC/sdisna.f index e7b17964af..9bb63c0c3f 100644 --- a/SRC/sdisna.f +++ b/SRC/sdisna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SDISNA * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbbrd.f b/SRC/sgbbrd.f index aaa5e03ddd..5067308d8e 100644 --- a/SRC/sgbbrd.f +++ b/SRC/sgbbrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbcon.f b/SRC/sgbcon.f index d8996001b7..2080fea4ce 100644 --- a/SRC/sgbcon.f +++ b/SRC/sgbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbequ.f b/SRC/sgbequ.f index 78696edf27..49f2c46e11 100644 --- a/SRC/sgbequ.f +++ b/SRC/sgbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbequb.f b/SRC/sgbequb.f index 55d5b69fc3..62c7df900e 100644 --- a/SRC/sgbequb.f +++ b/SRC/sgbequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbrfs.f b/SRC/sgbrfs.f index 5db769aff8..7dc4a9213c 100644 --- a/SRC/sgbrfs.f +++ b/SRC/sgbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbrfsx.f b/SRC/sgbrfsx.f index 25b43a9f76..68e1131e9b 100644 --- a/SRC/sgbrfsx.f +++ b/SRC/sgbrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsv.f b/SRC/sgbsv.f index bbb9fe090b..957563fc0d 100644 --- a/SRC/sgbsv.f +++ b/SRC/sgbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsvx.f b/SRC/sgbsvx.f index 3f5e388146..668341490a 100644 --- a/SRC/sgbsvx.f +++ b/SRC/sgbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbsvxx.f b/SRC/sgbsvxx.f index cb18efe321..e55220e47b 100644 --- a/SRC/sgbsvxx.f +++ b/SRC/sgbsvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtf2.f b/SRC/sgbtf2.f index cfe01affcc..a6c0786d93 100644 --- a/SRC/sgbtf2.f +++ b/SRC/sgbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtrf.f b/SRC/sgbtrf.f index 91fdfb1862..fbb45125d9 100644 --- a/SRC/sgbtrf.f +++ b/SRC/sgbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgbtrs.f b/SRC/sgbtrs.f index b894eb65b7..35d30087d4 100644 --- a/SRC/sgbtrs.f +++ b/SRC/sgbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebak.f b/SRC/sgebak.f index 597a1e4436..0439ba4620 100644 --- a/SRC/sgebak.f +++ b/SRC/sgebak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebal.f b/SRC/sgebal.f index 6f8851b03e..1a85c9c9c8 100644 --- a/SRC/sgebal.f +++ b/SRC/sgebal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebd2.f b/SRC/sgebd2.f index cd76f6c2c2..978ec9f369 100644 --- a/SRC/sgebd2.f +++ b/SRC/sgebd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgebrd.f b/SRC/sgebrd.f index 49c801c43c..2890c712f1 100644 --- a/SRC/sgebrd.f +++ b/SRC/sgebrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgecon.f b/SRC/sgecon.f index f1b5de21ce..dfb6ccef2f 100644 --- a/SRC/sgecon.f +++ b/SRC/sgecon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index c477691e85..90d15c3360 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b SGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/sgedmdq.f90 b/SRC/sgedmdq.f90 index 7996a5f2a9..2506149cc7 100644 --- a/SRC/sgedmdq.f90 +++ b/SRC/sgedmdq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b SGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/sgeequ.f b/SRC/sgeequ.f index c2467552c1..d897366b42 100644 --- a/SRC/sgeequ.f +++ b/SRC/sgeequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeequb.f b/SRC/sgeequb.f index 77878e6346..8fa6a42cd2 100644 --- a/SRC/sgeequb.f +++ b/SRC/sgeequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sgees.f b/SRC/sgees.f index 9765c4f874..fec356aa3b 100644 --- a/SRC/sgees.f +++ b/SRC/sgees.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index 3ec6fe8eac..0a760c83c5 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeev.f b/SRC/sgeev.f index ca0b279a18..b8010eddbf 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index 892029e179..ebb557b339 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgehd2.f b/SRC/sgehd2.f index cc630e4810..2692e68273 100644 --- a/SRC/sgehd2.f +++ b/SRC/sgehd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f index 62163a9f20..c1980b2bd0 100644 --- a/SRC/sgehrd.f +++ b/SRC/sgehrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index 43ca22a33a..56e1b85805 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelq.f b/SRC/sgelq.f index b9dd5e5e15..b040267216 100644 --- a/SRC/sgelq.f +++ b/SRC/sgelq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGELQ * * Definition: diff --git a/SRC/sgelq2.f b/SRC/sgelq2.f index de7700c7e4..14c345bf39 100644 --- a/SRC/sgelq2.f +++ b/SRC/sgelq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelqf.f b/SRC/sgelqf.f index 03cbbc1442..5702ab27c0 100644 --- a/SRC/sgelqf.f +++ b/SRC/sgelqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelqt.f b/SRC/sgelqt.f index 8650ca33ee..f941388ece 100644 --- a/SRC/sgelqt.f +++ b/SRC/sgelqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGELQT * * Definition: diff --git a/SRC/sgelqt3.f b/SRC/sgelqt3.f index 39a24884a4..fc62d5b79c 100644 --- a/SRC/sgelqt3.f +++ b/SRC/sgelqt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGELQT3 * * Definition: diff --git a/SRC/sgels.f b/SRC/sgels.f index 82944f44e4..9a311a8254 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelsd.f b/SRC/sgelsd.f index 2c19d8b553..b219f338c3 100644 --- a/SRC/sgelsd.f +++ b/SRC/sgelsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelss.f b/SRC/sgelss.f index 0d5de672f1..69d9e96a1c 100644 --- a/SRC/sgelss.f +++ b/SRC/sgelss.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelst.f b/SRC/sgelst.f index c8e2f327bd..3c6ccf16f9 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index df19eed37a..9aa1b3d018 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index 13f3c4ab92..7e4d9bf656 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEMLQ * * Definition: diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f index 21b4217886..7917f6b9c1 100644 --- a/SRC/sgemlqt.f +++ b/SRC/sgemlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEMLQT * * Definition: diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f index 934b4bd6e3..19bf467b8b 100644 --- a/SRC/sgemqr.f +++ b/SRC/sgemqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEMQR * * Definition: diff --git a/SRC/sgemqrt.f b/SRC/sgemqrt.f index 4e01d8c4a3..cd141ece5c 100644 --- a/SRC/sgemqrt.f +++ b/SRC/sgemqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeql2.f b/SRC/sgeql2.f index 73d4e95b1e..c727c3611f 100644 --- a/SRC/sgeql2.f +++ b/SRC/sgeql2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqlf.f b/SRC/sgeqlf.f index 6b4a5c5c9b..f6003c6baa 100644 --- a/SRC/sgeqlf.f +++ b/SRC/sgeqlf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqp3.f b/SRC/sgeqp3.f index 187ccfb255..10b8bf94e3 100644 --- a/SRC/sgeqp3.f +++ b/SRC/sgeqp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f index 74cb689e68..e5b3e4cd86 100644 --- a/SRC/sgeqp3rk.f +++ b/SRC/sgeqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f index 3893696a31..ae5bd23e22 100644 --- a/SRC/sgeqr.f +++ b/SRC/sgeqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQR * * Definition: diff --git a/SRC/sgeqr2.f b/SRC/sgeqr2.f index 62887d8a1b..3a78733b7d 100644 --- a/SRC/sgeqr2.f +++ b/SRC/sgeqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqr2p.f b/SRC/sgeqr2p.f index 6e8bb0f738..9f3693a631 100644 --- a/SRC/sgeqr2p.f +++ b/SRC/sgeqr2p.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrf.f b/SRC/sgeqrf.f index c8a23b24d8..689fe1aea2 100644 --- a/SRC/sgeqrf.f +++ b/SRC/sgeqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrfp.f b/SRC/sgeqrfp.f index acb90e0c2e..37747c5124 100644 --- a/SRC/sgeqrfp.f +++ b/SRC/sgeqrfp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt.f b/SRC/sgeqrt.f index d7760d4367..d497a64e01 100644 --- a/SRC/sgeqrt.f +++ b/SRC/sgeqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt2.f b/SRC/sgeqrt2.f index 9c13eb5b75..374850531f 100644 --- a/SRC/sgeqrt2.f +++ b/SRC/sgeqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgeqrt3.f b/SRC/sgeqrt3.f index 82fbe6e70b..cf965353de 100644 --- a/SRC/sgeqrt3.f +++ b/SRC/sgeqrt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerfs.f b/SRC/sgerfs.f index 573b7d1ab9..1ae6cfb14c 100644 --- a/SRC/sgerfs.f +++ b/SRC/sgerfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerfsx.f b/SRC/sgerfsx.f index 2956679c57..d5e9894f23 100644 --- a/SRC/sgerfsx.f +++ b/SRC/sgerfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerq2.f b/SRC/sgerq2.f index 9659b55bd1..1c612f8f27 100644 --- a/SRC/sgerq2.f +++ b/SRC/sgerq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgerqf.f b/SRC/sgerqf.f index 1fec504520..2890eb576d 100644 --- a/SRC/sgerqf.f +++ b/SRC/sgerqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesc2.f b/SRC/sgesc2.f index 8d7eca7d18..dc0c4ff6e1 100644 --- a/SRC/sgesc2.f +++ b/SRC/sgesc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesdd.f b/SRC/sgesdd.f index 37d10a2847..762e5716b3 100644 --- a/SRC/sgesdd.f +++ b/SRC/sgesdd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesv.f b/SRC/sgesv.f index 1a698161fe..cf17675eb1 100644 --- a/SRC/sgesv.f +++ b/SRC/sgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \addtogroup gesv *> *> \brief SGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/sgesvd.f b/SRC/sgesvd.f index 7a86794848..37d402f898 100644 --- a/SRC/sgesvd.f +++ b/SRC/sgesvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvdq.f b/SRC/sgesvdq.f index 0195d3d7fa..c5e2fc1f16 100644 --- a/SRC/sgesvdq.f +++ b/SRC/sgesvdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvdx.f b/SRC/sgesvdx.f index 994cc54171..47d409d4d4 100644 --- a/SRC/sgesvdx.f +++ b/SRC/sgesvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvj.f b/SRC/sgesvj.f index c0aad8b983..346105ac50 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvx.f b/SRC/sgesvx.f index 3451082fd7..6867f9c713 100644 --- a/SRC/sgesvx.f +++ b/SRC/sgesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgesvxx.f b/SRC/sgesvxx.f index e0c79765e4..9c43504b60 100644 --- a/SRC/sgesvxx.f +++ b/SRC/sgesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetc2.f b/SRC/sgetc2.f index 09cf2d9ebd..498bc79d03 100644 --- a/SRC/sgetc2.f +++ b/SRC/sgetc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetf2.f b/SRC/sgetf2.f index ca89da5056..9b6405c9b2 100644 --- a/SRC/sgetf2.f +++ b/SRC/sgetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrf.f b/SRC/sgetrf.f index 9cc061ea7a..ef080a2952 100644 --- a/SRC/sgetrf.f +++ b/SRC/sgetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrf2.f b/SRC/sgetrf2.f index 0527b33b9d..22d82e4fc7 100644 --- a/SRC/sgetrf2.f +++ b/SRC/sgetrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetri.f b/SRC/sgetri.f index 4fedd76ce0..1e5bdad0b6 100644 --- a/SRC/sgetri.f +++ b/SRC/sgetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetrs.f b/SRC/sgetrs.f index a68238ecb7..202da5a43f 100644 --- a/SRC/sgetrs.f +++ b/SRC/sgetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index 43cbe225c8..ce4e02d4f5 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETSLS * * Definition: diff --git a/SRC/sgetsqrhrt.f b/SRC/sgetsqrhrt.f index 908d0cdd40..50637bd393 100644 --- a/SRC/sgetsqrhrt.f +++ b/SRC/sgetsqrhrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/sggbak.f b/SRC/sggbak.f index 1410f1ded2..be81dbe267 100644 --- a/SRC/sggbak.f +++ b/SRC/sggbak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/sggbal.f b/SRC/sggbal.f index f7ec6b737e..f01e1af5c5 100644 --- a/SRC/sggbal.f +++ b/SRC/sggbal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/sgges.f b/SRC/sgges.f index 1696df7e4c..44176f39fc 100644 --- a/SRC/sgges.f +++ b/SRC/sgges.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgges3.f b/SRC/sgges3.f index 74b2617fbc..4bd012b0ee 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/sggesx.f b/SRC/sggesx.f index 8c19cd1a1a..130cc82746 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggev.f b/SRC/sggev.f index 6b97110f35..9e69a6751b 100644 --- a/SRC/sggev.f +++ b/SRC/sggev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggev3.f b/SRC/sggev3.f index 758cadabe7..c5b137551c 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/sggevx.f b/SRC/sggevx.f index 52362c236e..9cc5a6973d 100644 --- a/SRC/sggevx.f +++ b/SRC/sggevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggglm.f b/SRC/sggglm.f index b7ba43ac81..52c59b8bf2 100644 --- a/SRC/sggglm.f +++ b/SRC/sggglm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/sgghd3.f b/SRC/sgghd3.f index 3bc6975f57..14e1f02bc1 100644 --- a/SRC/sgghd3.f +++ b/SRC/sgghd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgghrd.f b/SRC/sgghrd.f index bcd5a338a7..f5e1f4f32b 100644 --- a/SRC/sgghrd.f +++ b/SRC/sgghrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/sgglse.f b/SRC/sgglse.f index 2dd9362b9c..527e7b3718 100644 --- a/SRC/sgglse.f +++ b/SRC/sgglse.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggqrf.f b/SRC/sggqrf.f index 4b973c9a7f..ca7ae12bd0 100644 --- a/SRC/sggqrf.f +++ b/SRC/sggqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sggrqf.f b/SRC/sggrqf.f index 4ec99b22ed..b3842ec2ab 100644 --- a/SRC/sggrqf.f +++ b/SRC/sggrqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/sggsvd3.f b/SRC/sggsvd3.f index ce398ed5af..6f0cab29af 100644 --- a/SRC/sggsvd3.f +++ b/SRC/sggsvd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sggsvp3.f b/SRC/sggsvp3.f index a76388afe1..4cb9218173 100644 --- a/SRC/sggsvp3.f +++ b/SRC/sggsvp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sgsvj0.f b/SRC/sgsvj0.f index 6fe0319078..13526a5569 100644 --- a/SRC/sgsvj0.f +++ b/SRC/sgsvj0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGSVJ0 pre-processor for the routine sgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgsvj1.f b/SRC/sgsvj1.f index a8503d734e..b009550632 100644 --- a/SRC/sgsvj1.f +++ b/SRC/sgsvj1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtcon.f b/SRC/sgtcon.f index 969648e862..ba6d64960c 100644 --- a/SRC/sgtcon.f +++ b/SRC/sgtcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtrfs.f b/SRC/sgtrfs.f index 5bb8783bff..decb47b025 100644 --- a/SRC/sgtrfs.f +++ b/SRC/sgtrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtsv.f b/SRC/sgtsv.f index a206838072..bbb65c870f 100644 --- a/SRC/sgtsv.f +++ b/SRC/sgtsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtsvx.f b/SRC/sgtsvx.f index 84c797b620..2792d1970c 100644 --- a/SRC/sgtsvx.f +++ b/SRC/sgtsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sgttrf.f b/SRC/sgttrf.f index d6cc506827..ccdf145141 100644 --- a/SRC/sgttrf.f +++ b/SRC/sgttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/sgttrs.f b/SRC/sgttrs.f index 35cd0c21de..862ee2cc14 100644 --- a/SRC/sgttrs.f +++ b/SRC/sgttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sgtts2.f b/SRC/sgtts2.f index b8fc5da9a0..0095805cb9 100644 --- a/SRC/sgtts2.f +++ b/SRC/sgtts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/shgeqz.f b/SRC/shgeqz.f index 5084bbf6ce..3475077657 100644 --- a/SRC/shgeqz.f +++ b/SRC/shgeqz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/shsein.f b/SRC/shsein.f index 620723cc01..50ce5ce707 100644 --- a/SRC/shsein.f +++ b/SRC/shsein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/shseqr.f b/SRC/shseqr.f index 6c5209f633..19853718f2 100644 --- a/SRC/shseqr.f +++ b/SRC/shseqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sisnan.f b/SRC/sisnan.f index e24d1e3dae..510a9ff9d0 100644 --- a/SRC/sisnan.f +++ b/SRC/sisnan.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SISNAN tests input for NaN. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbamv.f b/SRC/sla_gbamv.f index 46e0801568..eaeebfa575 100644 --- a/SRC/sla_gbamv.f +++ b/SRC/sla_gbamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrcond.f b/SRC/sla_gbrcond.f index 68a4a14d73..83c9cf6d0f 100644 --- a/SRC/sla_gbrcond.f +++ b/SRC/sla_gbrcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GBRCOND estimates the Skeel condition number for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrfsx_extended.f b/SRC/sla_gbrfsx_extended.f index 0c4aca6e62..c2e0300334 100644 --- a/SRC/sla_gbrfsx_extended.f +++ b/SRC/sla_gbrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gbrpvgrw.f b/SRC/sla_gbrpvgrw.f index 21c4c7464e..cbc43d2301 100644 --- a/SRC/sla_gbrpvgrw.f +++ b/SRC/sla_gbrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_geamv.f b/SRC/sla_geamv.f index e536148e62..1c1b4ab76c 100644 --- a/SRC/sla_geamv.f +++ b/SRC/sla_geamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gercond.f b/SRC/sla_gercond.f index 5ee9d4da0f..7870233713 100644 --- a/SRC/sla_gercond.f +++ b/SRC/sla_gercond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GERCOND estimates the Skeel condition number for a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gerfsx_extended.f b/SRC/sla_gerfsx_extended.f index 5d2b19dce6..4ac6e76e15 100644 --- a/SRC/sla_gerfsx_extended.f +++ b/SRC/sla_gerfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GERFSX_EXTENDED improves the computed solution to a system of linear equations for general matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_gerpvgrw.f b/SRC/sla_gerpvgrw.f index 90863f6593..f041c5dd2c 100644 --- a/SRC/sla_gerpvgrw.f +++ b/SRC/sla_gerpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_GERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_lin_berr.f b/SRC/sla_lin_berr.f index 53c9bc01f5..bc876eac39 100644 --- a/SRC/sla_lin_berr.f +++ b/SRC/sla_lin_berr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porcond.f b/SRC/sla_porcond.f index 01ab43bafe..53dc5a8bde 100644 --- a/SRC/sla_porcond.f +++ b/SRC/sla_porcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porfsx_extended.f b/SRC/sla_porfsx_extended.f index ee4d819baf..57a6c5df81 100644 --- a/SRC/sla_porfsx_extended.f +++ b/SRC/sla_porfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_porpvgrw.f b/SRC/sla_porpvgrw.f index c91ced2bf4..6f6160af8f 100644 --- a/SRC/sla_porpvgrw.f +++ b/SRC/sla_porpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syamv.f b/SRC/sla_syamv.f index 4ea8fe739a..1a2ac1394f 100644 --- a/SRC/sla_syamv.f +++ b/SRC/sla_syamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrcond.f b/SRC/sla_syrcond.f index 64e3dacdb1..4282b79ce2 100644 --- a/SRC/sla_syrcond.f +++ b/SRC/sla_syrcond.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrfsx_extended.f b/SRC/sla_syrfsx_extended.f index 9f7e517dc6..563889e231 100644 --- a/SRC/sla_syrfsx_extended.f +++ b/SRC/sla_syrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_syrpvgrw.f b/SRC/sla_syrpvgrw.f index 32b7b2a54e..947549cd9f 100644 --- a/SRC/sla_syrpvgrw.f +++ b/SRC/sla_syrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sla_wwaddw.f b/SRC/sla_wwaddw.f index 47d85855c3..480c7d5eef 100644 --- a/SRC/sla_wwaddw.f +++ b/SRC/sla_wwaddw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/slabad.f b/SRC/slabad.f index a70d8de1ea..896fe6fef9 100644 --- a/SRC/slabad.f +++ b/SRC/slabad.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLABAD * * =========== DOCUMENTATION =========== diff --git a/SRC/slabrd.f b/SRC/slabrd.f index f4c1d4440c..049a94c3db 100644 --- a/SRC/slabrd.f +++ b/SRC/slabrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacn2.f b/SRC/slacn2.f index c00e742ac3..07682f8216 100644 --- a/SRC/slacn2.f +++ b/SRC/slacn2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacon.f b/SRC/slacon.f index 6b3b2b4155..025c9fc674 100644 --- a/SRC/slacon.f +++ b/SRC/slacon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/slacpy.f b/SRC/slacpy.f index c41c1acb08..2ae16e608b 100644 --- a/SRC/slacpy.f +++ b/SRC/slacpy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/sladiv.f b/SRC/sladiv.f index 4ded68e8a7..fbea4626e3 100644 --- a/SRC/sladiv.f +++ b/SRC/sladiv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slae2.f b/SRC/slae2.f index d8dfbeb3f7..2bbc1da887 100644 --- a/SRC/slae2.f +++ b/SRC/slae2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaebz.f b/SRC/slaebz.f index 14b8684c2c..c764b09a2d 100644 --- a/SRC/slaebz.f +++ b/SRC/slaebz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAEBZ computes the number of eigenvalues of a real symmetric tridiagonal matrix which are less than or equal to a given value, and performs other tasks required by the routine sstebz. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed0.f b/SRC/slaed0.f index 52b28e8b1f..a26f9afe13 100644 --- a/SRC/slaed0.f +++ b/SRC/slaed0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED0 used by SSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed1.f b/SRC/slaed1.f index f2175afbc5..3163573288 100644 --- a/SRC/slaed1.f +++ b/SRC/slaed1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED1 used by SSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed2.f b/SRC/slaed2.f index 59c856435c..50636df802 100644 --- a/SRC/slaed2.f +++ b/SRC/slaed2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED2 used by SSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed3.f b/SRC/slaed3.f index 86a986c797..967972d153 100644 --- a/SRC/slaed3.f +++ b/SRC/slaed3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED3 used by SSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed4.f b/SRC/slaed4.f index 2310dc079a..08af234d29 100644 --- a/SRC/slaed4.f +++ b/SRC/slaed4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED4 used by SSTEDC. Finds a single root of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed5.f b/SRC/slaed5.f index b7dcfbd549..cb435ae714 100644 --- a/SRC/slaed5.f +++ b/SRC/slaed5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED5 used by SSTEDC. Solves the 2-by-2 secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed6.f b/SRC/slaed6.f index d4e9640921..502ff7d2b3 100644 --- a/SRC/slaed6.f +++ b/SRC/slaed6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED6 used by SSTEDC. Computes one Newton step in solution of the secular equation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed7.f b/SRC/slaed7.f index 5e7eaecdbc..474f7f921c 100644 --- a/SRC/slaed7.f +++ b/SRC/slaed7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED7 used by SSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed8.f b/SRC/slaed8.f index 84d07d3688..52f33113fc 100644 --- a/SRC/slaed8.f +++ b/SRC/slaed8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED8 used by SSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaed9.f b/SRC/slaed9.f index 3af1fb9c20..b3b0740d0b 100644 --- a/SRC/slaed9.f +++ b/SRC/slaed9.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAED9 used by SSTEDC. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaeda.f b/SRC/slaeda.f index 56fbe09868..9755985599 100644 --- a/SRC/slaeda.f +++ b/SRC/slaeda.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAEDA used by SSTEDC. Computes the Z vector determining the rank-one modification of the diagonal matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaein.f b/SRC/slaein.f index 069116fe39..31ef5113bd 100644 --- a/SRC/slaein.f +++ b/SRC/slaein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaev2.f b/SRC/slaev2.f index ce97cd16c9..99fa18e4ad 100644 --- a/SRC/slaev2.f +++ b/SRC/slaev2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaexc.f b/SRC/slaexc.f index bb24e8bf07..a384608567 100644 --- a/SRC/slaexc.f +++ b/SRC/slaexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAEXC swaps adjacent diagonal blocks of a real upper quasi-triangular matrix in Schur canonical form, by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slag2.f b/SRC/slag2.f index bbf0f26c58..443ed10906 100644 --- a/SRC/slag2.f +++ b/SRC/slag2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary to avoid over-/underflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slag2d.f b/SRC/slag2d.f index ff4d2bc774..0edfa1ae26 100644 --- a/SRC/slag2d.f +++ b/SRC/slag2d.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAG2D converts a single precision matrix to a double precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slags2.f b/SRC/slags2.f index f7512245f8..152f7fdcd3 100644 --- a/SRC/slags2.f +++ b/SRC/slags2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAGS2 computes 2-by-2 orthogonal matrices U, V, and Q, and applies them to matrices A and B such that the rows of the transformed A and B are parallel. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagtf.f b/SRC/slagtf.f index 9fe7cfa5ce..28c6081bcc 100644 --- a/SRC/slagtf.f +++ b/SRC/slagtf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAGTF computes an LU factorization of a matrix T-λI, where T is a general tridiagonal matrix, and λ a scalar, using partial pivoting with row interchanges. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagtm.f b/SRC/slagtm.f index 226c5546b7..8adab06859 100644 --- a/SRC/slagtm.f +++ b/SRC/slagtm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/slagts.f b/SRC/slagts.f index 73ff03d401..236d7af69d 100644 --- a/SRC/slagts.f +++ b/SRC/slagts.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAGTS solves the system of equations (T-λI)x = y *> or (T-λI)^Tx = y, where T is a general tridiagonal matrix *> and λ a scalar, using the LU factorization computed by slagtf. diff --git a/SRC/slagv2.f b/SRC/slagv2.f index c6b51a3f45..f95cc7a99f 100644 --- a/SRC/slagv2.f +++ b/SRC/slagv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAGV2 computes the Generalized Schur factorization of a real 2-by-2 matrix pencil (A,B) where B is upper triangular. * * =========== DOCUMENTATION =========== diff --git a/SRC/slahqr.f b/SRC/slahqr.f index d604eeb427..b66b6255b3 100644 --- a/SRC/slahqr.f +++ b/SRC/slahqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/slahr2.f b/SRC/slahr2.f index 1c01bd04d7..4218c4ed10 100644 --- a/SRC/slahr2.f +++ b/SRC/slahr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaic1.f b/SRC/slaic1.f index 7db0335d4e..cf1c421912 100644 --- a/SRC/slaic1.f +++ b/SRC/slaic1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaisnan.f b/SRC/slaisnan.f index a4e5920d0f..01a7f17aef 100644 --- a/SRC/slaisnan.f +++ b/SRC/slaisnan.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAISNAN tests input for NaN by comparing two arguments for inequality. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaln2.f b/SRC/slaln2.f index 10efacde15..b849895f73 100644 --- a/SRC/slaln2.f +++ b/SRC/slaln2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLALN2 solves a 1-by-1 or 2-by-2 linear system of equations of the specified form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slals0.f b/SRC/slals0.f index f44026ca70..214276fe3d 100644 --- a/SRC/slals0.f +++ b/SRC/slals0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/slalsa.f b/SRC/slalsa.f index 5e2db8e343..9afa963234 100644 --- a/SRC/slalsa.f +++ b/SRC/slalsa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/slalsd.f b/SRC/slalsd.f index ec92fe9a22..0037b7c576 100644 --- a/SRC/slalsd.f +++ b/SRC/slalsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/slamrg.f b/SRC/slamrg.f index c827db73cc..9672fee916 100644 --- a/SRC/slamrg.f +++ b/SRC/slamrg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order. * * =========== DOCUMENTATION =========== diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index 4ffb269a85..432afadedf 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAMSWLQ * * Definition: diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f index 1882381c56..f9b167aea3 100644 --- a/SRC/slamtsqr.f +++ b/SRC/slamtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAMTSQR * * Definition: diff --git a/SRC/slaneg.f b/SRC/slaneg.f index 56e74f1670..76017d72d5 100644 --- a/SRC/slaneg.f +++ b/SRC/slaneg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANEG computes the Sturm count. * * =========== DOCUMENTATION =========== diff --git a/SRC/slangb.f b/SRC/slangb.f index 3f3df3f0a0..676186b2d2 100644 --- a/SRC/slangb.f +++ b/SRC/slangb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slange.f b/SRC/slange.f index 838ab249d8..747d8707b7 100644 --- a/SRC/slange.f +++ b/SRC/slange.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slangt.f b/SRC/slangt.f index 356dcae01a..f708f3f063 100644 --- a/SRC/slangt.f +++ b/SRC/slangt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanhs.f b/SRC/slanhs.f index 8d54a1feb1..770aea44d7 100644 --- a/SRC/slanhs.f +++ b/SRC/slanhs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansb.f b/SRC/slansb.f index 8a265b6a34..5b678a4f60 100644 --- a/SRC/slansb.f +++ b/SRC/slansb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansf.f b/SRC/slansf.f index f18103ce97..65bb721cee 100644 --- a/SRC/slansf.f +++ b/SRC/slansf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANSF * * =========== DOCUMENTATION =========== diff --git a/SRC/slansp.f b/SRC/slansp.f index f43970885f..bc81cc2520 100644 --- a/SRC/slansp.f +++ b/SRC/slansp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanst.f b/SRC/slanst.f index d646d5a697..40076c1aa8 100644 --- a/SRC/slanst.f +++ b/SRC/slanst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slansy.f b/SRC/slansy.f index 461c59e0db..5ffa1149b6 100644 --- a/SRC/slansy.f +++ b/SRC/slansy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantb.f b/SRC/slantb.f index 699504bcde..a453849163 100644 --- a/SRC/slantb.f +++ b/SRC/slantb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantp.f b/SRC/slantp.f index 669997886f..b7af16fade 100644 --- a/SRC/slantp.f +++ b/SRC/slantp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slantr.f b/SRC/slantr.f index b7dd34b7bc..13f20ed5bf 100644 --- a/SRC/slantr.f +++ b/SRC/slantr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slanv2.f b/SRC/slanv2.f index 3de4023dfb..ac1a197822 100644 --- a/SRC/slanv2.f +++ b/SRC/slanv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaorhr_col_getrfnp.f b/SRC/slaorhr_col_getrfnp.f index 4e4724e77c..f793ebe245 100644 --- a/SRC/slaorhr_col_getrfnp.f +++ b/SRC/slaorhr_col_getrfnp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAORHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/slaorhr_col_getrfnp2.f b/SRC/slaorhr_col_getrfnp2.f index 75ad3625c5..d270810dc7 100644 --- a/SRC/slaorhr_col_getrfnp2.f +++ b/SRC/slaorhr_col_getrfnp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAORHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/slapll.f b/SRC/slapll.f index 4f213dce9f..e260e3d766 100644 --- a/SRC/slapll.f +++ b/SRC/slapll.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapmr.f b/SRC/slapmr.f index 17fb57612e..566dc04923 100644 --- a/SRC/slapmr.f +++ b/SRC/slapmr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapmt.f b/SRC/slapmt.f index 85a8f6b055..ebd5b0b93d 100644 --- a/SRC/slapmt.f +++ b/SRC/slapmt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slapy2.f b/SRC/slapy2.f index cacefc093c..51d5155f69 100644 --- a/SRC/slapy2.f +++ b/SRC/slapy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAPY2 returns sqrt(x2+y2). * * =========== DOCUMENTATION =========== diff --git a/SRC/slapy3.f b/SRC/slapy3.f index 8068bf65f2..b1ea75ceef 100644 --- a/SRC/slapy3.f +++ b/SRC/slapy3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAPY3 returns sqrt(x2+y2+z2). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqgb.f b/SRC/slaqgb.f index f85b038cae..c69d4e3952 100644 --- a/SRC/slaqgb.f +++ b/SRC/slaqgb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqge.f b/SRC/slaqge.f index 56c8a675cb..50182fbf36 100644 --- a/SRC/slaqge.f +++ b/SRC/slaqge.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqp2.f b/SRC/slaqp2.f index d12bea6414..c88e2e5e85 100644 --- a/SRC/slaqp2.f +++ b/SRC/slaqp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqp2rk.f b/SRC/slaqp2rk.f index f1c5724103..f88b0ce909 100644 --- a/SRC/slaqp2rk.f +++ b/SRC/slaqp2rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqp3rk.f b/SRC/slaqp3rk.f index 4e912a4744..08b8bfcbdd 100644 --- a/SRC/slaqp3rk.f +++ b/SRC/slaqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqps.f b/SRC/slaqps.f index 3be1d88b76..b16a48a8a4 100644 --- a/SRC/slaqps.f +++ b/SRC/slaqps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr0.f b/SRC/slaqr0.f index f9ab04ecbf..47259deb3a 100644 --- a/SRC/slaqr0.f +++ b/SRC/slaqr0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr1.f b/SRC/slaqr1.f index 7e4e620caf..c2950609c4 100644 --- a/SRC/slaqr1.f +++ b/SRC/slaqr1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr2.f b/SRC/slaqr2.f index 9d0079ddac..cc160b9bf3 100644 --- a/SRC/slaqr2.f +++ b/SRC/slaqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr3.f b/SRC/slaqr3.f index 6f8d28444e..7e53564a2b 100644 --- a/SRC/slaqr3.f +++ b/SRC/slaqr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR3 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr4.f b/SRC/slaqr4.f index e31d739067..2a69d02218 100644 --- a/SRC/slaqr4.f +++ b/SRC/slaqr4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqr5.f b/SRC/slaqr5.f index 310e62db96..a7ae7067fd 100644 --- a/SRC/slaqr5.f +++ b/SRC/slaqr5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsb.f b/SRC/slaqsb.f index e90596bc36..a36383cbf5 100644 --- a/SRC/slaqsb.f +++ b/SRC/slaqsb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsp.f b/SRC/slaqsp.f index a7c0deda44..dd599545bf 100644 --- a/SRC/slaqsp.f +++ b/SRC/slaqsp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqsy.f b/SRC/slaqsy.f index 543fe00962..9478144b90 100644 --- a/SRC/slaqsy.f +++ b/SRC/slaqsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqtr.f b/SRC/slaqtr.f index 9f8367057c..351901d7b8 100644 --- a/SRC/slaqtr.f +++ b/SRC/slaqtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQTR solves a real quasi-triangular system of equations, or a complex quasi-triangular system of special form, in real arithmetic. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz0.f b/SRC/slaqz0.f index 0c1e56b7e2..19b4adc2b0 100644 --- a/SRC/slaqz0.f +++ b/SRC/slaqz0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz1.f b/SRC/slaqz1.f index b2fb2fd5bf..38991e9866 100644 --- a/SRC/slaqz1.f +++ b/SRC/slaqz1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz2.f b/SRC/slaqz2.f index 58d4d3ff8b..6e6ca80d94 100644 --- a/SRC/slaqz2.f +++ b/SRC/slaqz2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz3.f b/SRC/slaqz3.f index 5a28c955cd..6cac3a00f9 100644 --- a/SRC/slaqz3.f +++ b/SRC/slaqz3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/slaqz4.f b/SRC/slaqz4.f index 7b739d749c..6b60b166d8 100644 --- a/SRC/slaqz4.f +++ b/SRC/slaqz4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAQZ4 * * =========== DOCUMENTATION =========== diff --git a/SRC/slar1v.f b/SRC/slar1v.f index ffa5ddaeff..970fe5190a 100644 --- a/SRC/slar1v.f +++ b/SRC/slar1v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/slar2v.f b/SRC/slar2v.f index cc35cf2115..5067ae644d 100644 --- a/SRC/slar2v.f +++ b/SRC/slar2v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarf.f b/SRC/slarf.f index 976ce9910c..6c369d6f31 100644 --- a/SRC/slarf.f +++ b/SRC/slarf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfb.f b/SRC/slarfb.f index c3b1d0833f..8c073cdcef 100644 --- a/SRC/slarfb.f +++ b/SRC/slarfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFB applies a block reflector or its transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfb_gett.f b/SRC/slarfb_gett.f index 0f28192068..72252a5a2c 100644 --- a/SRC/slarfb_gett.f +++ b/SRC/slarfb_gett.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfg.f b/SRC/slarfg.f index b2180a247b..6cd9103386 100644 --- a/SRC/slarfg.f +++ b/SRC/slarfg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfgp.f b/SRC/slarfgp.f index 69714f865e..c28274c2c4 100644 --- a/SRC/slarfgp.f +++ b/SRC/slarfgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarft.f b/SRC/slarft.f index 7f28af730c..31b7951819 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfx.f b/SRC/slarfx.f index 35faeac8a1..43e4a66667 100644 --- a/SRC/slarfx.f +++ b/SRC/slarfx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarfy.f b/SRC/slarfy.f index a2d1b9f952..060f81a032 100644 --- a/SRC/slarfy.f +++ b/SRC/slarfy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/slargv.f b/SRC/slargv.f index 3d7de5c74a..019317d3de 100644 --- a/SRC/slargv.f +++ b/SRC/slargv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARGV generates a vector of plane rotations with real cosines and real sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarmm.f b/SRC/slarmm.f index bd52b142b0..1f454d7fb0 100644 --- a/SRC/slarmm.f +++ b/SRC/slarmm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARMM * * Definition: diff --git a/SRC/slarnv.f b/SRC/slarnv.f index d641a3694e..dac8ea8285 100644 --- a/SRC/slarnv.f +++ b/SRC/slarnv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarra.f b/SRC/slarra.f index a5b35fd70b..d7f00ca0fa 100644 --- a/SRC/slarra.f +++ b/SRC/slarra.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRA computes the splitting points with the specified threshold. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrb.f b/SRC/slarrb.f index f311208336..8781664281 100644 --- a/SRC/slarrb.f +++ b/SRC/slarrb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRB provides limited bisection to locate eigenvalues for more accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrc.f b/SRC/slarrc.f index 197941d8cc..c1d625030a 100644 --- a/SRC/slarrc.f +++ b/SRC/slarrc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRC computes the number of eigenvalues of the symmetric tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrd.f b/SRC/slarrd.f index ab77f996ce..f87c7e8fc5 100644 --- a/SRC/slarrd.f +++ b/SRC/slarrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRD computes the eigenvalues of a symmetric tridiagonal matrix to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarre.f b/SRC/slarre.f index 8847860e6e..31dea0ae81 100644 --- a/SRC/slarre.f +++ b/SRC/slarre.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRE given the tridiagonal matrix T, sets small off-diagonal elements to zero and for each unreduced block Ti, finds base representations and eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrf.f b/SRC/slarrf.f index 12868ce644..ff83c80cbe 100644 --- a/SRC/slarrf.f +++ b/SRC/slarrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRF finds a new relatively robust representation such that at least one of the eigenvalues is relatively isolated. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrj.f b/SRC/slarrj.f index 42b9ad13d6..3daedfd078 100644 --- a/SRC/slarrj.f +++ b/SRC/slarrj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrk.f b/SRC/slarrk.f index 382fe60281..fbb7312785 100644 --- a/SRC/slarrk.f +++ b/SRC/slarrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRK computes one eigenvalue of a symmetric tridiagonal matrix T to suitable accuracy. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrr.f b/SRC/slarrr.f index 0e78bbe8b0..a36644b9dd 100644 --- a/SRC/slarrr.f +++ b/SRC/slarrr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRR performs tests to decide whether the symmetric tridiagonal matrix T warrants expensive computations which guarantee high relative accuracy in the eigenvalues. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarrv.f b/SRC/slarrv.f index 1c67df7c50..b3d964d465 100644 --- a/SRC/slarrv.f +++ b/SRC/slarrv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarscl2.f b/SRC/slarscl2.f index 4885c4cfae..dce4b78e6c 100644 --- a/SRC/slarscl2.f +++ b/SRC/slarscl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartg.f90 b/SRC/slartg.f90 index bbfc7f0860..fdf4099039 100644 --- a/SRC/slartg.f90 +++ b/SRC/slartg.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b SLARTG generates a plane rotation with real cosine and real sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/slartgp.f b/SRC/slartgp.f index a2faea0c0e..e8e8523720 100644 --- a/SRC/slartgp.f +++ b/SRC/slartgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARTGP generates a plane rotation so that the diagonal is nonnegative. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartgs.f b/SRC/slartgs.f index 6e4f7e7bd6..3985fb497f 100644 --- a/SRC/slartgs.f +++ b/SRC/slartgs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/slartv.f b/SRC/slartv.f index b530915b80..c43750f5a0 100644 --- a/SRC/slartv.f +++ b/SRC/slartv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaruv.f b/SRC/slaruv.f index b41ac48826..3cda4b714d 100644 --- a/SRC/slaruv.f +++ b/SRC/slaruv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARUV returns a vector of n random real numbers from a uniform distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarz.f b/SRC/slarz.f index 79a3489d1d..fbe69f26a7 100644 --- a/SRC/slarz.f +++ b/SRC/slarz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarzb.f b/SRC/slarzb.f index 92a5f893df..63129ac745 100644 --- a/SRC/slarzb.f +++ b/SRC/slarzb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARZB applies a block reflector or its transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slarzt.f b/SRC/slarzt.f index e805562b60..a248235593 100644 --- a/SRC/slarzt.f +++ b/SRC/slarzt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/slas2.f b/SRC/slas2.f index 285dae69f9..c68ca75959 100644 --- a/SRC/slas2.f +++ b/SRC/slas2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAS2 computes singular values of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slascl.f b/SRC/slascl.f index 08329c4bcd..cbac702f11 100644 --- a/SRC/slascl.f +++ b/SRC/slascl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/slascl2.f b/SRC/slascl2.f index 1312774b6a..03e9cb5cf8 100644 --- a/SRC/slascl2.f +++ b/SRC/slascl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd0.f b/SRC/slasd0.f index d2006f9611..5589d68606 100644 --- a/SRC/slasd0.f +++ b/SRC/slasd0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD0 computes the singular values of a real upper bidiagonal n-by-m matrix B with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd1.f b/SRC/slasd1.f index 30cd54c265..68a9a48a45 100644 --- a/SRC/slasd1.f +++ b/SRC/slasd1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd2.f b/SRC/slasd2.f index f40eacfd1b..769d2e78c6 100644 --- a/SRC/slasd2.f +++ b/SRC/slasd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd3.f b/SRC/slasd3.f index aaf3bd6364..bccfb411b6 100644 --- a/SRC/slasd3.f +++ b/SRC/slasd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and Z, and then updates the singular vectors by matrix multiplication. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd4.f b/SRC/slasd4.f index c3a07f8ef0..d8374c30b7 100644 --- a/SRC/slasd4.f +++ b/SRC/slasd4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modification to a positive diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd5.f b/SRC/slasd5.f index 9fb27ec562..0eecf1df2b 100644 --- a/SRC/slasd5.f +++ b/SRC/slasd5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd6.f b/SRC/slasd6.f index a0c2e9d950..565e6fd176 100644 --- a/SRC/slasd6.f +++ b/SRC/slasd6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by appending a row. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd7.f b/SRC/slasd7.f index 2370536ade..fe2ce9e850 100644 --- a/SRC/slasd7.f +++ b/SRC/slasd7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to deflate the size of the problem. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasd8.f b/SRC/slasd8.f index 313e75f2a5..392103bb1a 100644 --- a/SRC/slasd8.f +++ b/SRC/slasd8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasda.f b/SRC/slasda.f index 32bdc028e8..477fde6155 100644 --- a/SRC/slasda.f +++ b/SRC/slasda.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasdq.f b/SRC/slasdq.f index 303153f730..0c53e56908 100644 --- a/SRC/slasdq.f +++ b/SRC/slasdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasdt.f b/SRC/slasdt.f index d99ece00d0..f5192cfdaa 100644 --- a/SRC/slasdt.f +++ b/SRC/slasdt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaset.f b/SRC/slaset.f index 99e3fd295a..1f9754366a 100644 --- a/SRC/slaset.f +++ b/SRC/slaset.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq1.f b/SRC/slasq1.f index 55c612655d..054dedb0b3 100644 --- a/SRC/slasq1.f +++ b/SRC/slasq1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASQ1 computes the singular values of a real square bidiagonal matrix. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq2.f b/SRC/slasq2.f index 653298dadf..aca6ce8b06 100644 --- a/SRC/slasq2.f +++ b/SRC/slasq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq3.f b/SRC/slasq3.f index d2ff537c10..08c72e6a5f 100644 --- a/SRC/slasq3.f +++ b/SRC/slasq3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq4.f b/SRC/slasq4.f index 2fdeb89b8c..941b17a77f 100644 --- a/SRC/slasq4.f +++ b/SRC/slasq4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq5.f b/SRC/slasq5.f index 8f0da2ab16..e1ade48ca7 100644 --- a/SRC/slasq5.f +++ b/SRC/slasq5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasq6.f b/SRC/slasq6.f index cb29232602..dbf967a39f 100644 --- a/SRC/slasq6.f +++ b/SRC/slasq6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasr.f b/SRC/slasr.f index c3fa5d491b..8250a8cd1f 100644 --- a/SRC/slasr.f +++ b/SRC/slasr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasrt.f b/SRC/slasrt.f index 365ad98314..925e138c3c 100644 --- a/SRC/slasrt.f +++ b/SRC/slasrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASRT sorts numbers in increasing or decreasing order. * * =========== DOCUMENTATION =========== diff --git a/SRC/slassq.f90 b/SRC/slassq.f90 index e96189f866..c8959f4a7b 100644 --- a/SRC/slassq.f90 +++ b/SRC/slassq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b SLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/slasv2.f b/SRC/slasv2.f index 5af0f86c39..5832e801dc 100644 --- a/SRC/slasv2.f +++ b/SRC/slasv2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index 31641836f7..594c646db3 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASWLQ * * Definition: diff --git a/SRC/slaswp.f b/SRC/slaswp.f index fcdce24d7f..9ac0b731c3 100644 --- a/SRC/slaswp.f +++ b/SRC/slaswp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasy2.f b/SRC/slasy2.f index 10710b76ba..101733d42d 100644 --- a/SRC/slasy2.f +++ b/SRC/slasy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf.f b/SRC/slasyf.f index 8636b7d1a0..adde278267 100644 --- a/SRC/slasyf.f +++ b/SRC/slasyf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASYF computes a partial factorization of a real symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_aa.f b/SRC/slasyf_aa.f index 6faf8f8c29..096361fd87 100644 --- a/SRC/slasyf_aa.f +++ b/SRC/slasyf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_rk.f b/SRC/slasyf_rk.f index 24e4336dd1..a19a39b7ad 100644 --- a/SRC/slasyf_rk.f +++ b/SRC/slasyf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASYF_RK computes a partial factorization of a real symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slasyf_rook.f b/SRC/slasyf_rook.f index 40c22dd432..c214ae0a85 100644 --- a/SRC/slasyf_rook.f +++ b/SRC/slasyf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLASYF_ROOK computes a partial factorization of a real symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatbs.f b/SRC/slatbs.f index 6257004308..b4a0a5d911 100644 --- a/SRC/slatbs.f +++ b/SRC/slatbs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatdf.f b/SRC/slatdf.f index 4b17964c60..75a9ab6e63 100644 --- a/SRC/slatdf.f +++ b/SRC/slatdf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatps.f b/SRC/slatps.f index 00511bd993..83e0a0f201 100644 --- a/SRC/slatps.f +++ b/SRC/slatps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrd.f b/SRC/slatrd.f index 50d8fe4d30..6a3ada686e 100644 --- a/SRC/slatrd.f +++ b/SRC/slatrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an orthogonal similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrs.f b/SRC/slatrs.f index b1f21bd997..df5e56467e 100644 --- a/SRC/slatrs.f +++ b/SRC/slatrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatrs3.f b/SRC/slatrs3.f index d133ea8f93..a01be4aa37 100644 --- a/SRC/slatrs3.f +++ b/SRC/slatrs3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/slatrz.f b/SRC/slatrz.f index 998c047711..4d058cb8a9 100644 --- a/SRC/slatrz.f +++ b/SRC/slatrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATRZ factors an upper trapezoidal matrix by means of orthogonal transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f index d7e490b8ac..4730815b5f 100644 --- a/SRC/slatsqr.f +++ b/SRC/slatsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLATSQR * * Definition: diff --git a/SRC/slauu2.f b/SRC/slauu2.f index cb836a2f51..5e30818730 100644 --- a/SRC/slauu2.f +++ b/SRC/slauu2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/slauum.f b/SRC/slauum.f index aa707100c2..bff8f88d92 100644 --- a/SRC/slauum.f +++ b/SRC/slauum.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sopgtr.f b/SRC/sopgtr.f index 02ccefe7b6..c61a5c329f 100644 --- a/SRC/sopgtr.f +++ b/SRC/sopgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SOPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sopmtr.f b/SRC/sopmtr.f index 259ca7d625..e8542f3473 100644 --- a/SRC/sopmtr.f +++ b/SRC/sopmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SOPMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index 4d7e942cfe..46f7a496a3 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index c7ffdaf0f4..20e38371e0 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index eac7a7c051..02f6611a86 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index e443fb578f..ba12eda1aa 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index 417179b9c2..fc352c5555 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb5.f b/SRC/sorbdb5.f index 7dd03aaf6f..7e21c2ea9e 100644 --- a/SRC/sorbdb5.f +++ b/SRC/sorbdb5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorbdb6.f b/SRC/sorbdb6.f index ef2784df54..a070793a7c 100644 --- a/SRC/sorbdb6.f +++ b/SRC/sorbdb6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorcsd.f b/SRC/sorcsd.f index 381fe2e67f..26ef57a391 100644 --- a/SRC/sorcsd.f +++ b/SRC/sorcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f index 11e0a9872e..d1e448c803 100644 --- a/SRC/sorcsd2by1.f +++ b/SRC/sorcsd2by1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorg2l.f b/SRC/sorg2l.f index 0556d4a08e..0a3c96697a 100644 --- a/SRC/sorg2l.f +++ b/SRC/sorg2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORG2L generates all or part of the orthogonal matrix Q from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorg2r.f b/SRC/sorg2r.f index 42ef85c8ff..67d35d950e 100644 --- a/SRC/sorg2r.f +++ b/SRC/sorg2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgbr.f b/SRC/sorgbr.f index 316b8d3f30..37d8c6faaa 100644 --- a/SRC/sorgbr.f +++ b/SRC/sorgbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorghr.f b/SRC/sorghr.f index 480f1556d1..1ad580264f 100644 --- a/SRC/sorghr.f +++ b/SRC/sorghr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgl2.f b/SRC/sorgl2.f index f56d8e8c2a..2f03d32e53 100644 --- a/SRC/sorgl2.f +++ b/SRC/sorgl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGL2 * * =========== DOCUMENTATION =========== diff --git a/SRC/sorglq.f b/SRC/sorglq.f index cf5b438bc1..04d30233f3 100644 --- a/SRC/sorglq.f +++ b/SRC/sorglq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgql.f b/SRC/sorgql.f index 88abfd7c52..519d6ad205 100644 --- a/SRC/sorgql.f +++ b/SRC/sorgql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgqr.f b/SRC/sorgqr.f index e4d6d4969d..2f36c52522 100644 --- a/SRC/sorgqr.f +++ b/SRC/sorgqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgr2.f b/SRC/sorgr2.f index bd3ade3da7..73caec659a 100644 --- a/SRC/sorgr2.f +++ b/SRC/sorgr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGR2 generates all or part of the orthogonal matrix Q from an RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgrq.f b/SRC/sorgrq.f index 9eaacc4e99..11ada09b91 100644 --- a/SRC/sorgrq.f +++ b/SRC/sorgrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtr.f b/SRC/sorgtr.f index 44992646bd..b043a29d4f 100644 --- a/SRC/sorgtr.f +++ b/SRC/sorgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtsqr.f b/SRC/sorgtsqr.f index 93f605564d..0be27af77c 100644 --- a/SRC/sorgtsqr.f +++ b/SRC/sorgtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorgtsqr_row.f b/SRC/sorgtsqr_row.f index 1e6b62d2d5..5a1e1ff072 100644 --- a/SRC/sorgtsqr_row.f +++ b/SRC/sorgtsqr_row.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/sorhr_col.f b/SRC/sorhr_col.f index 86d69b04f7..cf9d985af8 100644 --- a/SRC/sorhr_col.f +++ b/SRC/sorhr_col.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm22.f b/SRC/sorm22.f index d9ca2ede78..a70d5b6003 100644 --- a/SRC/sorm22.f +++ b/SRC/sorm22.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORM22 multiplies a general matrix by a banded orthogonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm2l.f b/SRC/sorm2l.f index 12ca1ad701..bdd883c6c7 100644 --- a/SRC/sorm2l.f +++ b/SRC/sorm2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sorm2r.f b/SRC/sorm2r.f index 3876e56262..4f53cbd3a0 100644 --- a/SRC/sorm2r.f +++ b/SRC/sorm2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormbr.f b/SRC/sormbr.f index 99064dd1f6..bf36ca7660 100644 --- a/SRC/sormbr.f +++ b/SRC/sormbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/sormhr.f b/SRC/sormhr.f index 1dc94b64e7..44a1ef2707 100644 --- a/SRC/sormhr.f +++ b/SRC/sormhr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/sorml2.f b/SRC/sorml2.f index d18a437cad..27f970fcdb 100644 --- a/SRC/sorml2.f +++ b/SRC/sorml2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORML2 multiplies a general matrix by the orthogonal matrix from a LQ factorization determined by sgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormlq.f b/SRC/sormlq.f index 9dcd896573..16803efe0b 100644 --- a/SRC/sormlq.f +++ b/SRC/sormlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormql.f b/SRC/sormql.f index 3ba68e9c7d..6bf13a889a 100644 --- a/SRC/sormql.f +++ b/SRC/sormql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/sormqr.f b/SRC/sormqr.f index a563bef2ea..1669662d53 100644 --- a/SRC/sormqr.f +++ b/SRC/sormqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sormr2.f b/SRC/sormr2.f index dcd5073776..5e71a483aa 100644 --- a/SRC/sormr2.f +++ b/SRC/sormr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormr3.f b/SRC/sormr3.f index f0cc68428a..673a008760 100644 --- a/SRC/sormr3.f +++ b/SRC/sormr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMR3 multiplies a general matrix by the orthogonal matrix from a RZ factorization determined by stzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/sormrq.f b/SRC/sormrq.f index fc266d6324..0b56416d12 100644 --- a/SRC/sormrq.f +++ b/SRC/sormrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormrz.f b/SRC/sormrz.f index b69efd9ada..151f505707 100644 --- a/SRC/sormrz.f +++ b/SRC/sormrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/sormtr.f b/SRC/sormtr.f index 82bed6cc7e..7f9463ff33 100644 --- a/SRC/sormtr.f +++ b/SRC/sormtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SORMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/spbcon.f b/SRC/spbcon.f index 3267a6a3df..10494fa5d7 100644 --- a/SRC/spbcon.f +++ b/SRC/spbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spbequ.f b/SRC/spbequ.f index db14523cca..675d79e304 100644 --- a/SRC/spbequ.f +++ b/SRC/spbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spbrfs.f b/SRC/spbrfs.f index 9d4f2e4ac8..841b23db06 100644 --- a/SRC/spbrfs.f +++ b/SRC/spbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/spbstf.f b/SRC/spbstf.f index 786dbcdb89..030652cc5d 100644 --- a/SRC/spbstf.f +++ b/SRC/spbstf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/spbsv.f b/SRC/spbsv.f index 5bb1574f1d..19a07fbc62 100644 --- a/SRC/spbsv.f +++ b/SRC/spbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spbsvx.f b/SRC/spbsvx.f index d6a31bdbd1..6d4d5248a3 100644 --- a/SRC/spbsvx.f +++ b/SRC/spbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtf2.f b/SRC/spbtf2.f index aa88fb6e5c..1128c7d925 100644 --- a/SRC/spbtf2.f +++ b/SRC/spbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtrf.f b/SRC/spbtrf.f index cc1f9ad900..51f6202487 100644 --- a/SRC/spbtrf.f +++ b/SRC/spbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spbtrs.f b/SRC/spbtrs.f index ca46293aa7..e0c9356a03 100644 --- a/SRC/spbtrs.f +++ b/SRC/spbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spftrf.f b/SRC/spftrf.f index 3ea9c40201..181bd872f1 100644 --- a/SRC/spftrf.f +++ b/SRC/spftrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spftri.f b/SRC/spftri.f index 245308a14b..e35d64f9a0 100644 --- a/SRC/spftri.f +++ b/SRC/spftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spftrs.f b/SRC/spftrs.f index f803969a21..55834fcd0c 100644 --- a/SRC/spftrs.f +++ b/SRC/spftrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spocon.f b/SRC/spocon.f index 315de6665a..68de3c19ac 100644 --- a/SRC/spocon.f +++ b/SRC/spocon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spoequ.f b/SRC/spoequ.f index 6b755a7fd7..ee88598a41 100644 --- a/SRC/spoequ.f +++ b/SRC/spoequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spoequb.f b/SRC/spoequb.f index ea674a24ba..57a6e053bc 100644 --- a/SRC/spoequb.f +++ b/SRC/spoequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/sporfs.f b/SRC/sporfs.f index e7a9e161c7..3c266e8f5a 100644 --- a/SRC/sporfs.f +++ b/SRC/sporfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sporfsx.f b/SRC/sporfsx.f index 58c18b7a42..484794f0ee 100644 --- a/SRC/sporfsx.f +++ b/SRC/sporfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/sposv.f b/SRC/sposv.f index 931044b5cd..ba7deb1fcf 100644 --- a/SRC/sposv.f +++ b/SRC/sposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sposvx.f b/SRC/sposvx.f index 2e2a4a3a8a..a3ebd43ca6 100644 --- a/SRC/sposvx.f +++ b/SRC/sposvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sposvxx.f b/SRC/sposvxx.f index 606ce3ba74..0ab4ebeb3b 100644 --- a/SRC/sposvxx.f +++ b/SRC/sposvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spotf2.f b/SRC/spotf2.f index cd837ce75a..55a2f082c0 100644 --- a/SRC/spotf2.f +++ b/SRC/spotf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrf.f b/SRC/spotrf.f index e3cd89125e..5e7c4aa51b 100644 --- a/SRC/spotrf.f +++ b/SRC/spotrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrf2.f b/SRC/spotrf2.f index cffd19ee7a..0f28783334 100644 --- a/SRC/spotrf2.f +++ b/SRC/spotrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/spotri.f b/SRC/spotri.f index da14de22ab..8b92d7386f 100644 --- a/SRC/spotri.f +++ b/SRC/spotri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spotrs.f b/SRC/spotrs.f index c428e9f4b9..5a0d9c5e32 100644 --- a/SRC/spotrs.f +++ b/SRC/spotrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sppcon.f b/SRC/sppcon.f index 3cca710882..f49e99a3a9 100644 --- a/SRC/sppcon.f +++ b/SRC/sppcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sppequ.f b/SRC/sppequ.f index d6a9ecc842..3cb760bd89 100644 --- a/SRC/sppequ.f +++ b/SRC/sppequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/spprfs.f b/SRC/spprfs.f index 599b9b7083..f90004609d 100644 --- a/SRC/spprfs.f +++ b/SRC/spprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sppsv.f b/SRC/sppsv.f index 27a4f861f6..538efe1450 100644 --- a/SRC/sppsv.f +++ b/SRC/sppsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sppsvx.f b/SRC/sppsvx.f index f9407bb761..6c6c868bab 100644 --- a/SRC/sppsvx.f +++ b/SRC/sppsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spptrf.f b/SRC/spptrf.f index 20e747bae1..1fdbeb48d1 100644 --- a/SRC/spptrf.f +++ b/SRC/spptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spptri.f b/SRC/spptri.f index 8d23713871..c5414c5d4f 100644 --- a/SRC/spptri.f +++ b/SRC/spptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/spptrs.f b/SRC/spptrs.f index 9a9f274edf..acd7e1b00e 100644 --- a/SRC/spptrs.f +++ b/SRC/spptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/spstf2.f b/SRC/spstf2.f index c970f4a537..0d3c65e51d 100644 --- a/SRC/spstf2.f +++ b/SRC/spstf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/spstrf.f b/SRC/spstrf.f index c7140f541c..db70868743 100644 --- a/SRC/spstrf.f +++ b/SRC/spstrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/sptcon.f b/SRC/sptcon.f index bf5125b5a6..8ec3b5e519 100644 --- a/SRC/sptcon.f +++ b/SRC/sptcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/spteqr.f b/SRC/spteqr.f index ee1b5d502a..505d34cf1c 100644 --- a/SRC/spteqr.f +++ b/SRC/spteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/sptrfs.f b/SRC/sptrfs.f index 1e1b615ca4..7aa95adf06 100644 --- a/SRC/sptrfs.f +++ b/SRC/sptrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sptsv.f b/SRC/sptsv.f index 0507df3942..cd8e7ed494 100644 --- a/SRC/sptsv.f +++ b/SRC/sptsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sptsvx.f b/SRC/sptsvx.f index f32f69857d..fade56b6ae 100644 --- a/SRC/sptsvx.f +++ b/SRC/sptsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/spttrf.f b/SRC/spttrf.f index ef413453b3..87cfd3e2c7 100644 --- a/SRC/spttrf.f +++ b/SRC/spttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/spttrs.f b/SRC/spttrs.f index 44f876dfd9..73e5a5be6b 100644 --- a/SRC/spttrs.f +++ b/SRC/spttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sptts2.f b/SRC/sptts2.f index 7a33fba3c6..0a7b2626b0 100644 --- a/SRC/sptts2.f +++ b/SRC/sptts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/srscl.f b/SRC/srscl.f index f73c7ad928..786c72e79c 100644 --- a/SRC/srscl.f +++ b/SRC/srscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f index df58fc7ea6..97ad31b4a6 100644 --- a/SRC/ssb2st_kernels.f +++ b/SRC/ssb2st_kernels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> s, Wed Dec 7 08:22:40 2016 diff --git a/SRC/ssbev.f b/SRC/ssbev.f index 8a8c03683c..115de0498b 100644 --- a/SRC/ssbev.f +++ b/SRC/ssbev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbev_2stage.f b/SRC/ssbev_2stage.f index 9fa9409b90..34fd37f512 100644 --- a/SRC/ssbev_2stage.f +++ b/SRC/ssbev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbev_2stage.f, fortran d -> s, Sat Nov 5 23:58:09 2016 diff --git a/SRC/ssbevd.f b/SRC/ssbevd.f index e1b7818cbf..b299b5538f 100644 --- a/SRC/ssbevd.f +++ b/SRC/ssbevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbevd_2stage.f b/SRC/ssbevd_2stage.f index 65a959b25f..248dab3092 100644 --- a/SRC/ssbevd_2stage.f +++ b/SRC/ssbevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbevd_2stage.f, fortran d -> s, Sat Nov 5 23:58:03 2016 diff --git a/SRC/ssbevx.f b/SRC/ssbevx.f index ce5fb3535b..44028482b0 100644 --- a/SRC/ssbevx.f +++ b/SRC/ssbevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbevx_2stage.f b/SRC/ssbevx_2stage.f index 3362834601..38dd2f9fad 100644 --- a/SRC/ssbevx_2stage.f +++ b/SRC/ssbevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @generated from dsbevx_2stage.f, fortran d -> s, Sat Nov 5 23:58:06 2016 diff --git a/SRC/ssbgst.f b/SRC/ssbgst.f index de4dd0ce88..0ceb55907e 100644 --- a/SRC/ssbgst.f +++ b/SRC/ssbgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgv.f b/SRC/ssbgv.f index 3fb342d031..52a4ea103e 100644 --- a/SRC/ssbgv.f +++ b/SRC/ssbgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgvd.f b/SRC/ssbgvd.f index 7c7d974999..3409034359 100644 --- a/SRC/ssbgvd.f +++ b/SRC/ssbgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbgvx.f b/SRC/ssbgvx.f index 52c0316b3c..be40b2d772 100644 --- a/SRC/ssbgvx.f +++ b/SRC/ssbgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssbtrd.f b/SRC/ssbtrd.f index 675ab60f60..007cce45bf 100644 --- a/SRC/ssbtrd.f +++ b/SRC/ssbtrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssfrk.f b/SRC/ssfrk.f index 577d318d8e..b6ed55e964 100644 --- a/SRC/ssfrk.f +++ b/SRC/ssfrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSFRK performs a symmetric rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/sspcon.f b/SRC/sspcon.f index 0385f99785..b8195fffac 100644 --- a/SRC/sspcon.f +++ b/SRC/sspcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/sspev.f b/SRC/sspev.f index dc302b45d7..39d722fddd 100644 --- a/SRC/sspev.f +++ b/SRC/sspev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspevd.f b/SRC/sspevd.f index 5fa0c86ad8..cd6249702f 100644 --- a/SRC/sspevd.f +++ b/SRC/sspevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspevx.f b/SRC/sspevx.f index c39e17a3d6..16a2b666b8 100644 --- a/SRC/sspevx.f +++ b/SRC/sspevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgst.f b/SRC/sspgst.f index 9fd193b53d..2fb0065a48 100644 --- a/SRC/sspgst.f +++ b/SRC/sspgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgv.f b/SRC/sspgv.f index e8023f22be..423bddca5e 100644 --- a/SRC/sspgv.f +++ b/SRC/sspgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgvd.f b/SRC/sspgvd.f index f776b37aa8..55d263ac9c 100644 --- a/SRC/sspgvd.f +++ b/SRC/sspgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/sspgvx.f b/SRC/sspgvx.f index 5039add9f5..f868cb3e7e 100644 --- a/SRC/sspgvx.f +++ b/SRC/sspgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssprfs.f b/SRC/ssprfs.f index fd82cd59dd..84219f3bff 100644 --- a/SRC/ssprfs.f +++ b/SRC/ssprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/sspsv.f b/SRC/sspsv.f index f4446c26f3..6cf3de7558 100644 --- a/SRC/sspsv.f +++ b/SRC/sspsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sspsvx.f b/SRC/sspsvx.f index 61ee2ff222..81c04faa52 100644 --- a/SRC/sspsvx.f +++ b/SRC/sspsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrd.f b/SRC/ssptrd.f index 176db4b884..5a4399f9fe 100644 --- a/SRC/ssptrd.f +++ b/SRC/ssptrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrf.f b/SRC/ssptrf.f index 29785243c3..7a094f2ccd 100644 --- a/SRC/ssptrf.f +++ b/SRC/ssptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptri.f b/SRC/ssptri.f index 888c62ea38..7565afa9ff 100644 --- a/SRC/ssptri.f +++ b/SRC/ssptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ssptrs.f b/SRC/ssptrs.f index 5694dfc8b4..ad3b5264a9 100644 --- a/SRC/ssptrs.f +++ b/SRC/ssptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/sstebz.f b/SRC/sstebz.f index 3849546216..b40c88b945 100644 --- a/SRC/sstebz.f +++ b/SRC/sstebz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEBZ * * =========== DOCUMENTATION =========== diff --git a/SRC/sstedc.f b/SRC/sstedc.f index c8d16c63ce..fea5338bfb 100644 --- a/SRC/sstedc.f +++ b/SRC/sstedc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/sstegr.f b/SRC/sstegr.f index 3f14df64e5..3b68957acd 100644 --- a/SRC/sstegr.f +++ b/SRC/sstegr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/sstein.f b/SRC/sstein.f index 333d381e6b..279dc99bbe 100644 --- a/SRC/sstein.f +++ b/SRC/sstein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/sstemr.f b/SRC/sstemr.f index 346d5b00d9..2de9590b4e 100644 --- a/SRC/sstemr.f +++ b/SRC/sstemr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/ssteqr.f b/SRC/ssteqr.f index 3616213ebd..e3c5eb62b9 100644 --- a/SRC/ssteqr.f +++ b/SRC/ssteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/ssterf.f b/SRC/ssterf.f index 5e6d1e68cc..f268174b52 100644 --- a/SRC/ssterf.f +++ b/SRC/ssterf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSTERF * * =========== DOCUMENTATION =========== diff --git a/SRC/sstev.f b/SRC/sstev.f index 2a5760f0c9..3cd17ab21b 100644 --- a/SRC/sstev.f +++ b/SRC/sstev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevd.f b/SRC/sstevd.f index 690304c945..99f5755e5c 100644 --- a/SRC/sstevd.f +++ b/SRC/sstevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevr.f b/SRC/sstevr.f index c34c0904b1..28af73e605 100644 --- a/SRC/sstevr.f +++ b/SRC/sstevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/sstevx.f b/SRC/sstevx.f index 37bf92a8a2..84a8f3802a 100644 --- a/SRC/sstevx.f +++ b/SRC/sstevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon.f b/SRC/ssycon.f index 678baf09ea..6ccabc5fca 100644 --- a/SRC/ssycon.f +++ b/SRC/ssycon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon_3.f b/SRC/ssycon_3.f index c3f88df39c..b17157a5a2 100644 --- a/SRC/ssycon_3.f +++ b/SRC/ssycon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssycon_rook.f b/SRC/ssycon_rook.f index c7925e770b..ac30c6055d 100644 --- a/SRC/ssycon_rook.f +++ b/SRC/ssycon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconv.f b/SRC/ssyconv.f index 3c32583e0f..809a108620 100644 --- a/SRC/ssyconv.f +++ b/SRC/ssyconv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconvf.f b/SRC/ssyconvf.f index f42e9f142c..8847438551 100644 --- a/SRC/ssyconvf.f +++ b/SRC/ssyconvf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyconvf_rook.f b/SRC/ssyconvf_rook.f index de02f2c386..f83acf5a08 100644 --- a/SRC/ssyconvf_rook.f +++ b/SRC/ssyconvf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyequb.f b/SRC/ssyequb.f index 260384afb1..0a06e50982 100644 --- a/SRC/ssyequb.f +++ b/SRC/ssyequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyev.f b/SRC/ssyev.f index dd0700610f..b031fe1a04 100644 --- a/SRC/ssyev.f +++ b/SRC/ssyev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyev_2stage.f b/SRC/ssyev_2stage.f index 9278cad296..62f3b8be21 100644 --- a/SRC/ssyev_2stage.f +++ b/SRC/ssyev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyev_2stage.f, fortran d -> s, Sat Nov 5 23:55:51 2016 diff --git a/SRC/ssyevd.f b/SRC/ssyevd.f index 9141d29155..4b2742ac1f 100644 --- a/SRC/ssyevd.f +++ b/SRC/ssyevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevd_2stage.f b/SRC/ssyevd_2stage.f index 986deac2ac..fba72c4c96 100644 --- a/SRC/ssyevd_2stage.f +++ b/SRC/ssyevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevd_2stage.f, fortran d -> s, Sat Nov 5 23:55:54 2016 diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 87d59add43..8fedb4ca28 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevr_2stage.f b/SRC/ssyevr_2stage.f index 2a98d46d7a..62fe3b6c7d 100644 --- a/SRC/ssyevr_2stage.f +++ b/SRC/ssyevr_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevr_2stage.f, fortran d -> s, Sat Nov 5 23:50:10 2016 diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index bac5620ff0..d898adccad 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyevx_2stage.f b/SRC/ssyevx_2stage.f index 8a32da15f8..6d525ae071 100644 --- a/SRC/ssyevx_2stage.f +++ b/SRC/ssyevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices * * @generated from dsyevx_2stage.f, fortran d -> s, Sat Nov 5 23:55:46 2016 diff --git a/SRC/ssygs2.f b/SRC/ssygs2.f index b3b85dd3df..7ce85c7611 100644 --- a/SRC/ssygs2.f +++ b/SRC/ssygs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGS2 reduces a symmetric definite generalized eigenproblem to standard form, using the factorization results obtained from spotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygst.f b/SRC/ssygst.f index 973711e197..a604ba5ebf 100644 --- a/SRC/ssygst.f +++ b/SRC/ssygst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGST * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygv.f b/SRC/ssygv.f index 0dfabbb2c1..b3b49af8e3 100644 --- a/SRC/ssygv.f +++ b/SRC/ssygv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGV * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygv_2stage.f b/SRC/ssygv_2stage.f index ac2dfcbab4..6f7a2e947e 100644 --- a/SRC/ssygv_2stage.f +++ b/SRC/ssygv_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGV_2STAGE * * @generated from dsygv_2stage.f, fortran d -> s, Sun Nov 6 12:54:29 2016 diff --git a/SRC/ssygvd.f b/SRC/ssygvd.f index 3f70819d52..6665e4a6be 100644 --- a/SRC/ssygvd.f +++ b/SRC/ssygvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssygvx.f b/SRC/ssygvx.f index 4c5ea41cea..7c2def6ace 100644 --- a/SRC/ssygvx.f +++ b/SRC/ssygvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyrfs.f b/SRC/ssyrfs.f index 06d500e6a5..c2f10ccf6f 100644 --- a/SRC/ssyrfs.f +++ b/SRC/ssyrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyrfsx.f b/SRC/ssyrfsx.f index 7416573f23..43ba9ba9f5 100644 --- a/SRC/ssyrfsx.f +++ b/SRC/ssyrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv.f b/SRC/ssysv.f index f0aa0fee7f..2ff7666749 100644 --- a/SRC/ssysv.f +++ b/SRC/ssysv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_aa.f b/SRC/ssysv_aa.f index d95e854577..bd25328ea6 100644 --- a/SRC/ssysv_aa.f +++ b/SRC/ssysv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_aa_2stage.f b/SRC/ssysv_aa_2stage.f index fcbcda58c1..fb068b3bf7 100644 --- a/SRC/ssysv_aa_2stage.f +++ b/SRC/ssysv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_rk.f b/SRC/ssysv_rk.f index c0ca14eb7a..7538e2e612 100644 --- a/SRC/ssysv_rk.f +++ b/SRC/ssysv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysv_rook.f b/SRC/ssysv_rook.f index b48ae14024..7745a10823 100644 --- a/SRC/ssysv_rook.f +++ b/SRC/ssysv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysvx.f b/SRC/ssysvx.f index 7734a31a08..b85f180fe2 100644 --- a/SRC/ssysvx.f +++ b/SRC/ssysvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief SSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/ssysvxx.f b/SRC/ssysvxx.f index a7f062f59e..06756010bd 100644 --- a/SRC/ssysvxx.f +++ b/SRC/ssysvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYSVXX * * =========== DOCUMENTATION =========== diff --git a/SRC/ssyswapr.f b/SRC/ssyswapr.f index e54e61d8d5..5d2b15a15c 100644 --- a/SRC/ssyswapr.f +++ b/SRC/ssyswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYSWAPR applies an elementary permutation on the rows and columns of a symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytd2.f b/SRC/ssytd2.f index 2769d09764..fffde2e4ea 100644 --- a/SRC/ssytd2.f +++ b/SRC/ssytd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2.f b/SRC/ssytf2.f index 886e556b21..d186f8a808 100644 --- a/SRC/ssytf2.f +++ b/SRC/ssytf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2_rk.f b/SRC/ssytf2_rk.f index d67bd7d1c7..992e8245bd 100644 --- a/SRC/ssytf2_rk.f +++ b/SRC/ssytf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytf2_rook.f b/SRC/ssytf2_rook.f index 45bd45c5a8..04c072f098 100644 --- a/SRC/ssytf2_rook.f +++ b/SRC/ssytf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd.f b/SRC/ssytrd.f index 184cc9165d..44201a9540 100644 --- a/SRC/ssytrd.f +++ b/SRC/ssytrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd_2stage.f b/SRC/ssytrd_2stage.f index 45e990c1ae..66d5f1562c 100644 --- a/SRC/ssytrd_2stage.f +++ b/SRC/ssytrd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRD_2STAGE * * @generated from zhetrd_2stage.f, fortran z -> s, Sun Nov 6 19:34:06 2016 diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index c6cb196d30..2a5eb3c1c9 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRD_SY2SB * * @generated from zhetrd_he2hb.f, fortran z -> s, Wed Dec 7 08:22:40 2016 diff --git a/SRC/ssytrf.f b/SRC/ssytrf.f index b66eb37f26..299da90d1a 100644 --- a/SRC/ssytrf.f +++ b/SRC/ssytrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_aa.f b/SRC/ssytrf_aa.f index 1d106d830d..168493caf9 100644 --- a/SRC/ssytrf_aa.f +++ b/SRC/ssytrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_aa_2stage.f b/SRC/ssytrf_aa_2stage.f index f4721edb8a..c24e59aaf1 100644 --- a/SRC/ssytrf_aa_2stage.f +++ b/SRC/ssytrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_rk.f b/SRC/ssytrf_rk.f index b063d63e46..311c54ae82 100644 --- a/SRC/ssytrf_rk.f +++ b/SRC/ssytrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrf_rook.f b/SRC/ssytrf_rook.f index dbf98be353..2a73c8edc2 100644 --- a/SRC/ssytrf_rook.f +++ b/SRC/ssytrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri.f b/SRC/ssytri.f index 9f11e15c7e..40c6d3ea1e 100644 --- a/SRC/ssytri.f +++ b/SRC/ssytri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri2.f b/SRC/ssytri2.f index a6140aba02..fd1c53473d 100644 --- a/SRC/ssytri2.f +++ b/SRC/ssytri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri2x.f b/SRC/ssytri2x.f index add882bb57..d2a77dcea2 100644 --- a/SRC/ssytri2x.f +++ b/SRC/ssytri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_3.f b/SRC/ssytri_3.f index fb36f4e2ca..f0152a1499 100644 --- a/SRC/ssytri_3.f +++ b/SRC/ssytri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_3x.f b/SRC/ssytri_3x.f index d0fd016c03..ae2725c44e 100644 --- a/SRC/ssytri_3x.f +++ b/SRC/ssytri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytri_rook.f b/SRC/ssytri_rook.f index efbee73e0a..f3a6b7fefa 100644 --- a/SRC/ssytri_rook.f +++ b/SRC/ssytri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs.f b/SRC/ssytrs.f index 4cb2fcdca1..2bdaf8679d 100644 --- a/SRC/ssytrs.f +++ b/SRC/ssytrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs2.f b/SRC/ssytrs2.f index dd8a39fef8..a7367f6fa5 100644 --- a/SRC/ssytrs2.f +++ b/SRC/ssytrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_3.f b/SRC/ssytrs_3.f index b6ee69761d..3baf0d503b 100644 --- a/SRC/ssytrs_3.f +++ b/SRC/ssytrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_aa.f b/SRC/ssytrs_aa.f index f9231b9943..76b9283a8a 100644 --- a/SRC/ssytrs_aa.f +++ b/SRC/ssytrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_aa_2stage.f b/SRC/ssytrs_aa_2stage.f index 11aed3adba..8da01e107d 100644 --- a/SRC/ssytrs_aa_2stage.f +++ b/SRC/ssytrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrs_rook.f b/SRC/ssytrs_rook.f index e60ba9dda1..fd9f5d5992 100644 --- a/SRC/ssytrs_rook.f +++ b/SRC/ssytrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/stbcon.f b/SRC/stbcon.f index 48a70913f0..ae99aca08e 100644 --- a/SRC/stbcon.f +++ b/SRC/stbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/stbrfs.f b/SRC/stbrfs.f index e0c267a22d..df345e6810 100644 --- a/SRC/stbrfs.f +++ b/SRC/stbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/stbtrs.f b/SRC/stbtrs.f index 72332967ab..103e1d28ce 100644 --- a/SRC/stbtrs.f +++ b/SRC/stbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/stfsm.f b/SRC/stfsm.f index 84c9e48675..c167f80c09 100644 --- a/SRC/stfsm.f +++ b/SRC/stfsm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/stftri.f b/SRC/stftri.f index 0ba26f9df1..88a7ed8dc4 100644 --- a/SRC/stftri.f +++ b/SRC/stftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/stfttp.f b/SRC/stfttp.f index b8640eebbd..bfb8b8faec 100644 --- a/SRC/stfttp.f +++ b/SRC/stfttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/stfttr.f b/SRC/stfttr.f index 1751967e9a..8f5b066d00 100644 --- a/SRC/stfttr.f +++ b/SRC/stfttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/stgevc.f b/SRC/stgevc.f index 141345e779..7883bcc315 100644 --- a/SRC/stgevc.f +++ b/SRC/stgevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/stgex2.f b/SRC/stgex2.f index b48667d2ec..46bc141d49 100644 --- a/SRC/stgex2.f +++ b/SRC/stgex2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/stgexc.f b/SRC/stgexc.f index a046cc600c..f858b3cc98 100644 --- a/SRC/stgexc.f +++ b/SRC/stgexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsen.f b/SRC/stgsen.f index 673b480d3f..bb34b48ad5 100644 --- a/SRC/stgsen.f +++ b/SRC/stgsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsja.f b/SRC/stgsja.f index 95ec1fd56c..bb7f2c0c06 100644 --- a/SRC/stgsja.f +++ b/SRC/stgsja.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsna.f b/SRC/stgsna.f index d7ff2592af..1da319f5fd 100644 --- a/SRC/stgsna.f +++ b/SRC/stgsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsy2.f b/SRC/stgsy2.f index f730ff193a..9f3c81c1f6 100644 --- a/SRC/stgsy2.f +++ b/SRC/stgsy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/stgsyl.f b/SRC/stgsyl.f index e9cd6981d6..02aa969c99 100644 --- a/SRC/stgsyl.f +++ b/SRC/stgsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/stpcon.f b/SRC/stpcon.f index 8c11b4a04b..5af13682ba 100644 --- a/SRC/stpcon.f +++ b/SRC/stpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/stplqt.f b/SRC/stplqt.f index 425734a3a0..bee065ee0e 100644 --- a/SRC/stplqt.f +++ b/SRC/stplqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/stplqt2.f b/SRC/stplqt2.f index 529a200a79..a22427b379 100644 --- a/SRC/stplqt2.f +++ b/SRC/stplqt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f index 278a7c309f..a43d4ae046 100644 --- a/SRC/stpmlqt.f +++ b/SRC/stpmlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpmqrt.f b/SRC/stpmqrt.f index a31df38c71..c8fa16fb9b 100644 --- a/SRC/stpmqrt.f +++ b/SRC/stpmqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpqrt.f b/SRC/stpqrt.f index 43d92b80a4..bcfa8395a8 100644 --- a/SRC/stpqrt.f +++ b/SRC/stpqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/stpqrt2.f b/SRC/stpqrt2.f index 571e4be14b..13479ec3ba 100644 --- a/SRC/stpqrt2.f +++ b/SRC/stpqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/stprfb.f b/SRC/stprfb.f index 23f4446ed0..0e1b4e0a88 100644 --- a/SRC/stprfb.f +++ b/SRC/stprfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPRFB applies a real "triangular-pentagonal" block reflector to a real matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/stprfs.f b/SRC/stprfs.f index 92b5b6d691..55780ebaf0 100644 --- a/SRC/stprfs.f +++ b/SRC/stprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/stptri.f b/SRC/stptri.f index c141c48689..1e8e7529e0 100644 --- a/SRC/stptri.f +++ b/SRC/stptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/stptrs.f b/SRC/stptrs.f index d060ec5d90..556f03c642 100644 --- a/SRC/stptrs.f +++ b/SRC/stptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/stpttf.f b/SRC/stpttf.f index cc9cbe579f..271388f0a8 100644 --- a/SRC/stpttf.f +++ b/SRC/stpttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/stpttr.f b/SRC/stpttr.f index d5b9fca3a6..0490a471bb 100644 --- a/SRC/stpttr.f +++ b/SRC/stpttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/strcon.f b/SRC/strcon.f index dd835c77af..7f9bf8fe35 100644 --- a/SRC/strcon.f +++ b/SRC/strcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/strevc.f b/SRC/strevc.f index b88fff34bd..3451714870 100644 --- a/SRC/strevc.f +++ b/SRC/strevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/strevc3.f b/SRC/strevc3.f index da445df368..7cb868e207 100644 --- a/SRC/strevc3.f +++ b/SRC/strevc3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/strexc.f b/SRC/strexc.f index db5951360a..f4efb9d770 100644 --- a/SRC/strexc.f +++ b/SRC/strexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/strrfs.f b/SRC/strrfs.f index b47f8fb1ae..7ab50576f5 100644 --- a/SRC/strrfs.f +++ b/SRC/strrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/strsen.f b/SRC/strsen.f index 5ffcc920df..3110ebe771 100644 --- a/SRC/strsen.f +++ b/SRC/strsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/strsna.f b/SRC/strsna.f index fc2601a8a1..436a5d19ea 100644 --- a/SRC/strsna.f +++ b/SRC/strsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/strsyl.f b/SRC/strsyl.f index 938cc33a61..2d1acea55f 100644 --- a/SRC/strsyl.f +++ b/SRC/strsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index 505a0a2fbf..708cf27066 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRSYL3 * * Definition: diff --git a/SRC/strti2.f b/SRC/strti2.f index be1a42b017..03a00d7102 100644 --- a/SRC/strti2.f +++ b/SRC/strti2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/strtri.f b/SRC/strtri.f index 7c09134c78..4d0728f225 100644 --- a/SRC/strtri.f +++ b/SRC/strtri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/strtrs.f b/SRC/strtrs.f index c546cae843..6cba2e842b 100644 --- a/SRC/strtrs.f +++ b/SRC/strtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/strttf.f b/SRC/strttf.f index 6731b50658..9863d141b2 100644 --- a/SRC/strttf.f +++ b/SRC/strttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/strttp.f b/SRC/strttp.f index b9c81a2e29..f27fe3b094 100644 --- a/SRC/strttp.f +++ b/SRC/strttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/stzrzf.f b/SRC/stzrzf.f index 987e0aa3a1..8214ff1003 100644 --- a/SRC/stzrzf.f +++ b/SRC/stzrzf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b STZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/xerbla.f b/SRC/xerbla.f index 841961b31f..96de0ef24a 100644 --- a/SRC/xerbla.f +++ b/SRC/xerbla.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b XERBLA * * =========== DOCUMENTATION =========== diff --git a/SRC/xerbla_array.f b/SRC/xerbla_array.f index 3c34c09657..e27ed8c932 100644 --- a/SRC/xerbla_array.f +++ b/SRC/xerbla_array.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b XERBLA_ARRAY * * =========== DOCUMENTATION =========== diff --git a/SRC/zbbcsd.f b/SRC/zbbcsd.f index 5b8af32720..e5b48753c8 100644 --- a/SRC/zbbcsd.f +++ b/SRC/zbbcsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZBBCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index 0561c7faa2..cc0922b1b6 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZBDSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zcgesv.f b/SRC/zcgesv.f index 5d859fab36..51c33ea578 100644 --- a/SRC/zcgesv.f +++ b/SRC/zcgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZCGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision with iterative refinement) * * =========== DOCUMENTATION =========== diff --git a/SRC/zcposv.f b/SRC/zcposv.f index 40ea8bb4fa..fa750bd2c0 100644 --- a/SRC/zcposv.f +++ b/SRC/zcposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZCPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zdrscl.f b/SRC/zdrscl.f index e809e954e5..00653c75a4 100644 --- a/SRC/zdrscl.f +++ b/SRC/zdrscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbbrd.f b/SRC/zgbbrd.f index e77b15237c..64ff685b70 100644 --- a/SRC/zgbbrd.f +++ b/SRC/zgbbrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbcon.f b/SRC/zgbcon.f index fb7b49b0a3..021dd0388b 100644 --- a/SRC/zgbcon.f +++ b/SRC/zgbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbequ.f b/SRC/zgbequ.f index 3b7a18e87e..247d0720be 100644 --- a/SRC/zgbequ.f +++ b/SRC/zgbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbequb.f b/SRC/zgbequb.f index 3065b59d43..74c95dadbd 100644 --- a/SRC/zgbequb.f +++ b/SRC/zgbequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbrfs.f b/SRC/zgbrfs.f index e1af6dc863..d0010fb0d6 100644 --- a/SRC/zgbrfs.f +++ b/SRC/zgbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbrfsx.f b/SRC/zgbrfsx.f index 7492fb41ea..578854a95a 100644 --- a/SRC/zgbrfsx.f +++ b/SRC/zgbrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsv.f b/SRC/zgbsv.f index b626fddc0e..2b89c17a5e 100644 --- a/SRC/zgbsv.f +++ b/SRC/zgbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsvx.f b/SRC/zgbsvx.f index 86d82c0229..faa0eeb3b5 100644 --- a/SRC/zgbsvx.f +++ b/SRC/zgbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbsvxx.f b/SRC/zgbsvxx.f index 128bf3bb34..a9f083679b 100644 --- a/SRC/zgbsvxx.f +++ b/SRC/zgbsvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGBSVXX computes the solution to system of linear equations A * X = B for GB matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtf2.f b/SRC/zgbtf2.f index 294450670d..0efba1ed6c 100644 --- a/SRC/zgbtf2.f +++ b/SRC/zgbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtrf.f b/SRC/zgbtrf.f index 33e5c605f8..d3a49057f5 100644 --- a/SRC/zgbtrf.f +++ b/SRC/zgbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgbtrs.f b/SRC/zgbtrs.f index 20c4eaf9d2..eb30782732 100644 --- a/SRC/zgbtrs.f +++ b/SRC/zgbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebak.f b/SRC/zgebak.f index 553daad07e..90b355762d 100644 --- a/SRC/zgebak.f +++ b/SRC/zgebak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebal.f b/SRC/zgebal.f index f29f0dae7f..8217aa545a 100644 --- a/SRC/zgebal.f +++ b/SRC/zgebal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebd2.f b/SRC/zgebd2.f index b6601399c7..ec1142954b 100644 --- a/SRC/zgebd2.f +++ b/SRC/zgebd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgebrd.f b/SRC/zgebrd.f index 1d05082bf5..d19e686a36 100644 --- a/SRC/zgebrd.f +++ b/SRC/zgebrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEBRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgecon.f b/SRC/zgecon.f index f8b8a2ad6f..77e6a4375b 100644 --- a/SRC/zgecon.f +++ b/SRC/zgecon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGECON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index 3dad610e5a..a2af6e04b9 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b ZGEDMD computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index f74007614d..c16288d0fa 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b ZGEDMDQ computes the Dynamic Mode Decomposition (DMD) for a pair of data snapshot matrices. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zgeequ.f b/SRC/zgeequ.f index 7d66783fac..0802647831 100644 --- a/SRC/zgeequ.f +++ b/SRC/zgeequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeequb.f b/SRC/zgeequb.f index db5ab6d0ea..0e1c777b86 100644 --- a/SRC/zgeequb.f +++ b/SRC/zgeequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zgees.f b/SRC/zgees.f index ee8081bcd4..dc577e0395 100644 --- a/SRC/zgees.f +++ b/SRC/zgees.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f index a3595d9bb9..cd297bf516 100644 --- a/SRC/zgeesx.f +++ b/SRC/zgeesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeev.f b/SRC/zgeev.f index 9fc2e7d0fb..95b3989b89 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index 83eb0693bb..54bd3cd49f 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgehd2.f b/SRC/zgehd2.f index 5700361499..63c9fce1c8 100644 --- a/SRC/zgehd2.f +++ b/SRC/zgehd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f index 9731bf87f0..8a18fde198 100644 --- a/SRC/zgehrd.f +++ b/SRC/zgehrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgejsv.f b/SRC/zgejsv.f index 85578f2d95..c53336852e 100644 --- a/SRC/zgejsv.f +++ b/SRC/zgejsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEJSV * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelq.f b/SRC/zgelq.f index 09d5a36e3f..86610e8019 100644 --- a/SRC/zgelq.f +++ b/SRC/zgelq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGELQ * * Definition: diff --git a/SRC/zgelq2.f b/SRC/zgelq2.f index 471a2c590f..bd3521caa3 100644 --- a/SRC/zgelq2.f +++ b/SRC/zgelq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGELQ2 computes the LQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqf.f b/SRC/zgelqf.f index cbd13c74dd..3188a1298a 100644 --- a/SRC/zgelqf.f +++ b/SRC/zgelqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGELQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqt.f b/SRC/zgelqt.f index 32ff7f958c..4c2b6d9dc4 100644 --- a/SRC/zgelqt.f +++ b/SRC/zgelqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGELQT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelqt3.f b/SRC/zgelqt3.f index 71b5b6be7c..b07e59d14f 100644 --- a/SRC/zgelqt3.f +++ b/SRC/zgelqt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgels.f b/SRC/zgels.f index 99e8035da1..2b8913c198 100644 --- a/SRC/zgels.f +++ b/SRC/zgels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGELS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelsd.f b/SRC/zgelsd.f index b703515ec2..57c47792a5 100644 --- a/SRC/zgelsd.f +++ b/SRC/zgelsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelss.f b/SRC/zgelss.f index bf1483cff1..378c8afa96 100644 --- a/SRC/zgelss.f +++ b/SRC/zgelss.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGELSS solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelst.f b/SRC/zgelst.f index 13fbbef813..09f7ccd7b2 100644 --- a/SRC/zgelst.f +++ b/SRC/zgelst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization with compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgelsy.f b/SRC/zgelsy.f index 94db5185b8..57826bcf68 100644 --- a/SRC/zgelsy.f +++ b/SRC/zgelsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGELSY solves overdetermined or underdetermined systems for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f index 929d59c6ad..11489087a4 100644 --- a/SRC/zgemlq.f +++ b/SRC/zgemlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEMLQ * * Definition: diff --git a/SRC/zgemlqt.f b/SRC/zgemlqt.f index c358e9be67..d85651b1ec 100644 --- a/SRC/zgemlqt.f +++ b/SRC/zgemlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f index 919c81fb6b..d14d74fe28 100644 --- a/SRC/zgemqr.f +++ b/SRC/zgemqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEMQR * * Definition: diff --git a/SRC/zgemqrt.f b/SRC/zgemqrt.f index 75077c2f2e..3e6c467d0f 100644 --- a/SRC/zgemqrt.f +++ b/SRC/zgemqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeql2.f b/SRC/zgeql2.f index caf1815fa3..cdac186e98 100644 --- a/SRC/zgeql2.f +++ b/SRC/zgeql2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqlf.f b/SRC/zgeqlf.f index 77c63140a1..ef793923bc 100644 --- a/SRC/zgeqlf.f +++ b/SRC/zgeqlf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQLF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqp3.f b/SRC/zgeqp3.f index 48ff85d9eb..ba07cbc42a 100644 --- a/SRC/zgeqp3.f +++ b/SRC/zgeqp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqp3rk.f b/SRC/zgeqp3rk.f index 92e5995f51..654093e31d 100644 --- a/SRC/zgeqp3rk.f +++ b/SRC/zgeqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f index 0bb0b82533..7df9c2403d 100644 --- a/SRC/zgeqr.f +++ b/SRC/zgeqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQR * * Definition: diff --git a/SRC/zgeqr2.f b/SRC/zgeqr2.f index c14f5ded6c..457404ad91 100644 --- a/SRC/zgeqr2.f +++ b/SRC/zgeqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqr2p.f b/SRC/zgeqr2p.f index 1ec2304115..93451faec8 100644 --- a/SRC/zgeqr2p.f +++ b/SRC/zgeqr2p.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elements using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrf.f b/SRC/zgeqrf.f index 5ac3e1fd34..2ef06633e8 100644 --- a/SRC/zgeqrf.f +++ b/SRC/zgeqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrfp.f b/SRC/zgeqrfp.f index b32142060f..3562de36ec 100644 --- a/SRC/zgeqrfp.f +++ b/SRC/zgeqrfp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQRFP * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt.f b/SRC/zgeqrt.f index 2539059123..01cc907754 100644 --- a/SRC/zgeqrt.f +++ b/SRC/zgeqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt2.f b/SRC/zgeqrt2.f index fcd486d88a..3cdcf5353d 100644 --- a/SRC/zgeqrt2.f +++ b/SRC/zgeqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgeqrt3.f b/SRC/zgeqrt3.f index 7637ca38e6..da23cff85c 100644 --- a/SRC/zgeqrt3.f +++ b/SRC/zgeqrt3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact WY representation of Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerfs.f b/SRC/zgerfs.f index 144dac488e..71cb31cc1a 100644 --- a/SRC/zgerfs.f +++ b/SRC/zgerfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerfsx.f b/SRC/zgerfsx.f index b9bfdc732d..dc7a78477b 100644 --- a/SRC/zgerfsx.f +++ b/SRC/zgerfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerq2.f b/SRC/zgerq2.f index 3b8b429219..f7bac6d570 100644 --- a/SRC/zgerq2.f +++ b/SRC/zgerq2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgerqf.f b/SRC/zgerqf.f index 54f2d639e9..1a689f84ca 100644 --- a/SRC/zgerqf.f +++ b/SRC/zgerqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGERQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesc2.f b/SRC/zgesc2.f index 60579a8e49..d90249c640 100644 --- a/SRC/zgesc2.f +++ b/SRC/zgesc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesdd.f b/SRC/zgesdd.f index 0ad38714ad..1c48bb9e0b 100644 --- a/SRC/zgesdd.f +++ b/SRC/zgesdd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGESDD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesv.f b/SRC/zgesv.f index 19616e39ce..816ce90769 100644 --- a/SRC/zgesv.f +++ b/SRC/zgesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \addtogroup gesv *> *> \brief ZGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) diff --git a/SRC/zgesvd.f b/SRC/zgesvd.f index 53cf124b4d..7b723e133f 100644 --- a/SRC/zgesvd.f +++ b/SRC/zgesvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVD computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvdq.f b/SRC/zgesvdq.f index 3fcf4ca66d..1fecd324c3 100644 --- a/SRC/zgesvdq.f +++ b/SRC/zgesvdq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvdx.f b/SRC/zgesvdx.f index 77d48b0f64..09b4acdf64 100644 --- a/SRC/zgesvdx.f +++ b/SRC/zgesvdx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVDX computes the singular value decomposition (SVD) for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvj.f b/SRC/zgesvj.f index 47338710fb..ac03d9f0d4 100644 --- a/SRC/zgesvj.f +++ b/SRC/zgesvj.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVJ * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvx.f b/SRC/zgesvx.f index 91fd15c513..226fded21f 100644 --- a/SRC/zgesvx.f +++ b/SRC/zgesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgesvxx.f b/SRC/zgesvxx.f index 03dd482cad..8f2202481e 100644 --- a/SRC/zgesvxx.f +++ b/SRC/zgesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetc2.f b/SRC/zgetc2.f index 2e86f694e2..649820bc56 100644 --- a/SRC/zgetc2.f +++ b/SRC/zgetc2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetf2.f b/SRC/zgetf2.f index c953988fd2..7c63dbbeee 100644 --- a/SRC/zgetf2.f +++ b/SRC/zgetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrf.f b/SRC/zgetrf.f index 7c8cae27aa..51a92e8155 100644 --- a/SRC/zgetrf.f +++ b/SRC/zgetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrf2.f b/SRC/zgetrf2.f index a0dd98e1bb..a493bf5c42 100644 --- a/SRC/zgetrf2.f +++ b/SRC/zgetrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetri.f b/SRC/zgetri.f index ab9c43a853..f063ed8376 100644 --- a/SRC/zgetri.f +++ b/SRC/zgetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetrs.f b/SRC/zgetrs.f index 1e6ec8946d..3c5969a356 100644 --- a/SRC/zgetrs.f +++ b/SRC/zgetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index 0de8270ad4..26311c611b 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETSLS * * Definition: diff --git a/SRC/zgetsqrhrt.f b/SRC/zgetsqrhrt.f index 35ee2dace9..b9ebaadd47 100644 --- a/SRC/zgetsqrhrt.f +++ b/SRC/zgetsqrhrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGETSQRHRT * * =========== DOCUMENTATION =========== diff --git a/SRC/zggbak.f b/SRC/zggbak.f index 129842f3fe..0765e6b8f4 100644 --- a/SRC/zggbak.f +++ b/SRC/zggbak.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGBAK * * =========== DOCUMENTATION =========== diff --git a/SRC/zggbal.f b/SRC/zggbal.f index 89e736e375..56e1c0011e 100644 --- a/SRC/zggbal.f +++ b/SRC/zggbal.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGBAL * * =========== DOCUMENTATION =========== diff --git a/SRC/zgges.f b/SRC/zgges.f index 673f38ba5f..abc8e52613 100644 --- a/SRC/zgges.f +++ b/SRC/zgges.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgges3.f b/SRC/zgges3.f index bfabead6e6..5186cf0d61 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/zggesx.f b/SRC/zggesx.f index 5f334c5b10..2a87f13d7a 100644 --- a/SRC/zggesx.f +++ b/SRC/zggesx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggev.f b/SRC/zggev.f index fe182fd66c..25999af511 100644 --- a/SRC/zggev.f +++ b/SRC/zggev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggev3.f b/SRC/zggev3.f index b68184fe09..fdb0f32f01 100644 --- a/SRC/zggev3.f +++ b/SRC/zggev3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) * * =========== DOCUMENTATION =========== diff --git a/SRC/zggevx.f b/SRC/zggevx.f index 53d6b38fae..cd3eb57b1b 100644 --- a/SRC/zggevx.f +++ b/SRC/zggevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggglm.f b/SRC/zggglm.f index f4184eab13..6a7c3da5fe 100644 --- a/SRC/zggglm.f +++ b/SRC/zggglm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGGLM * * =========== DOCUMENTATION =========== diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f index d4f34087d9..d78f27e690 100644 --- a/SRC/zgghd3.f +++ b/SRC/zgghd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGHD3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgghrd.f b/SRC/zgghrd.f index 4a6c7d321c..ee43f5aea9 100644 --- a/SRC/zgghrd.f +++ b/SRC/zgghrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGHRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zgglse.f b/SRC/zgglse.f index aca2b6ff63..abefbae1e5 100644 --- a/SRC/zgglse.f +++ b/SRC/zgglse.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGLSE solves overdetermined or underdetermined systems for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggqrf.f b/SRC/zggqrf.f index 0506fcf414..9ac978c720 100644 --- a/SRC/zggqrf.f +++ b/SRC/zggqrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGQRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zggrqf.f b/SRC/zggrqf.f index 76b5488841..69c14af245 100644 --- a/SRC/zggrqf.f +++ b/SRC/zggrqf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGRQF * * =========== DOCUMENTATION =========== diff --git a/SRC/zggsvd3.f b/SRC/zggsvd3.f index 73a8f01358..3ccc3fde55 100644 --- a/SRC/zggsvd3.f +++ b/SRC/zggsvd3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zggsvp3.f b/SRC/zggsvp3.f index 4ec1446633..0f663836a0 100644 --- a/SRC/zggsvp3.f +++ b/SRC/zggsvp3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGGSVP3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zgsvj0.f b/SRC/zgsvj0.f index a5ddadbd69..c0ab8a879d 100644 --- a/SRC/zgsvj0.f +++ b/SRC/zgsvj0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGSVJ0 pre-processor for the routine zgesvj. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgsvj1.f b/SRC/zgsvj1.f index f47bf9331d..8fdbe7124e 100644 --- a/SRC/zgsvj1.f +++ b/SRC/zgsvj1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGSVJ1 pre-processor for the routine zgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtcon.f b/SRC/zgtcon.f index c5ae8749d8..7248b4248a 100644 --- a/SRC/zgtcon.f +++ b/SRC/zgtcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtrfs.f b/SRC/zgtrfs.f index b61010a5c6..6ff55b3d39 100644 --- a/SRC/zgtrfs.f +++ b/SRC/zgtrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtsv.f b/SRC/zgtsv.f index 14cbad988c..08b640b33e 100644 --- a/SRC/zgtsv.f +++ b/SRC/zgtsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGTSV computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtsvx.f b/SRC/zgtsvx.f index 2a9dc11161..f38f5d8850 100644 --- a/SRC/zgtsvx.f +++ b/SRC/zgtsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zgttrf.f b/SRC/zgttrf.f index 585484b4c6..3529288aba 100644 --- a/SRC/zgttrf.f +++ b/SRC/zgttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zgttrs.f b/SRC/zgttrs.f index ca50380732..1b6197b9e2 100644 --- a/SRC/zgttrs.f +++ b/SRC/zgttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zgtts2.f b/SRC/zgtts2.f index c5a6aa84a2..6bd2a82c6b 100644 --- a/SRC/zgtts2.f +++ b/SRC/zgtts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZGTTS2 solves a system of linear equations with a tridiagonal matrix using the LU factorization computed by sgttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f index e890425f83..527738aa8e 100644 --- a/SRC/zhb2st_kernels.f +++ b/SRC/zhb2st_kernels.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHB2ST_KERNELS * * @precisions fortran z -> s d c diff --git a/SRC/zhbev.f b/SRC/zhbev.f index 0ae3cd55d9..f838d2aaaa 100644 --- a/SRC/zhbev.f +++ b/SRC/zhbev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbev_2stage.f b/SRC/zhbev_2stage.f index f8dc61fbf3..d1b2b95023 100644 --- a/SRC/zhbev_2stage.f +++ b/SRC/zhbev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbevd.f b/SRC/zhbevd.f index e7cc945de5..f1f6692883 100644 --- a/SRC/zhbevd.f +++ b/SRC/zhbevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbevd_2stage.f b/SRC/zhbevd_2stage.f index bcf6375d98..a104684538 100644 --- a/SRC/zhbevd_2stage.f +++ b/SRC/zhbevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbevx.f b/SRC/zhbevx.f index 9996ecd279..c0b9281842 100644 --- a/SRC/zhbevx.f +++ b/SRC/zhbevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbevx_2stage.f b/SRC/zhbevx_2stage.f index 101129e3b4..e03c398ee2 100644 --- a/SRC/zhbevx_2stage.f +++ b/SRC/zhbevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhbgst.f b/SRC/zhbgst.f index 6e09d0ea5f..7fd937533d 100644 --- a/SRC/zhbgst.f +++ b/SRC/zhbgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHBGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgv.f b/SRC/zhbgv.f index e84e249b90..3a1e0ffa29 100644 --- a/SRC/zhbgv.f +++ b/SRC/zhbgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHBGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgvd.f b/SRC/zhbgvd.f index 9324b892d2..8527cdc0fd 100644 --- a/SRC/zhbgvd.f +++ b/SRC/zhbgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHBGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbgvx.f b/SRC/zhbgvx.f index 094f754e11..bbd34f1ddf 100644 --- a/SRC/zhbgvx.f +++ b/SRC/zhbgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHBGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhbtrd.f b/SRC/zhbtrd.f index 424531eccd..17b10dc2fa 100644 --- a/SRC/zhbtrd.f +++ b/SRC/zhbtrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHBTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon.f b/SRC/zhecon.f index 6e80d5ede9..4b5172ba19 100644 --- a/SRC/zhecon.f +++ b/SRC/zhecon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHECON * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon_3.f b/SRC/zhecon_3.f index d5aaf57971..eb739fe1c1 100644 --- a/SRC/zhecon_3.f +++ b/SRC/zhecon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHECON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhecon_rook.f b/SRC/zhecon_rook.f index fc253c7cfc..4d37894429 100644 --- a/SRC/zhecon_rook.f +++ b/SRC/zhecon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/zheequb.f b/SRC/zheequb.f index 8e93544927..54333a581b 100644 --- a/SRC/zheequb.f +++ b/SRC/zheequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zheev.f b/SRC/zheev.f index 156636defb..abce95d1a4 100644 --- a/SRC/zheev.f +++ b/SRC/zheev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheev_2stage.f b/SRC/zheev_2stage.f index ba0f6408ee..764884c24d 100644 --- a/SRC/zheev_2stage.f +++ b/SRC/zheev_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevd.f b/SRC/zheevd.f index be776df585..559624bc13 100644 --- a/SRC/zheevd.f +++ b/SRC/zheevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevd_2stage.f b/SRC/zheevd_2stage.f index 781255eb30..379999e14f 100644 --- a/SRC/zheevd_2stage.f +++ b/SRC/zheevd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 16382d8969..94ad90f166 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevr_2stage.f b/SRC/zheevr_2stage.f index 5cb32e637b..7f1b36cfa9 100644 --- a/SRC/zheevr_2stage.f +++ b/SRC/zheevr_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVR_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zheevx.f b/SRC/zheevx.f index 6b9b58a347..f8696e4e5b 100644 --- a/SRC/zheevx.f +++ b/SRC/zheevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheevx_2stage.f b/SRC/zheevx_2stage.f index db582a0c43..91afb31008 100644 --- a/SRC/zheevx_2stage.f +++ b/SRC/zheevx_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices * * @precisions fortran z -> s d c diff --git a/SRC/zhegs2.f b/SRC/zhegs2.f index 1463dccc68..ae12e2974d 100644 --- a/SRC/zhegs2.f +++ b/SRC/zhegs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGS2 reduces a Hermitian definite generalized eigenproblem to standard form, using the factorization results obtained from cpotrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegst.f b/SRC/zhegst.f index ad2f6481c6..2420085a8a 100644 --- a/SRC/zhegst.f +++ b/SRC/zhegst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegv.f b/SRC/zhegv.f index 35f0d1a757..1309e9e41d 100644 --- a/SRC/zhegv.f +++ b/SRC/zhegv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegv_2stage.f b/SRC/zhegv_2stage.f index 1dfcbaf3d0..a067c28bb1 100644 --- a/SRC/zhegv_2stage.f +++ b/SRC/zhegv_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGV_2STAGE * * @precisions fortran z -> c diff --git a/SRC/zhegvd.f b/SRC/zhegvd.f index a4033115cf..3966685f33 100644 --- a/SRC/zhegvd.f +++ b/SRC/zhegvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhegvx.f b/SRC/zhegvx.f index a6a0550f58..6d7d9b903f 100644 --- a/SRC/zhegvx.f +++ b/SRC/zhegvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHEGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zherfs.f b/SRC/zherfs.f index 0390a35411..6253026bdc 100644 --- a/SRC/zherfs.f +++ b/SRC/zherfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHERFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zherfsx.f b/SRC/zherfsx.f index 8b429285bb..194569d3a0 100644 --- a/SRC/zherfsx.f +++ b/SRC/zherfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHERFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv.f b/SRC/zhesv.f index d5fa6dd19c..864e3a52ee 100644 --- a/SRC/zhesv.f +++ b/SRC/zhesv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESV computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_aa.f b/SRC/zhesv_aa.f index 2165625803..4ba71b83a8 100644 --- a/SRC/zhesv_aa.f +++ b/SRC/zhesv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESV_AA computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_aa_2stage.f b/SRC/zhesv_aa_2stage.f index 47d06416a7..aee87df199 100644 --- a/SRC/zhesv_aa_2stage.f +++ b/SRC/zhesv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_rk.f b/SRC/zhesv_rk.f index 3687a34f94..e242454b5a 100644 --- a/SRC/zhesv_rk.f +++ b/SRC/zhesv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesv_rook.f b/SRC/zhesv_rook.f index 225e6d1c2c..7b029281bb 100644 --- a/SRC/zhesv_rook.f +++ b/SRC/zhesv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the bounded Bunch-Kaufman ("rook") diagonal pivoting method * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesvx.f b/SRC/zhesvx.f index ae6844c4cb..629a7c586b 100644 --- a/SRC/zhesvx.f +++ b/SRC/zhesvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESVX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhesvxx.f b/SRC/zhesvxx.f index e590a020c7..a65a40db8c 100644 --- a/SRC/zhesvxx.f +++ b/SRC/zhesvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHESVXX computes the solution to system of linear equations A * X = B for HE matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zheswapr.f b/SRC/zheswapr.f index c59fb63f04..e8966ca125 100644 --- a/SRC/zheswapr.f +++ b/SRC/zheswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHESWAPR applies an elementary permutation on the rows and columns of a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetd2.f b/SRC/zhetd2.f index 47b98c3915..4637d13fec 100644 --- a/SRC/zhetd2.f +++ b/SRC/zhetd2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transformation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2.f b/SRC/zhetf2.f index 9baf9f992a..8a809f3a8a 100644 --- a/SRC/zhetf2.f +++ b/SRC/zhetf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (unblocked algorithm, calling Level 2 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2_rk.f b/SRC/zhetf2_rk.f index fa027f0cbf..4973be3319 100644 --- a/SRC/zhetf2_rk.f +++ b/SRC/zhetf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetf2_rook.f b/SRC/zhetf2_rook.f index f7d372d5ad..f9f276a6a7 100644 --- a/SRC/zhetf2_rook.f +++ b/SRC/zhetf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd.f b/SRC/zhetrd.f index 58c230f9bd..273e87f38e 100644 --- a/SRC/zhetrd.f +++ b/SRC/zhetrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd_2stage.f b/SRC/zhetrd_2stage.f index 8163b18133..c24a1f2afe 100644 --- a/SRC/zhetrd_2stage.f +++ b/SRC/zhetrd_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRD_2STAGE * * @precisions fortran z -> s d c diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index 4d86b8434d..4e85f69721 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRD_HE2HB * * @precisions fortran z -> s d c diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f index d02a0ccdaa..141cd01b11 100644 --- a/SRC/zhetrf.f +++ b/SRC/zhetrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_aa.f b/SRC/zhetrf_aa.f index d1b2264e18..1967aaa12b 100644 --- a/SRC/zhetrf_aa.f +++ b/SRC/zhetrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_aa_2stage.f b/SRC/zhetrf_aa_2stage.f index fe229d0c54..2dbb6047c1 100644 --- a/SRC/zhetrf_aa_2stage.f +++ b/SRC/zhetrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f index f99aa3eb2c..16deddbeed 100644 --- a/SRC/zhetrf_rk.f +++ b/SRC/zhetrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrf_rook.f b/SRC/zhetrf_rook.f index 4f4578024b..d1dac08b8c 100644 --- a/SRC/zhetrf_rook.f +++ b/SRC/zhetrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri.f b/SRC/zhetri.f index 3633c034c6..0e3b8a13ae 100644 --- a/SRC/zhetri.f +++ b/SRC/zhetri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f index d5d51cd83c..1d932b866c 100644 --- a/SRC/zhetri2.f +++ b/SRC/zhetri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri2x.f b/SRC/zhetri2x.f index 04cbb2d039..fc996115bc 100644 --- a/SRC/zhetri2x.f +++ b/SRC/zhetri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_3.f b/SRC/zhetri_3.f index 2c901d8132..30b82e6d68 100644 --- a/SRC/zhetri_3.f +++ b/SRC/zhetri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_3x.f b/SRC/zhetri_3x.f index 89e2c6d641..863c51f211 100644 --- a/SRC/zhetri_3x.f +++ b/SRC/zhetri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetri_rook.f b/SRC/zhetri_rook.f index 7714557a58..7143a0ebf2 100644 --- a/SRC/zhetri_rook.f +++ b/SRC/zhetri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs.f b/SRC/zhetrs.f index e5f7f208a0..af77bcffa8 100644 --- a/SRC/zhetrs.f +++ b/SRC/zhetrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs2.f b/SRC/zhetrs2.f index 36c0a23beb..a97731cabb 100644 --- a/SRC/zhetrs2.f +++ b/SRC/zhetrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_3.f b/SRC/zhetrs_3.f index 7bf61b3416..a6ad12885a 100644 --- a/SRC/zhetrs_3.f +++ b/SRC/zhetrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f index da540f8725..e596f9d0ac 100644 --- a/SRC/zhetrs_aa.f +++ b/SRC/zhetrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrs_aa_2stage.f b/SRC/zhetrs_aa_2stage.f index f26df2959e..60ab021083 100644 --- a/SRC/zhetrs_aa_2stage.f +++ b/SRC/zhetrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS_AA_2STAGE * * @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017 diff --git a/SRC/zhetrs_rook.f b/SRC/zhetrs_rook.f index 84b430624e..25c5951569 100644 --- a/SRC/zhetrs_rook.f +++ b/SRC/zhetrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using factorization obtained with one of the bounded diagonal pivoting methods (max 2 interchanges) * * =========== DOCUMENTATION =========== diff --git a/SRC/zhfrk.f b/SRC/zhfrk.f index c085656566..5acfb1cd15 100644 --- a/SRC/zhfrk.f +++ b/SRC/zhfrk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHFRK performs a Hermitian rank-k operation for matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/zhgeqz.f b/SRC/zhgeqz.f index e2c8aed1ca..5ccf71b921 100644 --- a/SRC/zhgeqz.f +++ b/SRC/zhgeqz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHGEQZ * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpcon.f b/SRC/zhpcon.f index a65a63cebb..92c4445849 100644 --- a/SRC/zhpcon.f +++ b/SRC/zhpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpev.f b/SRC/zhpev.f index 24315b835c..b72e680b98 100644 --- a/SRC/zhpev.f +++ b/SRC/zhpev.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpevd.f b/SRC/zhpevd.f index 468974dc1c..5f8727d4b8 100644 --- a/SRC/zhpevd.f +++ b/SRC/zhpevd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHPEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpevx.f b/SRC/zhpevx.f index bb91ac63e5..4b797f6b04 100644 --- a/SRC/zhpevx.f +++ b/SRC/zhpevx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgst.f b/SRC/zhpgst.f index 9469d106fe..2628e3059f 100644 --- a/SRC/zhpgst.f +++ b/SRC/zhpgst.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPGST * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgv.f b/SRC/zhpgv.f index fb308ebe53..efaf884d25 100644 --- a/SRC/zhpgv.f +++ b/SRC/zhpgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPGV * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgvd.f b/SRC/zhpgvd.f index 21b7a18a04..98a2dd8654 100644 --- a/SRC/zhpgvd.f +++ b/SRC/zhpgvd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPGVD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpgvx.f b/SRC/zhpgvx.f index 226037a2d4..d3bbe9ad1d 100644 --- a/SRC/zhpgvx.f +++ b/SRC/zhpgvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPGVX * * =========== DOCUMENTATION =========== diff --git a/SRC/zhprfs.f b/SRC/zhprfs.f index 63b221f61d..e765171e21 100644 --- a/SRC/zhprfs.f +++ b/SRC/zhprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpsv.f b/SRC/zhpsv.f index 9173b162fd..9a83d3bed5 100644 --- a/SRC/zhpsv.f +++ b/SRC/zhpsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhpsvx.f b/SRC/zhpsvx.f index d526e49ba3..32b90fb34e 100644 --- a/SRC/zhpsvx.f +++ b/SRC/zhpsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrd.f b/SRC/zhptrd.f index 7d335e0495..a2892b22e5 100644 --- a/SRC/zhptrd.f +++ b/SRC/zhptrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPTRD * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrf.f b/SRC/zhptrf.f index 7802c98b63..15395ce90e 100644 --- a/SRC/zhptrf.f +++ b/SRC/zhptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptri.f b/SRC/zhptri.f index 1ef2a9bda0..8bca3f824b 100644 --- a/SRC/zhptri.f +++ b/SRC/zhptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zhptrs.f b/SRC/zhptrs.f index b1459fb960..5d3495a552 100644 --- a/SRC/zhptrs.f +++ b/SRC/zhptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zhsein.f b/SRC/zhsein.f index 5cf4055bf4..fc902e4391 100644 --- a/SRC/zhsein.f +++ b/SRC/zhsein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHSEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/zhseqr.f b/SRC/zhseqr.f index 6882c2b1c9..12f060144c 100644 --- a/SRC/zhseqr.f +++ b/SRC/zhseqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHSEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbamv.f b/SRC/zla_gbamv.f index e403c5677e..31131b3754 100644 --- a/SRC/zla_gbamv.f +++ b/SRC/zla_gbamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GBAMV performs a matrix-vector operation to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrcond_c.f b/SRC/zla_gbrcond_c.f index a74a85bff2..616680be10 100644 --- a/SRC/zla_gbrcond_c.f +++ b/SRC/zla_gbrcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GBRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrcond_x.f b/SRC/zla_gbrcond_x.f index c4b2c9192c..08e94c7e63 100644 --- a/SRC/zla_gbrcond_x.f +++ b/SRC/zla_gbrcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GBRCOND_X computes the infinity norm condition number of op(A)*diag(x) for general banded matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrfsx_extended.f b/SRC/zla_gbrfsx_extended.f index 091363f117..ac046d1f4e 100644 --- a/SRC/zla_gbrfsx_extended.f +++ b/SRC/zla_gbrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GBRFSX_EXTENDED improves the computed solution to a system of linear equations for general banded matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gbrpvgrw.f b/SRC/zla_gbrpvgrw.f index 216cd46e11..26bd8b9deb 100644 --- a/SRC/zla_gbrpvgrw.f +++ b/SRC/zla_gbrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_geamv.f b/SRC/zla_geamv.f index 64b69c63ba..ce587ededc 100644 --- a/SRC/zla_geamv.f +++ b/SRC/zla_geamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GEAMV computes a matrix-vector product using a general matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gercond_c.f b/SRC/zla_gercond_c.f index 7fd26bc208..ff29d36555 100644 --- a/SRC/zla_gercond_c.f +++ b/SRC/zla_gercond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gercond_x.f b/SRC/zla_gercond_x.f index 731fa36d56..b1bea56972 100644 --- a/SRC/zla_gercond_x.f +++ b/SRC/zla_gercond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GERCOND_X computes the infinity norm condition number of op(A)*diag(x) for general matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gerfsx_extended.f b/SRC/zla_gerfsx_extended.f index 2058bc1fdb..59fa9ceeff 100644 --- a/SRC/zla_gerfsx_extended.f +++ b/SRC/zla_gerfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GERFSX_EXTENDED * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_gerpvgrw.f b/SRC/zla_gerpvgrw.f index a9ec9717c7..b0c502f21c 100644 --- a/SRC/zla_gerpvgrw.f +++ b/SRC/zla_gerpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_GERPVGRW multiplies a square real matrix by a complex matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_heamv.f b/SRC/zla_heamv.f index 69ef36bfe0..d17f504ef3 100644 --- a/SRC/zla_heamv.f +++ b/SRC/zla_heamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_HEAMV computes a matrix-vector product using a Hermitian indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_hercond_c.f b/SRC/zla_hercond_c.f index 6185cc9f35..9dcda014fe 100644 --- a/SRC/zla_hercond_c.f +++ b/SRC/zla_hercond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_hercond_x.f b/SRC/zla_hercond_x.f index 35932d16ed..b3650cd808 100644 --- a/SRC/zla_hercond_x.f +++ b/SRC/zla_hercond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_herfsx_extended.f b/SRC/zla_herfsx_extended.f index 5c6acf3be7..d79a23b6c6 100644 --- a/SRC/zla_herfsx_extended.f +++ b/SRC/zla_herfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_HERFSX_EXTENDED improves the computed solution to a system of linear equations for Hermitian indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_herpvgrw.f b/SRC/zla_herpvgrw.f index 1e8213a70c..bb12c294c5 100644 --- a/SRC/zla_herpvgrw.f +++ b/SRC/zla_herpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_HERPVGRW * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_lin_berr.f b/SRC/zla_lin_berr.f index cfd4f0cea6..b07efd568b 100644 --- a/SRC/zla_lin_berr.f +++ b/SRC/zla_lin_berr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_LIN_BERR computes a component-wise relative backward error. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porcond_c.f b/SRC/zla_porcond_c.f index 8d44948fd9..0376fae742 100644 --- a/SRC/zla_porcond_c.f +++ b/SRC/zla_porcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_PORCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porcond_x.f b/SRC/zla_porcond_x.f index 37440e5190..36e4dc844e 100644 --- a/SRC/zla_porcond_x.f +++ b/SRC/zla_porcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_PORCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian positive-definite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porfsx_extended.f b/SRC/zla_porfsx_extended.f index 4f3d07c36c..f788b0f7e3 100644 --- a/SRC/zla_porfsx_extended.f +++ b/SRC/zla_porfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_PORFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric or Hermitian positive-definite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_porpvgrw.f b/SRC/zla_porpvgrw.f index b6b55ba7f9..146432531e 100644 --- a/SRC/zla_porpvgrw.f +++ b/SRC/zla_porpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_PORPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric or Hermitian positive-definite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syamv.f b/SRC/zla_syamv.f index 6b7d376159..db8bc95bc0 100644 --- a/SRC/zla_syamv.f +++ b/SRC/zla_syamv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_SYAMV computes a matrix-vector product using a symmetric indefinite matrix to calculate error bounds. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrcond_c.f b/SRC/zla_syrcond_c.f index 1ffd490027..3a4056e7c2 100644 --- a/SRC/zla_syrcond_c.f +++ b/SRC/zla_syrcond_c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrcond_x.f b/SRC/zla_syrcond_x.f index b22c01c970..b5591aadb6 100644 --- a/SRC/zla_syrcond_x.f +++ b/SRC/zla_syrcond_x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_SYRCOND_X computes the infinity norm condition number of op(A)*diag(x) for symmetric indefinite matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrfsx_extended.f b/SRC/zla_syrfsx_extended.f index 737dcfaf34..751d6be2eb 100644 --- a/SRC/zla_syrfsx_extended.f +++ b/SRC/zla_syrfsx_extended.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_SYRFSX_EXTENDED improves the computed solution to a system of linear equations for symmetric indefinite matrices by performing extra-precise iterative refinement and provides error bounds and backward error estimates for the solution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_syrpvgrw.f b/SRC/zla_syrpvgrw.f index 44acc0801b..cba0a62ffe 100644 --- a/SRC/zla_syrpvgrw.f +++ b/SRC/zla_syrpvgrw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zla_wwaddw.f b/SRC/zla_wwaddw.f index 8288806f15..18d415967a 100644 --- a/SRC/zla_wwaddw.f +++ b/SRC/zla_wwaddw.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLA_WWADDW adds a vector into a doubled-single vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlabrd.f b/SRC/zlabrd.f index 9a74d94dd3..a725343590 100644 --- a/SRC/zlabrd.f +++ b/SRC/zlabrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacgv.f b/SRC/zlacgv.f index d28a55d7f0..1496def6a1 100644 --- a/SRC/zlacgv.f +++ b/SRC/zlacgv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACGV conjugates a complex vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacn2.f b/SRC/zlacn2.f index 88ee1a7a58..14f437e5ba 100644 --- a/SRC/zlacn2.f +++ b/SRC/zlacn2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacon.f b/SRC/zlacon.f index b6c7c1e9ba..687fd8e15f 100644 --- a/SRC/zlacon.f +++ b/SRC/zlacon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacp2.f b/SRC/zlacp2.f index 32c5c01ad1..0b32918e07 100644 --- a/SRC/zlacp2.f +++ b/SRC/zlacp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACP2 copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacpy.f b/SRC/zlacpy.f index 9f7795c665..bb4f3d192b 100644 --- a/SRC/zlacpy.f +++ b/SRC/zlacpy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACPY copies all or part of one two-dimensional array to another. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacrm.f b/SRC/zlacrm.f index 1093f3b73c..1d09e34260 100644 --- a/SRC/zlacrm.f +++ b/SRC/zlacrm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACRM multiplies a complex matrix by a square real matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlacrt.f b/SRC/zlacrt.f index 69935ea97f..7d48ec40fb 100644 --- a/SRC/zlacrt.f +++ b/SRC/zlacrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLACRT performs a linear transformation of a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zladiv.f b/SRC/zladiv.f index f211f30ad5..74a5414e5c 100644 --- a/SRC/zladiv.f +++ b/SRC/zladiv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed0.f b/SRC/zlaed0.f index 245ffe909b..526daef202 100644 --- a/SRC/zlaed0.f +++ b/SRC/zlaed0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAED0 used by ZSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmetric tridiagonal matrix using the divide and conquer method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed7.f b/SRC/zlaed7.f index 4e2c5580bc..05dc11c79f 100644 --- a/SRC/zlaed7.f +++ b/SRC/zlaed7.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAED7 used by ZSTEDC. Computes the updated eigensystem of a diagonal matrix after modification by a rank-one symmetric matrix. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaed8.f b/SRC/zlaed8.f index bddda985b5..298f5b46ba 100644 --- a/SRC/zlaed8.f +++ b/SRC/zlaed8.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAED8 used by ZSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matrix is dense. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaein.f b/SRC/zlaein.f index bb2bff0d1d..275a7c95d9 100644 --- a/SRC/zlaein.f +++ b/SRC/zlaein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iteration. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaesy.f b/SRC/zlaesy.f index d6a5a45c2e..2dd3f36a37 100644 --- a/SRC/zlaesy.f +++ b/SRC/zlaesy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAESY computes the eigenvalues and eigenvectors of a 2-by-2 complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaev2.f b/SRC/zlaev2.f index 299ae50c9e..2440753644 100644 --- a/SRC/zlaev2.f +++ b/SRC/zlaev2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAEV2 computes the eigenvalues and eigenvectors of a 2-by-2 symmetric/Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlag2c.f b/SRC/zlag2c.f index 6497a33946..f30536854a 100644 --- a/SRC/zlag2c.f +++ b/SRC/zlag2c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAG2C converts a complex double precision matrix to a complex single precision matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlags2.f b/SRC/zlags2.f index 96c95495eb..86ac4d2391 100644 --- a/SRC/zlags2.f +++ b/SRC/zlags2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAGS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlagtm.f b/SRC/zlagtm.f index c74259fd1a..df14b88808 100644 --- a/SRC/zlagtm.f +++ b/SRC/zlagtm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix, B and C are rectangular matrices, and α and β are scalars, which may be 0, 1, or -1. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef.f b/SRC/zlahef.f index f9147d2add..1df25bea06 100644 --- a/SRC/zlahef.f +++ b/SRC/zlahef.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAHEF computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kaufman diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_aa.f b/SRC/zlahef_aa.f index 42c499b11b..1d3b650232 100644 --- a/SRC/zlahef_aa.f +++ b/SRC/zlahef_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAHEF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_rk.f b/SRC/zlahef_rk.f index 753c0a9d23..3e9b2dcc9b 100644 --- a/SRC/zlahef_rk.f +++ b/SRC/zlahef_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAHEF_RK computes a partial factorization of a complex Hermitian indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahef_rook.f b/SRC/zlahef_rook.f index 5a50ced2c9..60e58aaffd 100644 --- a/SRC/zlahef_rook.f +++ b/SRC/zlahef_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" * \brief \b ZLAHEF_ROOK computes a partial factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (blocked algorithm, calling Level 3 BLAS). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahqr.f b/SRC/zlahqr.f index 77f75b74f6..2dce7abf75 100644 --- a/SRC/zlahqr.f +++ b/SRC/zlahqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix, using the double-shift/single-shift QR algorithm. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlahr2.f b/SRC/zlahr2.f index 87d1ebf864..316afedb13 100644 --- a/SRC/zlahr2.f +++ b/SRC/zlahr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAHR2 reduces the specified number of first columns of a general rectangular matrix A so that elements below the specified subdiagonal are zero, and returns auxiliary matrices which are needed to apply the transformation to the unreduced part of A. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaic1.f b/SRC/zlaic1.f index 1d8b454e87..4cc4282de3 100644 --- a/SRC/zlaic1.f +++ b/SRC/zlaic1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAIC1 applies one step of incremental condition estimation. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlals0.f b/SRC/zlals0.f index 694e924e9d..18037e69b0 100644 --- a/SRC/zlals0.f +++ b/SRC/zlals0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer SVD approach. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlalsa.f b/SRC/zlalsa.f index e801580a6a..67b9a4bcc4 100644 --- a/SRC/zlalsa.f +++ b/SRC/zlalsa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlalsd.f b/SRC/zlalsd.f index 264ec68a2f..cb7b33f883 100644 --- a/SRC/zlalsd.f +++ b/SRC/zlalsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLALSD uses the singular value decomposition of A to solve the least squares problem. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f index a36ddcaefc..59a0a55581 100644 --- a/SRC/zlamswlq.f +++ b/SRC/zlamswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAMSWLQ * * Definition: diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f index 16a6de3beb..03770c06e3 100644 --- a/SRC/zlamtsqr.f +++ b/SRC/zlamtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAMTSQR * * Definition: diff --git a/SRC/zlangb.f b/SRC/zlangb.f index 2e162858de..8a6a6c8132 100644 --- a/SRC/zlangb.f +++ b/SRC/zlangb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of general band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlange.f b/SRC/zlange.f index 530c1e7ada..78e5423ae7 100644 --- a/SRC/zlange.f +++ b/SRC/zlange.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlangt.f b/SRC/zlangt.f index 1afade3a91..1edc24b06b 100644 --- a/SRC/zlangt.f +++ b/SRC/zlangt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of a general tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhb.f b/SRC/zlanhb.f index 027780f1bf..a7bb10ff23 100644 --- a/SRC/zlanhb.f +++ b/SRC/zlanhb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhe.f b/SRC/zlanhe.f index 31a14b5de1..01431ffb54 100644 --- a/SRC/zlanhe.f +++ b/SRC/zlanhe.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhf.f b/SRC/zlanhf.f index 42ef4ecbac..a3534854b5 100644 --- a/SRC/zlanhf.f +++ b/SRC/zlanhf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhp.f b/SRC/zlanhp.f index aa17ce9a16..0f06b99563 100644 --- a/SRC/zlanhp.f +++ b/SRC/zlanhp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanhs.f b/SRC/zlanhs.f index 481434aa3c..7a1c00cf1e 100644 --- a/SRC/zlanhs.f +++ b/SRC/zlanhs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlanht.f b/SRC/zlanht.f index c34fcc3b42..573a665a2f 100644 --- a/SRC/zlanht.f +++ b/SRC/zlanht.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANHT returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian tridiagonal matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansb.f b/SRC/zlansb.f index 1918361226..5dddf53a55 100644 --- a/SRC/zlansb.f +++ b/SRC/zlansb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansp.f b/SRC/zlansp.f index 5ec1419d10..33f649e19e 100644 --- a/SRC/zlansp.f +++ b/SRC/zlansp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlansy.f b/SRC/zlansy.f index 297c04323b..436e07bf5d 100644 --- a/SRC/zlansy.f +++ b/SRC/zlansy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantb.f b/SRC/zlantb.f index 3aec962dde..89b0daadef 100644 --- a/SRC/zlantb.f +++ b/SRC/zlantb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantp.f b/SRC/zlantp.f index 6d5e21edf6..5e4ce52ee8 100644 --- a/SRC/zlantp.f +++ b/SRC/zlantp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlantr.f b/SRC/zlantr.f index 593d98cebc..13efbffa13 100644 --- a/SRC/zlantr.f +++ b/SRC/zlantr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapll.f b/SRC/zlapll.f index b567d0e686..ee5111cf00 100644 --- a/SRC/zlapll.f +++ b/SRC/zlapll.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAPLL measures the linear dependence of two vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapmr.f b/SRC/zlapmr.f index d730c3c95f..f9c0b4ea88 100644 --- a/SRC/zlapmr.f +++ b/SRC/zlapmr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAPMR rearranges rows of a matrix as specified by a permutation vector. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlapmt.f b/SRC/zlapmt.f index f382f9c633..b7fe771467 100644 --- a/SRC/zlapmt.f +++ b/SRC/zlapmt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAPMT performs a forward or backward permutation of the columns of a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqgb.f b/SRC/zlaqgb.f index 766b9baa74..57be950e02 100644 --- a/SRC/zlaqgb.f +++ b/SRC/zlaqgb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqge.f b/SRC/zlaqge.f index adcc6ac688..270ed0f9cf 100644 --- a/SRC/zlaqge.f +++ b/SRC/zlaqge.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhb.f b/SRC/zlaqhb.f index 9c7892dacc..9794ba09e4 100644 --- a/SRC/zlaqhb.f +++ b/SRC/zlaqhb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhe.f b/SRC/zlaqhe.f index 0484791cee..5de8e3fc96 100644 --- a/SRC/zlaqhe.f +++ b/SRC/zlaqhe.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQHE scales a Hermitian matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqhp.f b/SRC/zlaqhp.f index 3eb1550a31..1baebbb06d 100644 --- a/SRC/zlaqhp.f +++ b/SRC/zlaqhp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQHP scales a Hermitian matrix stored in packed form. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqp2.f b/SRC/zlaqp2.f index 85a166736e..ee47f5119b 100644 --- a/SRC/zlaqp2.f +++ b/SRC/zlaqp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQP2 computes a QR factorization with column pivoting of the matrix block. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqp2rk.f b/SRC/zlaqp2rk.f index 035799b3d2..f6bf555c26 100644 --- a/SRC/zlaqp2rk.f +++ b/SRC/zlaqp2rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqp3rk.f b/SRC/zlaqp3rk.f index df56bcffed..28bc517c3c 100644 --- a/SRC/zlaqp3rk.f +++ b/SRC/zlaqp3rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqps.f b/SRC/zlaqps.f index 7cb95b5b17..d4282fb74c 100644 --- a/SRC/zlaqps.f +++ b/SRC/zlaqps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQPS computes a step of QR factorization with column pivoting of a real m-by-n matrix A by using BLAS level 3. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr0.f b/SRC/zlaqr0.f index 025ed43b59..7f397e9c9c 100644 --- a/SRC/zlaqr0.f +++ b/SRC/zlaqr0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr1.f b/SRC/zlaqr1.f index 5da941f4ba..a03645389f 100644 --- a/SRC/zlaqr1.f +++ b/SRC/zlaqr1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr2.f b/SRC/zlaqr2.f index e1a741498b..e29c3875a8 100644 --- a/SRC/zlaqr2.f +++ b/SRC/zlaqr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR2 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index 4a0cd79b06..a6f962611c 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR3 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr4.f b/SRC/zlaqr4.f index efb34c9ef4..83657195bb 100644 --- a/SRC/zlaqr4.f +++ b/SRC/zlaqr4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR4 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur decomposition. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqr5.f b/SRC/zlaqr5.f index 2c19dac3bb..9ad1e787d1 100644 --- a/SRC/zlaqr5.f +++ b/SRC/zlaqr5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQR5 performs a single small-bulge multi-shift QR sweep. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsb.f b/SRC/zlaqsb.f index 65aa58284e..9cc707a26c 100644 --- a/SRC/zlaqsb.f +++ b/SRC/zlaqsb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsp.f b/SRC/zlaqsp.f index 5e05c83657..14bfe4738f 100644 --- a/SRC/zlaqsp.f +++ b/SRC/zlaqsp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQSP scales a symmetric/Hermitian matrix in packed storage, using scaling factors computed by sppequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqsy.f b/SRC/zlaqsy.f index 426a2de302..be4088e061 100644 --- a/SRC/zlaqsy.f +++ b/SRC/zlaqsy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz0.f b/SRC/zlaqz0.f index 70b513a282..05a99761da 100644 --- a/SRC/zlaqz0.f +++ b/SRC/zlaqz0.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQZ0 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz1.f b/SRC/zlaqz1.f index 3b02e8f297..e7786fc32e 100644 --- a/SRC/zlaqz1.f +++ b/SRC/zlaqz1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQZ1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz2.f b/SRC/zlaqz2.f index 8695497cd8..283e20bad3 100644 --- a/SRC/zlaqz2.f +++ b/SRC/zlaqz2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQZ2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaqz3.f b/SRC/zlaqz3.f index cd10e1bcaf..8d2a3889f0 100644 --- a/SRC/zlaqz3.f +++ b/SRC/zlaqz3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAQZ3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlar1v.f b/SRC/zlar1v.f index f49de8441e..a548af50bd 100644 --- a/SRC/zlar1v.f +++ b/SRC/zlar1v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAR1V computes the (scaled) r-th column of the inverse of the submatrix in rows b1 through bn of the tridiagonal matrix LDLT - λI. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlar2v.f b/SRC/zlar2v.f index 2c2839b3da..84e98d0ae6 100644 --- a/SRC/zlar2v.f +++ b/SRC/zlar2v.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAR2V applies a vector of plane rotations with real cosines and complex sines from both sides to a sequence of 2-by-2 symmetric/Hermitian matrices. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarcm.f b/SRC/zlarcm.f index b0e8062c7a..a717b57d44 100644 --- a/SRC/zlarcm.f +++ b/SRC/zlarcm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARCM copies all or part of a real two-dimensional array to a complex array. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarf.f b/SRC/zlarf.f index 15127e6166..4aa6a824d6 100644 --- a/SRC/zlarf.f +++ b/SRC/zlarf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARF applies an elementary reflector to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfb.f b/SRC/zlarfb.f index beccaa0fdf..1a495fc183 100644 --- a/SRC/zlarfb.f +++ b/SRC/zlarfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfb_gett.f b/SRC/zlarfb_gett.f index 9f1481b467..63d4390925 100644 --- a/SRC/zlarfb_gett.f +++ b/SRC/zlarfb_gett.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFB_GETT * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfg.f b/SRC/zlarfg.f index 3e0d2d8d90..c3eda21bb0 100644 --- a/SRC/zlarfg.f +++ b/SRC/zlarfg.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFG generates an elementary reflector (Householder matrix). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f index cd3404f1c7..2db8d7cb06 100644 --- a/SRC/zlarfgp.f +++ b/SRC/zlarfgp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFGP generates an elementary reflector (Householder matrix) with non-negative beta. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarft.f b/SRC/zlarft.f index 958c77e27f..be773becc2 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfx.f b/SRC/zlarfx.f index 5672e62315..f7920bce44 100644 --- a/SRC/zlarfx.f +++ b/SRC/zlarfx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarfy.f b/SRC/zlarfy.f index 7568127628..9f7c56430b 100644 --- a/SRC/zlarfy.f +++ b/SRC/zlarfy.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARFY * * =========== DOCUMENTATION =========== diff --git a/SRC/zlargv.f b/SRC/zlargv.f index 9e489933c0..a75f44e1a7 100644 --- a/SRC/zlargv.f +++ b/SRC/zlargv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARGV generates a vector of plane rotations with real cosines and complex sines. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarnv.f b/SRC/zlarnv.f index fef269fc91..6752b237b7 100644 --- a/SRC/zlarnv.f +++ b/SRC/zlarnv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARNV returns a vector of random numbers from a uniform or normal distribution. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarrv.f b/SRC/zlarrv.f index d18e6a2c9e..46e9c7fe3d 100644 --- a/SRC/zlarrv.f +++ b/SRC/zlarrv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARRV computes the eigenvectors of the tridiagonal matrix T = L D LT given L, D and the eigenvalues of L D LT. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarscl2.f b/SRC/zlarscl2.f index 536122f72e..dcf68e83d0 100644 --- a/SRC/zlarscl2.f +++ b/SRC/zlarscl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARSCL2 performs reciprocal diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlartg.f90 b/SRC/zlartg.f90 index a71130f811..566b80a260 100644 --- a/SRC/zlartg.f90 +++ b/SRC/zlartg.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b ZLARTG generates a plane rotation with real cosine and complex sine. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zlartv.f b/SRC/zlartv.f index 44bdc4a526..5b9346e9b8 100644 --- a/SRC/zlartv.f +++ b/SRC/zlartv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARTV applies a vector of plane rotations with real cosines and complex sines to the elements of a pair of vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarz.f b/SRC/zlarz.f index 51f24f852b..521c6c4171 100644 --- a/SRC/zlarz.f +++ b/SRC/zlarz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARZ applies an elementary reflector (as returned by stzrzf) to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarzb.f b/SRC/zlarzb.f index 584c3fade6..78905cc1ed 100644 --- a/SRC/zlarzb.f +++ b/SRC/zlarzb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARZB applies a block reflector or its conjugate-transpose to a general matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlarzt.f b/SRC/zlarzt.f index 20a463a83a..769ca4467e 100644 --- a/SRC/zlarzt.f +++ b/SRC/zlarzt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLARZT forms the triangular factor T of a block reflector H = I - vtvH. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlascl.f b/SRC/zlascl.f index 5001851cff..eb7d875279 100644 --- a/SRC/zlascl.f +++ b/SRC/zlascl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlascl2.f b/SRC/zlascl2.f index dc44cbc1a0..1309af8125 100644 --- a/SRC/zlascl2.f +++ b/SRC/zlascl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASCL2 performs diagonal scaling on a matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaset.f b/SRC/zlaset.f index 0de5fc1a81..bbeeb50cfb 100644 --- a/SRC/zlaset.f +++ b/SRC/zlaset.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasr.f b/SRC/zlasr.f index dbd3189947..43daf84f40 100644 --- a/SRC/zlasr.f +++ b/SRC/zlasr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASR applies a sequence of plane rotations to a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlassq.f90 b/SRC/zlassq.f90 index f2ab6a4319..c352147664 100644 --- a/SRC/zlassq.f90 +++ b/SRC/zlassq.f90 @@ -1,4 +1,3 @@ -#include "lapack_64.h" !> \brief \b ZLASSQ updates a sum of squares represented in scaled form. ! ! =========== DOCUMENTATION =========== diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f index a7cc0f45df..7352071320 100644 --- a/SRC/zlaswlq.f +++ b/SRC/zlaswlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASWLQ * * Definition: diff --git a/SRC/zlaswp.f b/SRC/zlaswp.f index 62cbcfa611..8ec7bd80ac 100644 --- a/SRC/zlaswp.f +++ b/SRC/zlaswp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASWP performs a series of row interchanges on a general rectangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf.f b/SRC/zlasyf.f index 0f10c6af21..d5728b00a5 100644 --- a/SRC/zlasyf.f +++ b/SRC/zlasyf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASYF computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_aa.f b/SRC/zlasyf_aa.f index d27ab74b17..732ccb76d1 100644 --- a/SRC/zlasyf_aa.f +++ b/SRC/zlasyf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASYF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_rk.f b/SRC/zlasyf_rk.f index 7f1d1d0f58..29a6684b67 100644 --- a/SRC/zlasyf_rk.f +++ b/SRC/zlasyf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASYF_RK computes a partial factorization of a complex symmetric indefinite matrix using bounded Bunch-Kaufman (rook) diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlasyf_rook.f b/SRC/zlasyf_rook.f index 16ecd98bd0..3d1c1c9cdd 100644 --- a/SRC/zlasyf_rook.f +++ b/SRC/zlasyf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLASYF_ROOK computes a partial factorization of a complex symmetric matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlat2c.f b/SRC/zlat2c.f index 7c4b455bfb..57f0680bff 100644 --- a/SRC/zlat2c.f +++ b/SRC/zlat2c.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAT2C converts a double complex triangular matrix to a complex triangular matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatbs.f b/SRC/zlatbs.f index bb6329cd9b..84046aa83b 100644 --- a/SRC/zlatbs.f +++ b/SRC/zlatbs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATBS solves a triangular banded system of equations. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatdf.f b/SRC/zlatdf.f index 65a4c77205..24c142b51e 100644 --- a/SRC/zlatdf.f +++ b/SRC/zlatdf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution to the reciprocal Dif-estimate. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatps.f b/SRC/zlatps.f index e1c12b224a..fae2a4a295 100644 --- a/SRC/zlatps.f +++ b/SRC/zlatps.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATPS solves a triangular system of equations with the matrix held in packed storage. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrd.f b/SRC/zlatrd.f index cc3cbfb51f..a99d11ea1c 100644 --- a/SRC/zlatrd.f +++ b/SRC/zlatrd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal form by an unitary similarity transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrs.f b/SRC/zlatrs.f index 4b06c227b0..45d12cc692 100644 --- a/SRC/zlatrs.f +++ b/SRC/zlatrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatrs3.f b/SRC/zlatrs3.f index c352e6e3b8..af5fc69a30 100644 --- a/SRC/zlatrs3.f +++ b/SRC/zlatrs3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATRS3 solves a triangular system of equations with the scale factors set to prevent overflow. * * Definition: diff --git a/SRC/zlatrz.f b/SRC/zlatrz.f index 246470107b..99eb04dc46 100644 --- a/SRC/zlatrz.f +++ b/SRC/zlatrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATRZ factors an upper trapezoidal matrix by means of unitary transformations. * * =========== DOCUMENTATION =========== diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f index c53a778dfc..24d00f28a8 100644 --- a/SRC/zlatsqr.f +++ b/SRC/zlatsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLATSQR * * Definition: diff --git a/SRC/zlaunhr_col_getrfnp.f b/SRC/zlaunhr_col_getrfnp.f index f2835e8b7a..3751066370 100644 --- a/SRC/zlaunhr_col_getrfnp.f +++ b/SRC/zlaunhr_col_getrfnp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAUNHR_COL_GETRFNP * * =========== DOCUMENTATION =========== diff --git a/SRC/zlaunhr_col_getrfnp2.f b/SRC/zlaunhr_col_getrfnp2.f index 14273231ff..d33e99e1a1 100644 --- a/SRC/zlaunhr_col_getrfnp2.f +++ b/SRC/zlaunhr_col_getrfnp2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAUNHR_COL_GETRFNP2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zlauu2.f b/SRC/zlauu2.f index dc6cd19ead..4dd329f563 100644 --- a/SRC/zlauu2.f +++ b/SRC/zlauu2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAUU2 computes the product UUH or LHL, where U and L are upper or lower triangular matrices (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zlauum.f b/SRC/zlauum.f index 2cb1d6f474..fc5a062f44 100644 --- a/SRC/zlauum.f +++ b/SRC/zlauum.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZLAUUM computes the product UUH or LHL, where U and L are upper or lower triangular matrices (blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbcon.f b/SRC/zpbcon.f index c9a03fe12f..8d382572c4 100644 --- a/SRC/zpbcon.f +++ b/SRC/zpbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbequ.f b/SRC/zpbequ.f index 0c842fbacd..7ae1351a97 100644 --- a/SRC/zpbequ.f +++ b/SRC/zpbequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbrfs.f b/SRC/zpbrfs.f index f6186cc76b..03d20e079c 100644 --- a/SRC/zpbrfs.f +++ b/SRC/zpbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbstf.f b/SRC/zpbstf.f index b47d34a8b5..34d8e1c6b2 100644 --- a/SRC/zpbstf.f +++ b/SRC/zpbstf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBSTF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbsv.f b/SRC/zpbsv.f index e08950a454..4c4803853d 100644 --- a/SRC/zpbsv.f +++ b/SRC/zpbsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPBSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbsvx.f b/SRC/zpbsvx.f index 423077b258..3f2531ca12 100644 --- a/SRC/zpbsvx.f +++ b/SRC/zpbsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtf2.f b/SRC/zpbtf2.f index bea5650ecb..31deca7dae 100644 --- a/SRC/zpbtf2.f +++ b/SRC/zpbtf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtrf.f b/SRC/zpbtrf.f index 3c1c8b54a3..c0887467fc 100644 --- a/SRC/zpbtrf.f +++ b/SRC/zpbtrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpbtrs.f b/SRC/zpbtrs.f index 8f47f07d9d..efeff6a57c 100644 --- a/SRC/zpbtrs.f +++ b/SRC/zpbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftrf.f b/SRC/zpftrf.f index 8e641cad58..96fd24195e 100644 --- a/SRC/zpftrf.f +++ b/SRC/zpftrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPFTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftri.f b/SRC/zpftri.f index 7e045d6060..620afed72e 100644 --- a/SRC/zpftri.f +++ b/SRC/zpftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpftrs.f b/SRC/zpftrs.f index 5b274d64a7..794e9ba588 100644 --- a/SRC/zpftrs.f +++ b/SRC/zpftrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPFTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpocon.f b/SRC/zpocon.f index 3b07832731..30f0bba14d 100644 --- a/SRC/zpocon.f +++ b/SRC/zpocon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpoequ.f b/SRC/zpoequ.f index 924d78f26b..0c02ad2d36 100644 --- a/SRC/zpoequ.f +++ b/SRC/zpoequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpoequb.f b/SRC/zpoequb.f index 732cf02388..529cda962a 100644 --- a/SRC/zpoequb.f +++ b/SRC/zpoequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zporfs.f b/SRC/zporfs.f index cf200c932d..9b407ae162 100644 --- a/SRC/zporfs.f +++ b/SRC/zporfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPORFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zporfsx.f b/SRC/zporfsx.f index 29f7c8a391..ce2e7f91fe 100644 --- a/SRC/zporfsx.f +++ b/SRC/zporfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPORFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zposv.f b/SRC/zposv.f index 8db30067c0..c10c7888c5 100644 --- a/SRC/zposv.f +++ b/SRC/zposv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPOSV computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zposvx.f b/SRC/zposvx.f index b857c5efb5..ca8497ad68 100644 --- a/SRC/zposvx.f +++ b/SRC/zposvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zposvxx.f b/SRC/zposvxx.f index 1cb1b613a2..1a55e527ba 100644 --- a/SRC/zposvxx.f +++ b/SRC/zposvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotf2.f b/SRC/zpotf2.f index 37322bb443..7de8c11851 100644 --- a/SRC/zpotf2.f +++ b/SRC/zpotf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrf.f b/SRC/zpotrf.f index c003af8968..c9f19aa87f 100644 --- a/SRC/zpotrf.f +++ b/SRC/zpotrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrf2.f b/SRC/zpotrf2.f index 8e79308007..4cdbb0ac1f 100644 --- a/SRC/zpotrf2.f +++ b/SRC/zpotrf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOTRF2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotri.f b/SRC/zpotri.f index e79ffc6e31..1ab4589903 100644 --- a/SRC/zpotri.f +++ b/SRC/zpotri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpotrs.f b/SRC/zpotrs.f index 045b4c7225..4478616d41 100644 --- a/SRC/zpotrs.f +++ b/SRC/zpotrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPOTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zppcon.f b/SRC/zppcon.f index 2b25e75660..091c2869a9 100644 --- a/SRC/zppcon.f +++ b/SRC/zppcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zppequ.f b/SRC/zppequ.f index d4a060c8fa..81e870fa75 100644 --- a/SRC/zppequ.f +++ b/SRC/zppequ.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPEQU * * =========== DOCUMENTATION =========== diff --git a/SRC/zpprfs.f b/SRC/zpprfs.f index 755832e21d..55a1e4f11d 100644 --- a/SRC/zpprfs.f +++ b/SRC/zpprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zppsv.f b/SRC/zppsv.f index 28c46a72b4..b6a677fa3e 100644 --- a/SRC/zppsv.f +++ b/SRC/zppsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zppsvx.f b/SRC/zppsvx.f index 8cf6af090b..8c250aca90 100644 --- a/SRC/zppsvx.f +++ b/SRC/zppsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptrf.f b/SRC/zpptrf.f index 3c9ea20011..1603f003ca 100644 --- a/SRC/zpptrf.f +++ b/SRC/zpptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptri.f b/SRC/zpptri.f index a8780a5b4a..4838b80861 100644 --- a/SRC/zpptri.f +++ b/SRC/zpptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zpptrs.f b/SRC/zpptrs.f index aacb83dca9..55412a67d6 100644 --- a/SRC/zpptrs.f +++ b/SRC/zpptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zpstf2.f b/SRC/zpstf2.f index c135f4a1a4..b30e38f16f 100644 --- a/SRC/zpstf2.f +++ b/SRC/zpstf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPSTF2 computes the Cholesky factorization with complete pivoting of a complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zpstrf.f b/SRC/zpstrf.f index f3b1e37267..6d6671b1a4 100644 --- a/SRC/zpstrf.f +++ b/SRC/zpstrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPSTRF computes the Cholesky factorization with complete pivoting of a complex Hermitian positive semidefinite matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zptcon.f b/SRC/zptcon.f index d2a0234862..c9cf150206 100644 --- a/SRC/zptcon.f +++ b/SRC/zptcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zpteqr.f b/SRC/zpteqr.f index 14d2085beb..12cb9c707a 100644 --- a/SRC/zpteqr.f +++ b/SRC/zpteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zptrfs.f b/SRC/zptrfs.f index b791ae3751..0ec3d87ca3 100644 --- a/SRC/zptrfs.f +++ b/SRC/zptrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zptsv.f b/SRC/zptsv.f index 115f16e312..ea93048547 100644 --- a/SRC/zptsv.f +++ b/SRC/zptsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPTSV computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zptsvx.f b/SRC/zptsvx.f index 662dbee2fa..8dfd518abe 100644 --- a/SRC/zptsvx.f +++ b/SRC/zptsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zpttrf.f b/SRC/zpttrf.f index eaace87869..75a2c62687 100644 --- a/SRC/zpttrf.f +++ b/SRC/zpttrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zpttrs.f b/SRC/zpttrs.f index 9f64fdd644..6cd8dd24dc 100644 --- a/SRC/zpttrs.f +++ b/SRC/zpttrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zptts2.f b/SRC/zptts2.f index 2341f28845..f63f6a9955 100644 --- a/SRC/zptts2.f +++ b/SRC/zptts2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZPTTS2 solves a tridiagonal system of the form AX=B using the L D LH factorization computed by spttrf. * * =========== DOCUMENTATION =========== diff --git a/SRC/zrot.f b/SRC/zrot.f index 6724d23b29..c39a0484ec 100644 --- a/SRC/zrot.f +++ b/SRC/zrot.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors. * * =========== DOCUMENTATION =========== diff --git a/SRC/zrscl.f b/SRC/zrscl.f index 5b365a0533..728d893d01 100644 --- a/SRC/zrscl.f +++ b/SRC/zrscl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar. * * =========== DOCUMENTATION =========== diff --git a/SRC/zspcon.f b/SRC/zspcon.f index bfa7a55b33..908547d37c 100644 --- a/SRC/zspcon.f +++ b/SRC/zspcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zspmv.f b/SRC/zspmv.f index db145f46bb..192f2c0df8 100644 --- a/SRC/zspmv.f +++ b/SRC/zspmv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix * * =========== DOCUMENTATION =========== diff --git a/SRC/zspr.f b/SRC/zspr.f index 134f983594..8832ca603b 100644 --- a/SRC/zspr.f +++ b/SRC/zspr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPR performs the symmetrical rank-1 update of a complex symmetric packed matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsprfs.f b/SRC/zsprfs.f index 9ce3be12bb..d880b8410a 100644 --- a/SRC/zsprfs.f +++ b/SRC/zsprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zspsv.f b/SRC/zspsv.f index 15737e8031..10526e8f59 100644 --- a/SRC/zspsv.f +++ b/SRC/zspsv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSPSV computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zspsvx.f b/SRC/zspsvx.f index ec495af66c..89562f806b 100644 --- a/SRC/zspsvx.f +++ b/SRC/zspsvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptrf.f b/SRC/zsptrf.f index 1f8af54976..3ff525a087 100644 --- a/SRC/zsptrf.f +++ b/SRC/zsptrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptri.f b/SRC/zsptri.f index cff89df959..cc65583cec 100644 --- a/SRC/zsptri.f +++ b/SRC/zsptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zsptrs.f b/SRC/zsptrs.f index 76b68cc0de..07a106aafd 100644 --- a/SRC/zsptrs.f +++ b/SRC/zsptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zstedc.f b/SRC/zstedc.f index e148dde235..cbad0cf87c 100644 --- a/SRC/zstedc.f +++ b/SRC/zstedc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSTEDC * * =========== DOCUMENTATION =========== diff --git a/SRC/zstegr.f b/SRC/zstegr.f index d9d6b3eac5..8bd2c29121 100644 --- a/SRC/zstegr.f +++ b/SRC/zstegr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSTEGR * * =========== DOCUMENTATION =========== diff --git a/SRC/zstein.f b/SRC/zstein.f index bb92ac2362..ed4512f90b 100644 --- a/SRC/zstein.f +++ b/SRC/zstein.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSTEIN * * =========== DOCUMENTATION =========== diff --git a/SRC/zstemr.f b/SRC/zstemr.f index 287517f7fa..eab8eca207 100644 --- a/SRC/zstemr.f +++ b/SRC/zstemr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSTEMR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsteqr.f b/SRC/zsteqr.f index a6b76fb839..f111d41569 100644 --- a/SRC/zsteqr.f +++ b/SRC/zsteqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSTEQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon.f b/SRC/zsycon.f index 20137e4667..05f06ec786 100644 --- a/SRC/zsycon.f +++ b/SRC/zsycon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCON * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon_3.f b/SRC/zsycon_3.f index b59c53cf7a..f545593f2c 100644 --- a/SRC/zsycon_3.f +++ b/SRC/zsycon_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCON_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsycon_rook.f b/SRC/zsycon_rook.f index 83f9c7e37c..038713f2d2 100644 --- a/SRC/zsycon_rook.f +++ b/SRC/zsycon_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCON_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconv.f b/SRC/zsyconv.f index aa475b876b..b0d455f056 100644 --- a/SRC/zsyconv.f +++ b/SRC/zsyconv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCONV * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconvf.f b/SRC/zsyconvf.f index 2388021f2d..945c489db2 100644 --- a/SRC/zsyconvf.f +++ b/SRC/zsyconvf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCONVF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyconvf_rook.f b/SRC/zsyconvf_rook.f index 71bade2e4c..3d8570582b 100644 --- a/SRC/zsyconvf_rook.f +++ b/SRC/zsyconvf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYCONVF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyequb.f b/SRC/zsyequb.f index e15dead7b4..c1ef77d850 100644 --- a/SRC/zsyequb.f +++ b/SRC/zsyequb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYEQUB * * =========== DOCUMENTATION =========== diff --git a/SRC/zsymv.f b/SRC/zsymv.f index 1121a36d35..7c123f7bfd 100644 --- a/SRC/zsymv.f +++ b/SRC/zsymv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYMV computes a matrix-vector product for a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyr.f b/SRC/zsyr.f index 7f4c3f4416..a059077afc 100644 --- a/SRC/zsyr.f +++ b/SRC/zsyr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYR performs the symmetric rank-1 update of a complex symmetric matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyrfs.f b/SRC/zsyrfs.f index cfee8b1cb9..a6fef57ca8 100644 --- a/SRC/zsyrfs.f +++ b/SRC/zsyrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyrfsx.f b/SRC/zsyrfsx.f index bd4e9b1bde..bb58ca03c1 100644 --- a/SRC/zsyrfsx.f +++ b/SRC/zsyrfsx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYRFSX * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv.f b/SRC/zsysv.f index d13bfb91f1..cf3f4b72d7 100644 --- a/SRC/zsysv.f +++ b/SRC/zsysv.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSV computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_aa.f b/SRC/zsysv_aa.f index 59dafa80ef..dec37bb396 100644 --- a/SRC/zsysv_aa.f +++ b/SRC/zsysv_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_aa_2stage.f b/SRC/zsysv_aa_2stage.f index 39f8704b25..643a12942e 100644 --- a/SRC/zsysv_aa_2stage.f +++ b/SRC/zsysv_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_rk.f b/SRC/zsysv_rk.f index c54396a8c8..21eb6a56a9 100644 --- a/SRC/zsysv_rk.f +++ b/SRC/zsysv_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysv_rook.f b/SRC/zsysv_rook.f index ab938e1d34..a26b32689d 100644 --- a/SRC/zsysv_rook.f +++ b/SRC/zsysv_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysvx.f b/SRC/zsysvx.f index 07d4a32c88..82b2beb86d 100644 --- a/SRC/zsysvx.f +++ b/SRC/zsysvx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsysvxx.f b/SRC/zsysvxx.f index ef04438bbf..84537b7760 100644 --- a/SRC/zsysvxx.f +++ b/SRC/zsysvxx.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices * * =========== DOCUMENTATION =========== diff --git a/SRC/zsyswapr.f b/SRC/zsyswapr.f index 48a1f675a4..892ee215aa 100644 --- a/SRC/zsyswapr.f +++ b/SRC/zsyswapr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYSWAPR * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2.f b/SRC/zsytf2.f index b238f2a8b0..0804e71648 100644 --- a/SRC/zsytf2.f +++ b/SRC/zsytf2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2_rk.f b/SRC/zsytf2_rk.f index 6b68d0f949..2831cf0ecd 100644 --- a/SRC/zsytf2_rk.f +++ b/SRC/zsytf2_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS2 unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytf2_rook.f b/SRC/zsytf2_rook.f index cfba0f9300..6c738ce8fe 100644 --- a/SRC/zsytf2_rook.f +++ b/SRC/zsytf2_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf.f b/SRC/zsytrf.f index aef88b1091..a38c88b071 100644 --- a/SRC/zsytrf.f +++ b/SRC/zsytrf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRF * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_aa.f b/SRC/zsytrf_aa.f index 749e2523ed..c0eef5660a 100644 --- a/SRC/zsytrf_aa.f +++ b/SRC/zsytrf_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRF_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_aa_2stage.f b/SRC/zsytrf_aa_2stage.f index c53386c410..f2b17eeeb5 100644 --- a/SRC/zsytrf_aa_2stage.f +++ b/SRC/zsytrf_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRF_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_rk.f b/SRC/zsytrf_rk.f index a56b8a2054..0ed6aa10b0 100644 --- a/SRC/zsytrf_rk.f +++ b/SRC/zsytrf_rk.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch-Kaufman (rook) diagonal pivoting method (BLAS3 blocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrf_rook.f b/SRC/zsytrf_rook.f index 958849befc..7eb02ba1ec 100644 --- a/SRC/zsytrf_rook.f +++ b/SRC/zsytrf_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRF_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri.f b/SRC/zsytri.f index 470f086997..f720629c36 100644 --- a/SRC/zsytri.f +++ b/SRC/zsytri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri2.f b/SRC/zsytri2.f index d417b71caf..4a208430a3 100644 --- a/SRC/zsytri2.f +++ b/SRC/zsytri2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri2x.f b/SRC/zsytri2x.f index fb097ea4bd..19c4b39ce5 100644 --- a/SRC/zsytri2x.f +++ b/SRC/zsytri2x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI2X * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_3.f b/SRC/zsytri_3.f index 04ed2a2072..d56331137b 100644 --- a/SRC/zsytri_3.f +++ b/SRC/zsytri_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_3x.f b/SRC/zsytri_3x.f index ebed7208ff..b4da257df2 100644 --- a/SRC/zsytri_3x.f +++ b/SRC/zsytri_3x.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI_3X * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytri_rook.f b/SRC/zsytri_rook.f index e9e75e5c18..f5b108ed28 100644 --- a/SRC/zsytri_rook.f +++ b/SRC/zsytri_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRI_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs.f b/SRC/zsytrs.f index f8e20c730a..c633376159 100644 --- a/SRC/zsytrs.f +++ b/SRC/zsytrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs2.f b/SRC/zsytrs2.f index 57afb3e4f5..9b0b6ab0dc 100644 --- a/SRC/zsytrs2.f +++ b/SRC/zsytrs2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_3.f b/SRC/zsytrs_3.f index 88cf7a38af..7b4647e3e1 100644 --- a/SRC/zsytrs_3.f +++ b/SRC/zsytrs_3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS_3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_aa.f b/SRC/zsytrs_aa.f index a88d771323..d114439b84 100644 --- a/SRC/zsytrs_aa.f +++ b/SRC/zsytrs_aa.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS_AA * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_aa_2stage.f b/SRC/zsytrs_aa_2stage.f index 6ddb166ca6..31a71e6ff3 100644 --- a/SRC/zsytrs_aa_2stage.f +++ b/SRC/zsytrs_aa_2stage.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS_AA_2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/zsytrs_rook.f b/SRC/zsytrs_rook.f index 179edf7d11..fd59882fde 100644 --- a/SRC/zsytrs_rook.f +++ b/SRC/zsytrs_rook.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZSYTRS_ROOK * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbcon.f b/SRC/ztbcon.f index ce77c646d2..826c37c442 100644 --- a/SRC/ztbcon.f +++ b/SRC/ztbcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTBCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbrfs.f b/SRC/ztbrfs.f index 18c5d358fd..3ef5cef55f 100644 --- a/SRC/ztbrfs.f +++ b/SRC/ztbrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTBRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztbtrs.f b/SRC/ztbtrs.f index 38b8dd304f..d21efe61d2 100644 --- a/SRC/ztbtrs.f +++ b/SRC/ztbtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTBTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfsm.f b/SRC/ztfsm.f index cba6cdb0d4..98d1820690 100644 --- a/SRC/ztfsm.f +++ b/SRC/ztfsm.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTFSM solves a matrix equation (one operand is a triangular matrix in RFP format). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztftri.f b/SRC/ztftri.f index eb84ab3246..71166f58d1 100644 --- a/SRC/ztftri.f +++ b/SRC/ztftri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTFTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfttp.f b/SRC/ztfttp.f index 41cad97bb3..e7b1451d61 100644 --- a/SRC/ztfttp.f +++ b/SRC/ztfttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztfttr.f b/SRC/ztfttr.f index cc11b7e812..72c58d7de0 100644 --- a/SRC/ztfttr.f +++ b/SRC/ztfttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgevc.f b/SRC/ztgevc.f index a6e254da51..63a0491fe1 100644 --- a/SRC/ztgevc.f +++ b/SRC/ztgevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGEVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgex2.f b/SRC/ztgex2.f index d2941e0da2..a9c7158ee0 100644 --- a/SRC/ztgex2.f +++ b/SRC/ztgex2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an unitary equivalence transformation. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgexc.f b/SRC/ztgexc.f index c89016b078..ef05ff87ea 100644 --- a/SRC/ztgexc.f +++ b/SRC/ztgexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGEXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsen.f b/SRC/ztgsen.f index fca4d0eedb..58a742240c 100644 --- a/SRC/ztgsen.f +++ b/SRC/ztgsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsja.f b/SRC/ztgsja.f index 2a2175a4a6..f605aae5c4 100644 --- a/SRC/ztgsja.f +++ b/SRC/ztgsja.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGSJA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsna.f b/SRC/ztgsna.f index 73f35a97a5..fd1a56561b 100644 --- a/SRC/ztgsna.f +++ b/SRC/ztgsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsy2.f b/SRC/ztgsy2.f index 1253c99d5e..ca402df1d0 100644 --- a/SRC/ztgsy2.f +++ b/SRC/ztgsy2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGSY2 solves the generalized Sylvester equation (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztgsyl.f b/SRC/ztgsyl.f index 47ba8164f0..097e619a1e 100644 --- a/SRC/ztgsyl.f +++ b/SRC/ztgsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTGSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpcon.f b/SRC/ztpcon.f index c285398ddf..5cb10e14a4 100644 --- a/SRC/ztpcon.f +++ b/SRC/ztpcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztplqt.f b/SRC/ztplqt.f index 7918e7ca9f..7bbfd8dced 100644 --- a/SRC/ztplqt.f +++ b/SRC/ztplqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztplqt2.f b/SRC/ztplqt2.f index 9d912e6dd5..cc666f88a1 100644 --- a/SRC/ztplqt2.f +++ b/SRC/ztplqt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f index 3f9fa32f79..d4a85e49c0 100644 --- a/SRC/ztpmlqt.f +++ b/SRC/ztpmlqt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPMLQT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpmqrt.f b/SRC/ztpmqrt.f index c753505bd2..373b9b3c23 100644 --- a/SRC/ztpmqrt.f +++ b/SRC/ztpmqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPMQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpqrt.f b/SRC/ztpqrt.f index 3d160a407e..428bf502f0 100644 --- a/SRC/ztpqrt.f +++ b/SRC/ztpqrt.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPQRT * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpqrt2.f b/SRC/ztpqrt2.f index f70d68b1fb..1c348dfc9b 100644 --- a/SRC/ztpqrt2.f +++ b/SRC/ztpqrt2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztprfb.f b/SRC/ztprfb.f index 4552e7accd..7474392979 100644 --- a/SRC/ztprfb.f +++ b/SRC/ztprfb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPRFB applies a complex "triangular-pentagonal" block reflector to a complex matrix, which is composed of two blocks. * * =========== DOCUMENTATION =========== diff --git a/SRC/ztprfs.f b/SRC/ztprfs.f index 6c4e513bbe..f8c255c6dd 100644 --- a/SRC/ztprfs.f +++ b/SRC/ztprfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztptri.f b/SRC/ztptri.f index 352ebf0be8..4527a08acc 100644 --- a/SRC/ztptri.f +++ b/SRC/ztptri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztptrs.f b/SRC/ztptrs.f index bf40b413dd..cfddc32513 100644 --- a/SRC/ztptrs.f +++ b/SRC/ztptrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpttf.f b/SRC/ztpttf.f index 00766385b2..3dd0b765c2 100644 --- a/SRC/ztpttf.f +++ b/SRC/ztpttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztpttr.f b/SRC/ztpttr.f index bd2b69bcd1..a04b7c9448 100644 --- a/SRC/ztpttr.f +++ b/SRC/ztpttr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (TR). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrcon.f b/SRC/ztrcon.f index 15373cb52e..19f4beca74 100644 --- a/SRC/ztrcon.f +++ b/SRC/ztrcon.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRCON * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrevc.f b/SRC/ztrevc.f index e373ac1fcd..8a83708f51 100644 --- a/SRC/ztrevc.f +++ b/SRC/ztrevc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTREVC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrevc3.f b/SRC/ztrevc3.f index 0b0a3d6bd0..3c4115c249 100644 --- a/SRC/ztrevc3.f +++ b/SRC/ztrevc3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTREVC3 * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrexc.f b/SRC/ztrexc.f index 1355c34143..5ebc1ad2f0 100644 --- a/SRC/ztrexc.f +++ b/SRC/ztrexc.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTREXC * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrrfs.f b/SRC/ztrrfs.f index c55dd331c2..1dc44e596c 100644 --- a/SRC/ztrrfs.f +++ b/SRC/ztrrfs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRRFS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsen.f b/SRC/ztrsen.f index d848d4a0d8..c782922126 100644 --- a/SRC/ztrsen.f +++ b/SRC/ztrsen.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRSEN * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsna.f b/SRC/ztrsna.f index dbd6a7d810..541438bebf 100644 --- a/SRC/ztrsna.f +++ b/SRC/ztrsna.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRSNA * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsyl.f b/SRC/ztrsyl.f index 0ae6d5748e..f8d8646132 100644 --- a/SRC/ztrsyl.f +++ b/SRC/ztrsyl.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRSYL * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrsyl3.f b/SRC/ztrsyl3.f index eb40ae0d21..eeda7f3ad2 100644 --- a/SRC/ztrsyl3.f +++ b/SRC/ztrsyl3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRSYL3 * * Definition: diff --git a/SRC/ztrti2.f b/SRC/ztrti2.f index 922b77b502..306313ca25 100644 --- a/SRC/ztrti2.f +++ b/SRC/ztrti2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRTI2 computes the inverse of a triangular matrix (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrtri.f b/SRC/ztrtri.f index 3c8f86915a..5b1592d5d4 100644 --- a/SRC/ztrtri.f +++ b/SRC/ztrtri.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRTRI * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrtrs.f b/SRC/ztrtrs.f index ef4a2f01b8..728e0a403d 100644 --- a/SRC/ztrtrs.f +++ b/SRC/ztrtrs.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRTRS * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrttf.f b/SRC/ztrttf.f index fa03d7640c..b1eb814f34 100644 --- a/SRC/ztrttf.f +++ b/SRC/ztrttf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed format (TF). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztrttp.f b/SRC/ztrttp.f index 78f0fde13a..ec3a44718f 100644 --- a/SRC/ztrttp.f +++ b/SRC/ztrttp.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP). * * =========== DOCUMENTATION =========== diff --git a/SRC/ztzrzf.f b/SRC/ztzrzf.f index 125542053e..b7b9d98eb7 100644 --- a/SRC/ztzrzf.f +++ b/SRC/ztzrzf.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZTZRZF * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb.f b/SRC/zunbdb.f index 2965b8c810..f05e46e6d7 100644 --- a/SRC/zunbdb.f +++ b/SRC/zunbdb.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb1.f b/SRC/zunbdb1.f index e3756d2b8b..b96c499938 100644 --- a/SRC/zunbdb1.f +++ b/SRC/zunbdb1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb2.f b/SRC/zunbdb2.f index ccf8c3d994..245391982f 100644 --- a/SRC/zunbdb2.f +++ b/SRC/zunbdb2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB2 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb3.f b/SRC/zunbdb3.f index 2f03c477f9..67b3eeedcb 100644 --- a/SRC/zunbdb3.f +++ b/SRC/zunbdb3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB3 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb4.f b/SRC/zunbdb4.f index 5ffacd757a..a242d956dc 100644 --- a/SRC/zunbdb4.f +++ b/SRC/zunbdb4.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB4 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb5.f b/SRC/zunbdb5.f index 7eb9c69cfa..c935b94d36 100644 --- a/SRC/zunbdb5.f +++ b/SRC/zunbdb5.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB5 * * =========== DOCUMENTATION =========== diff --git a/SRC/zunbdb6.f b/SRC/zunbdb6.f index 0fd81e4a74..a30c3050ae 100644 --- a/SRC/zunbdb6.f +++ b/SRC/zunbdb6.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNBDB6 * * =========== DOCUMENTATION =========== diff --git a/SRC/zuncsd.f b/SRC/zuncsd.f index d2c2a1bf78..fa97f9bc02 100644 --- a/SRC/zuncsd.f +++ b/SRC/zuncsd.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNCSD * * =========== DOCUMENTATION =========== diff --git a/SRC/zuncsd2by1.f b/SRC/zuncsd2by1.f index b5f6b93b20..973b247fed 100644 --- a/SRC/zuncsd2by1.f +++ b/SRC/zuncsd2by1.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNCSD2BY1 * * =========== DOCUMENTATION =========== diff --git a/SRC/zung2l.f b/SRC/zung2l.f index 39073c0b8f..28854861bb 100644 --- a/SRC/zung2l.f +++ b/SRC/zung2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zung2r.f b/SRC/zung2r.f index 53629c106a..b73246b2b3 100644 --- a/SRC/zung2r.f +++ b/SRC/zung2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNG2R * * =========== DOCUMENTATION =========== diff --git a/SRC/zungbr.f b/SRC/zungbr.f index aa448966e7..223c63ec02 100644 --- a/SRC/zungbr.f +++ b/SRC/zungbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGBR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunghr.f b/SRC/zunghr.f index e4d4361bbe..9310ac8392 100644 --- a/SRC/zunghr.f +++ b/SRC/zunghr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGHR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungl2.f b/SRC/zungl2.f index e1817aa1e2..83308c59b1 100644 --- a/SRC/zungl2.f +++ b/SRC/zungl2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGL2 generates all or part of the unitary matrix Q from an LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunglq.f b/SRC/zunglq.f index cad89816c9..8380de9b62 100644 --- a/SRC/zunglq.f +++ b/SRC/zunglq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zungql.f b/SRC/zungql.f index 65c6c55aa2..38bc22120d 100644 --- a/SRC/zungql.f +++ b/SRC/zungql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGQL * * =========== DOCUMENTATION =========== diff --git a/SRC/zungqr.f b/SRC/zungqr.f index 0898e5f7d5..2067a16241 100644 --- a/SRC/zungqr.f +++ b/SRC/zungqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungr2.f b/SRC/zungr2.f index b86e0a3957..05c5fc74ec 100644 --- a/SRC/zungr2.f +++ b/SRC/zungr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGR2 generates all or part of the unitary matrix Q from an RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zungrq.f b/SRC/zungrq.f index 78cee12b4f..44492eef3d 100644 --- a/SRC/zungrq.f +++ b/SRC/zungrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtr.f b/SRC/zungtr.f index 42d70dc535..cf1cce051d 100644 --- a/SRC/zungtr.f +++ b/SRC/zungtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtsqr.f b/SRC/zungtsqr.f index 8ac60f4660..6b8aa87604 100644 --- a/SRC/zungtsqr.f +++ b/SRC/zungtsqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGTSQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zungtsqr_row.f b/SRC/zungtsqr_row.f index 636a259117..96a27d260b 100644 --- a/SRC/zungtsqr_row.f +++ b/SRC/zungtsqr_row.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNGTSQR_ROW * * =========== DOCUMENTATION =========== diff --git a/SRC/zunhr_col.f b/SRC/zunhr_col.f index 49c2eb40af..44a5ef74bb 100644 --- a/SRC/zunhr_col.f +++ b/SRC/zunhr_col.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNHR_COL * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm22.f b/SRC/zunm22.f index e83625148e..dfc154ce91 100644 --- a/SRC/zunm22.f +++ b/SRC/zunm22.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNM22 multiplies a general matrix by a banded unitary matrix. * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm2l.f b/SRC/zunm2l.f index d41a406198..0e0ed1c067 100644 --- a/SRC/zunm2l.f +++ b/SRC/zunm2l.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunm2r.f b/SRC/zunm2r.f index 4e76979837..6d6c802a6d 100644 --- a/SRC/zunm2r.f +++ b/SRC/zunm2r.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmbr.f b/SRC/zunmbr.f index 499d15123c..da69023526 100644 --- a/SRC/zunmbr.f +++ b/SRC/zunmbr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMBR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmhr.f b/SRC/zunmhr.f index 8183f56854..ccff793fd5 100644 --- a/SRC/zunmhr.f +++ b/SRC/zunmhr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMHR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunml2.f b/SRC/zunml2.f index 78f870a2ac..00385dc612 100644 --- a/SRC/zunml2.f +++ b/SRC/zunml2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNML2 multiplies a general matrix by the unitary matrix from a LQ factorization determined by cgelqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmlq.f b/SRC/zunmlq.f index 6b7b8468d3..6696ea2426 100644 --- a/SRC/zunmlq.f +++ b/SRC/zunmlq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMLQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmql.f b/SRC/zunmql.f index 3822da5df3..5722c17c49 100644 --- a/SRC/zunmql.f +++ b/SRC/zunmql.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMQL * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmqr.f b/SRC/zunmqr.f index 6db7bc50a7..ec84968253 100644 --- a/SRC/zunmqr.f +++ b/SRC/zunmqr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMQR * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmr2.f b/SRC/zunmr2.f index 0ccd59bb49..6547522173 100644 --- a/SRC/zunmr2.f +++ b/SRC/zunmr2.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMR2 multiplies a general matrix by the unitary matrix from a RQ factorization determined by cgerqf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmr3.f b/SRC/zunmr3.f index d1d9a1f754..df51b5fac1 100644 --- a/SRC/zunmr3.f +++ b/SRC/zunmr3.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMR3 multiplies a general matrix by the unitary matrix from a RZ factorization determined by ctzrzf (unblocked algorithm). * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmrq.f b/SRC/zunmrq.f index 9a0d0b71de..1964514f46 100644 --- a/SRC/zunmrq.f +++ b/SRC/zunmrq.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMRQ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmrz.f b/SRC/zunmrz.f index 23c1f17876..7e8e94e829 100644 --- a/SRC/zunmrz.f +++ b/SRC/zunmrz.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMRZ * * =========== DOCUMENTATION =========== diff --git a/SRC/zunmtr.f b/SRC/zunmtr.f index c5544d23a8..f2cc9b54cf 100644 --- a/SRC/zunmtr.f +++ b/SRC/zunmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUNMTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zupgtr.f b/SRC/zupgtr.f index c7d3d6a92c..0040afecd7 100644 --- a/SRC/zupgtr.f +++ b/SRC/zupgtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUPGTR * * =========== DOCUMENTATION =========== diff --git a/SRC/zupmtr.f b/SRC/zupmtr.f index 0da3a9f017..acf922f6d5 100644 --- a/SRC/zupmtr.f +++ b/SRC/zupmtr.f @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZUPMTR * * =========== DOCUMENTATION =========== From 21299d28eb4b0d5c2f3423d9dd105a7ca0c3012e Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 2 Jan 2024 17:03:54 -0800 Subject: [PATCH 050/206] Enable Index-64 extended API only for Intel and GNU compilers Other compilers might not fully support preprocessing --- CMakeLists.txt | 4 ++- SRC/CMakeLists.txt | 47 ++++++++++++++++++++--------------- SRC/chetrd_hb2st.F | 1 - SRC/iparam2stage.F | 1 - SRC/ssytrd_sb2st.F | 1 - SRC/zhetrd_hb2st.F | 1 - TESTING/MATGEN/CMakeLists.txt | 26 +++++++++++++++---- TESTING/MATGEN/clagge.f | 1 - TESTING/MATGEN/claghe.f | 1 - TESTING/MATGEN/clagsy.f | 1 - TESTING/MATGEN/clahilb.f | 1 - TESTING/MATGEN/clakf2.f | 1 - TESTING/MATGEN/clarge.f | 1 - TESTING/MATGEN/clarnd.f | 1 - TESTING/MATGEN/claror.f | 1 - TESTING/MATGEN/clarot.f | 1 - TESTING/MATGEN/clatm1.f | 1 - TESTING/MATGEN/clatm2.f | 1 - TESTING/MATGEN/clatm3.f | 1 - TESTING/MATGEN/clatm5.f | 1 - TESTING/MATGEN/clatm6.f | 1 - TESTING/MATGEN/clatme.f | 1 - TESTING/MATGEN/clatmr.f | 1 - TESTING/MATGEN/clatms.f | 1 - TESTING/MATGEN/clatmt.f | 1 - TESTING/MATGEN/dlagge.f | 1 - TESTING/MATGEN/dlagsy.f | 1 - TESTING/MATGEN/dlahilb.f | 1 - TESTING/MATGEN/dlakf2.f | 1 - TESTING/MATGEN/dlaran.f | 1 - TESTING/MATGEN/dlarge.f | 1 - TESTING/MATGEN/dlarnd.f | 1 - TESTING/MATGEN/dlaror.f | 1 - TESTING/MATGEN/dlarot.f | 1 - TESTING/MATGEN/dlatm1.f | 1 - TESTING/MATGEN/dlatm2.f | 1 - TESTING/MATGEN/dlatm3.f | 1 - TESTING/MATGEN/dlatm5.f | 1 - TESTING/MATGEN/dlatm6.f | 1 - TESTING/MATGEN/dlatm7.f | 1 - TESTING/MATGEN/dlatme.f | 1 - TESTING/MATGEN/dlatmr.f | 1 - TESTING/MATGEN/dlatms.f | 1 - TESTING/MATGEN/dlatmt.f | 1 - TESTING/MATGEN/slagge.f | 1 - TESTING/MATGEN/slagsy.f | 1 - TESTING/MATGEN/slahilb.f | 1 - TESTING/MATGEN/slakf2.f | 1 - TESTING/MATGEN/slaran.f | 1 - TESTING/MATGEN/slarge.f | 1 - TESTING/MATGEN/slarnd.f | 1 - TESTING/MATGEN/slaror.f | 1 - TESTING/MATGEN/slarot.f | 1 - TESTING/MATGEN/slatm1.f | 1 - TESTING/MATGEN/slatm2.f | 1 - TESTING/MATGEN/slatm3.f | 1 - TESTING/MATGEN/slatm5.f | 1 - TESTING/MATGEN/slatm6.f | 1 - TESTING/MATGEN/slatm7.f | 1 - TESTING/MATGEN/slatme.f | 1 - TESTING/MATGEN/slatmr.f | 1 - TESTING/MATGEN/slatms.f | 1 - TESTING/MATGEN/slatmt.f | 1 - TESTING/MATGEN/zlagge.f | 1 - TESTING/MATGEN/zlaghe.f | 1 - TESTING/MATGEN/zlagsy.f | 1 - TESTING/MATGEN/zlahilb.f | 1 - TESTING/MATGEN/zlakf2.f | 1 - TESTING/MATGEN/zlarge.f | 1 - TESTING/MATGEN/zlarnd.f | 1 - TESTING/MATGEN/zlaror.f | 1 - TESTING/MATGEN/zlarot.f | 1 - TESTING/MATGEN/zlatm1.f | 1 - TESTING/MATGEN/zlatm2.f | 1 - TESTING/MATGEN/zlatm3.f | 1 - TESTING/MATGEN/zlatm5.f | 1 - TESTING/MATGEN/zlatm6.f | 1 - TESTING/MATGEN/zlatme.f | 1 - TESTING/MATGEN/zlatmr.f | 1 - TESTING/MATGEN/zlatms.f | 1 - TESTING/MATGEN/zlatmt.f | 1 - 81 files changed, 51 insertions(+), 104 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 74384ec91d..fa53ae5398 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -107,8 +107,10 @@ else() set(LAPACKELIB "lapacke") set(TMGLIB "tmglib") endif() -# By default build standard API and extended _64 API +# By default build extended _64 API for supported compilers only +set(INDEX64_EXT_API_COMPILERS "Intel|GNU") option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix" ON) +message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDEX64_EXT_API}") include(GNUInstallDirs) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 8642ca511e..a2f396bae2 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -535,26 +535,33 @@ set_target_properties( ) if(BUILD_INDEX64_EXT_API) - set(SOURCES_64) - file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) - file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) - file(GLOB SOURCES_64 ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj/*.*) - list(REMOVE_ITEM SOURCES_64 la_xisnan.F90) - foreach(F IN LISTS SOURCES_64) - set(FFILE "") - file(READ ${F} FFILE) - file(WRITE ${F} "#include \"lapack_64.h\"\n") - file(APPEND ${F} "${FFILE}") - endforeach() - file(COPY lapack_64.h DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) - add_library(${LAPACKLIB}_64_obj OBJECT ${SOURCES_64}) - target_link_libraries(${LAPACKLIB}_64_obj mod_files) - target_compile_options(${LAPACKLIB}_64_obj PRIVATE ${FOPT_ILP64} -DLAPACK_64) - set_target_properties( - ${LAPACKLIB}_64_obj PROPERTIES - POSITION_INDEPENDENT_CODE ON - Fortran_PREPROCESS ON - ) + if(NOT CMAKE_Fortran_COMPILER_ID MATCHES ${INDEX64_EXT_API_COMPILERS}) + message(STATUS "Build Index-64 API as extended API with _64 suffix: skipped (unsupported Fortran compiler)") + # Disable extended API for LAPACK and LAPACKE as it depends on LAPACK build. + set(BUILD_INDEX64_EXT_API OFF) + set(BUILD_INDEX64_EXT_API OFF PARENT_SCOPE) + else() + set(SOURCES_64) + file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) + file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) + file(GLOB SOURCES_64 ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj/*.*) + list(REMOVE_ITEM SOURCES_64 la_xisnan.F90) + foreach(F IN LISTS SOURCES_64) + set(FFILE "") + file(READ ${F} FFILE) + file(WRITE ${F} "#include \"lapack_64.h\"\n") + file(APPEND ${F} "${FFILE}") + endforeach() + file(COPY lapack_64.h DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) + add_library(${LAPACKLIB}_64_obj OBJECT ${SOURCES_64}) + target_link_libraries(${LAPACKLIB}_64_obj mod_files) + target_compile_options(${LAPACKLIB}_64_obj PRIVATE ${FOPT_ILP64} -DLAPACK_64) + set_target_properties( + ${LAPACKLIB}_64_obj PROPERTIES + POSITION_INDEPENDENT_CODE ON + Fortran_PREPROCESS ON + ) + endif() endif() add_library(${LAPACKLIB} diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index 205c10f724..344818ef36 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/iparam2stage.F b/SRC/iparam2stage.F index 4b7d054556..9aafb16ea9 100644 --- a/SRC/iparam2stage.F +++ b/SRC/iparam2stage.F @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b IPARAM2STAGE * * =========== DOCUMENTATION =========== diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index 0840f306de..19e6c614ce 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 282ede2e82..c875cf3953 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -1,4 +1,3 @@ -#include "lapack_64.h" *> \brief \b ZHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/CMakeLists.txt b/TESTING/MATGEN/CMakeLists.txt index 1e218ee3d6..6d3a75ceb0 100644 --- a/TESTING/MATGEN/CMakeLists.txt +++ b/TESTING/MATGEN/CMakeLists.txt @@ -55,15 +55,31 @@ set_target_properties( ) if(BUILD_INDEX64_EXT_API) - set(SOURCES_64) - list(APPEND SOURCES_64 ${SOURCES}) - add_library(${TMGLIB}_64_obj OBJECT ${SOURCES_64}) - target_compile_options(${TMGLIB}_64_obj PRIVATE ${FOPT_ILP64} -DMATGEN_64) - set_target_properties( + if(NOT CMAKE_Fortran_COMPILER_ID MATCHES ${INDEX64_EXT_API_COMPILERS}) + message(STATUS "Build Index-64 API as extended API with _64 suffix: skipped (unsupported Fortran compiler)") + # Disable extended API for MATGEN and LAPACK. + set(BUILD_INDEX64_EXT_API OFF) + set(BUILD_INDEX64_EXT_API OFF PARENT_SCOPE) + else() + set(SOURCES_64) + file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) + file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) + file(GLOB SOURCES_64 ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj/*.*) + foreach(F IN LISTS SOURCES_64) + set(FFILE "") + file(READ ${F} FFILE) + file(WRITE ${F} "#include \"matgen_64.h\"\n") + file(APPEND ${F} "${FFILE}") + endforeach() + file(COPY matgen_64.h DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) + add_library(${TMGLIB}_64_obj OBJECT ${SOURCES_64}) + target_compile_options(${TMGLIB}_64_obj PRIVATE ${FOPT_ILP64} -DMATGEN_64) + set_target_properties( ${TMGLIB}_64_obj PROPERTIES POSITION_INDEPENDENT_CODE ON Fortran_PREPROCESS ON ) + endif() endif() add_library(${TMGLIB} diff --git a/TESTING/MATGEN/clagge.f b/TESTING/MATGEN/clagge.f index 6a1a19f80e..4575608f69 100644 --- a/TESTING/MATGEN/clagge.f +++ b/TESTING/MATGEN/clagge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/claghe.f b/TESTING/MATGEN/claghe.f index 2dbba8e8bb..723e0f2d14 100644 --- a/TESTING/MATGEN/claghe.f +++ b/TESTING/MATGEN/claghe.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAGHE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clagsy.f b/TESTING/MATGEN/clagsy.f index f8822d0237..b01d155653 100644 --- a/TESTING/MATGEN/clagsy.f +++ b/TESTING/MATGEN/clagsy.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clahilb.f b/TESTING/MATGEN/clahilb.f index e47bb36e9f..e543614a58 100644 --- a/TESTING/MATGEN/clahilb.f +++ b/TESTING/MATGEN/clahilb.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clakf2.f b/TESTING/MATGEN/clakf2.f index 27c0495671..5f03cc181c 100644 --- a/TESTING/MATGEN/clakf2.f +++ b/TESTING/MATGEN/clakf2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarge.f b/TESTING/MATGEN/clarge.f index ccd2afeb0e..77086a4815 100644 --- a/TESTING/MATGEN/clarge.f +++ b/TESTING/MATGEN/clarge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarnd.f b/TESTING/MATGEN/clarnd.f index 1995dbdc96..1de7f9f273 100644 --- a/TESTING/MATGEN/clarnd.f +++ b/TESTING/MATGEN/clarnd.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/claror.f b/TESTING/MATGEN/claror.f index d04bcf4f12..de5331e1f6 100644 --- a/TESTING/MATGEN/claror.f +++ b/TESTING/MATGEN/claror.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clarot.f b/TESTING/MATGEN/clarot.f index 5e22508fbf..37cf75dcf4 100644 --- a/TESTING/MATGEN/clarot.f +++ b/TESTING/MATGEN/clarot.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm1.f b/TESTING/MATGEN/clatm1.f index a5220885de..0ed6d8d871 100644 --- a/TESTING/MATGEN/clatm1.f +++ b/TESTING/MATGEN/clatm1.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm2.f b/TESTING/MATGEN/clatm2.f index 77ac2d507c..cd2dc7ae47 100644 --- a/TESTING/MATGEN/clatm2.f +++ b/TESTING/MATGEN/clatm2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm3.f b/TESTING/MATGEN/clatm3.f index 4588a2c9a0..863325b3f2 100644 --- a/TESTING/MATGEN/clatm3.f +++ b/TESTING/MATGEN/clatm3.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm5.f b/TESTING/MATGEN/clatm5.f index 9348f71805..c5938713b4 100644 --- a/TESTING/MATGEN/clatm5.f +++ b/TESTING/MATGEN/clatm5.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatm6.f b/TESTING/MATGEN/clatm6.f index e03a600380..632e896d8c 100644 --- a/TESTING/MATGEN/clatm6.f +++ b/TESTING/MATGEN/clatm6.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatme.f b/TESTING/MATGEN/clatme.f index 66e03b7ab9..213a4b3bca 100644 --- a/TESTING/MATGEN/clatme.f +++ b/TESTING/MATGEN/clatme.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatmr.f b/TESTING/MATGEN/clatmr.f index c066d76daf..9399ea0093 100644 --- a/TESTING/MATGEN/clatmr.f +++ b/TESTING/MATGEN/clatmr.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatms.f b/TESTING/MATGEN/clatms.f index 8211a3f3a7..cee254c7a9 100644 --- a/TESTING/MATGEN/clatms.f +++ b/TESTING/MATGEN/clatms.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/clatmt.f b/TESTING/MATGEN/clatmt.f index 336b298c6a..52425d8ac5 100644 --- a/TESTING/MATGEN/clatmt.f +++ b/TESTING/MATGEN/clatmt.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b CLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlagge.f b/TESTING/MATGEN/dlagge.f index 1399684713..ffd11d2785 100644 --- a/TESTING/MATGEN/dlagge.f +++ b/TESTING/MATGEN/dlagge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlagsy.f b/TESTING/MATGEN/dlagsy.f index 11d71085fb..7ba58ee4f5 100644 --- a/TESTING/MATGEN/dlagsy.f +++ b/TESTING/MATGEN/dlagsy.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlahilb.f b/TESTING/MATGEN/dlahilb.f index afaa5009a8..f16c6bfb8c 100644 --- a/TESTING/MATGEN/dlahilb.f +++ b/TESTING/MATGEN/dlahilb.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlakf2.f b/TESTING/MATGEN/dlakf2.f index 81d7d07166..76baefdcdd 100644 --- a/TESTING/MATGEN/dlakf2.f +++ b/TESTING/MATGEN/dlakf2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlaran.f b/TESTING/MATGEN/dlaran.f index 6510d3166d..24f6e97278 100644 --- a/TESTING/MATGEN/dlaran.f +++ b/TESTING/MATGEN/dlaran.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLARAN * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarge.f b/TESTING/MATGEN/dlarge.f index 10d7e10b71..4f1c09477d 100644 --- a/TESTING/MATGEN/dlarge.f +++ b/TESTING/MATGEN/dlarge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarnd.f b/TESTING/MATGEN/dlarnd.f index f9f5f1a4a5..f41f2ceab8 100644 --- a/TESTING/MATGEN/dlarnd.f +++ b/TESTING/MATGEN/dlarnd.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlaror.f b/TESTING/MATGEN/dlaror.f index 4abbe12ebd..183aa00d0a 100644 --- a/TESTING/MATGEN/dlaror.f +++ b/TESTING/MATGEN/dlaror.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlarot.f b/TESTING/MATGEN/dlarot.f index 99cc47a276..7dc7d6a0fc 100644 --- a/TESTING/MATGEN/dlarot.f +++ b/TESTING/MATGEN/dlarot.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm1.f b/TESTING/MATGEN/dlatm1.f index 8189d3724b..efe782ed47 100644 --- a/TESTING/MATGEN/dlatm1.f +++ b/TESTING/MATGEN/dlatm1.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm2.f b/TESTING/MATGEN/dlatm2.f index 41490814a9..5a55addc36 100644 --- a/TESTING/MATGEN/dlatm2.f +++ b/TESTING/MATGEN/dlatm2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm3.f b/TESTING/MATGEN/dlatm3.f index 05053ac648..7ffee9cec9 100644 --- a/TESTING/MATGEN/dlatm3.f +++ b/TESTING/MATGEN/dlatm3.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm5.f b/TESTING/MATGEN/dlatm5.f index 618c354d79..379183b009 100644 --- a/TESTING/MATGEN/dlatm5.f +++ b/TESTING/MATGEN/dlatm5.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm6.f b/TESTING/MATGEN/dlatm6.f index 7d6c2b2b35..01941609cf 100644 --- a/TESTING/MATGEN/dlatm6.f +++ b/TESTING/MATGEN/dlatm6.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatm7.f b/TESTING/MATGEN/dlatm7.f index 8ebb7b5abd..38c993dad7 100644 --- a/TESTING/MATGEN/dlatm7.f +++ b/TESTING/MATGEN/dlatm7.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATM7 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatme.f b/TESTING/MATGEN/dlatme.f index 5fd3fde975..311f16e2da 100644 --- a/TESTING/MATGEN/dlatme.f +++ b/TESTING/MATGEN/dlatme.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatmr.f b/TESTING/MATGEN/dlatmr.f index 836dcec83b..4bcc12f363 100644 --- a/TESTING/MATGEN/dlatmr.f +++ b/TESTING/MATGEN/dlatmr.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatms.f b/TESTING/MATGEN/dlatms.f index 0ca3b7fb56..0cb6cf2434 100644 --- a/TESTING/MATGEN/dlatms.f +++ b/TESTING/MATGEN/dlatms.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/dlatmt.f b/TESTING/MATGEN/dlatmt.f index 9430164131..7b39daee7c 100644 --- a/TESTING/MATGEN/dlatmt.f +++ b/TESTING/MATGEN/dlatmt.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b DLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slagge.f b/TESTING/MATGEN/slagge.f index d84e403703..9627d563d8 100644 --- a/TESTING/MATGEN/slagge.f +++ b/TESTING/MATGEN/slagge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slagsy.f b/TESTING/MATGEN/slagsy.f index 756ed3baf6..dd319dadcd 100644 --- a/TESTING/MATGEN/slagsy.f +++ b/TESTING/MATGEN/slagsy.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slahilb.f b/TESTING/MATGEN/slahilb.f index 5fe5888a18..852de07529 100644 --- a/TESTING/MATGEN/slahilb.f +++ b/TESTING/MATGEN/slahilb.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slakf2.f b/TESTING/MATGEN/slakf2.f index d407a510cd..ef9f90adf0 100644 --- a/TESTING/MATGEN/slakf2.f +++ b/TESTING/MATGEN/slakf2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slaran.f b/TESTING/MATGEN/slaran.f index 2fdbe82325..586612d9f4 100644 --- a/TESTING/MATGEN/slaran.f +++ b/TESTING/MATGEN/slaran.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLARAN * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarge.f b/TESTING/MATGEN/slarge.f index 67d35d75a8..8bebf48d5d 100644 --- a/TESTING/MATGEN/slarge.f +++ b/TESTING/MATGEN/slarge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarnd.f b/TESTING/MATGEN/slarnd.f index fcbcab1b6b..c2d7a5cb2d 100644 --- a/TESTING/MATGEN/slarnd.f +++ b/TESTING/MATGEN/slarnd.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slaror.f b/TESTING/MATGEN/slaror.f index 09ae74a576..0fc0a7272d 100644 --- a/TESTING/MATGEN/slaror.f +++ b/TESTING/MATGEN/slaror.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slarot.f b/TESTING/MATGEN/slarot.f index ed92521585..0e4d7ef106 100644 --- a/TESTING/MATGEN/slarot.f +++ b/TESTING/MATGEN/slarot.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm1.f b/TESTING/MATGEN/slatm1.f index d6cfbd7364..fb76c55ac9 100644 --- a/TESTING/MATGEN/slatm1.f +++ b/TESTING/MATGEN/slatm1.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm2.f b/TESTING/MATGEN/slatm2.f index b92ac09be0..b259c333ea 100644 --- a/TESTING/MATGEN/slatm2.f +++ b/TESTING/MATGEN/slatm2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm3.f b/TESTING/MATGEN/slatm3.f index 594012ff9d..875866d65e 100644 --- a/TESTING/MATGEN/slatm3.f +++ b/TESTING/MATGEN/slatm3.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm5.f b/TESTING/MATGEN/slatm5.f index b4790b917f..345cf44d18 100644 --- a/TESTING/MATGEN/slatm5.f +++ b/TESTING/MATGEN/slatm5.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm6.f b/TESTING/MATGEN/slatm6.f index 5332410785..b0d27f7dcd 100644 --- a/TESTING/MATGEN/slatm6.f +++ b/TESTING/MATGEN/slatm6.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatm7.f b/TESTING/MATGEN/slatm7.f index 46b509bf0d..9f9863b00a 100644 --- a/TESTING/MATGEN/slatm7.f +++ b/TESTING/MATGEN/slatm7.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATM7 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatme.f b/TESTING/MATGEN/slatme.f index 6672959920..049409ca56 100644 --- a/TESTING/MATGEN/slatme.f +++ b/TESTING/MATGEN/slatme.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatmr.f b/TESTING/MATGEN/slatmr.f index 7635395a21..0761fef0a0 100644 --- a/TESTING/MATGEN/slatmr.f +++ b/TESTING/MATGEN/slatmr.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatms.f b/TESTING/MATGEN/slatms.f index dad00527fe..aead76b5f3 100644 --- a/TESTING/MATGEN/slatms.f +++ b/TESTING/MATGEN/slatms.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/slatmt.f b/TESTING/MATGEN/slatmt.f index 0a390dc4b5..43b5fa372a 100644 --- a/TESTING/MATGEN/slatmt.f +++ b/TESTING/MATGEN/slatmt.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b SLATMT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlagge.f b/TESTING/MATGEN/zlagge.f index 8ae6b32e35..8c2a9676ed 100644 --- a/TESTING/MATGEN/zlagge.f +++ b/TESTING/MATGEN/zlagge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAGGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlaghe.f b/TESTING/MATGEN/zlaghe.f index a58d550fc7..fb77cfb4ca 100644 --- a/TESTING/MATGEN/zlaghe.f +++ b/TESTING/MATGEN/zlaghe.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAGHE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlagsy.f b/TESTING/MATGEN/zlagsy.f index cbc8ed770a..adbb41e39e 100644 --- a/TESTING/MATGEN/zlagsy.f +++ b/TESTING/MATGEN/zlagsy.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAGSY * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlahilb.f b/TESTING/MATGEN/zlahilb.f index da65e4b6e4..858b7444af 100644 --- a/TESTING/MATGEN/zlahilb.f +++ b/TESTING/MATGEN/zlahilb.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAHILB * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlakf2.f b/TESTING/MATGEN/zlakf2.f index 1186d9c8a3..b6b9ca4a7b 100644 --- a/TESTING/MATGEN/zlakf2.f +++ b/TESTING/MATGEN/zlakf2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAKF2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarge.f b/TESTING/MATGEN/zlarge.f index 7674da80a1..f899bfd3ef 100644 --- a/TESTING/MATGEN/zlarge.f +++ b/TESTING/MATGEN/zlarge.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLARGE * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarnd.f b/TESTING/MATGEN/zlarnd.f index bbc0df4c8b..6e88067d4f 100644 --- a/TESTING/MATGEN/zlarnd.f +++ b/TESTING/MATGEN/zlarnd.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLARND * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlaror.f b/TESTING/MATGEN/zlaror.f index 3823e05c97..8ae8f9dc61 100644 --- a/TESTING/MATGEN/zlaror.f +++ b/TESTING/MATGEN/zlaror.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAROR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlarot.f b/TESTING/MATGEN/zlarot.f index 49ff62ffe2..3857d28569 100644 --- a/TESTING/MATGEN/zlarot.f +++ b/TESTING/MATGEN/zlarot.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLAROT * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm1.f b/TESTING/MATGEN/zlatm1.f index 18d499dbcc..0a7475634d 100644 --- a/TESTING/MATGEN/zlatm1.f +++ b/TESTING/MATGEN/zlatm1.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATM1 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm2.f b/TESTING/MATGEN/zlatm2.f index 537e6e82fa..af0151587e 100644 --- a/TESTING/MATGEN/zlatm2.f +++ b/TESTING/MATGEN/zlatm2.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATM2 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm3.f b/TESTING/MATGEN/zlatm3.f index da134cb830..e7fab607cf 100644 --- a/TESTING/MATGEN/zlatm3.f +++ b/TESTING/MATGEN/zlatm3.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATM3 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm5.f b/TESTING/MATGEN/zlatm5.f index 4fc2b82ffb..ebc2ec4419 100644 --- a/TESTING/MATGEN/zlatm5.f +++ b/TESTING/MATGEN/zlatm5.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATM5 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatm6.f b/TESTING/MATGEN/zlatm6.f index f4b695aad2..104becfd1b 100644 --- a/TESTING/MATGEN/zlatm6.f +++ b/TESTING/MATGEN/zlatm6.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATM6 * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatme.f b/TESTING/MATGEN/zlatme.f index 7ceb2f26ef..a081353ce9 100644 --- a/TESTING/MATGEN/zlatme.f +++ b/TESTING/MATGEN/zlatme.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATME * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatmr.f b/TESTING/MATGEN/zlatmr.f index 2d6b342638..72cffec121 100644 --- a/TESTING/MATGEN/zlatmr.f +++ b/TESTING/MATGEN/zlatmr.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATMR * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatms.f b/TESTING/MATGEN/zlatms.f index 779edf2bfb..5e6c4eeccb 100644 --- a/TESTING/MATGEN/zlatms.f +++ b/TESTING/MATGEN/zlatms.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATMS * * =========== DOCUMENTATION =========== diff --git a/TESTING/MATGEN/zlatmt.f b/TESTING/MATGEN/zlatmt.f index 2f62fa628f..9919456984 100644 --- a/TESTING/MATGEN/zlatmt.f +++ b/TESTING/MATGEN/zlatmt.f @@ -1,4 +1,3 @@ -#include "matgen_64.h" *> \brief \b ZLATMT * * =========== DOCUMENTATION =========== From 41909fd0c56a0a63d1e8e3fcc51631962d4fb1cc Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 2 Jan 2024 19:29:24 -0800 Subject: [PATCH 051/206] Add missed memory deallocation to LAPACKE DGESV examples --- LAPACKE/example/example_DGESV_colmajor.c | 14 +++++++++++--- LAPACKE/example/example_DGESV_colmajor_64.c | 17 ++++++++++++++--- LAPACKE/example/example_DGESV_rowmajor.c | 15 +++++++++++---- LAPACKE/example/example_DGESV_rowmajor_64.c | 17 ++++++++++++++--- 4 files changed, 50 insertions(+), 13 deletions(-) diff --git a/LAPACKE/example/example_DGESV_colmajor.c b/LAPACKE/example/example_DGESV_colmajor.c index 62602a6ee7..e028768309 100644 --- a/LAPACKE/example/example_DGESV_colmajor.c +++ b/LAPACKE/example/example_DGESV_colmajor.c @@ -66,9 +66,9 @@ int main(int argc, char **argv) { A = (double *)malloc(n*n*sizeof(double)) ; if (A==NULL){ printf("error of memory allocation\n"); exit(0); } b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i+j*lda] = ((double) rand()) / ((double) RAND_MAX) - 0.5; @@ -94,9 +94,17 @@ int main(int argc, char **argv) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); exit( 1 ); } - if (info <0) exit( 1 ); + if (info <0) { + free(A); + free(b); + free(ipiv); + exit( 1 ); + } /* Print solution */ print_matrix_colmajor( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ diff --git a/LAPACKE/example/example_DGESV_colmajor_64.c b/LAPACKE/example/example_DGESV_colmajor_64.c index 9c132dfc4d..91e47312e5 100644 --- a/LAPACKE/example/example_DGESV_colmajor_64.c +++ b/LAPACKE/example/example_DGESV_colmajor_64.c @@ -66,9 +66,9 @@ int main(int argc, char **argv) { A = (double *)malloc(n*n*sizeof(double)) ; if (A==NULL){ printf("error of memory allocation\n"); exit(0); } b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i+j*lda] = ((double) rand()) / ((double) RAND_MAX) - 0.5; @@ -94,15 +94,26 @@ int main(int argc, char **argv) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); exit( 1 ); } - if (info <0) exit( 1 ); + if (info <0) { + free(A); + free(b); + free(ipiv); + exit( 1 ); + } /* Print solution */ print_matrix_colmajor_64( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ print_matrix_colmajor_64( "Details of LU factorization", n, n, A, lda ); /* Print pivot indices */ print_vector_64( "Pivot indices", n, ipiv ); + free(A); + free(b); + free(ipiv); exit( 0 ); } /* End of LAPACKE_dgesv Example */ diff --git a/LAPACKE/example/example_DGESV_rowmajor.c b/LAPACKE/example/example_DGESV_rowmajor.c index 64b78ba7bb..045f05bea8 100644 --- a/LAPACKE/example/example_DGESV_rowmajor.c +++ b/LAPACKE/example/example_DGESV_rowmajor.c @@ -65,9 +65,9 @@ int main(int argc, char **argv) { A = (double *)malloc(n*n*sizeof(double)) ; if (A==NULL){ printf("error of memory allocation\n"); exit(0); } b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; @@ -91,9 +91,17 @@ int main(int argc, char **argv) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); exit( 1 ); } - if (info <0) exit( 1 ); + if (info <0) { + free(A); + free(b); + free(ipiv); + exit( 1 ); + } /* Print solution */ print_matrix_rowmajor( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ @@ -105,7 +113,6 @@ int main(int argc, char **argv) { free(A); free(b); free(ipiv); - exit( 0 ); } /* End of LAPACKE_dgesv Example */ diff --git a/LAPACKE/example/example_DGESV_rowmajor_64.c b/LAPACKE/example/example_DGESV_rowmajor_64.c index 28f65fa137..add578dbc6 100644 --- a/LAPACKE/example/example_DGESV_rowmajor_64.c +++ b/LAPACKE/example/example_DGESV_rowmajor_64.c @@ -65,9 +65,9 @@ int main(int argc, char **argv) { A = (double *)malloc(n*n*sizeof(double)) ; if (A==NULL){ printf("error of memory allocation\n"); exit(0); } b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); exit(0); } + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); exit(0); } + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; @@ -91,15 +91,26 @@ int main(int argc, char **argv) { printf( "The diagonal element of the triangular factor of A,\n" ); printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); exit( 1 ); } - if (info <0) exit( 1 ); + if (info <0) { + free(A); + free(b); + free(ipiv); + exit( 1 ); + } /* Print solution */ print_matrix_rowmajor_64( "Solution", n, nrhs, b, ldb ); /* Print details of LU factorization */ print_matrix_rowmajor_64( "Details of LU factorization", n, n, A, lda ); /* Print pivot indices */ print_vector_64( "Pivot indices", n, ipiv ); + free(A); + free(b); + free(ipiv); exit( 0 ); } /* End of LAPACKE_dgesv Example */ From 15d05b4fbc2085000d678cc6125ac7d3bf574242 Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Tue, 2 Jan 2024 19:35:23 -0800 Subject: [PATCH 052/206] fix code style in LAPACKE DGESV examples --- LAPACKE/example/example_DGESV_colmajor.c | 60 ++++++++++----------- LAPACKE/example/example_DGESV_colmajor_64.c | 60 ++++++++++----------- LAPACKE/example/example_DGESV_rowmajor.c | 60 ++++++++++----------- LAPACKE/example/example_DGESV_rowmajor_64.c | 60 ++++++++++----------- 4 files changed, 120 insertions(+), 120 deletions(-) diff --git a/LAPACKE/example/example_DGESV_colmajor.c b/LAPACKE/example/example_DGESV_colmajor.c index e028768309..62a467139c 100644 --- a/LAPACKE/example/example_DGESV_colmajor.c +++ b/LAPACKE/example/example_DGESV_colmajor.c @@ -41,41 +41,41 @@ int main(int argc, char **argv) { /* Locals */ lapack_int n, nrhs, lda, ldb, info; - int i, j; + int i, j; /* Local arrays */ - double *A, *b; - lapack_int *ipiv; + double *A, *b; + lapack_int *ipiv; /* Default Value */ - n = 5; nrhs = 1; + n = 5; nrhs = 1; /* Arguments */ - for( i = 1; i < argc; i++ ) { - if( strcmp( argv[i], "-n" ) == 0 ) { - n = atoi(argv[i+1]); - i++; - } - if( strcmp( argv[i], "-nrhs" ) == 0 ) { - nrhs = atoi(argv[i+1]); - i++; - } - } + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } /* Initialization */ lda=n, ldb=n; - A = (double *)malloc(n*n*sizeof(double)) ; - if (A==NULL){ printf("error of memory allocation\n"); exit(0); } - b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } - ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } + ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i+j*lda] = ((double) rand()) / ((double) RAND_MAX) - 0.5; - } + } - for(i=0;i 0 ) { - printf( "The diagonal element of the triangular factor of A,\n" ); - printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); - printf( "the solution could not be computed.\n" ); - free(A); - free(b); - free(ipiv); - exit( 1 ); + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); + exit( 1 ); } if (info <0) { free(A); diff --git a/LAPACKE/example/example_DGESV_colmajor_64.c b/LAPACKE/example/example_DGESV_colmajor_64.c index 91e47312e5..6273de4460 100644 --- a/LAPACKE/example/example_DGESV_colmajor_64.c +++ b/LAPACKE/example/example_DGESV_colmajor_64.c @@ -41,41 +41,41 @@ int main(int argc, char **argv) { /* Locals */ int64_t n, nrhs, lda, ldb, info; - int i, j; + int i, j; /* Local arrays */ - double *A, *b; - int64_t *ipiv; + double *A, *b; + int64_t *ipiv; /* Default Value */ - n = 5; nrhs = 1; + n = 5; nrhs = 1; /* Arguments */ - for( i = 1; i < argc; i++ ) { - if( strcmp( argv[i], "-n" ) == 0 ) { - n = atoi(argv[i+1]); - i++; - } - if( strcmp( argv[i], "-nrhs" ) == 0 ) { - nrhs = atoi(argv[i+1]); - i++; - } - } + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } /* Initialization */ lda=n, ldb=n; - A = (double *)malloc(n*n*sizeof(double)) ; - if (A==NULL){ printf("error of memory allocation\n"); exit(0); } - b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } - ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } + ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i+j*lda] = ((double) rand()) / ((double) RAND_MAX) - 0.5; - } + } - for(i=0;i 0 ) { - printf( "The diagonal element of the triangular factor of A,\n" ); - printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); - printf( "the solution could not be computed.\n" ); - free(A); - free(b); - free(ipiv); - exit( 1 ); + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); + exit( 1 ); } if (info <0) { free(A); diff --git a/LAPACKE/example/example_DGESV_rowmajor.c b/LAPACKE/example/example_DGESV_rowmajor.c index 045f05bea8..8cce8963db 100644 --- a/LAPACKE/example/example_DGESV_rowmajor.c +++ b/LAPACKE/example/example_DGESV_rowmajor.c @@ -40,41 +40,41 @@ int main(int argc, char **argv) { /* Locals */ lapack_int n, nrhs, lda, ldb, info; - int i, j; + int i, j; /* Local arrays */ - double *A, *b; - lapack_int *ipiv; + double *A, *b; + lapack_int *ipiv; /* Default Value */ - n = 5; nrhs = 1; + n = 5; nrhs = 1; /* Arguments */ - for( i = 1; i < argc; i++ ) { - if( strcmp( argv[i], "-n" ) == 0 ) { - n = atoi(argv[i+1]); - i++; - } - if( strcmp( argv[i], "-nrhs" ) == 0 ) { - nrhs = atoi(argv[i+1]); - i++; - } - } + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } /* Initialization */ lda=n, ldb=nrhs; - A = (double *)malloc(n*n*sizeof(double)) ; - if (A==NULL){ printf("error of memory allocation\n"); exit(0); } - b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } - ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } + ipiv = (lapack_int *)malloc(n*sizeof(lapack_int)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; - } + } - for(i=0;i 0 ) { - printf( "The diagonal element of the triangular factor of A,\n" ); - printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); - printf( "the solution could not be computed.\n" ); - free(A); - free(b); - free(ipiv); - exit( 1 ); + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); + exit( 1 ); } if (info <0) { free(A); diff --git a/LAPACKE/example/example_DGESV_rowmajor_64.c b/LAPACKE/example/example_DGESV_rowmajor_64.c index add578dbc6..6ebef3031c 100644 --- a/LAPACKE/example/example_DGESV_rowmajor_64.c +++ b/LAPACKE/example/example_DGESV_rowmajor_64.c @@ -40,41 +40,41 @@ int main(int argc, char **argv) { /* Locals */ int64_t n, nrhs, lda, ldb, info; - int i, j; + int i, j; /* Local arrays */ - double *A, *b; - int64_t *ipiv; + double *A, *b; + int64_t *ipiv; /* Default Value */ - n = 5; nrhs = 1; + n = 5; nrhs = 1; /* Arguments */ - for( i = 1; i < argc; i++ ) { - if( strcmp( argv[i], "-n" ) == 0 ) { - n = atoi(argv[i+1]); - i++; - } - if( strcmp( argv[i], "-nrhs" ) == 0 ) { - nrhs = atoi(argv[i+1]); - i++; - } - } + for( i = 1; i < argc; i++ ) { + if( strcmp( argv[i], "-n" ) == 0 ) { + n = atoi(argv[i+1]); + i++; + } + if( strcmp( argv[i], "-nrhs" ) == 0 ) { + nrhs = atoi(argv[i+1]); + i++; + } + } /* Initialization */ lda=n, ldb=nrhs; - A = (double *)malloc(n*n*sizeof(double)) ; - if (A==NULL){ printf("error of memory allocation\n"); exit(0); } - b = (double *)malloc(n*nrhs*sizeof(double)) ; - if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } - ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; - if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } + A = (double *)malloc(n*n*sizeof(double)) ; + if (A==NULL){ printf("error of memory allocation\n"); exit(0); } + b = (double *)malloc(n*nrhs*sizeof(double)) ; + if (b==NULL){ printf("error of memory allocation\n"); free(A); exit(0); } + ipiv = (int64_t *)malloc(n*sizeof(int64_t)) ; + if (ipiv==NULL){ printf("error of memory allocation\n"); free(A); free(b); exit(0); } for( i = 0; i < n; i++ ) { for( j = 0; j < n; j++ ) A[i*lda+j] = ((double) rand()) / ((double) RAND_MAX) - 0.5; - } + } - for(i=0;i 0 ) { - printf( "The diagonal element of the triangular factor of A,\n" ); - printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); - printf( "the solution could not be computed.\n" ); - free(A); - free(b); - free(ipiv); - exit( 1 ); + printf( "The diagonal element of the triangular factor of A,\n" ); + printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info ); + printf( "the solution could not be computed.\n" ); + free(A); + free(b); + free(ipiv); + exit( 1 ); } if (info <0) { free(A); From bc5d836a319f34d15922a50cf53a5e0cdadd02db Mon Sep 17 00:00:00 2001 From: Maria Kraynyuk Date: Mon, 5 Feb 2024 11:37:04 -0800 Subject: [PATCH 053/206] resolve conflicts after rebasing --- SRC/cgedmd.f90 | 6 +++--- SRC/cgedmdq.f90 | 8 ++++---- SRC/sgedmd.f90 | 4 ++-- SRC/sgedmdq.f90 | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index 87e92eeb4c..d4a09e8b42 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -741,9 +741,9 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ELSE IF ( LQUERY ) THEN ! Return minimal and optimal workspace sizes IWORK(1) = IMINWR - RWORK(1) = MLRWRK - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK + RWORK(1) = REAL(MLRWRK) + ZWORK(1) = CMPLX(MLWORK) + ZWORK(2) = CMPLX(OLWORK) RETURN END IF !............................................................ diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index dd70a34a9e..9e152a5956 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -762,10 +762,10 @@ SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ELSE IF ( LQUERY ) THEN ! Return minimal and optimal workspace sizes IWORK(1) = IMINWR - ZWORK(1) = MLWORK - ZWORK(2) = OLWORK - WORK(1) = MLRWRK - WORK(2) = MLRWRK + ZWORK(1) = CMPLX(MLWORK) + ZWORK(2) = CMPLX(OLWORK) + WORK(1) = REAL(MLRWRK) + WORK(2) = REAL(MLRWRK) RETURN END IF !..... diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index 90d15c3360..2ce6a3b8c8 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -763,8 +763,8 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ELSE IF ( LQUERY ) THEN ! Return minimal and optimal workspace sizes IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK + WORK(1) = REAL(MLWORK) + WORK(2) = REAL(OLWORK) RETURN END IF !............................................................ diff --git a/SRC/sgedmdq.f90 b/SRC/sgedmdq.f90 index 2506149cc7..769a7830b7 100644 --- a/SRC/sgedmdq.f90 +++ b/SRC/sgedmdq.f90 @@ -775,8 +775,8 @@ SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ELSE IF ( LQUERY ) THEN ! Return minimal and optimal workspace sizes IWORK(1) = IMINWR - WORK(1) = MLWORK - WORK(2) = OLWORK + WORK(1) = REAL(MLWORK) + WORK(2) = REAL(OLWORK) RETURN END IF !..... From acbac1092c15d24a44c695c2e4b0c6b2b99cc296 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Sat, 16 Dec 2023 15:53:03 +0100 Subject: [PATCH 054/206] Update documentation of work size in bdsqr (thanks @TarcioV) In https://github.com/Reference-LAPACK/lapack/pull/234 only dbdsqr was updated. This updates the documentation of the other precisions. --- SRC/cbdsqr.f | 2 +- SRC/sbdsqr.f | 2 +- SRC/zbdsqr.f | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index 5c94c0cccb..63ee7e1118 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is REAL array, dimension (4*N) +*> RWORK is REAL array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index 2d78c65a81..ac62273981 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (4*N) +*> WORK is REAL array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index cc0922b1b6..38ef4ec197 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (4*N) +*> RWORK is DOUBLE PRECISION array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO From 230b8c4862a3f45ee645e26e8f609ac3dbe9574d Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Sun, 17 Dec 2023 16:18:31 +0100 Subject: [PATCH 055/206] Fix -ZERO singular value in bdsqr [D,Z]BDSQR returns for D = [ -4.0, -3.0, -2.0, -1.0, 0.0, 1.0, 2.0, 3.0, 4.0, 5.0] E = [ 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0] as singular value D(10) = -ZERO. By definition, singular values are non-negative. LASQ1 already fixes the sign and returns +ZERO. --- SRC/cbdsqr.f | 6 ++++++ SRC/dbdsqr.f | 6 ++++++ SRC/sbdsqr.f | 7 +++++++ SRC/zbdsqr.f | 6 ++++++ 4 files changed, 25 insertions(+) diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index 63ee7e1118..e3b11a5cb4 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -809,6 +809,12 @@ SUBROUTINE CBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * 160 CONTINUE DO 170 I = 1, N + IF( D( I ).EQ.ZERO ) THEN +* +* Avoid -ZERO +* + D( I ) = ZERO + END IF IF( D( I ).LT.ZERO ) THEN D( I ) = -D( I ) * diff --git a/SRC/dbdsqr.f b/SRC/dbdsqr.f index 1a6480e0c8..4b6fe20417 100644 --- a/SRC/dbdsqr.f +++ b/SRC/dbdsqr.f @@ -817,6 +817,12 @@ SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * 160 CONTINUE DO 170 I = 1, N + IF( D( I ).EQ.ZERO ) THEN +* +* Avoid -ZERO +* + D( I ) = ZERO + END IF IF( D( I ).LT.ZERO ) THEN D( I ) = -D( I ) * diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index ac62273981..27b434363e 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -817,7 +817,14 @@ SUBROUTINE SBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * 160 CONTINUE DO 170 I = 1, N + IF( D( I ).EQ.ZERO ) THEN +* +* Avoid -ZERO +* + D( I ) = ZERO + END IF IF( D( I ).LT.ZERO ) THEN + D( I ) = -D( I ) * * Change sign of singular vectors, if desired diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index 38ef4ec197..c8ba35fa68 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -807,6 +807,12 @@ SUBROUTINE ZBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, * 160 CONTINUE DO 170 I = 1, N + IF( D( I ).EQ.ZERO ) THEN +* +* Avoid -ZERO +* + D( I ) = ZERO + END IF IF( D( I ).LT.ZERO ) THEN D( I ) = -D( I ) * From e02fbdaebc34a5056dc0dfd44537495860660122 Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Fri, 1 Mar 2024 12:45:56 +0100 Subject: [PATCH 056/206] xGEDMD(Q): silence warning with 64-bit integers Fix the following warning by GCC 12.2.0: Warning: Use of the NUMERIC_STORAGE_SIZE named constant from intrinsic module ISO_FORTRAN_ENV at (1) is incompatible with option -fdefault-integer-8 --- SRC/cgedmd.f90 | 4 ++-- SRC/cgedmdq.f90 | 4 ++-- SRC/dgedmd.f90 | 5 ++--- SRC/dgedmdq.f90 | 4 ++-- SRC/sgedmd.f90 | 4 ++-- SRC/sgedmdq.f90 | 4 ++-- SRC/zgedmd.f90 | 4 ++-- SRC/zgedmdq.f90 | 4 ++-- 8 files changed, 16 insertions(+), 17 deletions(-) diff --git a/SRC/cgedmd.f90 b/SRC/cgedmd.f90 index d4a09e8b42..9cc23e81e0 100644 --- a/SRC/cgedmd.f90 +++ b/SRC/cgedmd.f90 @@ -11,7 +11,7 @@ ! W, LDW, S, LDS, ZWORK, LZWORK, & ! RWORK, LRWORK, IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real32 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real32 ! @@ -506,7 +506,7 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real32 IMPLICIT NONE INTEGER, PARAMETER :: WP = real32 ! diff --git a/SRC/cgedmdq.f90 b/SRC/cgedmdq.f90 index 9e152a5956..0f296963c3 100644 --- a/SRC/cgedmdq.f90 +++ b/SRC/cgedmdq.f90 @@ -12,7 +12,7 @@ ! S, LDS, ZWORK, LZWORK, WORK, LWORK, & ! IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real32 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real32 !..... @@ -563,7 +563,7 @@ SUBROUTINE CGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real32 IMPLICIT NONE INTEGER, PARAMETER :: WP = real32 ! diff --git a/SRC/dgedmd.f90 b/SRC/dgedmd.f90 index 9c4afd182d..642e2d61b3 100644 --- a/SRC/dgedmd.f90 +++ b/SRC/dgedmd.f90 @@ -10,9 +10,8 @@ ! K, REIG, IMEIG, Z, LDZ, RES, & ! B, LDB, W, LDW, S, LDS, & ! WORK, LWORK, IWORK, LIWORK, INFO ) -! !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real64 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real64 !..... @@ -541,7 +540,7 @@ SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real64 IMPLICIT NONE INTEGER, PARAMETER :: WP = real64 ! diff --git a/SRC/dgedmdq.f90 b/SRC/dgedmdq.f90 index b1fb62b44a..75d9d18ee3 100644 --- a/SRC/dgedmdq.f90 +++ b/SRC/dgedmdq.f90 @@ -11,7 +11,7 @@ ! Z, LDZ, RES, B, LDB, V, LDV, & ! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real64 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real64 !..... @@ -581,7 +581,7 @@ SUBROUTINE DGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real64 IMPLICIT NONE INTEGER, PARAMETER :: WP = real64 ! diff --git a/SRC/sgedmd.f90 b/SRC/sgedmd.f90 index 2ce6a3b8c8..68e85d8210 100644 --- a/SRC/sgedmd.f90 +++ b/SRC/sgedmd.f90 @@ -11,7 +11,7 @@ ! B, LDB, W, LDW, S, LDS, & ! WORK, LWORK, IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real32 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real32 !..... @@ -540,7 +540,7 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real32 IMPLICIT NONE INTEGER, PARAMETER :: WP = real32 ! diff --git a/SRC/sgedmdq.f90 b/SRC/sgedmdq.f90 index 769a7830b7..6bb0a9ed0a 100644 --- a/SRC/sgedmdq.f90 +++ b/SRC/sgedmdq.f90 @@ -11,7 +11,7 @@ ! Z, LDZ, RES, B, LDB, V, LDV, & ! S, LDS, WORK, LWORK, IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real32 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real32 !..... @@ -581,7 +581,7 @@ SUBROUTINE SGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real32 IMPLICIT NONE INTEGER, PARAMETER :: WP = real32 ! diff --git a/SRC/zgedmd.f90 b/SRC/zgedmd.f90 index a2af6e04b9..7e40a3f1b6 100644 --- a/SRC/zgedmd.f90 +++ b/SRC/zgedmd.f90 @@ -11,7 +11,7 @@ ! W, LDW, S, LDS, ZWORK, LZWORK, & ! RWORK, LRWORK, IWORK, LIWORK, INFO ) !...... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real64 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real64 ! @@ -506,7 +506,7 @@ SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real64 IMPLICIT NONE INTEGER, PARAMETER :: WP = real64 ! diff --git a/SRC/zgedmdq.f90 b/SRC/zgedmdq.f90 index c16288d0fa..9436d471a8 100644 --- a/SRC/zgedmdq.f90 +++ b/SRC/zgedmdq.f90 @@ -12,7 +12,7 @@ ! S, LDS, ZWORK, LZWORK, WORK, LWORK, & ! IWORK, LIWORK, INFO ) !..... -! USE iso_fortran_env +! USE, INTRINSIC :: iso_fortran_env, only: real64 ! IMPLICIT NONE ! INTEGER, PARAMETER :: WP = real64 !..... @@ -562,7 +562,7 @@ SUBROUTINE ZGEDMDQ( JOBS, JOBZ, JOBR, JOBQ, JOBT, JOBF, & ! -- Colorado Denver and NAG Ltd.. -- ! !..... - USE iso_fortran_env + USE, INTRINSIC :: iso_fortran_env, only: real64 IMPLICIT NONE INTEGER, PARAMETER :: WP = real64 ! From 742c35546bad2647adae4af882b0798de6c1ac8f Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Thu, 21 Mar 2024 17:51:58 +0100 Subject: [PATCH 057/206] C/ZHEEVR: add remark about safe parameter choice The remark was only found in the real-valued implementations. --- SRC/cheevr.f | 1 + SRC/zheevr.f | 1 + 2 files changed, 2 insertions(+) diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 162c8cd87e..da8ec2b367 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -242,6 +242,7 @@ *> Note: the user must ensure that at least max(1,M) columns are *> supplied in the array Z; if RANGE = 'V', the exact value of M *> is not known in advance and an upper bound must be used. +*> Supplying N columns is always safe. *> \endverbatim *> *> \param[in] LDZ diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 94ad90f166..2ffe3f1723 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -242,6 +242,7 @@ *> Note: the user must ensure that at least max(1,M) columns are *> supplied in the array Z; if RANGE = 'V', the exact value of M *> is not known in advance and an upper bound must be used. +*> Supplying N columns is always safe. *> \endverbatim *> *> \param[in] LDZ From 88f15c26311939fcb11cef269fecb2f72f821985 Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Thu, 21 Mar 2024 17:53:49 +0100 Subject: [PATCH 058/206] xSY/HEEVR: clarify use of multiple algorithms fixes #997 --- SRC/cheevr.f | 19 ++++++++++++++++--- SRC/dsyevr.f | 19 ++++++++++++++++--- SRC/ssyevr.f | 19 ++++++++++++++++--- SRC/zheevr.f | 19 ++++++++++++++++--- 4 files changed, 64 insertions(+), 12 deletions(-) diff --git a/SRC/cheevr.f b/SRC/cheevr.f index da8ec2b367..795e32e981 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -41,9 +41,16 @@ *> \verbatim *> *> CHEEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can -*> be selected by specifying either a range of values or a range of -*> indices for the desired eigenvalues. +*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> selected by specifying either a range of values or a range of indices +*> for the desired eigenvalues. Invocations with different choices for +*> these parameters may result in the computation of slightly different +*> eigenvalues and/or eigenvectors for the same matrix. The reason for +*> this behavior is that there exists a variety of algorithms (each +*> performing best for a particular set of options) with CHEEVR +*> attempting to select the best based on the various parameters. In all +*> cases, the computed values are accurate within the limits of finite +*> precision arithmetic. *> *> CHEEVR first reduces the matrix A to tridiagonal form T with a call *> to CHETRD. Then, whenever possible, CHEEVR calls CSTEMR to compute @@ -107,6 +114,9 @@ *> JOBZ is CHARACTER*1 *> = 'N': Compute eigenvalues only; *> = 'V': Compute eigenvalues and eigenvectors. +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] RANGE @@ -118,6 +128,9 @@ *> = 'I': the IL-th through IU-th eigenvalues will be found. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and *> CSTEIN are called +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] UPLO diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 72dd32d99b..99eb60ec85 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -39,9 +39,16 @@ *> \verbatim *> *> DSYEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be -*> selected by specifying either a range of values or a range of -*> indices for the desired eigenvalues. +*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> selected by specifying either a range of values or a range of indices +*> for the desired eigenvalues. Invocations with different choices for +*> these parameters may result in the computation of slightly different +*> eigenvalues and/or eigenvectors for the same matrix. The reason for +*> this behavior is that there exists a variety of algorithms (each +*> performing best for a particular set of options) with DSYEVR +*> attempting to select the best based on the various parameters. In all +*> cases, the computed values are accurate within the limits of finite +*> precision arithmetic. *> *> DSYEVR first reduces the matrix A to tridiagonal form T with a call *> to DSYTRD. Then, whenever possible, DSYEVR calls DSTEMR to compute @@ -105,6 +112,9 @@ *> JOBZ is CHARACTER*1 *> = 'N': Compute eigenvalues only; *> = 'V': Compute eigenvalues and eigenvectors. +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] RANGE @@ -116,6 +126,9 @@ *> = 'I': the IL-th through IU-th eigenvalues will be found. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and *> DSTEIN are called +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] UPLO diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 8fedb4ca28..f12095649f 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -39,9 +39,16 @@ *> \verbatim *> *> SSYEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be -*> selected by specifying either a range of values or a range of -*> indices for the desired eigenvalues. +*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> selected by specifying either a range of values or a range of indices +*> for the desired eigenvalues. Invocations with different choices for +*> these parameters may result in the computation of slightly different +*> eigenvalues and/or eigenvectors for the same matrix. The reason for +*> this behavior is that there exists a variety of algorithms (each +*> performing best for a particular set of options) with SSYEVR +*> attempting to select the best based on the various parameters. In all +*> cases, the computed values are accurate within the limits of finite +*> precision arithmetic. *> *> SSYEVR first reduces the matrix A to tridiagonal form T with a call *> to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute @@ -105,6 +112,9 @@ *> JOBZ is CHARACTER*1 *> = 'N': Compute eigenvalues only; *> = 'V': Compute eigenvalues and eigenvectors. +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] RANGE @@ -116,6 +126,9 @@ *> = 'I': the IL-th through IU-th eigenvalues will be found. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and *> SSTEIN are called +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] UPLO diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 2ffe3f1723..e4114b9681 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -41,9 +41,16 @@ *> \verbatim *> *> ZHEEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can -*> be selected by specifying either a range of values or a range of -*> indices for the desired eigenvalues. +*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> selected by specifying either a range of values or a range of indices +*> for the desired eigenvalues. Invocations with different choices for +*> these parameters may result in the computation of slightly different +*> eigenvalues and/or eigenvectors for the same matrix. The reason for +*> this behavior is that there exists a variety of algorithms (each +*> performing best for a particular set of options) with ZHEEVR +*> attempting to select the best based on the various parameters. In all +*> cases, the computed values are accurate within the limits of finite +*> precision arithmetic. *> *> ZHEEVR first reduces the matrix A to tridiagonal form T with a call *> to ZHETRD. Then, whenever possible, ZHEEVR calls ZSTEMR to compute @@ -107,6 +114,9 @@ *> JOBZ is CHARACTER*1 *> = 'N': Compute eigenvalues only; *> = 'V': Compute eigenvalues and eigenvectors. +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] RANGE @@ -118,6 +128,9 @@ *> = 'I': the IL-th through IU-th eigenvalues will be found. *> For RANGE = 'V' or 'I' and IU - IL < N - 1, DSTEBZ and *> ZSTEIN are called +*> +*> This parameter influences the choice of the algorithm and +*> may alter the computed values. *> \endverbatim *> *> \param[in] UPLO From e79eae6c4e4d620efb95f739a3bcab5a9329cc26 Mon Sep 17 00:00:00 2001 From: Christoph Conrads Date: Thu, 21 Mar 2024 18:32:02 +0100 Subject: [PATCH 059/206] xHEEVR: fix a copy-and-paste error Thanks to @langou for proof-reading. --- SRC/cheevr.f | 2 +- SRC/zheevr.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 795e32e981..13a0011653 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -41,7 +41,7 @@ *> \verbatim *> *> CHEEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can be *> selected by specifying either a range of values or a range of indices *> for the desired eigenvalues. Invocations with different choices for *> these parameters may result in the computation of slightly different diff --git a/SRC/zheevr.f b/SRC/zheevr.f index e4114b9681..56761a5249 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -41,7 +41,7 @@ *> \verbatim *> *> ZHEEVR computes selected eigenvalues and, optionally, eigenvectors -*> of a real symmetric matrix A. Eigenvalues and eigenvectors can be +*> of a complex Hermitian matrix A. Eigenvalues and eigenvectors can be *> selected by specifying either a range of values or a range of indices *> for the desired eigenvalues. Invocations with different choices for *> these parameters may result in the computation of slightly different From ace63d1837f4cd3c919b809f4c4d06f75aa1a633 Mon Sep 17 00:00:00 2001 From: Ahnaf Tahmid Chowdhury Date: Fri, 29 Mar 2024 00:47:16 +0600 Subject: [PATCH 060/206] configure RPATH --- CMakeLists.txt | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fa53ae5398..f310eb1267 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -119,13 +119,20 @@ include(GNUInstallDirs) # the OSX RPATH settings have been updated per recommendations found # in the CMake Wiki: # http://www.cmake.org/Wiki/CMake_RPATH_handling#Mac_OS_X_and_the_RPATH -set(CMAKE_MACOSX_RPATH ON) -set(CMAKE_SKIP_BUILD_RPATH FALSE) -set(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) +option(CMAKE_MACOSX_RPATH "Enable macOS RPATH" ON) +message(STATUS "Enable macOS RPATH: ${CMAKE_MACOSX_RPATH}") +option(CMAKE_SKIP_BUILD_RPATH "Skip build-time RPATH" OFF) +message(STATUS "Skip build-time RPATH: ${CMAKE_SKIP_BUILD_RPATH}") +option(CMAKE_BUILD_WITH_INSTALL_RPATH "Build with install RPATH" OFF) +message(STATUS "Build with install RPATH: ${CMAKE_BUILD_WITH_INSTALL_RPATH}") + list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir) -if("${isSystemDir}" STREQUAL "-1") - set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR}) - set(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE) + +if ("${isSystemDir}" STREQUAL "-1") + option(CMAKE_INSTALL_RPATH "Install RPATH" ${CMAKE_INSTALL_FULL_LIBDIR}) + message(STATUS "Install RPATH: ${CMAKE_INSTALL_RPATH}") + option(CMAKE_INSTALL_RPATH_USE_LINK_PATH "Use link path for RPATH" ON) + message(STATUS "Install RPATH use link path: ${CMAKE_INSTALL_RPATH_USE_LINK_PATH}") endif() From 06fc0d8970bcd26f9947fb21dc82210f78811482 Mon Sep 17 00:00:00 2001 From: Igor Zhuravlov Date: Mon, 8 Apr 2024 19:12:19 +1000 Subject: [PATCH 061/206] fix comments add datatype declaration for LWORK --- SRC/cgetsqrhrt.f | 1 + SRC/cungtsqr_row.f | 1 + SRC/dorgtsqr_row.f | 1 + SRC/sorgtsqr_row.f | 1 + SRC/zgetsqrhrt.f | 1 + SRC/zungtsqr_row.f | 1 + 6 files changed, 6 insertions(+) diff --git a/SRC/cgetsqrhrt.f b/SRC/cgetsqrhrt.f index 9134014c72..2eb63e3dac 100644 --- a/SRC/cgetsqrhrt.f +++ b/SRC/cgetsqrhrt.f @@ -130,6 +130,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> If MIN(M,N) = 0, LWORK >= 1, else *> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), diff --git a/SRC/cungtsqr_row.f b/SRC/cungtsqr_row.f index 4515440a16..98df2aef69 100644 --- a/SRC/cungtsqr_row.f +++ b/SRC/cungtsqr_row.f @@ -144,6 +144,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> LWORK >= NBLOCAL * MAX(NBLOCAL,(N-NBLOCAL)), *> where NBLOCAL=MIN(NB,N). diff --git a/SRC/dorgtsqr_row.f b/SRC/dorgtsqr_row.f index 95cb02cc2e..3fc924ce72 100644 --- a/SRC/dorgtsqr_row.f +++ b/SRC/dorgtsqr_row.f @@ -144,6 +144,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> LWORK >= NBLOCAL * MAX(NBLOCAL,(N-NBLOCAL)), *> where NBLOCAL=MIN(NB,N). diff --git a/SRC/sorgtsqr_row.f b/SRC/sorgtsqr_row.f index 5a1e1ff072..29172919e0 100644 --- a/SRC/sorgtsqr_row.f +++ b/SRC/sorgtsqr_row.f @@ -144,6 +144,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> LWORK >= NBLOCAL * MAX(NBLOCAL,(N-NBLOCAL)), *> where NBLOCAL=MIN(NB,N). diff --git a/SRC/zgetsqrhrt.f b/SRC/zgetsqrhrt.f index b9ebaadd47..f541135903 100644 --- a/SRC/zgetsqrhrt.f +++ b/SRC/zgetsqrhrt.f @@ -130,6 +130,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> If MIN(M,N) = 0, LWORK >= 1, else *> LWORK >= MAX( 1, LWT + LW1, MAX( LWT+N*N+LW2, LWT+N*N+N ) ), diff --git a/SRC/zungtsqr_row.f b/SRC/zungtsqr_row.f index 96a27d260b..ee70f292e0 100644 --- a/SRC/zungtsqr_row.f +++ b/SRC/zungtsqr_row.f @@ -144,6 +144,7 @@ *> *> \param[in] LWORK *> \verbatim +*> LWORK is INTEGER *> The dimension of the array WORK. *> LWORK >= NBLOCAL * MAX(NBLOCAL,(N-NBLOCAL)), *> where NBLOCAL=MIN(NB,N). From 173a3f475c9de2c5b9a8fcd7fed1895e5862db98 Mon Sep 17 00:00:00 2001 From: Igor Zhuravlov Date: Wed, 10 Apr 2024 17:11:51 +1000 Subject: [PATCH 062/206] fix comments 1) add definition to xTRSYL3 2) minor formatting unifications --- SRC/ctrsyl3.f | 26 +++++++++++++++++++------- SRC/dlarmm.f | 4 ++-- SRC/dtrsyl3.f | 36 ++++++++++++++++++++++++++---------- SRC/slarmm.f | 4 ++-- SRC/strsyl3.f | 35 +++++++++++++++++++++++++---------- SRC/zgesvdq.f | 4 ++-- SRC/ztrsyl3.f | 26 +++++++++++++++++++------- 7 files changed, 95 insertions(+), 40 deletions(-) diff --git a/SRC/ctrsyl3.f b/SRC/ctrsyl3.f index d2b8fd9ccd..5bf90f242b 100644 --- a/SRC/ctrsyl3.f +++ b/SRC/ctrsyl3.f @@ -1,10 +1,23 @@ *> \brief \b CTRSYL3 * -* Definition: -* =========== +* Definition: +* =========== * +* SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, +* C, LDC, SCALE, SWORK, LDSWORK, INFO ) * -*> \par Purpose +* .. Scalar Arguments .. +* CHARACTER TRANA, TRANB +* INTEGER INFO, ISGN, LDA, LDB, LDC, LDSWORK, M, N +* REAL SCALE +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ) +* REAL SWORK( LDSWORK, * ) +* .. +* +* +*> \par Purpose: * ============= *> *> \verbatim @@ -22,8 +35,8 @@ *> This is the block version of the algorithm. *> \endverbatim * -* Arguments -* ========= +* Arguments: +* ========== * *> \param[in] TRANA *> \verbatim @@ -152,8 +165,7 @@ * * ===================================================================== SUBROUTINE CTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, - $ C, - $ LDC, SCALE, SWORK, LDSWORK, INFO ) + $ C, LDC, SCALE, SWORK, LDSWORK, INFO ) IMPLICIT NONE * * .. Scalar Arguments .. diff --git a/SRC/dlarmm.f b/SRC/dlarmm.f index f276df3655..f1e78dfade 100644 --- a/SRC/dlarmm.f +++ b/SRC/dlarmm.f @@ -1,7 +1,7 @@ *> \brief \b DLARMM * -* Definition: -* =========== +* Definition: +* =========== * * DOUBLE PRECISION FUNCTION DLARMM( ANORM, BNORM, CNORM ) * diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index 78c262004f..7d794819ca 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -1,10 +1,27 @@ *> \brief \b DTRSYL3 * -* Definition: -* =========== -* -* -*> \par Purpose +* Definition: +* =========== +* +* SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, +* C, +* LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK, +* INFO ) +* +* .. Scalar Arguments .. +* CHARACTER TRANA, TRANB +* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N, +* LIWORK, LDSWORK +* DOUBLE PRECISION SCALE +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), +* SWORK( LDSWORK, * ) +* .. +* +* +*> \par Purpose: * ============= *> *> \verbatim @@ -27,8 +44,8 @@ *> This is the block version of the algorithm. *> \endverbatim * -* Arguments -* ========= +* Arguments: +* ========== * *> \param[in] TRANA *> \verbatim @@ -176,9 +193,8 @@ * * ===================================================================== SUBROUTINE DTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, - $ C, - $ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK, - $ INFO ) + $ C, LDC, SCALE, IWORK, LIWORK, SWORK, + $ LDSWORK, INFO ) IMPLICIT NONE * * .. Scalar Arguments .. diff --git a/SRC/slarmm.f b/SRC/slarmm.f index 1f454d7fb0..91462e1028 100644 --- a/SRC/slarmm.f +++ b/SRC/slarmm.f @@ -1,7 +1,7 @@ *> \brief \b SLARMM * -* Definition: -* =========== +* Definition: +* =========== * * REAL FUNCTION SLARMM( ANORM, BNORM, CNORM ) * diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index 708cf27066..baa1ce5c39 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -1,10 +1,26 @@ *> \brief \b STRSYL3 * -* Definition: -* =========== -* -* -*> \par Purpose +* Definition: +* =========== +* +* SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, +* C, LDC, SCALE, IWORK, LIWORK, SWORK, +* LDSWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER TRANA, TRANB +* INTEGER INFO, ISGN, LDA, LDB, LDC, M, N, +* LIWORK, LDSWORK +* REAL SCALE +* .. +* .. Array Arguments .. +* INTEGER IWORK( * ) +* REAL A( LDA, * ), B( LDB, * ), C( LDC, * ), +* SWORK( LDSWORK, * ) +* .. +* +* +*> \par Purpose: * ============= *> *> \verbatim @@ -27,8 +43,8 @@ *> This is the block version of the algorithm. *> \endverbatim * -* Arguments -* ========= +* Arguments: +* ========== * *> \param[in] TRANA *> \verbatim @@ -176,9 +192,8 @@ * * ===================================================================== SUBROUTINE STRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, - $ C, - $ LDC, SCALE, IWORK, LIWORK, SWORK, LDSWORK, - $ INFO ) + $ C, LDC, SCALE, IWORK, LIWORK, SWORK, + $ LDSWORK, INFO ) IMPLICIT NONE * * .. Scalar Arguments .. diff --git a/SRC/zgesvdq.f b/SRC/zgesvdq.f index 1fecd324c3..686212ddaa 100644 --- a/SRC/zgesvdq.f +++ b/SRC/zgesvdq.f @@ -51,8 +51,8 @@ *> left and the right singular vectors of A, respectively. *> \endverbatim * -* Arguments -* ========= +* Arguments: +* ========== * *> \param[in] JOBA *> \verbatim diff --git a/SRC/ztrsyl3.f b/SRC/ztrsyl3.f index eeda7f3ad2..0a2fc99dc1 100644 --- a/SRC/ztrsyl3.f +++ b/SRC/ztrsyl3.f @@ -1,10 +1,23 @@ *> \brief \b ZTRSYL3 * -* Definition: -* =========== +* Definition: +* =========== * +* SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, +* C, LDC, SCALE, SWORK, LDSWORK, INFO ) * -*> \par Purpose +* .. Scalar Arguments .. +* CHARACTER TRANA, TRANB +* INTEGER INFO, ISGN, LDA, LDB, LDC, LDSWORK, M, N +* DOUBLE PRECISION SCALE +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) +* DOUBLE PRECISION SWORK( LDSWORK, * ) +* .. +* +* +*> \par Purpose: * ============= *> *> \verbatim @@ -22,8 +35,8 @@ *> This is the block version of the algorithm. *> \endverbatim * -* Arguments -* ========= +* Arguments: +* ========== * *> \param[in] TRANA *> \verbatim @@ -153,8 +166,7 @@ * * ===================================================================== SUBROUTINE ZTRSYL3( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, - $ C, - $ LDC, SCALE, SWORK, LDSWORK, INFO ) + $ C, LDC, SCALE, SWORK, LDSWORK, INFO ) IMPLICIT NONE * * .. Scalar Arguments .. From 157f602f14221909bdb4b9f4fbf6f3abed1abfed Mon Sep 17 00:00:00 2001 From: Tim Kaune Date: Wed, 17 Apr 2024 11:56:10 +0200 Subject: [PATCH 063/206] Add the project option LAPACK_BINARY_PATH_SUFFIX It names a subdirectory added to the install location of all LAPACK binaries. It is empty by default. This allows a consumer, to install the Reference LAPACK binaries into a subdirectory of, e.g., `/usr/local/lib` without inadvertantly changing the install location of the CMake package scripts, which remain unchanged in `/usr/local/lib/cmake`. This can be necessary to avoid conflicts with other BLAS/LAPACK distributions. Previously, this would require the consumer to override `CMAKE_INSTALL_LIBDIR` directly. This shouldn't be done, though, because the variable is provided by the core CMake module GNUInstallDirs and is used in many places. Thus, changing it can have unforeseen consequences. Here, overriding it also changed the install locations of the CMake package scripts and PKGConfig files, which prevents them from being discovered by default by their respective tools. --- CMakeLists.txt | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fa53ae5398..f1a88e014a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -159,12 +159,18 @@ endif() # -------------------------------------------------- set(LAPACK_INSTALL_EXPORT_NAME ${LAPACKLIB}-targets) +set(LAPACK_BINARY_PATH_SUFFIX "" CACHE STRING "Path suffix appended to the install path of binaries") + +if(NOT "${LAPACK_BINARY_PATH_SUFFIX}" STREQUAL "" AND NOT "${LAPACK_BINARY_PATH_SUFFIX}" MATCHES "^/") + set(LAPACK_BINARY_PATH_SUFFIX "/${LAPACK_BINARY_PATH_SUFFIX}") +endif() + macro(lapack_install_library lib) install(TARGETS ${lib} EXPORT ${LAPACK_INSTALL_EXPORT_NAME} - ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT Development - LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT RuntimeLibraries - RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT RuntimeLibraries + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT Development + LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries + RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}${LAPACK_BINARY_PATH_SUFFIX}" COMPONENT RuntimeLibraries ) endmacro() @@ -557,7 +563,7 @@ install(FILES if (LAPACK++) install( DIRECTORY "${LAPACK_BINARY_DIR}/lib/" - DESTINATION ${CMAKE_INSTALL_LIBDIR} + DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" FILES_MATCHING REGEX "liblapackpp.(a|so)$" ) install( @@ -590,7 +596,7 @@ if (BLAS++) ) install( DIRECTORY "${LAPACK_BINARY_DIR}/lib/" - DESTINATION ${CMAKE_INSTALL_LIBDIR} + DESTINATION "${CMAKE_INSTALL_LIBDIR}${LAPACK_BINARY_PATH_SUFFIX}" FILES_MATCHING REGEX "libblaspp.(a|so)$" ) install( From eedcda61c10ca049b538dde51e4d97715f325521 Mon Sep 17 00:00:00 2001 From: Tim Kaune Date: Wed, 17 Apr 2024 11:58:19 +0200 Subject: [PATCH 064/206] Fix CMake installation instructions in LAPACK README The `CMAKE_INSTALL_LIBDIR` was used here from the command line, probably accidentally. It is a variable provided by the core CMake module GNUInstallDirs and shouldn't be overridden. The variable, that makes sense in this context is the `CMAKE_INSTALL_PREFIX` variable, which is intended to be set by the user. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index a00d4c51d8..26e91bea91 100644 --- a/README.md +++ b/README.md @@ -79,7 +79,7 @@ CBLAS, a C interface to the BLAS, and (5) LAPACKE, a C interface to LAPACK. ```sh mkdir build cd build - cmake -DCMAKE_INSTALL_LIBDIR=$HOME/.local/lapack .. + cmake -DCMAKE_INSTALL_PREFIX=$HOME/.local/lapack .. cmake --build . -j --target install ``` - LAPACK can be built and installed using [vcpkg](https://github.com/Microsoft/vcpkg/) dependency manager: From db65b3102e28c82bcda7aea15abf816696245e24 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 15 May 2024 15:37:42 +0200 Subject: [PATCH 065/206] initial skeleton with tests ran --- SRC/dlarf1.f | 231 +++++++++++++++++++++++++++ SRC/la_constants.mod | Bin 0 -> 1563 bytes SRC/la_xisnan.mod | Bin 0 -> 321 bytes testOutput | 368 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 599 insertions(+) create mode 100644 SRC/dlarf1.f create mode 100644 SRC/la_constants.mod create mode 100644 SRC/la_xisnan.mod create mode 100644 testOutput diff --git a/SRC/dlarf1.f b/SRC/dlarf1.f new file mode 100644 index 0000000000..071e72c817 --- /dev/null +++ b/SRC/dlarf1.f @@ -0,0 +1,231 @@ +*> \brief \b DLARF applies an elementary reflector to a general rectangular matrix. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARF + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. +* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLARF applies a real elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a real scalar and v is a real vector. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is DOUBLE PRECISION +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf +* +* ===================================================================== + SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + INTEGER IONE + PARAMETER ( IONE = 1 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC +* .. +* .. External Subroutines .. + EXTERNAL DGEMV, DGER +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILADLR, ILADLC + EXTERNAL LSAME, ILADLR, ILADLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILADLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILADLR(M, LASTV, C, LDC) + END IF + END IF +! Note that lastc.eq.0 renders the BLAS operations null; no special +! case is needed at this level. + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.GT.0 ) THEN +* +* w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) +* + CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C(2,1), LDC, + $ V(INCV), INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) := w(1:lastc,1) + C(1,1:lastc)**T * v(1,1) +* = w(1:lastc,1) + C(1,1:lastc)**T +* + CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) +* +* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T +* + CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.GT.0 ) THEN +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC, + $ V, INCV, ZERO, WORK, 1 ) +* +* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T +* + CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) + END IF + END IF + RETURN +* +* End of DLARF +* + END diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod new file mode 100644 index 0000000000000000000000000000000000000000..b8006a566979124de13911e5efcec9baedca2f6f GIT binary patch literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) literal 0 HcmV?d00001 diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod new file mode 100644 index 0000000000000000000000000000000000000000..1b5610476a459fda31282807dce61ffd51c6d396 GIT binary patch literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< literal 0 HcmV?d00001 diff --git a/testOutput b/testOutput new file mode 100644 index 0000000000..ed9c630306 --- /dev/null +++ b/testOutput @@ -0,0 +1,368 @@ +make -C INSTALL run +make -C SRC +make -C TESTING/MATGEN +make -C BLAS +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/INSTALL' +gfortran -O2 -frecursive -o testlsame lsame.o lsametst.o +gfortran -O2 -frecursive -o testslamch slamch.o lsame.o slamchtst.o +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' +make -C SRC +gfortran -O2 -frecursive -o testdlamch dlamch.o lsame.o dlamchtst.o +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' +make[1]: Nothing to be done for 'all'. +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' +[INFO] : TIMER value: INT_ETIME (given by make.inc) +[INFO] : TIMER value: INT_ETIME (given by make.inc) +gfortran -O2 -frecursive -o testsecond second_INT_ETIME.o secondtst.o +gfortran -O2 -frecursive -o testdsecnd dsecnd_INT_ETIME.o dsecndtst.o +gfortran -O2 -frecursive -o testieee tstiee.o ../SRC/ieeeck.o ../SRC/ilaenv.o ../SRC/iparmq.o +gfortran -O2 -frecursive -o testversion ilaver.o LAPACK_version.o +gfortran -O2 -frecursive -o test_zcomplexabs test_zcomplexabs.o +gfortran -O2 -frecursive -o test_zcomplexdiv test_zcomplexdiv.o +gfortran -O2 -frecursive -o test_zcomplexmult test_zcomplexmult.o +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' +make[2]: Nothing to be done for 'all'. +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' +make -C BLAS blas_testing +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' +make -C SRC +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' +make[2]: Nothing to be done for 'all'. +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' +make -C TESTING run +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/TESTING' +./xblat1s > sblat1.out +./xblat1d > dblat1.out +./xblat1c > cblat1.out +./xblat1z > zblat1.out +./xblat2s < sblat2.in +./xblat2d < dblat2.in +gfortran -O2 -frecursive -o test_zminMax test_zminMax.o +./xblat2c < cblat2.in +./xblat2z < zblat2.in +./xblat3s < sblat3.in +./testlsame + ASCII character set + Tests completed +./testslamch + Epsilon = 5.96046448E-08 + Safe minimum = 1.17549435E-38 + Base = 2.00000000 + Precision = 1.19209290E-07 + Number of digits in mantissa = 24.0000000 + Rounding mode = 1.00000000 + Minimum exponent = -125.000000 + Underflow threshold = 1.17549435E-38 + Largest exponent = 128.000000 + Overflow threshold = 3.40282347E+38 + Reciprocal of safe minimum = 8.50705917E+37 +./testdlamch +./xblat3d < dblat3.in + Epsilon = 1.1102230246251565E-016 + Safe minimum = 2.2250738585072014E-308 + Base = 2.0000000000000000 + Precision = 2.2204460492503131E-016 + Number of digits in mantissa = 53.000000000000000 + Rounding mode = 1.0000000000000000 + Minimum exponent = -1021.0000000000000 + Underflow threshold = 2.2250738585072014E-308 + Largest exponent = 1024.0000000000000 + Overflow threshold = 1.7976931348623157E+308 + Reciprocal of safe minimum = 4.4942328371557898E+307 +./testsecond +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' +make -C TESTING/LIN cleanexe +./xblat3c < cblat3.in +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +rm -f xlintst* +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +make -C TESTING +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING' +make -C LIN xlintsts +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintsts aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o schkaa.o schkeq.o schkgb.o schkge.o schkgt.o schklq.o schkpb.o schkpo.o schkps.o schkpp.o schkpt.o schkq3.o schkqp3rk.o schkql.o schkqr.o schkrq.o schksp.o schksy.o schksy_rook.o schksy_rk.o schksy_aa.o schksy_aa_2stage.o schktb.o schktp.o schktr.o schktz.o sdrvgt.o sdrvls.o sdrvpb.o sdrvpp.o sdrvpt.o sdrvsp.o sdrvsy_rook.o sdrvsy_rk.o sdrvsy_aa.o sdrvsy_aa_2stage.o serrgt.o serrlq.o serrls.o serrps.o serrql.o serrqp.o serrqr.o serrrq.o serrtr.o serrtz.o sgbt01.o sgbt02.o sgbt05.o sgeqls.o sgerqs.o sget01.o sget02.o sget03.o sget04.o sget06.o sget07.o sgtt01.o sgtt02.o sgtt05.o slaptm.o slarhs.o slatb4.o slatb5.o slattb.o slattp.o slattr.o slavsp.o slavsy.o slavsy_rook.o slqt01.o slqt02.o slqt03.o spbt01.o spbt02.o spbt05.o spot01.o spot02.o spot03.o spot05.o spst01.o sppt01.o sppt02.o sppt03.o sppt05.o sptt01.o sptt02.o sptt05.o sqlt01.o sqlt02.o sqlt03.o sqpt01.o sqrt01.o sqrt01p.o sqrt02.o sqrt03.o sqrt11.o sqrt12.o sqrt13.o sqrt14.o sqrt15.o sqrt16.o sqrt17.o srqt01.o srqt02.o srqt03.o srzt01.o srzt02.o sspt01.o ssyt01.o ssyt01_rook.o ssyt01_3.o ssyt01_aa.o stbt02.o stbt03.o stbt05.o stbt06.o stpt01.o stpt02.o stpt03.o stpt05.o stpt06.o strt01.o strt02.o strt03.o strt05.o strt06.o sgennd.o sqrt04.o sqrt05.o schkqrt.o serrqrt.o schkqrtp.o serrqrtp.o schklqt.o schklqtp.o schktsqr.o serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o schkorhr_col.o serrorhr_col.o sorhr_col01.o sorhr_col02.o sdrvgb.o sdrvge.o sdrvsy.o sdrvpo.o serrvx.o serrge.o serrsy.o serrpo.o slaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a + Time for 0.100E+09 SAXPY ops = 0.00 seconds + *** Warning: Time for operations was less or equal than zero => timing in TESTING might be dubious + Including SECOND, time = 0.333E-02 seconds + Average time for SECOND = 0.665E-04 milliseconds +./testdsecnd +./xblat3z < zblat3.in +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/TESTING' +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' + Time for 0.100E+09 DAXPY ops = 0.100E-05 seconds + DAXPY performance rate = 0.100E+09 mflops + Including DSECND, time = 0.295E-02 seconds + Average time for DSECND = 0.590E-04 milliseconds + Equivalent floating point ops = 0.590E+07 ops +./testieee + We are about to check whether infinity arithmetic + can be trusted. If this test hangs, set + ILAENV = 0 for ISPEC = 11 in LAPACK/SRC/ilaenv.f + + Infinity arithmetic performed as per the ieee spec. + However, this is not an exhaustive test and does not + guarantee that infinity arithmetic meets the ieee spec. + + We are about to check whether NaN arithmetic + can be trusted. If this test hangs, set + ILAENV = 0 for ISPEC = 10 in LAPACK/SRC/ilaenv.f + + NaN arithmetic performed as per the ieee spec. + However, this is not an exhaustive test and does not + guarantee that NaN arithmetic meets the ieee spec. + +./testversion + LAPACK 3 . 12 . 0 +./test_zcomplexabs 2> test_zcomplexabs.err + # All tests pass for ABS(a+b*I) +./test_zcomplexdiv 2> test_zcomplexdiv.err + !! Some (x+x*I)/(x+x*I) differ from 1 + !! Some (x+x*I)/(x-x*I) differ from I + # 12602 tests out of 12606 pass for complex division, 4 fail. + # Please check the failed divisions in [stderr] +./test_zcomplexmult 2> test_zcomplexmult.err + # All tests pass for complex multiplication. +./test_zminMax 2> test_zminMax.err +[i8] MIN( NaN, 0.) = 0. +[i8] MAX( NaN, 0.) = 0. + # 14 tests out of 16 pass for intrinsic MIN and MAX, 2 fail. +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/INSTALL' +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing REAL LAPACK linear equation routines +./LIN/xlintsts < stest.in > stest.out 2>&1 +make -C LIN xlintstc +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstc aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o cchkaa.o cchkeq.o cchkgb.o cchkge.o cchkgt.o cchkhe.o cchkhe_rook.o cchkhe_rk.o cchkhe_aa.o cchkhe_aa_2stage.o cchkhp.o cchklq.o cchkpb.o cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkqp3rk.o cchkql.o cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o cchksy_aa.o cchksy_aa_2stage.o cchktb.o cchktp.o cchktr.o cchktz.o cdrvgt.o cdrvhe_rook.o cdrvhe_rk.o cdrvhe_aa.o cdrvhp.o cdrvhe_aa_2stage.o cdrvls.o cdrvpb.o cdrvpp.o cdrvpt.o cdrvsp.o cdrvsy_rook.o cdrvsy_rk.o cdrvsy_aa.o cdrvsy_aa_2stage.o cerrgt.o cerrlq.o cerrls.o cerrps.o cerrql.o cerrqp.o cerrqr.o cerrrq.o cerrtr.o cerrtz.o cgbt01.o cgbt02.o cgbt05.o cgeqls.o cgerqs.o cget01.o cget02.o cget03.o cget04.o cget07.o cgtt01.o cgtt02.o cgtt05.o chet01.o chet01_rook.o chet01_3.o chet01_aa.o chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o clatsp.o clatsy.o clattb.o clattp.o clattr.o clavhe.o clavhe_rook.o clavhp.o clavsp.o clavsy.o clavsy_rook.o clqt01.o clqt02.o clqt03.o cpbt01.o cpbt02.o cpbt05.o cpot01.o cpot02.o cpot03.o cpot05.o cpst01.o cppt01.o cppt02.o cppt03.o cppt05.o cptt01.o cptt02.o cptt05.o cqlt01.o cqlt02.o cqlt03.o cqpt01.o cqrt01.o cqrt01p.o cqrt02.o cqrt03.o cqrt11.o cqrt12.o cqrt13.o cqrt14.o cqrt15.o cqrt16.o cqrt17.o crqt01.o crqt02.o crqt03.o crzt01.o crzt02.o csbmv.o cspt01.o cspt02.o cspt03.o csyt01.o csyt01_rook.o csyt01_3.o csyt01_aa.o csyt02.o csyt03.o ctbt02.o ctbt03.o ctbt05.o ctbt06.o ctpt01.o ctpt02.o ctpt03.o ctpt05.o ctpt06.o ctrt01.o ctrt02.o ctrt03.o ctrt05.o ctrt06.o sget06.o cgennd.o cqrt04.o cqrt05.o cchkqrt.o cerrqrt.o cchkqrtp.o cerrqrtp.o cchklqt.o cchklqtp.o cchktsqr.o cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o cchkunhr_col.o cerrunhr_col.o cunhr_col01.o cunhr_col02.o cdrvgb.o cdrvge.o cdrvhe.o cdrvsy.o cdrvpo.o cerrvx.o cerrge.o cerrhe.o cerrsy.o cerrpo.o slaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing COMPLEX LAPACK linear equation routines +./LIN/xlintstc < ctest.in > ctest.out 2>&1 +make -C LIN xlintstd +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstd aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o dchkaa.o dchkeq.o dchkgb.o dchkge.o dchkgt.o dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o dchkpt.o dchkq3.o dchkqp3rk.o dchkql.o dchkqr.o dchkrq.o dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o dchksy_aa.o dchksy_aa_2stage.o dchktb.o dchktp.o dchktr.o dchktz.o ddrvgt.o ddrvls.o ddrvpb.o ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_rk.o ddrvsy_aa.o ddrvsy_aa_2stage.o derrgt.o derrlq.o derrls.o derrps.o derrql.o derrqp.o derrqr.o derrrq.o derrtr.o derrtz.o dgbt01.o dgbt02.o dgbt05.o dgeqls.o dgerqs.o dget01.o dget02.o dget03.o dget04.o dget06.o dget07.o dgtt01.o dgtt02.o dgtt05.o dlaptm.o dlarhs.o dlatb4.o dlatb5.o dlattb.o dlattp.o dlattr.o dlavsp.o dlavsy.o dlavsy_rook.o dlqt01.o dlqt02.o dlqt03.o dpbt01.o dpbt02.o dpbt05.o dpot01.o dpot02.o dpot03.o dpot05.o dpst01.o dppt01.o dppt02.o dppt03.o dppt05.o dptt01.o dptt02.o dptt05.o dqlt01.o dqlt02.o dqlt03.o dqpt01.o dqrt01.o dqrt01p.o dqrt02.o dqrt03.o dqrt11.o dqrt12.o dqrt13.o dqrt14.o dqrt15.o dqrt16.o dqrt17.o drqt01.o drqt02.o drqt03.o drzt01.o drzt02.o dspt01.o dsyt01.o dsyt01_rook.o dsyt01_3.o dsyt01_aa.o dtbt02.o dtbt03.o dtbt05.o dtbt06.o dtpt01.o dtpt02.o dtpt03.o dtpt05.o dtpt06.o dtrt01.o dtrt02.o dtrt03.o dtrt05.o dtrt06.o dgennd.o dqrt04.o dqrt05.o dchkqrt.o derrqrt.o dchkqrtp.o derrqrtp.o dchklqt.o dchklqtp.o dchktsqr.o derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o dchkorhr_col.o derrorhr_col.o dorhr_col01.o dorhr_col02.o ddrvgb.o ddrvge.o ddrvsy.o ddrvpo.o derrvx.o derrge.o derrsy.o derrpo.o dlaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing DOUBLE PRECISION LAPACK linear equation routines +./LIN/xlintstd < dtest.in > dtest.out 2>&1 +make -C LIN xlintstz +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstz aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o zchkaa.o zchkeq.o zchkgb.o zchkge.o zchkgt.o zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhe_aa_2stage.o zchkhp.o zchklq.o zchkpb.o zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkqp3rk.o zchkql.o zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o zchksy_aa.o zchksy_aa_2stage.o zchktb.o zchktp.o zchktr.o zchktz.o zdrvgt.o zdrvhe_rook.o zdrvhe_rk.o zdrvhe_aa.o zdrvhe_aa_2stage.o zdrvhp.o zdrvls.o zdrvpb.o zdrvpp.o zdrvpt.o zdrvsp.o zdrvsy_rook.o zdrvsy_rk.o zdrvsy_aa.o zdrvsy_aa_2stage.o zerrgt.o zerrlq.o zerrls.o zerrps.o zerrql.o zerrqp.o zerrqr.o zerrrq.o zerrtr.o zerrtz.o zgbt01.o zgbt02.o zgbt05.o zgeqls.o zgerqs.o zget01.o zget02.o zget03.o zget04.o zget07.o zgtt01.o zgtt02.o zgtt05.o zhet01.o zhet01_rook.o zhet01_3.o zhet01_aa.o zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o zlatsp.o zlatsy.o zlattb.o zlattp.o zlattr.o zlavhe.o zlavhe_rook.o zlavhp.o zlavsp.o zlavsy.o zlavsy_rook.o zlqt01.o zlqt02.o zlqt03.o zpbt01.o zpbt02.o zpbt05.o zpot01.o zpot02.o zpot03.o zpot05.o zpst01.o zppt01.o zppt02.o zppt03.o zppt05.o zptt01.o zptt02.o zptt05.o zqlt01.o zqlt02.o zqlt03.o zqpt01.o zqrt01.o zqrt01p.o zqrt02.o zqrt03.o zqrt11.o zqrt12.o zqrt13.o zqrt14.o zqrt15.o zqrt16.o zqrt17.o zrqt01.o zrqt02.o zrqt03.o zrzt01.o zrzt02.o zsbmv.o zspt01.o zspt02.o zspt03.o zsyt01.o zsyt01_rook.o zsyt01_3.o zsyt01_aa.o zsyt02.o zsyt03.o ztbt02.o ztbt03.o ztbt05.o ztbt06.o ztpt01.o ztpt02.o ztpt03.o ztpt05.o ztpt06.o ztrt01.o ztrt02.o ztrt03.o ztrt05.o ztrt06.o dget06.o zgennd.o zqrt04.o zqrt05.o zchkqrt.o zerrqrt.o zchkqrtp.o zerrqrtp.o zchklqt.o zchklqtp.o zchktsqr.o zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o zchkunhr_col.o zerrunhr_col.o zunhr_col01.o zunhr_col02.o zdrvgb.o zdrvge.o zdrvhe.o zdrvsy.o zdrvpo.o zerrvx.o zerrge.o zerrhe.o zerrsy.o zerrpo.o dlaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing COMPLEX16 LAPACK linear equation routines +./LIN/xlintstz < ztest.in > ztest.out 2>&1 +make -C LIN xlintstrfs +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstrfs schkrfp.o sdrvrfp.o sdrvrf1.o sdrvrf2.o sdrvrf3.o sdrvrf4.o serrrfp.o slatb4.o slarhs.o sget04.o spot01.o spot03.o spot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing REAL LAPACK RFP prototype linear equation routines +./LIN/xlintstrfs < stest_rfp.in > stest_rfp.out 2>&1 +make -C LIN xlintstds +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstds dchkab.o ddrvab.o ddrvac.o derrab.o derrac.o dget08.o alaerh.o alahd.o aladhd.o alareq.o chkxer.o dlarhs.o dlatb4.o xerbla.o dget02.o dpot06.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing SINGLE-DOUBLE PRECISION LAPACK prototype linear equation routines +./LIN/xlintstds < dstest.in > dstest.out 2>&1 +make -C LIN xlintstrfd +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstrfd dchkrfp.o ddrvrfp.o ddrvrf1.o ddrvrf2.o ddrvrf3.o ddrvrf4.o derrrfp.o dlatb4.o dlarhs.o dget04.o dpot01.o dpot03.o dpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines +./LIN/xlintstrfd < dtest_rfp.in > dtest_rfp.out 2>&1 +make -C LIN xlintstrfc +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstrfc cchkrfp.o cdrvrfp.o cdrvrf1.o cdrvrf2.o cdrvrf3.o cdrvrf4.o cerrrfp.o claipd.o clatb4.o clarhs.o csbmv.o cget04.o cpot01.o cpot03.o cpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing COMPLEX LAPACK RFP prototype linear equation routines +./LIN/xlintstrfc < ctest_rfp.in > ctest_rfp.out 2>&1 +make -C LIN xlintstzc +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstzc zchkab.o zdrvab.o zdrvac.o zerrab.o zerrac.o zget08.o alaerh.o alahd.o aladhd.o alareq.o chkxer.o zget02.o zlarhs.o zlatb4.o zsbmv.o xerbla.o zpot06.o zlaipd.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines +./LIN/xlintstzc < zctest.in > zctest.out 2>&1 +make -C LIN xlintstrfz +make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +gfortran -O2 -frecursive -o xlintstrfz zchkrfp.o zdrvrfp.o zdrvrf1.o zdrvrf2.o zdrvrf3.o zdrvrf4.o zerrrfp.o zlatb4.o zlaipd.o zlarhs.o zsbmv.o zget04.o zpot01.o zpot03.o zpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a +make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' +Testing COMPLEX16 LAPACK RFP prototype linear equation routines +./LIN/xlintstrfz < ztest_rfp.in > ztest_rfp.out 2>&1 +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING' +./lapack_testing.py + +---------------- Testing LAPACK Routines ---------------- + +-- Detailed results are stored in testing_results.txt + +------------------------- REAL ------------------------ + +Testing REAL Nonsymmetric-Eigenvalue-Problem-snep.out passed: 10080 + +Testing REAL Symmetric-Eigenvalue-Problem-ssep.out passed: 89520 + +Testing REAL Symmetric-Eigenvalue-Problem-2-stage-sse2.out passed: 89520 + +Testing REAL Singular-Value-Decomposition-ssvd.out passed: 125400 + +Testing REAL Eigen-Condition-sec.out passed: 501251 + +Testing REAL Nonsymmetric-Eigenvalue-sed.out passed: 14704 + +Testing REAL Nonsymmetric-Generalized-Eigenvalue-Problem-sgg.out passed: 8736 + +Testing REAL Nonsymmetric-Generalized-Eigenvalue-Problem-driver-sgd.out passed: 10482 + +Testing REAL Symmetric-Eigenvalue-Problem-ssb.out passed: 810 + +Testing REAL Symmetric-Eigenvalue-Generalized-Problem-ssg.out passed: 33516 + +Testing REAL Banded-Singular-Value-Decomposition-routines-sbb.out passed: 6000 + +Testing REAL Generalized-Linear-Regression-Model-routines-sglm.out passed: 48 + +Testing REAL Generalized-QR-and-RQ-factorization-routines-sgqr.out passed: 1728 + +Testing REAL Generalized-Singular-Value-Decomposition-routines-sgsv.out passed: 384 + +Testing REAL CS-Decomposition-routines-scsd.out passed: 600 + +Testing REAL Constrained-Linear-Least-Squares-routines-slse.out passed: 96 + +Testing REAL Linear-Equation-routines-stest.out passed: 663645 + +Testing REAL RFP-linear-equation-routines-stest_rfp.out passed: 13128 + + +------------------------- DOUBLE PRECISION ------------------------ + +Testing DOUBLE PRECISION Nonsymmetric-Eigenvalue-Problem-dnep.out passed: 10080 + +Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-dsep.out passed: 89520 + +Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-2-stage-dse2.out passed: 89520 + +Testing DOUBLE PRECISION Singular-Value-Decomposition-dsvd.out passed: 125400 + +Testing DOUBLE PRECISION Eigen-Condition-dec.out passed: 501261 + +Testing DOUBLE PRECISION Nonsymmetric-Eigenvalue-ded.out passed: 14704 + +Testing DOUBLE PRECISION Nonsymmetric-Generalized-Eigenvalue-Problem-dgg.out passed: 8736 + +Testing DOUBLE PRECISION Nonsymmetric-Generalized-Eigenvalue-Problem-driver-dgd.out passed: 10482 + +Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-dsb.out passed: 810 + +Testing DOUBLE PRECISION Symmetric-Eigenvalue-Generalized-Problem-dsg.out passed: 33516 + +Testing DOUBLE PRECISION Banded-Singular-Value-Decomposition-routines-dbb.out passed: 6000 + +Testing DOUBLE PRECISION Generalized-Linear-Regression-Model-routines-dglm.out passed: 48 + +Testing DOUBLE PRECISION Generalized-QR-and-RQ-factorization-routines-dgqr.out passed: 1728 + +Testing DOUBLE PRECISION Generalized-Singular-Value-Decomposition-routines-dgsv.out passed: 384 + +Testing DOUBLE PRECISION CS-Decomposition-routines-dcsd.out passed: 600 + +Testing DOUBLE PRECISION Constrained-Linear-Least-Squares-routines-dlse.out passed: 96 + +Testing DOUBLE PRECISION Linear-Equation-routines-dtest.out DQK: 36885 out of 241365 tests failed to pass the threshold + passed: 422280 +failing to pass the threshold: 36885 + +Testing DOUBLE PRECISION Mixed-Precision-linear-equation-routines-dstest.out passed: 812 + +Testing DOUBLE PRECISION RFP-linear-equation-routines-dtest_rfp.out passed: 13128 + + +------------------------- COMPLEX ------------------------ + +Testing COMPLEX Nonsymmetric-Eigenvalue-Problem-cnep.out passed: 10080 + +Testing COMPLEX Symmetric-Eigenvalue-Problem-csep.out passed: 77280 + +Testing COMPLEX Symmetric-Eigenvalue-Problem-2-stage-cse2.out passed: 77280 + +Testing COMPLEX Singular-Value-Decomposition-csvd.out passed: 92125 + +Testing COMPLEX Eigen-Condition-cec.out passed: 5966 + +Testing COMPLEX Nonsymmetric-Eigenvalue-ced.out passed: 14080 + +Testing COMPLEX Nonsymmetric-Generalized-Eigenvalue-Problem-cgg.out passed: 8736 + +Testing COMPLEX Nonsymmetric-Generalized-Eigenvalue-Problem-driver-cgd.out passed: 10482 + +Testing COMPLEX Symmetric-Eigenvalue-Problem-csb.out passed: 810 + +Testing COMPLEX Symmetric-Eigenvalue-Generalized-Problem-csg.out passed: 33516 + +Testing COMPLEX Banded-Singular-Value-Decomposition-routines-cbb.out passed: 6000 + +Testing COMPLEX Generalized-Linear-Regression-Model-routines-cglm.out passed: 48 + +Testing COMPLEX Generalized-QR-and-RQ-factorization-routines-cgqr.out passed: 1728 + +Testing COMPLEX Generalized-Singular-Value-Decomposition-routines-cgsv.out passed: 385 + +Testing COMPLEX CS-Decomposition-routines-ccsd.out passed: 600 + +Testing COMPLEX Constrained-Linear-Least-Squares-routines-clse.out passed: 96 + +Testing COMPLEX Linear-Equation-routines-ctest.out passed: 677390 + +Testing COMPLEX RFP-linear-equation-routines-ctest_rfp.out passed: 13128 + + +------------------------- COMPLEX16 ------------------------ + +Testing COMPLEX16 Nonsymmetric-Eigenvalue-Problem-znep.out passed: 10080 + +Testing COMPLEX16 Symmetric-Eigenvalue-Problem-zsep.out passed: 77280 + +Testing COMPLEX16 Symmetric-Eigenvalue-Problem-2-stage-zse2.out passed: 77280 + +Testing COMPLEX16 Singular-Value-Decomposition-zsvd.out passed: 92125 + +Testing COMPLEX16 Eigen-Condition-zec.out passed: 6222 + +Testing COMPLEX16 Nonsymmetric-Eigenvalue-zed.out passed: 14080 + +Testing COMPLEX16 Nonsymmetric-Generalized-Eigenvalue-Problem-zgg.out passed: 8736 + +Testing COMPLEX16 Nonsymmetric-Generalized-Eigenvalue-Problem-driver-zgd.out passed: 10482 + +Testing COMPLEX16 Symmetric-Eigenvalue-Problem-zsb.out passed: 810 + +Testing COMPLEX16 Symmetric-Eigenvalue-Generalized-Problem-zsg.out passed: 33516 + +Testing COMPLEX16 Banded-Singular-Value-Decomposition-routines-zbb.out passed: 6000 + +Testing COMPLEX16 Generalized-Linear-Regression-Model-routines-zglm.out passed: 48 + +Testing COMPLEX16 Generalized-QR-and-RQ-factorization-routines-zgqr.out passed: 1728 + +Testing COMPLEX16 Generalized-Singular-Value-Decomposition-routines-zgsv.out passed: 384 + +Testing COMPLEX16 CS-Decomposition-routines-zcsd.out passed: 600 + +Testing COMPLEX16 Constrained-Linear-Least-Squares-routines-zlse.out passed: 96 + +Testing COMPLEX16 Linear-Equation-routines-ztest.out passed: 677390 + +Testing COMPLEX16 Mixed-Precision-linear-equation-routines-zctest.out passed: 812 + +Testing COMPLEX16 RFP-linear-equation-routines-ztest_rfp.out passed: 13128 + + + --> LAPACK TESTING SUMMARY <-- + Processing LAPACK Testing output found in the TESTING directory +SUMMARY nb test run numerical error other error +================ =========== ================= ================ +REAL 1569648 0 (0.000%) 0 (0.000%) +DOUBLE PRECISION 1329105 36885 (2.775%) 0 (0.000%) +COMPLEX 1029730 0 (0.000%) 0 (0.000%) +COMPLEX16 1030797 0 (0.000%) 0 (0.000%) + +--> ALL PRECISIONS 4959280 36885 (0.744%) 0 (0.000%) + From 2ec963d93daede72abd79c4682b80fe81342e42e Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 15 May 2024 15:37:52 +0200 Subject: [PATCH 066/206] initial skeleton with tests ran --- testOutput | 368 ----------------------------------------------------- 1 file changed, 368 deletions(-) delete mode 100644 testOutput diff --git a/testOutput b/testOutput deleted file mode 100644 index ed9c630306..0000000000 --- a/testOutput +++ /dev/null @@ -1,368 +0,0 @@ -make -C INSTALL run -make -C SRC -make -C TESTING/MATGEN -make -C BLAS -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/INSTALL' -gfortran -O2 -frecursive -o testlsame lsame.o lsametst.o -gfortran -O2 -frecursive -o testslamch slamch.o lsame.o slamchtst.o -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' -make -C SRC -gfortran -O2 -frecursive -o testdlamch dlamch.o lsame.o dlamchtst.o -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' -make[1]: Nothing to be done for 'all'. -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' -[INFO] : TIMER value: INT_ETIME (given by make.inc) -[INFO] : TIMER value: INT_ETIME (given by make.inc) -gfortran -O2 -frecursive -o testsecond second_INT_ETIME.o secondtst.o -gfortran -O2 -frecursive -o testdsecnd dsecnd_INT_ETIME.o dsecndtst.o -gfortran -O2 -frecursive -o testieee tstiee.o ../SRC/ieeeck.o ../SRC/ilaenv.o ../SRC/iparmq.o -gfortran -O2 -frecursive -o testversion ilaver.o LAPACK_version.o -gfortran -O2 -frecursive -o test_zcomplexabs test_zcomplexabs.o -gfortran -O2 -frecursive -o test_zcomplexdiv test_zcomplexdiv.o -gfortran -O2 -frecursive -o test_zcomplexmult test_zcomplexmult.o -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' -make[2]: Nothing to be done for 'all'. -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' -make -C BLAS blas_testing -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' -make -C SRC -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' -make[2]: Nothing to be done for 'all'. -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/SRC' -make -C TESTING run -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/TESTING' -./xblat1s > sblat1.out -./xblat1d > dblat1.out -./xblat1c > cblat1.out -./xblat1z > zblat1.out -./xblat2s < sblat2.in -./xblat2d < dblat2.in -gfortran -O2 -frecursive -o test_zminMax test_zminMax.o -./xblat2c < cblat2.in -./xblat2z < zblat2.in -./xblat3s < sblat3.in -./testlsame - ASCII character set - Tests completed -./testslamch - Epsilon = 5.96046448E-08 - Safe minimum = 1.17549435E-38 - Base = 2.00000000 - Precision = 1.19209290E-07 - Number of digits in mantissa = 24.0000000 - Rounding mode = 1.00000000 - Minimum exponent = -125.000000 - Underflow threshold = 1.17549435E-38 - Largest exponent = 128.000000 - Overflow threshold = 3.40282347E+38 - Reciprocal of safe minimum = 8.50705917E+37 -./testdlamch -./xblat3d < dblat3.in - Epsilon = 1.1102230246251565E-016 - Safe minimum = 2.2250738585072014E-308 - Base = 2.0000000000000000 - Precision = 2.2204460492503131E-016 - Number of digits in mantissa = 53.000000000000000 - Rounding mode = 1.0000000000000000 - Minimum exponent = -1021.0000000000000 - Underflow threshold = 2.2250738585072014E-308 - Largest exponent = 1024.0000000000000 - Overflow threshold = 1.7976931348623157E+308 - Reciprocal of safe minimum = 4.4942328371557898E+307 -./testsecond -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' -make -C TESTING/LIN cleanexe -./xblat3c < cblat3.in -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -rm -f xlintst* -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -make -C TESTING -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING' -make -C LIN xlintsts -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintsts aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o schkaa.o schkeq.o schkgb.o schkge.o schkgt.o schklq.o schkpb.o schkpo.o schkps.o schkpp.o schkpt.o schkq3.o schkqp3rk.o schkql.o schkqr.o schkrq.o schksp.o schksy.o schksy_rook.o schksy_rk.o schksy_aa.o schksy_aa_2stage.o schktb.o schktp.o schktr.o schktz.o sdrvgt.o sdrvls.o sdrvpb.o sdrvpp.o sdrvpt.o sdrvsp.o sdrvsy_rook.o sdrvsy_rk.o sdrvsy_aa.o sdrvsy_aa_2stage.o serrgt.o serrlq.o serrls.o serrps.o serrql.o serrqp.o serrqr.o serrrq.o serrtr.o serrtz.o sgbt01.o sgbt02.o sgbt05.o sgeqls.o sgerqs.o sget01.o sget02.o sget03.o sget04.o sget06.o sget07.o sgtt01.o sgtt02.o sgtt05.o slaptm.o slarhs.o slatb4.o slatb5.o slattb.o slattp.o slattr.o slavsp.o slavsy.o slavsy_rook.o slqt01.o slqt02.o slqt03.o spbt01.o spbt02.o spbt05.o spot01.o spot02.o spot03.o spot05.o spst01.o sppt01.o sppt02.o sppt03.o sppt05.o sptt01.o sptt02.o sptt05.o sqlt01.o sqlt02.o sqlt03.o sqpt01.o sqrt01.o sqrt01p.o sqrt02.o sqrt03.o sqrt11.o sqrt12.o sqrt13.o sqrt14.o sqrt15.o sqrt16.o sqrt17.o srqt01.o srqt02.o srqt03.o srzt01.o srzt02.o sspt01.o ssyt01.o ssyt01_rook.o ssyt01_3.o ssyt01_aa.o stbt02.o stbt03.o stbt05.o stbt06.o stpt01.o stpt02.o stpt03.o stpt05.o stpt06.o strt01.o strt02.o strt03.o strt05.o strt06.o sgennd.o sqrt04.o sqrt05.o schkqrt.o serrqrt.o schkqrtp.o serrqrtp.o schklqt.o schklqtp.o schktsqr.o serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o schkorhr_col.o serrorhr_col.o sorhr_col01.o sorhr_col02.o sdrvgb.o sdrvge.o sdrvsy.o sdrvpo.o serrvx.o serrge.o serrsy.o serrpo.o slaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a - Time for 0.100E+09 SAXPY ops = 0.00 seconds - *** Warning: Time for operations was less or equal than zero => timing in TESTING might be dubious - Including SECOND, time = 0.333E-02 seconds - Average time for SECOND = 0.665E-04 milliseconds -./testdsecnd -./xblat3z < zblat3.in -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS/TESTING' -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/BLAS' - Time for 0.100E+09 DAXPY ops = 0.100E-05 seconds - DAXPY performance rate = 0.100E+09 mflops - Including DSECND, time = 0.295E-02 seconds - Average time for DSECND = 0.590E-04 milliseconds - Equivalent floating point ops = 0.590E+07 ops -./testieee - We are about to check whether infinity arithmetic - can be trusted. If this test hangs, set - ILAENV = 0 for ISPEC = 11 in LAPACK/SRC/ilaenv.f - - Infinity arithmetic performed as per the ieee spec. - However, this is not an exhaustive test and does not - guarantee that infinity arithmetic meets the ieee spec. - - We are about to check whether NaN arithmetic - can be trusted. If this test hangs, set - ILAENV = 0 for ISPEC = 10 in LAPACK/SRC/ilaenv.f - - NaN arithmetic performed as per the ieee spec. - However, this is not an exhaustive test and does not - guarantee that NaN arithmetic meets the ieee spec. - -./testversion - LAPACK 3 . 12 . 0 -./test_zcomplexabs 2> test_zcomplexabs.err - # All tests pass for ABS(a+b*I) -./test_zcomplexdiv 2> test_zcomplexdiv.err - !! Some (x+x*I)/(x+x*I) differ from 1 - !! Some (x+x*I)/(x-x*I) differ from I - # 12602 tests out of 12606 pass for complex division, 4 fail. - # Please check the failed divisions in [stderr] -./test_zcomplexmult 2> test_zcomplexmult.err - # All tests pass for complex multiplication. -./test_zminMax 2> test_zminMax.err -[i8] MIN( NaN, 0.) = 0. -[i8] MAX( NaN, 0.) = 0. - # 14 tests out of 16 pass for intrinsic MIN and MAX, 2 fail. -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/INSTALL' -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing REAL LAPACK linear equation routines -./LIN/xlintsts < stest.in > stest.out 2>&1 -make -C LIN xlintstc -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstc aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o cchkaa.o cchkeq.o cchkgb.o cchkge.o cchkgt.o cchkhe.o cchkhe_rook.o cchkhe_rk.o cchkhe_aa.o cchkhe_aa_2stage.o cchkhp.o cchklq.o cchkpb.o cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkqp3rk.o cchkql.o cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o cchksy_aa.o cchksy_aa_2stage.o cchktb.o cchktp.o cchktr.o cchktz.o cdrvgt.o cdrvhe_rook.o cdrvhe_rk.o cdrvhe_aa.o cdrvhp.o cdrvhe_aa_2stage.o cdrvls.o cdrvpb.o cdrvpp.o cdrvpt.o cdrvsp.o cdrvsy_rook.o cdrvsy_rk.o cdrvsy_aa.o cdrvsy_aa_2stage.o cerrgt.o cerrlq.o cerrls.o cerrps.o cerrql.o cerrqp.o cerrqr.o cerrrq.o cerrtr.o cerrtz.o cgbt01.o cgbt02.o cgbt05.o cgeqls.o cgerqs.o cget01.o cget02.o cget03.o cget04.o cget07.o cgtt01.o cgtt02.o cgtt05.o chet01.o chet01_rook.o chet01_3.o chet01_aa.o chpt01.o claipd.o claptm.o clarhs.o clatb4.o clatb5.o clatsp.o clatsy.o clattb.o clattp.o clattr.o clavhe.o clavhe_rook.o clavhp.o clavsp.o clavsy.o clavsy_rook.o clqt01.o clqt02.o clqt03.o cpbt01.o cpbt02.o cpbt05.o cpot01.o cpot02.o cpot03.o cpot05.o cpst01.o cppt01.o cppt02.o cppt03.o cppt05.o cptt01.o cptt02.o cptt05.o cqlt01.o cqlt02.o cqlt03.o cqpt01.o cqrt01.o cqrt01p.o cqrt02.o cqrt03.o cqrt11.o cqrt12.o cqrt13.o cqrt14.o cqrt15.o cqrt16.o cqrt17.o crqt01.o crqt02.o crqt03.o crzt01.o crzt02.o csbmv.o cspt01.o cspt02.o cspt03.o csyt01.o csyt01_rook.o csyt01_3.o csyt01_aa.o csyt02.o csyt03.o ctbt02.o ctbt03.o ctbt05.o ctbt06.o ctpt01.o ctpt02.o ctpt03.o ctpt05.o ctpt06.o ctrt01.o ctrt02.o ctrt03.o ctrt05.o ctrt06.o sget06.o cgennd.o cqrt04.o cqrt05.o cchkqrt.o cerrqrt.o cchkqrtp.o cerrqrtp.o cchklqt.o cchklqtp.o cchktsqr.o cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o cchkunhr_col.o cerrunhr_col.o cunhr_col01.o cunhr_col02.o cdrvgb.o cdrvge.o cdrvhe.o cdrvsy.o cdrvpo.o cerrvx.o cerrge.o cerrhe.o cerrsy.o cerrpo.o slaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing COMPLEX LAPACK linear equation routines -./LIN/xlintstc < ctest.in > ctest.out 2>&1 -make -C LIN xlintstd -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstd aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o dchkaa.o dchkeq.o dchkgb.o dchkge.o dchkgt.o dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o dchkpt.o dchkq3.o dchkqp3rk.o dchkql.o dchkqr.o dchkrq.o dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o dchksy_aa.o dchksy_aa_2stage.o dchktb.o dchktp.o dchktr.o dchktz.o ddrvgt.o ddrvls.o ddrvpb.o ddrvpp.o ddrvpt.o ddrvsp.o ddrvsy_rook.o ddrvsy_rk.o ddrvsy_aa.o ddrvsy_aa_2stage.o derrgt.o derrlq.o derrls.o derrps.o derrql.o derrqp.o derrqr.o derrrq.o derrtr.o derrtz.o dgbt01.o dgbt02.o dgbt05.o dgeqls.o dgerqs.o dget01.o dget02.o dget03.o dget04.o dget06.o dget07.o dgtt01.o dgtt02.o dgtt05.o dlaptm.o dlarhs.o dlatb4.o dlatb5.o dlattb.o dlattp.o dlattr.o dlavsp.o dlavsy.o dlavsy_rook.o dlqt01.o dlqt02.o dlqt03.o dpbt01.o dpbt02.o dpbt05.o dpot01.o dpot02.o dpot03.o dpot05.o dpst01.o dppt01.o dppt02.o dppt03.o dppt05.o dptt01.o dptt02.o dptt05.o dqlt01.o dqlt02.o dqlt03.o dqpt01.o dqrt01.o dqrt01p.o dqrt02.o dqrt03.o dqrt11.o dqrt12.o dqrt13.o dqrt14.o dqrt15.o dqrt16.o dqrt17.o drqt01.o drqt02.o drqt03.o drzt01.o drzt02.o dspt01.o dsyt01.o dsyt01_rook.o dsyt01_3.o dsyt01_aa.o dtbt02.o dtbt03.o dtbt05.o dtbt06.o dtpt01.o dtpt02.o dtpt03.o dtpt05.o dtpt06.o dtrt01.o dtrt02.o dtrt03.o dtrt05.o dtrt06.o dgennd.o dqrt04.o dqrt05.o dchkqrt.o derrqrt.o dchkqrtp.o derrqrtp.o dchklqt.o dchklqtp.o dchktsqr.o derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o dchkorhr_col.o derrorhr_col.o dorhr_col01.o dorhr_col02.o ddrvgb.o ddrvge.o ddrvsy.o ddrvpo.o derrvx.o derrge.o derrsy.o derrpo.o dlaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing DOUBLE PRECISION LAPACK linear equation routines -./LIN/xlintstd < dtest.in > dtest.out 2>&1 -make -C LIN xlintstz -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstz aladhd.o alaerh.o alaesm.o alahd.o alareq.o alasum.o alasvm.o chkxer.o icopy.o ilaenv.o xlaenv.o xerbla.o zchkaa.o zchkeq.o zchkgb.o zchkge.o zchkgt.o zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhe_aa_2stage.o zchkhp.o zchklq.o zchkpb.o zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkqp3rk.o zchkql.o zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o zchksy_aa.o zchksy_aa_2stage.o zchktb.o zchktp.o zchktr.o zchktz.o zdrvgt.o zdrvhe_rook.o zdrvhe_rk.o zdrvhe_aa.o zdrvhe_aa_2stage.o zdrvhp.o zdrvls.o zdrvpb.o zdrvpp.o zdrvpt.o zdrvsp.o zdrvsy_rook.o zdrvsy_rk.o zdrvsy_aa.o zdrvsy_aa_2stage.o zerrgt.o zerrlq.o zerrls.o zerrps.o zerrql.o zerrqp.o zerrqr.o zerrrq.o zerrtr.o zerrtz.o zgbt01.o zgbt02.o zgbt05.o zgeqls.o zgerqs.o zget01.o zget02.o zget03.o zget04.o zget07.o zgtt01.o zgtt02.o zgtt05.o zhet01.o zhet01_rook.o zhet01_3.o zhet01_aa.o zhpt01.o zlaipd.o zlaptm.o zlarhs.o zlatb4.o zlatb5.o zlatsp.o zlatsy.o zlattb.o zlattp.o zlattr.o zlavhe.o zlavhe_rook.o zlavhp.o zlavsp.o zlavsy.o zlavsy_rook.o zlqt01.o zlqt02.o zlqt03.o zpbt01.o zpbt02.o zpbt05.o zpot01.o zpot02.o zpot03.o zpot05.o zpst01.o zppt01.o zppt02.o zppt03.o zppt05.o zptt01.o zptt02.o zptt05.o zqlt01.o zqlt02.o zqlt03.o zqpt01.o zqrt01.o zqrt01p.o zqrt02.o zqrt03.o zqrt11.o zqrt12.o zqrt13.o zqrt14.o zqrt15.o zqrt16.o zqrt17.o zrqt01.o zrqt02.o zrqt03.o zrzt01.o zrzt02.o zsbmv.o zspt01.o zspt02.o zspt03.o zsyt01.o zsyt01_rook.o zsyt01_3.o zsyt01_aa.o zsyt02.o zsyt03.o ztbt02.o ztbt03.o ztbt05.o ztbt06.o ztpt01.o ztpt02.o ztpt03.o ztpt05.o ztpt06.o ztrt01.o ztrt02.o ztrt03.o ztrt05.o ztrt06.o dget06.o zgennd.o zqrt04.o zqrt05.o zchkqrt.o zerrqrt.o zchkqrtp.o zerrqrtp.o zchklqt.o zchklqtp.o zchktsqr.o zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o zchkunhr_col.o zerrunhr_col.o zunhr_col01.o zunhr_col02.o zdrvgb.o zdrvge.o zdrvhe.o zdrvsy.o zdrvpo.o zerrvx.o zerrge.o zerrhe.o zerrsy.o zerrpo.o dlaord.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing COMPLEX16 LAPACK linear equation routines -./LIN/xlintstz < ztest.in > ztest.out 2>&1 -make -C LIN xlintstrfs -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstrfs schkrfp.o sdrvrfp.o sdrvrf1.o sdrvrf2.o sdrvrf3.o sdrvrf4.o serrrfp.o slatb4.o slarhs.o sget04.o spot01.o spot03.o spot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing REAL LAPACK RFP prototype linear equation routines -./LIN/xlintstrfs < stest_rfp.in > stest_rfp.out 2>&1 -make -C LIN xlintstds -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstds dchkab.o ddrvab.o ddrvac.o derrab.o derrac.o dget08.o alaerh.o alahd.o aladhd.o alareq.o chkxer.o dlarhs.o dlatb4.o xerbla.o dget02.o dpot06.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing SINGLE-DOUBLE PRECISION LAPACK prototype linear equation routines -./LIN/xlintstds < dstest.in > dstest.out 2>&1 -make -C LIN xlintstrfd -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstrfd dchkrfp.o ddrvrfp.o ddrvrf1.o ddrvrf2.o ddrvrf3.o ddrvrf4.o derrrfp.o dlatb4.o dlarhs.o dget04.o dpot01.o dpot03.o dpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines -./LIN/xlintstrfd < dtest_rfp.in > dtest_rfp.out 2>&1 -make -C LIN xlintstrfc -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstrfc cchkrfp.o cdrvrfp.o cdrvrf1.o cdrvrf2.o cdrvrf3.o cdrvrf4.o cerrrfp.o claipd.o clatb4.o clarhs.o csbmv.o cget04.o cpot01.o cpot03.o cpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing COMPLEX LAPACK RFP prototype linear equation routines -./LIN/xlintstrfc < ctest_rfp.in > ctest_rfp.out 2>&1 -make -C LIN xlintstzc -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstzc zchkab.o zdrvab.o zdrvac.o zerrab.o zerrac.o zget08.o alaerh.o alahd.o aladhd.o alareq.o chkxer.o zget02.o zlarhs.o zlatb4.o zsbmv.o xerbla.o zpot06.o zlaipd.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines -./LIN/xlintstzc < zctest.in > zctest.out 2>&1 -make -C LIN xlintstrfz -make[2]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -gfortran -O2 -frecursive -o xlintstrfz zchkrfp.o zdrvrfp.o zdrvrf1.o zdrvrf2.o zdrvrf3.o zdrvrf4.o zerrrfp.o zlatb4.o zlaipd.o zlarhs.o zsbmv.o zget04.o zpot01.o zpot03.o zpot02.o chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o ../../libtmglib.a ../../liblapack.a ../../librefblas.a -make[2]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/LIN' -Testing COMPLEX16 LAPACK RFP prototype linear equation routines -./LIN/xlintstrfz < ztest_rfp.in > ztest_rfp.out 2>&1 -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING' -./lapack_testing.py - ----------------- Testing LAPACK Routines ---------------- - --- Detailed results are stored in testing_results.txt - -------------------------- REAL ------------------------ - -Testing REAL Nonsymmetric-Eigenvalue-Problem-snep.out passed: 10080 - -Testing REAL Symmetric-Eigenvalue-Problem-ssep.out passed: 89520 - -Testing REAL Symmetric-Eigenvalue-Problem-2-stage-sse2.out passed: 89520 - -Testing REAL Singular-Value-Decomposition-ssvd.out passed: 125400 - -Testing REAL Eigen-Condition-sec.out passed: 501251 - -Testing REAL Nonsymmetric-Eigenvalue-sed.out passed: 14704 - -Testing REAL Nonsymmetric-Generalized-Eigenvalue-Problem-sgg.out passed: 8736 - -Testing REAL Nonsymmetric-Generalized-Eigenvalue-Problem-driver-sgd.out passed: 10482 - -Testing REAL Symmetric-Eigenvalue-Problem-ssb.out passed: 810 - -Testing REAL Symmetric-Eigenvalue-Generalized-Problem-ssg.out passed: 33516 - -Testing REAL Banded-Singular-Value-Decomposition-routines-sbb.out passed: 6000 - -Testing REAL Generalized-Linear-Regression-Model-routines-sglm.out passed: 48 - -Testing REAL Generalized-QR-and-RQ-factorization-routines-sgqr.out passed: 1728 - -Testing REAL Generalized-Singular-Value-Decomposition-routines-sgsv.out passed: 384 - -Testing REAL CS-Decomposition-routines-scsd.out passed: 600 - -Testing REAL Constrained-Linear-Least-Squares-routines-slse.out passed: 96 - -Testing REAL Linear-Equation-routines-stest.out passed: 663645 - -Testing REAL RFP-linear-equation-routines-stest_rfp.out passed: 13128 - - -------------------------- DOUBLE PRECISION ------------------------ - -Testing DOUBLE PRECISION Nonsymmetric-Eigenvalue-Problem-dnep.out passed: 10080 - -Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-dsep.out passed: 89520 - -Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-2-stage-dse2.out passed: 89520 - -Testing DOUBLE PRECISION Singular-Value-Decomposition-dsvd.out passed: 125400 - -Testing DOUBLE PRECISION Eigen-Condition-dec.out passed: 501261 - -Testing DOUBLE PRECISION Nonsymmetric-Eigenvalue-ded.out passed: 14704 - -Testing DOUBLE PRECISION Nonsymmetric-Generalized-Eigenvalue-Problem-dgg.out passed: 8736 - -Testing DOUBLE PRECISION Nonsymmetric-Generalized-Eigenvalue-Problem-driver-dgd.out passed: 10482 - -Testing DOUBLE PRECISION Symmetric-Eigenvalue-Problem-dsb.out passed: 810 - -Testing DOUBLE PRECISION Symmetric-Eigenvalue-Generalized-Problem-dsg.out passed: 33516 - -Testing DOUBLE PRECISION Banded-Singular-Value-Decomposition-routines-dbb.out passed: 6000 - -Testing DOUBLE PRECISION Generalized-Linear-Regression-Model-routines-dglm.out passed: 48 - -Testing DOUBLE PRECISION Generalized-QR-and-RQ-factorization-routines-dgqr.out passed: 1728 - -Testing DOUBLE PRECISION Generalized-Singular-Value-Decomposition-routines-dgsv.out passed: 384 - -Testing DOUBLE PRECISION CS-Decomposition-routines-dcsd.out passed: 600 - -Testing DOUBLE PRECISION Constrained-Linear-Least-Squares-routines-dlse.out passed: 96 - -Testing DOUBLE PRECISION Linear-Equation-routines-dtest.out DQK: 36885 out of 241365 tests failed to pass the threshold - passed: 422280 -failing to pass the threshold: 36885 - -Testing DOUBLE PRECISION Mixed-Precision-linear-equation-routines-dstest.out passed: 812 - -Testing DOUBLE PRECISION RFP-linear-equation-routines-dtest_rfp.out passed: 13128 - - -------------------------- COMPLEX ------------------------ - -Testing COMPLEX Nonsymmetric-Eigenvalue-Problem-cnep.out passed: 10080 - -Testing COMPLEX Symmetric-Eigenvalue-Problem-csep.out passed: 77280 - -Testing COMPLEX Symmetric-Eigenvalue-Problem-2-stage-cse2.out passed: 77280 - -Testing COMPLEX Singular-Value-Decomposition-csvd.out passed: 92125 - -Testing COMPLEX Eigen-Condition-cec.out passed: 5966 - -Testing COMPLEX Nonsymmetric-Eigenvalue-ced.out passed: 14080 - -Testing COMPLEX Nonsymmetric-Generalized-Eigenvalue-Problem-cgg.out passed: 8736 - -Testing COMPLEX Nonsymmetric-Generalized-Eigenvalue-Problem-driver-cgd.out passed: 10482 - -Testing COMPLEX Symmetric-Eigenvalue-Problem-csb.out passed: 810 - -Testing COMPLEX Symmetric-Eigenvalue-Generalized-Problem-csg.out passed: 33516 - -Testing COMPLEX Banded-Singular-Value-Decomposition-routines-cbb.out passed: 6000 - -Testing COMPLEX Generalized-Linear-Regression-Model-routines-cglm.out passed: 48 - -Testing COMPLEX Generalized-QR-and-RQ-factorization-routines-cgqr.out passed: 1728 - -Testing COMPLEX Generalized-Singular-Value-Decomposition-routines-cgsv.out passed: 385 - -Testing COMPLEX CS-Decomposition-routines-ccsd.out passed: 600 - -Testing COMPLEX Constrained-Linear-Least-Squares-routines-clse.out passed: 96 - -Testing COMPLEX Linear-Equation-routines-ctest.out passed: 677390 - -Testing COMPLEX RFP-linear-equation-routines-ctest_rfp.out passed: 13128 - - -------------------------- COMPLEX16 ------------------------ - -Testing COMPLEX16 Nonsymmetric-Eigenvalue-Problem-znep.out passed: 10080 - -Testing COMPLEX16 Symmetric-Eigenvalue-Problem-zsep.out passed: 77280 - -Testing COMPLEX16 Symmetric-Eigenvalue-Problem-2-stage-zse2.out passed: 77280 - -Testing COMPLEX16 Singular-Value-Decomposition-zsvd.out passed: 92125 - -Testing COMPLEX16 Eigen-Condition-zec.out passed: 6222 - -Testing COMPLEX16 Nonsymmetric-Eigenvalue-zed.out passed: 14080 - -Testing COMPLEX16 Nonsymmetric-Generalized-Eigenvalue-Problem-zgg.out passed: 8736 - -Testing COMPLEX16 Nonsymmetric-Generalized-Eigenvalue-Problem-driver-zgd.out passed: 10482 - -Testing COMPLEX16 Symmetric-Eigenvalue-Problem-zsb.out passed: 810 - -Testing COMPLEX16 Symmetric-Eigenvalue-Generalized-Problem-zsg.out passed: 33516 - -Testing COMPLEX16 Banded-Singular-Value-Decomposition-routines-zbb.out passed: 6000 - -Testing COMPLEX16 Generalized-Linear-Regression-Model-routines-zglm.out passed: 48 - -Testing COMPLEX16 Generalized-QR-and-RQ-factorization-routines-zgqr.out passed: 1728 - -Testing COMPLEX16 Generalized-Singular-Value-Decomposition-routines-zgsv.out passed: 384 - -Testing COMPLEX16 CS-Decomposition-routines-zcsd.out passed: 600 - -Testing COMPLEX16 Constrained-Linear-Least-Squares-routines-zlse.out passed: 96 - -Testing COMPLEX16 Linear-Equation-routines-ztest.out passed: 677390 - -Testing COMPLEX16 Mixed-Precision-linear-equation-routines-zctest.out passed: 812 - -Testing COMPLEX16 RFP-linear-equation-routines-ztest_rfp.out passed: 13128 - - - --> LAPACK TESTING SUMMARY <-- - Processing LAPACK Testing output found in the TESTING directory -SUMMARY nb test run numerical error other error -================ =========== ================= ================ -REAL 1569648 0 (0.000%) 0 (0.000%) -DOUBLE PRECISION 1329105 36885 (2.775%) 0 (0.000%) -COMPLEX 1029730 0 (0.000%) 0 (0.000%) -COMPLEX16 1030797 0 (0.000%) 0 (0.000%) - ---> ALL PRECISIONS 4959280 36885 (0.744%) 0 (0.000%) - From fb5dc39422e55d940b84216e7f3100a8b3934ade Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Thu, 16 May 2024 10:53:04 +0200 Subject: [PATCH 067/206] current state of testing implementation --- SRC/Makefile | 2 +- SRC/dlarf1.f | 22 +- SRC/dorm2r.f | 4 +- SRC/dormqr.f | 80 +- libCompile | 2016 ++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 2076 insertions(+), 48 deletions(-) create mode 100644 libCompile diff --git a/SRC/Makefile b/SRC/Makefile index 5662d2ab00..106943b9ec 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -339,7 +339,7 @@ DLASRC = \ dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ - dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ + dlarf.o dlarf1.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dlarf1.f b/SRC/dlarf1.f index 071e72c817..20e7f91ca7 100644 --- a/SRC/dlarf1.f +++ b/SRC/dlarf1.f @@ -120,7 +120,7 @@ *> \ingroup larf * * ===================================================================== - SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) + SUBROUTINE DLARF1( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -145,7 +145,7 @@ SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC + INTEGER I, LASTV, LASTC, J * .. * .. External Subroutines .. EXTERNAL DGEMV, DGER @@ -192,16 +192,28 @@ SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.GT.0 ) THEN + IF( LASTV.GT.0 .AND. LASTC.GT.0) THEN * * w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) * - CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C(2,1), LDC, - $ V(INCV), INCV, ZERO, WORK, 1 ) +! CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), LDC, +! $ V(1+INCV), INCV, ZERO, WORK, 1 ) +! DO I = 1, LASTC +! WORK(I) = ZERO +! DO J = 2, LASTV +! WORK(I) = WORK(I) + V(1 + (J-1)*INCV) * C(J,I) +! END DO +! END DO + CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(2,1), LDC, + $ v(1+INCV), INCV, ZERO, WORK, 1) * * w(1:lastc,1) := w(1:lastc,1) + C(1,1:lastc)**T * v(1,1) * = w(1:lastc,1) + C(1,1:lastc)**T * + ! Now, do w(1:lastc,1) += C(1,1:lastc)**T +! DO I = 1, LASTC +! WORK(I) = WORK(I) + C(1,I) +! END DO CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) * * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index d894a806c3..ebf9c39e00 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -185,7 +185,7 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF, XERBLA + EXTERNAL DLARF, XERBLA, DLARF1 * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -268,7 +268,7 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * AII = A( I, I ) A( I, I ) = ONE - CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + CALL DLARF1( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, $ JC ), $ LDC, WORK ) A( I, I ) = AII diff --git a/SRC/dormqr.f b/SRC/dormqr.f index a9f8ba2279..d8fd7d034f 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -272,68 +272,68 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF END IF * - IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN +* IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN * * Use unblocked code * CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, $ IINFO ) - ELSE +* ELSE * * Use blocked code * - IWT = 1 + NW*NB - IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. - $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN - I1 = 1 - I2 = K - I3 = NB - ELSE - I1 = ( ( K-1 ) / NB )*NB + 1 - I2 = 1 - I3 = -NB - END IF -* - IF( LEFT ) THEN - NI = N - JC = 1 - ELSE - MI = M - IC = 1 - END IF -* - DO 10 I = I1, I2, I3 - IB = MIN( NB, K-I+1 ) +! IWT = 1 + NW*NB +! IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. +! $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN +! I1 = 1 +! I2 = K +! I3 = NB +! ELSE +! I1 = ( ( K-1 ) / NB )*NB + 1 +! I2 = 1 +! I3 = -NB +! END IF +* +! IF( LEFT ) THEN +! NI = N +! JC = 1 +! ELSE +! MI = M +! IC = 1 +! END IF +* +! DO 10 I = I1, I2, I3 +! IB = MIN( NB, K-I+1 ) * * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, - $ I ), - $ LDA, TAU( I ), WORK( IWT ), LDT ) - IF( LEFT ) THEN +! CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, +! $ I ), +! $ LDA, TAU( I ), WORK( IWT ), LDT ) +! IF( LEFT ) THEN * * H or H**T is applied to C(i:m,1:n) * - MI = M - I + 1 - IC = I - ELSE +! MI = M - I + 1 +! IC = I +! ELSE * * H or H**T is applied to C(1:m,i:n) * - NI = N - I + 1 - JC = I - END IF +! NI = N - I + 1 +! JC = I +! END IF * * Apply H or H**T * - CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, - $ NI, - $ IB, A( I, I ), LDA, WORK( IWT ), LDT, - $ C( IC, JC ), LDC, WORK, LDWORK ) - 10 CONTINUE - END IF +! CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, +! $ NI, +! $ IB, A( I, I ), LDA, WORK( IWT ), LDT, +! $ C( IC, JC ), LDC, WORK, LDWORK ) +! 10 CONTINUE +! END IF WORK( 1 ) = LWKOPT RETURN * diff --git a/libCompile b/libCompile new file mode 100644 index 0000000000..44c45e89de --- /dev/null +++ b/libCompile @@ -0,0 +1,2016 @@ +make -C SRC +make -C TESTING/MATGEN +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' +gfortran -O2 -frecursive -c -o slatms.o slatms.f +gfortran -O2 -frecursive -c -o slatme.o slatme.f +gfortran -O2 -frecursive -c -o slatmr.o slatmr.f +gfortran -O2 -frecursive -c -o slatmt.o slatmt.f +gfortran -O2 -frecursive -c -o slagge.o slagge.f +gfortran -O2 -frecursive -c -o slagsy.o slagsy.f +gfortran -O2 -frecursive -c -o slakf2.o slakf2.f +gfortran -O2 -frecursive -c -o slarge.o slarge.f +gfortran -O2 -frecursive -c -o slaror.o slaror.f +gfortran -O2 -frecursive -c -o slarot.o slarot.f +gfortran -O2 -frecursive -c -o slatm2.o slatm2.f +make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' +gfortran -O2 -frecursive -c -o sbdsvdx.o sbdsvdx.f +gfortran -O2 -frecursive -c -o spotrf2.o spotrf2.f +gfortran -O2 -frecursive -c -o sgetrf2.o sgetrf2.f +gfortran -O2 -frecursive -c -o sgbbrd.o sgbbrd.f +gfortran -O2 -frecursive -c -o sgbcon.o sgbcon.f +gfortran -O2 -frecursive -c -o slatm3.o slatm3.f +gfortran -O2 -frecursive -c -o sgbequ.o sgbequ.f +gfortran -O2 -frecursive -c -o slatm5.o slatm5.f +gfortran -O2 -frecursive -c -o sgbrfs.o sgbrfs.f +gfortran -O2 -frecursive -c -o slatm6.o slatm6.f +gfortran -O2 -frecursive -c -o slahilb.o slahilb.f +gfortran -O2 -frecursive -c -o sgbsv.o sgbsv.f +gfortran -O2 -frecursive -c -o sgbsvx.o sgbsvx.f +gfortran -O2 -frecursive -c -o clatms.o clatms.f +gfortran -O2 -frecursive -c -o clatme.o clatme.f +gfortran -O2 -frecursive -c -o sgbtf2.o sgbtf2.f +gfortran -O2 -frecursive -c -o clatmr.o clatmr.f +gfortran -O2 -frecursive -c -o clatmt.o clatmt.f +gfortran -O2 -frecursive -c -o sgbtrf.o sgbtrf.f +gfortran -O2 -frecursive -c -o clagge.o clagge.f +gfortran -O2 -frecursive -c -o claghe.o claghe.f +gfortran -O2 -frecursive -c -o sgbtrs.o sgbtrs.f +gfortran -O2 -frecursive -c -o sgebak.o sgebak.f +gfortran -O2 -frecursive -c -o clagsy.o clagsy.f +gfortran -O2 -frecursive -c -o clakf2.o clakf2.f +gfortran -O2 -frecursive -c -o clarge.o clarge.f +gfortran -O2 -frecursive -c -o sgebal.o sgebal.f +gfortran -O2 -frecursive -c -o claror.o claror.f +gfortran -O2 -frecursive -c -o sgebd2.o sgebd2.f +gfortran -O2 -frecursive -c -o clarot.o clarot.f +gfortran -O2 -frecursive -c -o clatm1.o clatm1.f +gfortran -O2 -frecursive -c -o sgebrd.o sgebrd.f +gfortran -O2 -frecursive -c -o clarnd.o clarnd.f +gfortran -O2 -frecursive -c -o clatm2.o clatm2.f +gfortran -O2 -frecursive -c -o clatm3.o clatm3.f +gfortran -O2 -frecursive -c -o sgecon.o sgecon.f +gfortran -O2 -frecursive -c -o clatm5.o clatm5.f +gfortran -O2 -frecursive -c -o sgeequ.o sgeequ.f +gfortran -O2 -frecursive -c -o clatm6.o clatm6.f +gfortran -O2 -frecursive -c -o sgees.o sgees.f +gfortran -O2 -frecursive -c -o sgeesx.o sgeesx.f +gfortran -O2 -frecursive -c -o clahilb.o clahilb.f +gfortran -O2 -frecursive -c -o slatm1.o slatm1.f +gfortran -O2 -frecursive -c -o slatm7.o slatm7.f +gfortran -O2 -frecursive -c -o sgeev.o sgeev.f +gfortran -O0 -frecursive -c -o slaran.o slaran.f +gfortran -O2 -frecursive -c -o sgeevx.o sgeevx.f +gfortran -O2 -frecursive -c -o slarnd.o slarnd.f +gfortran -O2 -frecursive -c -o dlatms.o dlatms.f +gfortran -O2 -frecursive -c -o sgehd2.o sgehd2.f +gfortran -O2 -frecursive -c -o sgehrd.o sgehrd.f +gfortran -O2 -frecursive -c -o sgelq2.o sgelq2.f +gfortran -O2 -frecursive -c -o dlatme.o dlatme.f +gfortran -O2 -frecursive -c -o sgelqf.o sgelqf.f +gfortran -O2 -frecursive -c -o dlatmr.o dlatmr.f +gfortran -O2 -frecursive -c -o sgels.o sgels.f +gfortran -O2 -frecursive -c -o dlatmt.o dlatmt.f +gfortran -O2 -frecursive -c -o dlagge.o dlagge.f +gfortran -O2 -frecursive -c -o dlagsy.o dlagsy.f +gfortran -O2 -frecursive -c -o dlakf2.o dlakf2.f +gfortran -O2 -frecursive -c -o dlarge.o dlarge.f +gfortran -O2 -frecursive -c -o sgelst.o sgelst.f +gfortran -O2 -frecursive -c -o dlaror.o dlaror.f +gfortran -O2 -frecursive -c -o dlarot.o dlarot.f +gfortran -O2 -frecursive -c -o dlatm2.o dlatm2.f +gfortran -O2 -frecursive -c -o sgelsd.o sgelsd.f +gfortran -O2 -frecursive -c -o dlatm3.o dlatm3.f +gfortran -O2 -frecursive -c -o sgelss.o sgelss.f +gfortran -O2 -frecursive -c -o dlatm5.o dlatm5.f +gfortran -O2 -frecursive -c -o dlatm6.o dlatm6.f +gfortran -O2 -frecursive -c -o sgelsy.o sgelsy.f +gfortran -O2 -frecursive -c -o dlahilb.o dlahilb.f +gfortran -O2 -frecursive -c -o zlatms.o zlatms.f +gfortran -O2 -frecursive -c -o sgeql2.o sgeql2.f +gfortran -O2 -frecursive -c -o zlatme.o zlatme.f +gfortran -O2 -frecursive -c -o sgeqlf.o sgeqlf.f +gfortran -O2 -frecursive -c -o zlatmr.o zlatmr.f +gfortran -O2 -frecursive -c -o sgeqp3.o sgeqp3.f +gfortran -O2 -frecursive -c -o zlatmt.o zlatmt.f +gfortran -O2 -frecursive -c -o sgeqp3rk.o sgeqp3rk.f +gfortran -O2 -frecursive -c -o zlagge.o zlagge.f +gfortran -O2 -frecursive -c -o zlaghe.o zlaghe.f +gfortran -O2 -frecursive -c -o sgeqr2.o sgeqr2.f +gfortran -O2 -frecursive -c -o zlagsy.o zlagsy.f +gfortran -O2 -frecursive -c -o sgeqr2p.o sgeqr2p.f +gfortran -O2 -frecursive -c -o sgeqrf.o sgeqrf.f +gfortran -O2 -frecursive -c -o zlakf2.o zlakf2.f +gfortran -O2 -frecursive -c -o zlarge.o zlarge.f +gfortran -O2 -frecursive -c -o zlaror.o zlaror.f +gfortran -O2 -frecursive -c -o sgeqrfp.o sgeqrfp.f +gfortran -O2 -frecursive -c -o zlarot.o zlarot.f +gfortran -O2 -frecursive -c -o zlatm1.o zlatm1.f +gfortran -O2 -frecursive -c -o zlarnd.o zlarnd.f +gfortran -O2 -frecursive -c -o sgerfs.o sgerfs.f +gfortran -O2 -frecursive -c -o sgerq2.o sgerq2.f +gfortran -O2 -frecursive -c -o sgerqf.o sgerqf.f +gfortran -O2 -frecursive -c -o zlatm2.o zlatm2.f +gfortran -O2 -frecursive -c -o sgesc2.o sgesc2.f +gfortran -O2 -frecursive -c -o sgesdd.o sgesdd.f +gfortran -O2 -frecursive -c -o zlatm3.o zlatm3.f +gfortran -O2 -frecursive -c -o zlatm5.o zlatm5.f +gfortran -O2 -frecursive -c -o zlatm6.o zlatm6.f +gfortran -O2 -frecursive -c -o sgesv.o sgesv.f +gfortran -O2 -frecursive -c -o zlahilb.o zlahilb.f +gfortran -O2 -frecursive -c -o dlatm1.o dlatm1.f +gfortran -O2 -frecursive -c -o sgesvd.o sgesvd.f +gfortran -O2 -frecursive -c -o dlatm7.o dlatm7.f +gfortran -O0 -frecursive -c -o dlaran.o dlaran.f +gfortran -O2 -frecursive -c -o dlarnd.o dlarnd.f +gfortran -O2 -frecursive -c -o sgesvdx.o sgesvdx.f +gfortran -O2 -frecursive -c -o sgesvx.o sgesvx.f +gfortran -O2 -frecursive -c -o sgetc2.o sgetc2.f +gfortran -O2 -frecursive -c -o sgetf2.o sgetf2.f +gfortran -O2 -frecursive -c -o sgetri.o sgetri.f +gfortran -O2 -frecursive -c -o sggbak.o sggbak.f +gfortran -O2 -frecursive -c -o sggbal.o sggbal.f +gfortran -O2 -frecursive -c -o sgges.o sgges.f +gfortran -O2 -frecursive -c -o sgges3.o sgges3.f +gfortran -O2 -frecursive -c -o sggesx.o sggesx.f +gfortran -O2 -frecursive -c -o sggev.o sggev.f +gfortran -O2 -frecursive -c -o sggev3.o sggev3.f +gfortran -O2 -frecursive -c -o sggevx.o sggevx.f +gfortran -O2 -frecursive -c -o sggglm.o sggglm.f +gfortran -O2 -frecursive -c -o sgghrd.o sgghrd.f +gfortran -O2 -frecursive -c -o sgghd3.o sgghd3.f +gfortran -O2 -frecursive -c -o sgglse.o sgglse.f +gfortran -O2 -frecursive -c -o sggqrf.o sggqrf.f +gfortran -O2 -frecursive -c -o sggrqf.o sggrqf.f +gfortran -O2 -frecursive -c -o sggsvd3.o sggsvd3.f +gfortran -O2 -frecursive -c -o sggsvp3.o sggsvp3.f +gfortran -O2 -frecursive -c -o sgtcon.o sgtcon.f +gfortran -O2 -frecursive -c -o sgtrfs.o sgtrfs.f +gfortran -O2 -frecursive -c -o sgtsv.o sgtsv.f +gfortran -O2 -frecursive -c -o sgtsvx.o sgtsvx.f +gfortran -O2 -frecursive -c -o sgttrf.o sgttrf.f +gfortran -O2 -frecursive -c -o sgttrs.o sgttrs.f +gfortran -O2 -frecursive -c -o sgtts2.o sgtts2.f +gfortran -O2 -frecursive -c -o shgeqz.o shgeqz.f +gfortran -O2 -frecursive -c -o slaqz0.o slaqz0.f +gfortran -O2 -frecursive -c -o slaqz1.o slaqz1.f +gfortran -O2 -frecursive -c -o slaqz2.o slaqz2.f +gfortran -O2 -frecursive -c -o slaqz3.o slaqz3.f +gfortran -O2 -frecursive -c -o slaqz4.o slaqz4.f +gfortran -O2 -frecursive -c -o shsein.o shsein.f +gfortran -O2 -frecursive -c -o shseqr.o shseqr.f +gfortran -O2 -frecursive -c -o slabrd.o slabrd.f +gfortran -O2 -frecursive -c -o slacon.o slacon.f +ar cr ../../libtmglib.a slatms.o slatme.o slatmr.o slatmt.o slagge.o slagsy.o slakf2.o slarge.o slaror.o slarot.o slatm2.o slatm3.o slatm5.o slatm6.o slahilb.o clatms.o clatme.o clatmr.o clatmt.o clagge.o claghe.o clagsy.o clakf2.o clarge.o claror.o clarot.o clatm1.o clarnd.o clatm2.o clatm3.o clatm5.o clatm6.o clahilb.o slatm1.o slatm7.o slaran.o slarnd.o dlatms.o dlatme.o dlatmr.o dlatmt.o dlagge.o dlagsy.o dlakf2.o dlarge.o dlaror.o dlarot.o dlatm2.o dlatm3.o dlatm5.o dlatm6.o dlahilb.o zlatms.o zlatme.o zlatmr.o zlatmt.o zlagge.o zlaghe.o zlagsy.o zlakf2.o zlarge.o zlaror.o zlarot.o zlatm1.o zlarnd.o zlatm2.o zlatm3.o zlatm5.o zlatm6.o zlahilb.o dlatm1.o dlatm7.o dlaran.o dlarnd.o +gfortran -O2 -frecursive -c -o slacn2.o slacn2.f +gfortran -O2 -frecursive -c -o slaein.o slaein.f +gfortran -O2 -frecursive -c -o slaexc.o slaexc.f +ranlib ../../libtmglib.a +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' +gfortran -O2 -frecursive -c -o slag2.o slag2.f +gfortran -O2 -frecursive -c -o slags2.o slags2.f +gfortran -O2 -frecursive -c -o slagtm.o slagtm.f +gfortran -O2 -frecursive -c -o slagv2.o slagv2.f +gfortran -O2 -frecursive -c -o slahqr.o slahqr.f +gfortran -O2 -frecursive -c -o slahr2.o slahr2.f +gfortran -O2 -frecursive -c -o slaic1.o slaic1.f +gfortran -O2 -frecursive -c -o slaln2.o slaln2.f +gfortran -O2 -frecursive -c -o slals0.o slals0.f +gfortran -O2 -frecursive -c -o slalsa.o slalsa.f +gfortran -O2 -frecursive -c -o slalsd.o slalsd.f +gfortran -O2 -frecursive -c -o slangb.o slangb.f +gfortran -O2 -frecursive -c -o slange.o slange.f +gfortran -O2 -frecursive -c -o slangt.o slangt.f +gfortran -O2 -frecursive -c -o slanhs.o slanhs.f +gfortran -O2 -frecursive -c -o slansb.o slansb.f +gfortran -O2 -frecursive -c -o slansp.o slansp.f +gfortran -O2 -frecursive -c -o slansy.o slansy.f +gfortran -O2 -frecursive -c -o slantb.o slantb.f +gfortran -O2 -frecursive -c -o slantp.o slantp.f +gfortran -O2 -frecursive -c -o slantr.o slantr.f +gfortran -O2 -frecursive -c -o slanv2.o slanv2.f +gfortran -O2 -frecursive -c -o slapll.o slapll.f +gfortran -O2 -frecursive -c -o slapmt.o slapmt.f +gfortran -O2 -frecursive -c -o slaqgb.o slaqgb.f +gfortran -O2 -frecursive -c -o slaqge.o slaqge.f +gfortran -O2 -frecursive -c -o slaqp2.o slaqp2.f +gfortran -O2 -frecursive -c -o slaqps.o slaqps.f +gfortran -O2 -frecursive -c -o slaqp2rk.o slaqp2rk.f +gfortran -O2 -frecursive -c -o slaqp3rk.o slaqp3rk.f +gfortran -O2 -frecursive -c -o slaqsb.o slaqsb.f +gfortran -O2 -frecursive -c -o slaqsp.o slaqsp.f +gfortran -O2 -frecursive -c -o slaqsy.o slaqsy.f +gfortran -O2 -frecursive -c -o slaqr0.o slaqr0.f +gfortran -O2 -frecursive -c -o slaqr1.o slaqr1.f +gfortran -O2 -frecursive -c -o slaqr2.o slaqr2.f +gfortran -O2 -frecursive -c -o slaqr3.o slaqr3.f +gfortran -O2 -frecursive -c -o slaqr4.o slaqr4.f +gfortran -O2 -frecursive -c -o slaqr5.o slaqr5.f +gfortran -O2 -frecursive -c -o slaqtr.o slaqtr.f +gfortran -O2 -frecursive -c -o slar1v.o slar1v.f +gfortran -O2 -frecursive -c -o slar2v.o slar2v.f +gfortran -O2 -frecursive -c -o ilaslr.o ilaslr.f +gfortran -O2 -frecursive -c -o ilaslc.o ilaslc.f +gfortran -O2 -frecursive -c -o slarf.o slarf.f +gfortran -O2 -frecursive -c -o slarfb.o slarfb.f +gfortran -O2 -frecursive -c -o slarfb_gett.o slarfb_gett.f +gfortran -O2 -frecursive -c -o slarfg.o slarfg.f +gfortran -O2 -frecursive -c -o slarfgp.o slarfgp.f +gfortran -O2 -frecursive -c -o slarft.o slarft.f +gfortran -O2 -frecursive -c -o slarfx.o slarfx.f +gfortran -O2 -frecursive -c -o slarfy.o slarfy.f +gfortran -O2 -frecursive -c -o slargv.o slargv.f +gfortran -O2 -frecursive -c -o slarmm.o slarmm.f +gfortran -O2 -frecursive -c -o slarrv.o slarrv.f +gfortran -O2 -frecursive -c -o slartv.o slartv.f +gfortran -O2 -frecursive -c -o slarz.o slarz.f +gfortran -O2 -frecursive -c -o slarzb.o slarzb.f +gfortran -O2 -frecursive -c -o slarzt.o slarzt.f +gfortran -O2 -frecursive -c -o slaswp.o slaswp.f +gfortran -O2 -frecursive -c -o slasy2.o slasy2.f +gfortran -O2 -frecursive -c -o slasyf.o slasyf.f +gfortran -O2 -frecursive -c -o slasyf_rook.o slasyf_rook.f +gfortran -O2 -frecursive -c -o slasyf_rk.o slasyf_rk.f +gfortran -O2 -frecursive -c -o slatbs.o slatbs.f +gfortran -O2 -frecursive -c -o slatdf.o slatdf.f +gfortran -O2 -frecursive -c -o slatps.o slatps.f +gfortran -O2 -frecursive -c -o slatrd.o slatrd.f +gfortran -O2 -frecursive -c -o slatrs.o slatrs.f +gfortran -O2 -frecursive -c -o slatrs3.o slatrs3.f +gfortran -O2 -frecursive -c -o slatrz.o slatrz.f +gfortran -O2 -frecursive -c -o slauu2.o slauu2.f +gfortran -O2 -frecursive -c -o slauum.o slauum.f +gfortran -O2 -frecursive -c -o sopgtr.o sopgtr.f +gfortran -O2 -frecursive -c -o sopmtr.o sopmtr.f +gfortran -O2 -frecursive -c -o sorg2l.o sorg2l.f +gfortran -O2 -frecursive -c -o sorg2r.o sorg2r.f +gfortran -O2 -frecursive -c -o sorgbr.o sorgbr.f +gfortran -O2 -frecursive -c -o sorghr.o sorghr.f +gfortran -O2 -frecursive -c -o sorgl2.o sorgl2.f +gfortran -O2 -frecursive -c -o sorglq.o sorglq.f +gfortran -O2 -frecursive -c -o sorgql.o sorgql.f +gfortran -O2 -frecursive -c -o sorgqr.o sorgqr.f +gfortran -O2 -frecursive -c -o sorgr2.o sorgr2.f +gfortran -O2 -frecursive -c -o sorgrq.o sorgrq.f +gfortran -O2 -frecursive -c -o sorgtr.o sorgtr.f +gfortran -O2 -frecursive -c -o sorgtsqr.o sorgtsqr.f +gfortran -O2 -frecursive -c -o sorgtsqr_row.o sorgtsqr_row.f +gfortran -O2 -frecursive -c -o sorm2l.o sorm2l.f +gfortran -O2 -frecursive -c -o sorm2r.o sorm2r.f +gfortran -O2 -frecursive -c -o sorm22.o sorm22.f +gfortran -O2 -frecursive -c -o sormbr.o sormbr.f +gfortran -O2 -frecursive -c -o sormhr.o sormhr.f +gfortran -O2 -frecursive -c -o sorml2.o sorml2.f +gfortran -O2 -frecursive -c -o sormlq.o sormlq.f +gfortran -O2 -frecursive -c -o sormql.o sormql.f +gfortran -O2 -frecursive -c -o sormqr.o sormqr.f +gfortran -O2 -frecursive -c -o sormr2.o sormr2.f +gfortran -O2 -frecursive -c -o sormr3.o sormr3.f +gfortran -O2 -frecursive -c -o sormrq.o sormrq.f +gfortran -O2 -frecursive -c -o sormrz.o sormrz.f +gfortran -O2 -frecursive -c -o sormtr.o sormtr.f +gfortran -O2 -frecursive -c -o spbcon.o spbcon.f +gfortran -O2 -frecursive -c -o spbequ.o spbequ.f +gfortran -O2 -frecursive -c -o spbrfs.o spbrfs.f +gfortran -O2 -frecursive -c -o spbstf.o spbstf.f +gfortran -O2 -frecursive -c -o spbsv.o spbsv.f +gfortran -O2 -frecursive -c -o spbsvx.o spbsvx.f +gfortran -O2 -frecursive -c -o spbtf2.o spbtf2.f +gfortran -O2 -frecursive -c -o spbtrf.o spbtrf.f +gfortran -O2 -frecursive -c -o spbtrs.o spbtrs.f +gfortran -O2 -frecursive -c -o spocon.o spocon.f +gfortran -O2 -frecursive -c -o spoequ.o spoequ.f +gfortran -O2 -frecursive -c -o sporfs.o sporfs.f +gfortran -O2 -frecursive -c -o sposv.o sposv.f +gfortran -O2 -frecursive -c -o sposvx.o sposvx.f +gfortran -O2 -frecursive -c -o spotf2.o spotf2.f +gfortran -O2 -frecursive -c -o spotri.o spotri.f +gfortran -O2 -frecursive -c -o spstrf.o spstrf.f +gfortran -O2 -frecursive -c -o spstf2.o spstf2.f +gfortran -O2 -frecursive -c -o sppcon.o sppcon.f +gfortran -O2 -frecursive -c -o sppequ.o sppequ.f +gfortran -O2 -frecursive -c -o spprfs.o spprfs.f +gfortran -O2 -frecursive -c -o sppsv.o sppsv.f +gfortran -O2 -frecursive -c -o sppsvx.o sppsvx.f +gfortran -O2 -frecursive -c -o spptrf.o spptrf.f +gfortran -O2 -frecursive -c -o spptri.o spptri.f +gfortran -O2 -frecursive -c -o spptrs.o spptrs.f +gfortran -O2 -frecursive -c -o sptcon.o sptcon.f +gfortran -O2 -frecursive -c -o spteqr.o spteqr.f +gfortran -O2 -frecursive -c -o sptrfs.o sptrfs.f +gfortran -O2 -frecursive -c -o sptsv.o sptsv.f +gfortran -O2 -frecursive -c -o sptsvx.o sptsvx.f +gfortran -O2 -frecursive -c -o spttrs.o spttrs.f +gfortran -O2 -frecursive -c -o sptts2.o sptts2.f +gfortran -O2 -frecursive -c -o srscl.o srscl.f +gfortran -O2 -frecursive -c -o ssbev.o ssbev.f +gfortran -O2 -frecursive -c -o ssbevd.o ssbevd.f +gfortran -O2 -frecursive -c -o ssbevx.o ssbevx.f +gfortran -O2 -frecursive -c -o ssbgst.o ssbgst.f +gfortran -O2 -frecursive -c -o ssbgv.o ssbgv.f +gfortran -O2 -frecursive -c -o ssbgvd.o ssbgvd.f +gfortran -O2 -frecursive -c -o ssbgvx.o ssbgvx.f +gfortran -O2 -frecursive -c -o ssbtrd.o ssbtrd.f +gfortran -O2 -frecursive -c -o sspcon.o sspcon.f +gfortran -O2 -frecursive -c -o sspev.o sspev.f +gfortran -O2 -frecursive -c -o sspevd.o sspevd.f +gfortran -O2 -frecursive -c -o sspevx.o sspevx.f +gfortran -O2 -frecursive -c -o sspgst.o sspgst.f +gfortran -O2 -frecursive -c -o sspgv.o sspgv.f +gfortran -O2 -frecursive -c -o sspgvd.o sspgvd.f +gfortran -O2 -frecursive -c -o sspgvx.o sspgvx.f +gfortran -O2 -frecursive -c -o ssprfs.o ssprfs.f +gfortran -O2 -frecursive -c -o sspsv.o sspsv.f +gfortran -O2 -frecursive -c -o sspsvx.o sspsvx.f +gfortran -O2 -frecursive -c -o ssptrd.o ssptrd.f +gfortran -O2 -frecursive -c -o ssptrf.o ssptrf.f +gfortran -O2 -frecursive -c -o ssptri.o ssptri.f +gfortran -O2 -frecursive -c -o ssptrs.o ssptrs.f +gfortran -O2 -frecursive -c -o sstegr.o sstegr.f +gfortran -O2 -frecursive -c -o sstein.o sstein.f +gfortran -O2 -frecursive -c -o sstev.o sstev.f +gfortran -O2 -frecursive -c -o sstevd.o sstevd.f +gfortran -O2 -frecursive -c -o sstevr.o sstevr.f +gfortran -O2 -frecursive -c -o sstevx.o sstevx.f +gfortran -O2 -frecursive -c -o ssycon.o ssycon.f +gfortran -O2 -frecursive -c -o ssyev.o ssyev.f +gfortran -O2 -frecursive -c -o ssyevd.o ssyevd.f +gfortran -O2 -frecursive -c -o ssyevr.o ssyevr.f +gfortran -O2 -frecursive -c -o ssyevx.o ssyevx.f +gfortran -O2 -frecursive -c -o ssygs2.o ssygs2.f +gfortran -O2 -frecursive -c -o ssygst.o ssygst.f +gfortran -O2 -frecursive -c -o ssygv.o ssygv.f +gfortran -O2 -frecursive -c -o ssygvd.o ssygvd.f +gfortran -O2 -frecursive -c -o ssygvx.o ssygvx.f +gfortran -O2 -frecursive -c -o ssyrfs.o ssyrfs.f +gfortran -O2 -frecursive -c -o ssysv.o ssysv.f +gfortran -O2 -frecursive -c -o ssysvx.o ssysvx.f +gfortran -O2 -frecursive -c -o ssytd2.o ssytd2.f +gfortran -O2 -frecursive -c -o ssytf2.o ssytf2.f +gfortran -O2 -frecursive -c -o ssytrd.o ssytrd.f +gfortran -O2 -frecursive -c -o ssytrf.o ssytrf.f +gfortran -O2 -frecursive -c -o ssytri.o ssytri.f +gfortran -O2 -frecursive -c -o ssytri2.o ssytri2.f +gfortran -O2 -frecursive -c -o ssytri2x.o ssytri2x.f +gfortran -O2 -frecursive -c -o ssyswapr.o ssyswapr.f +gfortran -O2 -frecursive -c -o ssytrs.o ssytrs.f +gfortran -O2 -frecursive -c -o ssytrs2.o ssytrs2.f +gfortran -O2 -frecursive -c -o ssyconv.o ssyconv.f +gfortran -O2 -frecursive -c -o ssyconvf.o ssyconvf.f +gfortran -O2 -frecursive -c -o ssyconvf_rook.o ssyconvf_rook.f +gfortran -O2 -frecursive -c -o ssytf2_rook.o ssytf2_rook.f +gfortran -O2 -frecursive -c -o ssytrf_rook.o ssytrf_rook.f +gfortran -O2 -frecursive -c -o ssytrs_rook.o ssytrs_rook.f +gfortran -O2 -frecursive -c -o ssytri_rook.o ssytri_rook.f +gfortran -O2 -frecursive -c -o ssycon_rook.o ssycon_rook.f +gfortran -O2 -frecursive -c -o ssysv_rook.o ssysv_rook.f +gfortran -O2 -frecursive -c -o ssytf2_rk.o ssytf2_rk.f +gfortran -O2 -frecursive -c -o ssytrf_rk.o ssytrf_rk.f +gfortran -O2 -frecursive -c -o ssytrs_3.o ssytrs_3.f +gfortran -O2 -frecursive -c -o ssytri_3.o ssytri_3.f +gfortran -O2 -frecursive -c -o ssytri_3x.o ssytri_3x.f +gfortran -O2 -frecursive -c -o ssycon_3.o ssycon_3.f +gfortran -O2 -frecursive -c -o ssysv_rk.o ssysv_rk.f +gfortran -O2 -frecursive -c -o slasyf_aa.o slasyf_aa.f +gfortran -O2 -frecursive -c -o ssysv_aa.o ssysv_aa.f +gfortran -O2 -frecursive -c -o ssytrf_aa.o ssytrf_aa.f +gfortran -O2 -frecursive -c -o ssytrs_aa.o ssytrs_aa.f +gfortran -O2 -frecursive -c -o ssysv_aa_2stage.o ssysv_aa_2stage.f +gfortran -O2 -frecursive -c -o ssytrf_aa_2stage.o ssytrf_aa_2stage.f +gfortran -O2 -frecursive -c -o ssytrs_aa_2stage.o ssytrs_aa_2stage.f +gfortran -O2 -frecursive -c -o stbcon.o stbcon.f +gfortran -O2 -frecursive -c -o stbrfs.o stbrfs.f +gfortran -O2 -frecursive -c -o stbtrs.o stbtrs.f +gfortran -O2 -frecursive -c -o stgevc.o stgevc.f +gfortran -O2 -frecursive -c -o stgex2.o stgex2.f +gfortran -O2 -frecursive -c -o stgexc.o stgexc.f +gfortran -O2 -frecursive -c -o stgsen.o stgsen.f +gfortran -O2 -frecursive -c -o stgsja.o stgsja.f +gfortran -O2 -frecursive -c -o stgsna.o stgsna.f +gfortran -O2 -frecursive -c -o stgsy2.o stgsy2.f +gfortran -O2 -frecursive -c -o stgsyl.o stgsyl.f +gfortran -O2 -frecursive -c -o stpcon.o stpcon.f +gfortran -O2 -frecursive -c -o stprfs.o stprfs.f +gfortran -O2 -frecursive -c -o stptri.o stptri.f +gfortran -O2 -frecursive -c -o stptrs.o stptrs.f +gfortran -O2 -frecursive -c -o strcon.o strcon.f +gfortran -O2 -frecursive -c -o strevc.o strevc.f +gfortran -O2 -frecursive -c -o strevc3.o strevc3.f +gfortran -O2 -frecursive -c -o strexc.o strexc.f +gfortran -O2 -frecursive -c -o strrfs.o strrfs.f +gfortran -O2 -frecursive -c -o strsen.o strsen.f +gfortran -O2 -frecursive -c -o strsna.o strsna.f +gfortran -O2 -frecursive -c -o strsyl.o strsyl.f +gfortran -O2 -frecursive -c -o strsyl3.o strsyl3.f +gfortran -O2 -frecursive -c -o strti2.o strti2.f +gfortran -O2 -frecursive -c -o strtri.o strtri.f +gfortran -O2 -frecursive -c -o strtrs.o strtrs.f +gfortran -O2 -frecursive -c -o stzrzf.o stzrzf.f +gfortran -O2 -frecursive -c -o sstemr.o sstemr.f +gfortran -O2 -frecursive -c -o slansf.o slansf.f +gfortran -O2 -frecursive -c -o spftrf.o spftrf.f +gfortran -O2 -frecursive -c -o spftri.o spftri.f +gfortran -O2 -frecursive -c -o spftrs.o spftrs.f +gfortran -O2 -frecursive -c -o ssfrk.o ssfrk.f +gfortran -O2 -frecursive -c -o stfsm.o stfsm.f +gfortran -O2 -frecursive -c -o stftri.o stftri.f +gfortran -O2 -frecursive -c -o stfttp.o stfttp.f +gfortran -O2 -frecursive -c -o stfttr.o stfttr.f +gfortran -O2 -frecursive -c -o stpttf.o stpttf.f +gfortran -O2 -frecursive -c -o stpttr.o stpttr.f +gfortran -O2 -frecursive -c -o strttf.o strttf.f +gfortran -O2 -frecursive -c -o strttp.o strttp.f +gfortran -O2 -frecursive -c -o sgejsv.o sgejsv.f +gfortran -O2 -frecursive -c -o sgesvj.o sgesvj.f +gfortran -O2 -frecursive -c -o sgsvj0.o sgsvj0.f +gfortran -O2 -frecursive -c -o sgsvj1.o sgsvj1.f +gfortran -O2 -frecursive -c -o sgeequb.o sgeequb.f +gfortran -O2 -frecursive -c -o ssyequb.o ssyequb.f +gfortran -O2 -frecursive -c -o spoequb.o spoequb.f +gfortran -O2 -frecursive -c -o sgbequb.o sgbequb.f +gfortran -O2 -frecursive -c -o sbbcsd.o sbbcsd.f +gfortran -O2 -frecursive -c -o slapmr.o slapmr.f +gfortran -O2 -frecursive -c -o sorbdb.o sorbdb.f +gfortran -O2 -frecursive -c -o sorbdb1.o sorbdb1.f +gfortran -O2 -frecursive -c -o sorbdb2.o sorbdb2.f +gfortran -O2 -frecursive -c -o sorbdb3.o sorbdb3.f +gfortran -O2 -frecursive -c -o sorbdb4.o sorbdb4.f +gfortran -O2 -frecursive -c -o sorbdb5.o sorbdb5.f +gfortran -O2 -frecursive -c -o sorbdb6.o sorbdb6.f +gfortran -O2 -frecursive -c -o sorcsd.o sorcsd.f +gfortran -O2 -frecursive -c -o sorcsd2by1.o sorcsd2by1.f +gfortran -O2 -frecursive -c -o sgeqrt.o sgeqrt.f +gfortran -O2 -frecursive -c -o sgeqrt2.o sgeqrt2.f +gfortran -O2 -frecursive -c -o sgeqrt3.o sgeqrt3.f +gfortran -O2 -frecursive -c -o sgemqrt.o sgemqrt.f +gfortran -O2 -frecursive -c -o stpqrt.o stpqrt.f +gfortran -O2 -frecursive -c -o stpqrt2.o stpqrt2.f +gfortran -O2 -frecursive -c -o stpmqrt.o stpmqrt.f +gfortran -O2 -frecursive -c -o stprfb.o stprfb.f +gfortran -O2 -frecursive -c -o sgelqt.o sgelqt.f +gfortran -O2 -frecursive -c -o sgelqt3.o sgelqt3.f +gfortran -O2 -frecursive -c -o sgemlqt.o sgemlqt.f +gfortran -O2 -frecursive -c -o sgetsls.o sgetsls.f +gfortran -O2 -frecursive -c -o sgetsqrhrt.o sgetsqrhrt.f +gfortran -O2 -frecursive -c -o sgeqr.o sgeqr.f +gfortran -O2 -frecursive -c -o slatsqr.o slatsqr.f +gfortran -O2 -frecursive -c -o slamtsqr.o slamtsqr.f +gfortran -O2 -frecursive -c -o sgemqr.o sgemqr.f +gfortran -O2 -frecursive -c -o sgelq.o sgelq.f +gfortran -O2 -frecursive -c -o slaswlq.o slaswlq.f +gfortran -O2 -frecursive -c -o slamswlq.o slamswlq.f +gfortran -O2 -frecursive -c -o sgemlq.o sgemlq.f +gfortran -O2 -frecursive -c -o stplqt.o stplqt.f +gfortran -O2 -frecursive -c -o stplqt2.o stplqt2.f +gfortran -O2 -frecursive -c -o stpmlqt.o stpmlqt.f +gfortran -O2 -frecursive -c -o sorhr_col.o sorhr_col.f +gfortran -O2 -frecursive -c -o slaorhr_col_getrfnp.o slaorhr_col_getrfnp.f +gfortran -O2 -frecursive -c -o slaorhr_col_getrfnp2.o slaorhr_col_getrfnp2.f +gfortran -O2 -frecursive -c -o ssytrd_2stage.o ssytrd_2stage.f +gfortran -O2 -frecursive -c -o ssytrd_sy2sb.o ssytrd_sy2sb.f +gfortran -O2 -frecursive -c -o ssytrd_sb2st.o ssytrd_sb2st.F +gfortran -O2 -frecursive -c -o ssb2st_kernels.o ssb2st_kernels.f +gfortran -O2 -frecursive -c -o ssyevd_2stage.o ssyevd_2stage.f +gfortran -O2 -frecursive -c -o ssyev_2stage.o ssyev_2stage.f +gfortran -O2 -frecursive -c -o ssyevx_2stage.o ssyevx_2stage.f +gfortran -O2 -frecursive -c -o ssyevr_2stage.o ssyevr_2stage.f +gfortran -O2 -frecursive -c -o ssbev_2stage.o ssbev_2stage.f +gfortran -O2 -frecursive -c -o ssbevx_2stage.o ssbevx_2stage.f +gfortran -O2 -frecursive -c -o ssbevd_2stage.o ssbevd_2stage.f +gfortran -O2 -frecursive -c -o ssygv_2stage.o ssygv_2stage.f +gfortran -O2 -frecursive -c -o sgesvdq.o sgesvdq.f +gfortran -O2 -frecursive -c -o la_constants.o la_constants.f90 +gfortran -O2 -frecursive -c -o dpotrf2.o dpotrf2.f +gfortran -O2 -frecursive -c -o dgetrf2.o dgetrf2.f +gfortran -O2 -frecursive -c -o dbdsvdx.o dbdsvdx.f +gfortran -O2 -frecursive -c -o dgbbrd.o dgbbrd.f +gfortran -O2 -frecursive -c -o dgbcon.o dgbcon.f +gfortran -O2 -frecursive -c -o dgbequ.o dgbequ.f +gfortran -O2 -frecursive -c -o dgbrfs.o dgbrfs.f +gfortran -O2 -frecursive -c -o dgbsv.o dgbsv.f +gfortran -O2 -frecursive -c -o dgbsvx.o dgbsvx.f +gfortran -O2 -frecursive -c -o dgbtf2.o dgbtf2.f +gfortran -O2 -frecursive -c -o dgbtrf.o dgbtrf.f +gfortran -O2 -frecursive -c -o dgbtrs.o dgbtrs.f +gfortran -O2 -frecursive -c -o dgebak.o dgebak.f +gfortran -O2 -frecursive -c -o dgebal.o dgebal.f +gfortran -O2 -frecursive -c -o dgebd2.o dgebd2.f +gfortran -O2 -frecursive -c -o dgebrd.o dgebrd.f +gfortran -O2 -frecursive -c -o dgecon.o dgecon.f +gfortran -O2 -frecursive -c -o dgeequ.o dgeequ.f +gfortran -O2 -frecursive -c -o dgees.o dgees.f +gfortran -O2 -frecursive -c -o dgeesx.o dgeesx.f +gfortran -O2 -frecursive -c -o dgeev.o dgeev.f +gfortran -O2 -frecursive -c -o dgeevx.o dgeevx.f +gfortran -O2 -frecursive -c -o dgehd2.o dgehd2.f +gfortran -O2 -frecursive -c -o dgehrd.o dgehrd.f +gfortran -O2 -frecursive -c -o dgelq2.o dgelq2.f +gfortran -O2 -frecursive -c -o dgelqf.o dgelqf.f +gfortran -O2 -frecursive -c -o dgels.o dgels.f +gfortran -O2 -frecursive -c -o dgelst.o dgelst.f +gfortran -O2 -frecursive -c -o dgelsd.o dgelsd.f +gfortran -O2 -frecursive -c -o dgelss.o dgelss.f +gfortran -O2 -frecursive -c -o dgelsy.o dgelsy.f +gfortran -O2 -frecursive -c -o dgeql2.o dgeql2.f +gfortran -O2 -frecursive -c -o dgeqlf.o dgeqlf.f +gfortran -O2 -frecursive -c -o dgeqp3.o dgeqp3.f +gfortran -O2 -frecursive -c -o dgeqp3rk.o dgeqp3rk.f +gfortran -O2 -frecursive -c -o dgeqr2.o dgeqr2.f +gfortran -O2 -frecursive -c -o dgeqr2p.o dgeqr2p.f +gfortran -O2 -frecursive -c -o dgeqrf.o dgeqrf.f +gfortran -O2 -frecursive -c -o dgeqrfp.o dgeqrfp.f +gfortran -O2 -frecursive -c -o dgerfs.o dgerfs.f +gfortran -O2 -frecursive -c -o dgerq2.o dgerq2.f +gfortran -O2 -frecursive -c -o dgerqf.o dgerqf.f +gfortran -O2 -frecursive -c -o dgesc2.o dgesc2.f +gfortran -O2 -frecursive -c -o dgesdd.o dgesdd.f +gfortran -O2 -frecursive -c -o dgesv.o dgesv.f +gfortran -O2 -frecursive -c -o dgesvd.o dgesvd.f +gfortran -O2 -frecursive -c -o dgesvdx.o dgesvdx.f +gfortran -O2 -frecursive -c -o dgesvx.o dgesvx.f +gfortran -O2 -frecursive -c -o dgetc2.o dgetc2.f +gfortran -O2 -frecursive -c -o dgetf2.o dgetf2.f +gfortran -O2 -frecursive -c -o dgetrf.o dgetrf.f +gfortran -O2 -frecursive -c -o dgetri.o dgetri.f +gfortran -O2 -frecursive -c -o dgetrs.o dgetrs.f +gfortran -O2 -frecursive -c -o dggbak.o dggbak.f +gfortran -O2 -frecursive -c -o dggbal.o dggbal.f +gfortran -O2 -frecursive -c -o dgges.o dgges.f +gfortran -O2 -frecursive -c -o dgges3.o dgges3.f +gfortran -O2 -frecursive -c -o dggesx.o dggesx.f +gfortran -O2 -frecursive -c -o dggev.o dggev.f +gfortran -O2 -frecursive -c -o dggev3.o dggev3.f +gfortran -O2 -frecursive -c -o dggevx.o dggevx.f +gfortran -O2 -frecursive -c -o dggglm.o dggglm.f +gfortran -O2 -frecursive -c -o dgghrd.o dgghrd.f +gfortran -O2 -frecursive -c -o dgghd3.o dgghd3.f +gfortran -O2 -frecursive -c -o dgglse.o dgglse.f +gfortran -O2 -frecursive -c -o dggqrf.o dggqrf.f +gfortran -O2 -frecursive -c -o dggrqf.o dggrqf.f +gfortran -O2 -frecursive -c -o dggsvd3.o dggsvd3.f +gfortran -O2 -frecursive -c -o dggsvp3.o dggsvp3.f +gfortran -O2 -frecursive -c -o dgtcon.o dgtcon.f +gfortran -O2 -frecursive -c -o dgtrfs.o dgtrfs.f +gfortran -O2 -frecursive -c -o dgtsv.o dgtsv.f +gfortran -O2 -frecursive -c -o dgtsvx.o dgtsvx.f +gfortran -O2 -frecursive -c -o dgttrf.o dgttrf.f +gfortran -O2 -frecursive -c -o dgttrs.o dgttrs.f +gfortran -O2 -frecursive -c -o dgtts2.o dgtts2.f +gfortran -O2 -frecursive -c -o dhgeqz.o dhgeqz.f +gfortran -O2 -frecursive -c -o dlaqz0.o dlaqz0.f +gfortran -O2 -frecursive -c -o dlaqz1.o dlaqz1.f +gfortran -O2 -frecursive -c -o dlaqz2.o dlaqz2.f +gfortran -O2 -frecursive -c -o dlaqz3.o dlaqz3.f +gfortran -O2 -frecursive -c -o dlaqz4.o dlaqz4.f +gfortran -O2 -frecursive -c -o dhsein.o dhsein.f +gfortran -O2 -frecursive -c -o dhseqr.o dhseqr.f +gfortran -O2 -frecursive -c -o dlabrd.o dlabrd.f +gfortran -O2 -frecursive -c -o dlacon.o dlacon.f +gfortran -O2 -frecursive -c -o dlacn2.o dlacn2.f +gfortran -O2 -frecursive -c -o dlaein.o dlaein.f +gfortran -O2 -frecursive -c -o dlaexc.o dlaexc.f +gfortran -O2 -frecursive -c -o dlag2.o dlag2.f +gfortran -O2 -frecursive -c -o dlags2.o dlags2.f +gfortran -O2 -frecursive -c -o dlagtm.o dlagtm.f +gfortran -O2 -frecursive -c -o dlagv2.o dlagv2.f +gfortran -O2 -frecursive -c -o dlahqr.o dlahqr.f +gfortran -O2 -frecursive -c -o dlahr2.o dlahr2.f +gfortran -O2 -frecursive -c -o dlaic1.o dlaic1.f +gfortran -O2 -frecursive -c -o dlaln2.o dlaln2.f +gfortran -O2 -frecursive -c -o dlals0.o dlals0.f +gfortran -O2 -frecursive -c -o dlalsa.o dlalsa.f +gfortran -O2 -frecursive -c -o dlalsd.o dlalsd.f +gfortran -O2 -frecursive -c -o dlangb.o dlangb.f +gfortran -O2 -frecursive -c -o dlange.o dlange.f +gfortran -O2 -frecursive -c -o dlangt.o dlangt.f +gfortran -O2 -frecursive -c -o dlanhs.o dlanhs.f +gfortran -O2 -frecursive -c -o dlansb.o dlansb.f +gfortran -O2 -frecursive -c -o dlansp.o dlansp.f +gfortran -O2 -frecursive -c -o dlansy.o dlansy.f +gfortran -O2 -frecursive -c -o dlantb.o dlantb.f +gfortran -O2 -frecursive -c -o dlantp.o dlantp.f +gfortran -O2 -frecursive -c -o dlantr.o dlantr.f +gfortran -O2 -frecursive -c -o dlanv2.o dlanv2.f +gfortran -O2 -frecursive -c -o dlapll.o dlapll.f +gfortran -O2 -frecursive -c -o dlapmt.o dlapmt.f +gfortran -O2 -frecursive -c -o dlaqgb.o dlaqgb.f +gfortran -O2 -frecursive -c -o dlaqge.o dlaqge.f +gfortran -O2 -frecursive -c -o dlaqp2.o dlaqp2.f +gfortran -O2 -frecursive -c -o dlaqps.o dlaqps.f +gfortran -O2 -frecursive -c -o dlaqp2rk.o dlaqp2rk.f +gfortran -O2 -frecursive -c -o dlaqp3rk.o dlaqp3rk.f +gfortran -O2 -frecursive -c -o dlaqsb.o dlaqsb.f +gfortran -O2 -frecursive -c -o dlaqsp.o dlaqsp.f +gfortran -O2 -frecursive -c -o dlaqsy.o dlaqsy.f +gfortran -O2 -frecursive -c -o dlaqr0.o dlaqr0.f +gfortran -O2 -frecursive -c -o dlaqr1.o dlaqr1.f +gfortran -O2 -frecursive -c -o dlaqr2.o dlaqr2.f +gfortran -O2 -frecursive -c -o dlaqr3.o dlaqr3.f +gfortran -O2 -frecursive -c -o dlaqr4.o dlaqr4.f +gfortran -O2 -frecursive -c -o dlaqr5.o dlaqr5.f +gfortran -O2 -frecursive -c -o dlaqtr.o dlaqtr.f +gfortran -O2 -frecursive -c -o dlar1v.o dlar1v.f +gfortran -O2 -frecursive -c -o dlar2v.o dlar2v.f +gfortran -O2 -frecursive -c -o iladlr.o iladlr.f +gfortran -O2 -frecursive -c -o iladlc.o iladlc.f +gfortran -O2 -frecursive -c -o dlarf.o dlarf.f +gfortran -O2 -frecursive -c -o dlarf1.o dlarf1.f +gfortran -O2 -frecursive -c -o dlarfb.o dlarfb.f +gfortran -O2 -frecursive -c -o dlarfb_gett.o dlarfb_gett.f +gfortran -O2 -frecursive -c -o dlarfg.o dlarfg.f +gfortran -O2 -frecursive -c -o dlarfgp.o dlarfgp.f +gfortran -O2 -frecursive -c -o dlarft.o dlarft.f +gfortran -O2 -frecursive -c -o dlarfx.o dlarfx.f +gfortran -O2 -frecursive -c -o dlarfy.o dlarfy.f +gfortran -O2 -frecursive -c -o dlargv.o dlargv.f +gfortran -O2 -frecursive -c -o dlarmm.o dlarmm.f +gfortran -O2 -frecursive -c -o dlarrv.o dlarrv.f +gfortran -O2 -frecursive -c -o dlartv.o dlartv.f +gfortran -O2 -frecursive -c -o dlarz.o dlarz.f +gfortran -O2 -frecursive -c -o dlarzb.o dlarzb.f +gfortran -O2 -frecursive -c -o dlarzt.o dlarzt.f +gfortran -O2 -frecursive -c -o dlaswp.o dlaswp.f +gfortran -O2 -frecursive -c -o dlasy2.o dlasy2.f +gfortran -O2 -frecursive -c -o dlasyf.o dlasyf.f +gfortran -O2 -frecursive -c -o dlasyf_rook.o dlasyf_rook.f +gfortran -O2 -frecursive -c -o dlasyf_rk.o dlasyf_rk.f +gfortran -O2 -frecursive -c -o dlatbs.o dlatbs.f +gfortran -O2 -frecursive -c -o dlatdf.o dlatdf.f +gfortran -O2 -frecursive -c -o dlatps.o dlatps.f +gfortran -O2 -frecursive -c -o dlatrd.o dlatrd.f +gfortran -O2 -frecursive -c -o dlatrs.o dlatrs.f +gfortran -O2 -frecursive -c -o dlatrs3.o dlatrs3.f +gfortran -O2 -frecursive -c -o dlatrz.o dlatrz.f +gfortran -O2 -frecursive -c -o dlauu2.o dlauu2.f +gfortran -O2 -frecursive -c -o dlauum.o dlauum.f +gfortran -O2 -frecursive -c -o dopgtr.o dopgtr.f +gfortran -O2 -frecursive -c -o dopmtr.o dopmtr.f +gfortran -O2 -frecursive -c -o dorg2l.o dorg2l.f +gfortran -O2 -frecursive -c -o dorg2r.o dorg2r.f +gfortran -O2 -frecursive -c -o dorgbr.o dorgbr.f +gfortran -O2 -frecursive -c -o dorghr.o dorghr.f +gfortran -O2 -frecursive -c -o dorgl2.o dorgl2.f +gfortran -O2 -frecursive -c -o dorglq.o dorglq.f +gfortran -O2 -frecursive -c -o dorgql.o dorgql.f +gfortran -O2 -frecursive -c -o dorgqr.o dorgqr.f +gfortran -O2 -frecursive -c -o dorgr2.o dorgr2.f +gfortran -O2 -frecursive -c -o dorgrq.o dorgrq.f +gfortran -O2 -frecursive -c -o dorgtr.o dorgtr.f +gfortran -O2 -frecursive -c -o dorgtsqr.o dorgtsqr.f +gfortran -O2 -frecursive -c -o dorgtsqr_row.o dorgtsqr_row.f +gfortran -O2 -frecursive -c -o dorm2l.o dorm2l.f +gfortran -O2 -frecursive -c -o dorm2r.o dorm2r.f +gfortran -O2 -frecursive -c -o dorm22.o dorm22.f +gfortran -O2 -frecursive -c -o dormbr.o dormbr.f +gfortran -O2 -frecursive -c -o dormhr.o dormhr.f +gfortran -O2 -frecursive -c -o dorml2.o dorml2.f +gfortran -O2 -frecursive -c -o dormlq.o dormlq.f +gfortran -O2 -frecursive -c -o dormql.o dormql.f +gfortran -O2 -frecursive -c -o dormqr.o dormqr.f +gfortran -O2 -frecursive -c -o dormr2.o dormr2.f +gfortran -O2 -frecursive -c -o dormr3.o dormr3.f +gfortran -O2 -frecursive -c -o dormrq.o dormrq.f +gfortran -O2 -frecursive -c -o dormrz.o dormrz.f +gfortran -O2 -frecursive -c -o dormtr.o dormtr.f +gfortran -O2 -frecursive -c -o dpbcon.o dpbcon.f +gfortran -O2 -frecursive -c -o dpbequ.o dpbequ.f +gfortran -O2 -frecursive -c -o dpbrfs.o dpbrfs.f +gfortran -O2 -frecursive -c -o dpbstf.o dpbstf.f +gfortran -O2 -frecursive -c -o dpbsv.o dpbsv.f +gfortran -O2 -frecursive -c -o dpbsvx.o dpbsvx.f +gfortran -O2 -frecursive -c -o dpbtf2.o dpbtf2.f +gfortran -O2 -frecursive -c -o dpbtrf.o dpbtrf.f +gfortran -O2 -frecursive -c -o dpbtrs.o dpbtrs.f +gfortran -O2 -frecursive -c -o dpocon.o dpocon.f +gfortran -O2 -frecursive -c -o dpoequ.o dpoequ.f +gfortran -O2 -frecursive -c -o dporfs.o dporfs.f +gfortran -O2 -frecursive -c -o dposv.o dposv.f +gfortran -O2 -frecursive -c -o dposvx.o dposvx.f +gfortran -O2 -frecursive -c -o dpotf2.o dpotf2.f +gfortran -O2 -frecursive -c -o dpotrf.o dpotrf.f +gfortran -O2 -frecursive -c -o dpotri.o dpotri.f +gfortran -O2 -frecursive -c -o dpotrs.o dpotrs.f +gfortran -O2 -frecursive -c -o dpstrf.o dpstrf.f +gfortran -O2 -frecursive -c -o dpstf2.o dpstf2.f +gfortran -O2 -frecursive -c -o dppcon.o dppcon.f +gfortran -O2 -frecursive -c -o dppequ.o dppequ.f +gfortran -O2 -frecursive -c -o dpprfs.o dpprfs.f +gfortran -O2 -frecursive -c -o dppsv.o dppsv.f +gfortran -O2 -frecursive -c -o dppsvx.o dppsvx.f +gfortran -O2 -frecursive -c -o dpptrf.o dpptrf.f +gfortran -O2 -frecursive -c -o dpptri.o dpptri.f +gfortran -O2 -frecursive -c -o dpptrs.o dpptrs.f +gfortran -O2 -frecursive -c -o dptcon.o dptcon.f +gfortran -O2 -frecursive -c -o dpteqr.o dpteqr.f +gfortran -O2 -frecursive -c -o dptrfs.o dptrfs.f +gfortran -O2 -frecursive -c -o dptsv.o dptsv.f +gfortran -O2 -frecursive -c -o dptsvx.o dptsvx.f +gfortran -O2 -frecursive -c -o dpttrs.o dpttrs.f +gfortran -O2 -frecursive -c -o dptts2.o dptts2.f +gfortran -O2 -frecursive -c -o drscl.o drscl.f +gfortran -O2 -frecursive -c -o dsbev.o dsbev.f +gfortran -O2 -frecursive -c -o dsbevd.o dsbevd.f +gfortran -O2 -frecursive -c -o dsbevx.o dsbevx.f +gfortran -O2 -frecursive -c -o dsbgst.o dsbgst.f +gfortran -O2 -frecursive -c -o dsbgv.o dsbgv.f +gfortran -O2 -frecursive -c -o dsbgvd.o dsbgvd.f +gfortran -O2 -frecursive -c -o dsbgvx.o dsbgvx.f +gfortran -O2 -frecursive -c -o dsbtrd.o dsbtrd.f +gfortran -O2 -frecursive -c -o dspcon.o dspcon.f +gfortran -O2 -frecursive -c -o dspev.o dspev.f +gfortran -O2 -frecursive -c -o dspevd.o dspevd.f +gfortran -O2 -frecursive -c -o dspevx.o dspevx.f +gfortran -O2 -frecursive -c -o dspgst.o dspgst.f +gfortran -O2 -frecursive -c -o dspgv.o dspgv.f +gfortran -O2 -frecursive -c -o dspgvd.o dspgvd.f +gfortran -O2 -frecursive -c -o dspgvx.o dspgvx.f +gfortran -O2 -frecursive -c -o dsprfs.o dsprfs.f +gfortran -O2 -frecursive -c -o dspsv.o dspsv.f +gfortran -O2 -frecursive -c -o dspsvx.o dspsvx.f +gfortran -O2 -frecursive -c -o dsptrd.o dsptrd.f +gfortran -O2 -frecursive -c -o dsptrf.o dsptrf.f +gfortran -O2 -frecursive -c -o dsptri.o dsptri.f +gfortran -O2 -frecursive -c -o dsptrs.o dsptrs.f +gfortran -O2 -frecursive -c -o dstegr.o dstegr.f +gfortran -O2 -frecursive -c -o dstein.o dstein.f +gfortran -O2 -frecursive -c -o dstev.o dstev.f +gfortran -O2 -frecursive -c -o dstevd.o dstevd.f +gfortran -O2 -frecursive -c -o dstevr.o dstevr.f +gfortran -O2 -frecursive -c -o dstevx.o dstevx.f +gfortran -O2 -frecursive -c -o dsycon.o dsycon.f +gfortran -O2 -frecursive -c -o dsyev.o dsyev.f +gfortran -O2 -frecursive -c -o dsyevd.o dsyevd.f +gfortran -O2 -frecursive -c -o dsyevr.o dsyevr.f +gfortran -O2 -frecursive -c -o dsyevx.o dsyevx.f +gfortran -O2 -frecursive -c -o dsygs2.o dsygs2.f +gfortran -O2 -frecursive -c -o dsygst.o dsygst.f +gfortran -O2 -frecursive -c -o dsygv.o dsygv.f +gfortran -O2 -frecursive -c -o dsygvd.o dsygvd.f +gfortran -O2 -frecursive -c -o dsygvx.o dsygvx.f +gfortran -O2 -frecursive -c -o dsyrfs.o dsyrfs.f +gfortran -O2 -frecursive -c -o dsysv.o dsysv.f +gfortran -O2 -frecursive -c -o dsysvx.o dsysvx.f +gfortran -O2 -frecursive -c -o dsytd2.o dsytd2.f +gfortran -O2 -frecursive -c -o dsytf2.o dsytf2.f +gfortran -O2 -frecursive -c -o dsytrd.o dsytrd.f +gfortran -O2 -frecursive -c -o dsytrf.o dsytrf.f +gfortran -O2 -frecursive -c -o dsytri.o dsytri.f +gfortran -O2 -frecursive -c -o dsytri2.o dsytri2.f +gfortran -O2 -frecursive -c -o dsytri2x.o dsytri2x.f +gfortran -O2 -frecursive -c -o dsyswapr.o dsyswapr.f +gfortran -O2 -frecursive -c -o dsytrs.o dsytrs.f +gfortran -O2 -frecursive -c -o dsytrs2.o dsytrs2.f +gfortran -O2 -frecursive -c -o dsyconv.o dsyconv.f +gfortran -O2 -frecursive -c -o dsyconvf.o dsyconvf.f +gfortran -O2 -frecursive -c -o dsyconvf_rook.o dsyconvf_rook.f +gfortran -O2 -frecursive -c -o dsytf2_rook.o dsytf2_rook.f +gfortran -O2 -frecursive -c -o dsytrf_rook.o dsytrf_rook.f +gfortran -O2 -frecursive -c -o dsytrs_rook.o dsytrs_rook.f +gfortran -O2 -frecursive -c -o dsytri_rook.o dsytri_rook.f +gfortran -O2 -frecursive -c -o dsycon_rook.o dsycon_rook.f +gfortran -O2 -frecursive -c -o dsysv_rook.o dsysv_rook.f +gfortran -O2 -frecursive -c -o dsytf2_rk.o dsytf2_rk.f +gfortran -O2 -frecursive -c -o dsytrf_rk.o dsytrf_rk.f +gfortran -O2 -frecursive -c -o dsytrs_3.o dsytrs_3.f +gfortran -O2 -frecursive -c -o dsytri_3.o dsytri_3.f +gfortran -O2 -frecursive -c -o dsytri_3x.o dsytri_3x.f +gfortran -O2 -frecursive -c -o dsycon_3.o dsycon_3.f +gfortran -O2 -frecursive -c -o dsysv_rk.o dsysv_rk.f +gfortran -O2 -frecursive -c -o dlasyf_aa.o dlasyf_aa.f +gfortran -O2 -frecursive -c -o dsysv_aa.o dsysv_aa.f +gfortran -O2 -frecursive -c -o dsytrf_aa.o dsytrf_aa.f +gfortran -O2 -frecursive -c -o dsytrs_aa.o dsytrs_aa.f +gfortran -O2 -frecursive -c -o dsysv_aa_2stage.o dsysv_aa_2stage.f +gfortran -O2 -frecursive -c -o dsytrf_aa_2stage.o dsytrf_aa_2stage.f +gfortran -O2 -frecursive -c -o dsytrs_aa_2stage.o dsytrs_aa_2stage.f +gfortran -O2 -frecursive -c -o dtbcon.o dtbcon.f +gfortran -O2 -frecursive -c -o dtbrfs.o dtbrfs.f +gfortran -O2 -frecursive -c -o dtbtrs.o dtbtrs.f +gfortran -O2 -frecursive -c -o dtgevc.o dtgevc.f +gfortran -O2 -frecursive -c -o dtgex2.o dtgex2.f +gfortran -O2 -frecursive -c -o dtgexc.o dtgexc.f +gfortran -O2 -frecursive -c -o dtgsen.o dtgsen.f +gfortran -O2 -frecursive -c -o dtgsja.o dtgsja.f +gfortran -O2 -frecursive -c -o dtgsna.o dtgsna.f +gfortran -O2 -frecursive -c -o dtgsy2.o dtgsy2.f +gfortran -O2 -frecursive -c -o dtgsyl.o dtgsyl.f +gfortran -O2 -frecursive -c -o dtpcon.o dtpcon.f +gfortran -O2 -frecursive -c -o dtprfs.o dtprfs.f +gfortran -O2 -frecursive -c -o dtptri.o dtptri.f +gfortran -O2 -frecursive -c -o dtptrs.o dtptrs.f +gfortran -O2 -frecursive -c -o dtrcon.o dtrcon.f +gfortran -O2 -frecursive -c -o dtrevc.o dtrevc.f +gfortran -O2 -frecursive -c -o dtrevc3.o dtrevc3.f +gfortran -O2 -frecursive -c -o dtrexc.o dtrexc.f +gfortran -O2 -frecursive -c -o dtrrfs.o dtrrfs.f +gfortran -O2 -frecursive -c -o dtrsen.o dtrsen.f +gfortran -O2 -frecursive -c -o dtrsna.o dtrsna.f +gfortran -O2 -frecursive -c -o dtrsyl.o dtrsyl.f +gfortran -O2 -frecursive -c -o dtrsyl3.o dtrsyl3.f +gfortran -O2 -frecursive -c -o dtrti2.o dtrti2.f +gfortran -O2 -frecursive -c -o dtrtri.o dtrtri.f +gfortran -O2 -frecursive -c -o dtrtrs.o dtrtrs.f +gfortran -O2 -frecursive -c -o dtzrzf.o dtzrzf.f +gfortran -O2 -frecursive -c -o dstemr.o dstemr.f +gfortran -O2 -frecursive -c -o dsgesv.o dsgesv.f +gfortran -O2 -frecursive -c -o dsposv.o dsposv.f +gfortran -O2 -frecursive -c -o dlag2s.o dlag2s.f +gfortran -O2 -frecursive -c -o slag2d.o slag2d.f +gfortran -O2 -frecursive -c -o dlat2s.o dlat2s.f +gfortran -O2 -frecursive -c -o dlansf.o dlansf.f +gfortran -O2 -frecursive -c -o dpftrf.o dpftrf.f +gfortran -O2 -frecursive -c -o dpftri.o dpftri.f +gfortran -O2 -frecursive -c -o dpftrs.o dpftrs.f +gfortran -O2 -frecursive -c -o dsfrk.o dsfrk.f +gfortran -O2 -frecursive -c -o dtfsm.o dtfsm.f +gfortran -O2 -frecursive -c -o dtftri.o dtftri.f +gfortran -O2 -frecursive -c -o dtfttp.o dtfttp.f +gfortran -O2 -frecursive -c -o dtfttr.o dtfttr.f +gfortran -O2 -frecursive -c -o dtpttf.o dtpttf.f +gfortran -O2 -frecursive -c -o dtpttr.o dtpttr.f +gfortran -O2 -frecursive -c -o dtrttf.o dtrttf.f +gfortran -O2 -frecursive -c -o dtrttp.o dtrttp.f +gfortran -O2 -frecursive -c -o dgejsv.o dgejsv.f +gfortran -O2 -frecursive -c -o dgesvj.o dgesvj.f +gfortran -O2 -frecursive -c -o dgsvj0.o dgsvj0.f +gfortran -O2 -frecursive -c -o dgsvj1.o dgsvj1.f +gfortran -O2 -frecursive -c -o dgeequb.o dgeequb.f +gfortran -O2 -frecursive -c -o dsyequb.o dsyequb.f +gfortran -O2 -frecursive -c -o dpoequb.o dpoequb.f +gfortran -O2 -frecursive -c -o dgbequb.o dgbequb.f +gfortran -O2 -frecursive -c -o dbbcsd.o dbbcsd.f +gfortran -O2 -frecursive -c -o dlapmr.o dlapmr.f +gfortran -O2 -frecursive -c -o dorbdb.o dorbdb.f +gfortran -O2 -frecursive -c -o dorbdb1.o dorbdb1.f +gfortran -O2 -frecursive -c -o dorbdb2.o dorbdb2.f +gfortran -O2 -frecursive -c -o dorbdb3.o dorbdb3.f +gfortran -O2 -frecursive -c -o dorbdb4.o dorbdb4.f +gfortran -O2 -frecursive -c -o dorbdb5.o dorbdb5.f +gfortran -O2 -frecursive -c -o dorbdb6.o dorbdb6.f +gfortran -O2 -frecursive -c -o dorcsd.o dorcsd.f +gfortran -O2 -frecursive -c -o dorcsd2by1.o dorcsd2by1.f +gfortran -O2 -frecursive -c -o dgeqrt.o dgeqrt.f +gfortran -O2 -frecursive -c -o dgeqrt2.o dgeqrt2.f +gfortran -O2 -frecursive -c -o dgeqrt3.o dgeqrt3.f +gfortran -O2 -frecursive -c -o dgemqrt.o dgemqrt.f +gfortran -O2 -frecursive -c -o dtpqrt.o dtpqrt.f +gfortran -O2 -frecursive -c -o dtpqrt2.o dtpqrt2.f +gfortran -O2 -frecursive -c -o dtpmqrt.o dtpmqrt.f +gfortran -O2 -frecursive -c -o dtprfb.o dtprfb.f +gfortran -O2 -frecursive -c -o dgelqt.o dgelqt.f +gfortran -O2 -frecursive -c -o dgelqt3.o dgelqt3.f +gfortran -O2 -frecursive -c -o dgemlqt.o dgemlqt.f +gfortran -O2 -frecursive -c -o dgetsls.o dgetsls.f +gfortran -O2 -frecursive -c -o dgetsqrhrt.o dgetsqrhrt.f +gfortran -O2 -frecursive -c -o dgeqr.o dgeqr.f +gfortran -O2 -frecursive -c -o dlatsqr.o dlatsqr.f +gfortran -O2 -frecursive -c -o dlamtsqr.o dlamtsqr.f +gfortran -O2 -frecursive -c -o dgemqr.o dgemqr.f +gfortran -O2 -frecursive -c -o dgelq.o dgelq.f +gfortran -O2 -frecursive -c -o dlaswlq.o dlaswlq.f +gfortran -O2 -frecursive -c -o dlamswlq.o dlamswlq.f +gfortran -O2 -frecursive -c -o dgemlq.o dgemlq.f +gfortran -O2 -frecursive -c -o dtplqt.o dtplqt.f +gfortran -O2 -frecursive -c -o dtplqt2.o dtplqt2.f +gfortran -O2 -frecursive -c -o dtpmlqt.o dtpmlqt.f +gfortran -O2 -frecursive -c -o dorhr_col.o dorhr_col.f +gfortran -O2 -frecursive -c -o dlaorhr_col_getrfnp.o dlaorhr_col_getrfnp.f +gfortran -O2 -frecursive -c -o dlaorhr_col_getrfnp2.o dlaorhr_col_getrfnp2.f +gfortran -O2 -frecursive -c -o dsytrd_2stage.o dsytrd_2stage.f +gfortran -O2 -frecursive -c -o dsytrd_sy2sb.o dsytrd_sy2sb.f +gfortran -O2 -frecursive -c -o dsb2st_kernels.o dsb2st_kernels.f +gfortran -O2 -frecursive -c -o dsyevd_2stage.o dsyevd_2stage.f +gfortran -O2 -frecursive -c -o dsyev_2stage.o dsyev_2stage.f +gfortran -O2 -frecursive -c -o dsyevx_2stage.o dsyevx_2stage.f +gfortran -O2 -frecursive -c -o dsyevr_2stage.o dsyevr_2stage.f +gfortran -O2 -frecursive -c -o dsbev_2stage.o dsbev_2stage.f +gfortran -O2 -frecursive -c -o dsbevx_2stage.o dsbevx_2stage.f +gfortran -O2 -frecursive -c -o dsbevd_2stage.o dsbevd_2stage.f +gfortran -O2 -frecursive -c -o dsygv_2stage.o dsygv_2stage.f +gfortran -O2 -frecursive -c -o dgesvdq.o dgesvdq.f +gfortran -O2 -frecursive -c -o spotrs.o spotrs.f +gfortran -O2 -frecursive -c -o sgetrs.o sgetrs.f +gfortran -O2 -frecursive -c -o spotrf.o spotrf.f +gfortran -O2 -frecursive -c -o sgetrf.o sgetrf.f +gfortran -O2 -frecursive -c -o cpotrf2.o cpotrf2.f +gfortran -O2 -frecursive -c -o cgetrf2.o cgetrf2.f +gfortran -O2 -frecursive -c -o cbdsqr.o cbdsqr.f +gfortran -O2 -frecursive -c -o cgbbrd.o cgbbrd.f +gfortran -O2 -frecursive -c -o cgbcon.o cgbcon.f +gfortran -O2 -frecursive -c -o cgbequ.o cgbequ.f +gfortran -O2 -frecursive -c -o cgbrfs.o cgbrfs.f +gfortran -O2 -frecursive -c -o cgbsv.o cgbsv.f +gfortran -O2 -frecursive -c -o cgbsvx.o cgbsvx.f +gfortran -O2 -frecursive -c -o cgbtf2.o cgbtf2.f +gfortran -O2 -frecursive -c -o cgbtrf.o cgbtrf.f +gfortran -O2 -frecursive -c -o cgbtrs.o cgbtrs.f +gfortran -O2 -frecursive -c -o cgebak.o cgebak.f +gfortran -O2 -frecursive -c -o cgebal.o cgebal.f +gfortran -O2 -frecursive -c -o cgebd2.o cgebd2.f +gfortran -O2 -frecursive -c -o cgebrd.o cgebrd.f +gfortran -O2 -frecursive -c -o cgecon.o cgecon.f +gfortran -O2 -frecursive -c -o cgeequ.o cgeequ.f +gfortran -O2 -frecursive -c -o cgees.o cgees.f +gfortran -O2 -frecursive -c -o cgeesx.o cgeesx.f +gfortran -O2 -frecursive -c -o cgeev.o cgeev.f +gfortran -O2 -frecursive -c -o cgeevx.o cgeevx.f +gfortran -O2 -frecursive -c -o cgehd2.o cgehd2.f +gfortran -O2 -frecursive -c -o cgehrd.o cgehrd.f +gfortran -O2 -frecursive -c -o cgelq2.o cgelq2.f +gfortran -O2 -frecursive -c -o cgelqf.o cgelqf.f +gfortran -O2 -frecursive -c -o cgels.o cgels.f +gfortran -O2 -frecursive -c -o cgelst.o cgelst.f +gfortran -O2 -frecursive -c -o cgelsd.o cgelsd.f +gfortran -O2 -frecursive -c -o cgelss.o cgelss.f +gfortran -O2 -frecursive -c -o cgelsy.o cgelsy.f +gfortran -O2 -frecursive -c -o cgeql2.o cgeql2.f +gfortran -O2 -frecursive -c -o cgeqlf.o cgeqlf.f +gfortran -O2 -frecursive -c -o cgeqp3.o cgeqp3.f +gfortran -O2 -frecursive -c -o cgeqp3rk.o cgeqp3rk.f +gfortran -O2 -frecursive -c -o cgeqr2.o cgeqr2.f +gfortran -O2 -frecursive -c -o cgeqr2p.o cgeqr2p.f +gfortran -O2 -frecursive -c -o cgeqrf.o cgeqrf.f +gfortran -O2 -frecursive -c -o cgeqrfp.o cgeqrfp.f +gfortran -O2 -frecursive -c -o cgerfs.o cgerfs.f +gfortran -O2 -frecursive -c -o cgerq2.o cgerq2.f +gfortran -O2 -frecursive -c -o cgerqf.o cgerqf.f +gfortran -O2 -frecursive -c -o cgesc2.o cgesc2.f +gfortran -O2 -frecursive -c -o cgesdd.o cgesdd.f +gfortran -O2 -frecursive -c -o cgesv.o cgesv.f +gfortran -O2 -frecursive -c -o cgesvd.o cgesvd.f +gfortran -O2 -frecursive -c -o cgesvdx.o cgesvdx.f +gfortran -O2 -frecursive -c -o cgesvj.o cgesvj.f +gfortran -O2 -frecursive -c -o cgejsv.o cgejsv.f +gfortran -O2 -frecursive -c -o cgsvj0.o cgsvj0.f +gfortran -O2 -frecursive -c -o cgsvj1.o cgsvj1.f +gfortran -O2 -frecursive -c -o cgesvx.o cgesvx.f +gfortran -O2 -frecursive -c -o cgetc2.o cgetc2.f +gfortran -O2 -frecursive -c -o cgetf2.o cgetf2.f +gfortran -O2 -frecursive -c -o cgetri.o cgetri.f +gfortran -O2 -frecursive -c -o cggbak.o cggbak.f +gfortran -O2 -frecursive -c -o cggbal.o cggbal.f +gfortran -O2 -frecursive -c -o cgges.o cgges.f +gfortran -O2 -frecursive -c -o cgges3.o cgges3.f +gfortran -O2 -frecursive -c -o cggesx.o cggesx.f +gfortran -O2 -frecursive -c -o cggev.o cggev.f +gfortran -O2 -frecursive -c -o cggev3.o cggev3.f +gfortran -O2 -frecursive -c -o cggevx.o cggevx.f +gfortran -O2 -frecursive -c -o cggglm.o cggglm.f +gfortran -O2 -frecursive -c -o cgghrd.o cgghrd.f +gfortran -O2 -frecursive -c -o cgghd3.o cgghd3.f +gfortran -O2 -frecursive -c -o cgglse.o cgglse.f +gfortran -O2 -frecursive -c -o cggqrf.o cggqrf.f +gfortran -O2 -frecursive -c -o cggrqf.o cggrqf.f +gfortran -O2 -frecursive -c -o cggsvd3.o cggsvd3.f +gfortran -O2 -frecursive -c -o cggsvp3.o cggsvp3.f +gfortran -O2 -frecursive -c -o cgtcon.o cgtcon.f +gfortran -O2 -frecursive -c -o cgtrfs.o cgtrfs.f +gfortran -O2 -frecursive -c -o cgtsv.o cgtsv.f +gfortran -O2 -frecursive -c -o cgtsvx.o cgtsvx.f +gfortran -O2 -frecursive -c -o cgttrf.o cgttrf.f +gfortran -O2 -frecursive -c -o cgttrs.o cgttrs.f +gfortran -O2 -frecursive -c -o cgtts2.o cgtts2.f +gfortran -O2 -frecursive -c -o chbev.o chbev.f +gfortran -O2 -frecursive -c -o chbevd.o chbevd.f +gfortran -O2 -frecursive -c -o chbevx.o chbevx.f +gfortran -O2 -frecursive -c -o chbgst.o chbgst.f +gfortran -O2 -frecursive -c -o chbgv.o chbgv.f +gfortran -O2 -frecursive -c -o chbgvd.o chbgvd.f +gfortran -O2 -frecursive -c -o chbgvx.o chbgvx.f +gfortran -O2 -frecursive -c -o chbtrd.o chbtrd.f +gfortran -O2 -frecursive -c -o checon.o checon.f +gfortran -O2 -frecursive -c -o cheev.o cheev.f +gfortran -O2 -frecursive -c -o cheevd.o cheevd.f +gfortran -O2 -frecursive -c -o cheevr.o cheevr.f +gfortran -O2 -frecursive -c -o cheevx.o cheevx.f +gfortran -O2 -frecursive -c -o chegs2.o chegs2.f +gfortran -O2 -frecursive -c -o chegst.o chegst.f +gfortran -O2 -frecursive -c -o chegv.o chegv.f +gfortran -O2 -frecursive -c -o chegvd.o chegvd.f +gfortran -O2 -frecursive -c -o chegvx.o chegvx.f +gfortran -O2 -frecursive -c -o cherfs.o cherfs.f +gfortran -O2 -frecursive -c -o chesv.o chesv.f +gfortran -O2 -frecursive -c -o chesvx.o chesvx.f +gfortran -O2 -frecursive -c -o chetd2.o chetd2.f +gfortran -O2 -frecursive -c -o chetf2.o chetf2.f +gfortran -O2 -frecursive -c -o chetrd.o chetrd.f +gfortran -O2 -frecursive -c -o chetrf.o chetrf.f +gfortran -O2 -frecursive -c -o chetri.o chetri.f +gfortran -O2 -frecursive -c -o chetri2.o chetri2.f +gfortran -O2 -frecursive -c -o chetri2x.o chetri2x.f +gfortran -O2 -frecursive -c -o cheswapr.o cheswapr.f +gfortran -O2 -frecursive -c -o chetrs.o chetrs.f +gfortran -O2 -frecursive -c -o chetrs2.o chetrs2.f +gfortran -O2 -frecursive -c -o chetf2_rook.o chetf2_rook.f +gfortran -O2 -frecursive -c -o chetrf_rook.o chetrf_rook.f +gfortran -O2 -frecursive -c -o chetri_rook.o chetri_rook.f +gfortran -O2 -frecursive -c -o chetrs_rook.o chetrs_rook.f +gfortran -O2 -frecursive -c -o checon_rook.o checon_rook.f +gfortran -O2 -frecursive -c -o chesv_rook.o chesv_rook.f +gfortran -O2 -frecursive -c -o chetf2_rk.o chetf2_rk.f +gfortran -O2 -frecursive -c -o chetrf_rk.o chetrf_rk.f +gfortran -O2 -frecursive -c -o chetri_3.o chetri_3.f +gfortran -O2 -frecursive -c -o chetri_3x.o chetri_3x.f +gfortran -O2 -frecursive -c -o chetrs_3.o chetrs_3.f +gfortran -O2 -frecursive -c -o checon_3.o checon_3.f +gfortran -O2 -frecursive -c -o chesv_rk.o chesv_rk.f +gfortran -O2 -frecursive -c -o chesv_aa.o chesv_aa.f +gfortran -O2 -frecursive -c -o chetrf_aa.o chetrf_aa.f +gfortran -O2 -frecursive -c -o chetrs_aa.o chetrs_aa.f +gfortran -O2 -frecursive -c -o clahef_aa.o clahef_aa.f +gfortran -O2 -frecursive -c -o chesv_aa_2stage.o chesv_aa_2stage.f +gfortran -O2 -frecursive -c -o chetrf_aa_2stage.o chetrf_aa_2stage.f +gfortran -O2 -frecursive -c -o chetrs_aa_2stage.o chetrs_aa_2stage.f +gfortran -O2 -frecursive -c -o chgeqz.o chgeqz.f +gfortran -O2 -frecursive -c -o chpcon.o chpcon.f +gfortran -O2 -frecursive -c -o chpev.o chpev.f +gfortran -O2 -frecursive -c -o chpevd.o chpevd.f +gfortran -O2 -frecursive -c -o claqz0.o claqz0.f +gfortran -O2 -frecursive -c -o claqz1.o claqz1.f +gfortran -O2 -frecursive -c -o claqz2.o claqz2.f +gfortran -O2 -frecursive -c -o claqz3.o claqz3.f +gfortran -O2 -frecursive -c -o chpevx.o chpevx.f +gfortran -O2 -frecursive -c -o chpgst.o chpgst.f +gfortran -O2 -frecursive -c -o chpgv.o chpgv.f +gfortran -O2 -frecursive -c -o chpgvd.o chpgvd.f +gfortran -O2 -frecursive -c -o chpgvx.o chpgvx.f +gfortran -O2 -frecursive -c -o chprfs.o chprfs.f +gfortran -O2 -frecursive -c -o chpsv.o chpsv.f +gfortran -O2 -frecursive -c -o chpsvx.o chpsvx.f +gfortran -O2 -frecursive -c -o chptrd.o chptrd.f +gfortran -O2 -frecursive -c -o chptrf.o chptrf.f +gfortran -O2 -frecursive -c -o chptri.o chptri.f +gfortran -O2 -frecursive -c -o chptrs.o chptrs.f +gfortran -O2 -frecursive -c -o chsein.o chsein.f +gfortran -O2 -frecursive -c -o chseqr.o chseqr.f +gfortran -O2 -frecursive -c -o clabrd.o clabrd.f +gfortran -O2 -frecursive -c -o clacgv.o clacgv.f +gfortran -O2 -frecursive -c -o clacon.o clacon.f +gfortran -O2 -frecursive -c -o clacn2.o clacn2.f +gfortran -O2 -frecursive -c -o clacp2.o clacp2.f +gfortran -O2 -frecursive -c -o clacpy.o clacpy.f +gfortran -O2 -frecursive -c -o clacrm.o clacrm.f +gfortran -O2 -frecursive -c -o clacrt.o clacrt.f +gfortran -O2 -frecursive -c -o cladiv.o cladiv.f +gfortran -O2 -frecursive -c -o claed0.o claed0.f +gfortran -O2 -frecursive -c -o claed7.o claed7.f +gfortran -O2 -frecursive -c -o claed8.o claed8.f +gfortran -O2 -frecursive -c -o claein.o claein.f +gfortran -O2 -frecursive -c -o claesy.o claesy.f +gfortran -O2 -frecursive -c -o claev2.o claev2.f +gfortran -O2 -frecursive -c -o clags2.o clags2.f +gfortran -O2 -frecursive -c -o clagtm.o clagtm.f +gfortran -O2 -frecursive -c -o clahef.o clahef.f +gfortran -O2 -frecursive -c -o clahef_rook.o clahef_rook.f +gfortran -O2 -frecursive -c -o clahef_rk.o clahef_rk.f +gfortran -O2 -frecursive -c -o clahqr.o clahqr.f +gfortran -O2 -frecursive -c -o clahr2.o clahr2.f +gfortran -O2 -frecursive -c -o claic1.o claic1.f +gfortran -O2 -frecursive -c -o clals0.o clals0.f +gfortran -O2 -frecursive -c -o clalsa.o clalsa.f +gfortran -O2 -frecursive -c -o clalsd.o clalsd.f +gfortran -O2 -frecursive -c -o clangb.o clangb.f +gfortran -O2 -frecursive -c -o clange.o clange.f +gfortran -O2 -frecursive -c -o clangt.o clangt.f +gfortran -O2 -frecursive -c -o clanhb.o clanhb.f +gfortran -O2 -frecursive -c -o clanhe.o clanhe.f +gfortran -O2 -frecursive -c -o clanhp.o clanhp.f +gfortran -O2 -frecursive -c -o clanhs.o clanhs.f +gfortran -O2 -frecursive -c -o clanht.o clanht.f +gfortran -O2 -frecursive -c -o clansb.o clansb.f +gfortran -O2 -frecursive -c -o clansp.o clansp.f +gfortran -O2 -frecursive -c -o clansy.o clansy.f +gfortran -O2 -frecursive -c -o clantb.o clantb.f +gfortran -O2 -frecursive -c -o clantp.o clantp.f +gfortran -O2 -frecursive -c -o clantr.o clantr.f +gfortran -O2 -frecursive -c -o clapll.o clapll.f +gfortran -O2 -frecursive -c -o clapmt.o clapmt.f +gfortran -O2 -frecursive -c -o clarcm.o clarcm.f +gfortran -O2 -frecursive -c -o claqgb.o claqgb.f +gfortran -O2 -frecursive -c -o claqge.o claqge.f +gfortran -O2 -frecursive -c -o claqhb.o claqhb.f +gfortran -O2 -frecursive -c -o claqhe.o claqhe.f +gfortran -O2 -frecursive -c -o claqhp.o claqhp.f +gfortran -O2 -frecursive -c -o claqp2.o claqp2.f +gfortran -O2 -frecursive -c -o claqps.o claqps.f +gfortran -O2 -frecursive -c -o claqp2rk.o claqp2rk.f +gfortran -O2 -frecursive -c -o claqp3rk.o claqp3rk.f +gfortran -O2 -frecursive -c -o claqsb.o claqsb.f +gfortran -O2 -frecursive -c -o claqr0.o claqr0.f +gfortran -O2 -frecursive -c -o claqr1.o claqr1.f +gfortran -O2 -frecursive -c -o claqr2.o claqr2.f +gfortran -O2 -frecursive -c -o claqr3.o claqr3.f +gfortran -O2 -frecursive -c -o claqr4.o claqr4.f +gfortran -O2 -frecursive -c -o claqr5.o claqr5.f +gfortran -O2 -frecursive -c -o claqsp.o claqsp.f +gfortran -O2 -frecursive -c -o claqsy.o claqsy.f +gfortran -O2 -frecursive -c -o clar1v.o clar1v.f +gfortran -O2 -frecursive -c -o clar2v.o clar2v.f +gfortran -O2 -frecursive -c -o ilaclr.o ilaclr.f +gfortran -O2 -frecursive -c -o ilaclc.o ilaclc.f +gfortran -O2 -frecursive -c -o clarf.o clarf.f +gfortran -O2 -frecursive -c -o clarfb.o clarfb.f +gfortran -O2 -frecursive -c -o clarfb_gett.o clarfb_gett.f +gfortran -O2 -frecursive -c -o clarfg.o clarfg.f +gfortran -O2 -frecursive -c -o clarft.o clarft.f +gfortran -O2 -frecursive -c -o clarfgp.o clarfgp.f +gfortran -O2 -frecursive -c -o clarfx.o clarfx.f +gfortran -O2 -frecursive -c -o clarfy.o clarfy.f +gfortran -O2 -frecursive -c -o clargv.o clargv.f +gfortran -O2 -frecursive -c -o clarnv.o clarnv.f +gfortran -O2 -frecursive -c -o clarrv.o clarrv.f +gfortran -O2 -frecursive -c -o clartv.o clartv.f +gfortran -O2 -frecursive -c -o clarz.o clarz.f +gfortran -O2 -frecursive -c -o clarzb.o clarzb.f +gfortran -O2 -frecursive -c -o clarzt.o clarzt.f +gfortran -O2 -frecursive -c -o clascl.o clascl.f +gfortran -O2 -frecursive -c -o claset.o claset.f +gfortran -O2 -frecursive -c -o clasr.o clasr.f +gfortran -O2 -frecursive -c -o claswp.o claswp.f +gfortran -O2 -frecursive -c -o clasyf.o clasyf.f +gfortran -O2 -frecursive -c -o clasyf_rook.o clasyf_rook.f +gfortran -O2 -frecursive -c -o clasyf_rk.o clasyf_rk.f +gfortran -O2 -frecursive -c -o clasyf_aa.o clasyf_aa.f +gfortran -O2 -frecursive -c -o clatbs.o clatbs.f +gfortran -O2 -frecursive -c -o clatdf.o clatdf.f +gfortran -O2 -frecursive -c -o clatps.o clatps.f +gfortran -O2 -frecursive -c -o clatrd.o clatrd.f +gfortran -O2 -frecursive -c -o clatrs.o clatrs.f +gfortran -O2 -frecursive -c -o clatrs3.o clatrs3.f +gfortran -O2 -frecursive -c -o clatrz.o clatrz.f +gfortran -O2 -frecursive -c -o clauu2.o clauu2.f +gfortran -O2 -frecursive -c -o clauum.o clauum.f +gfortran -O2 -frecursive -c -o cpbcon.o cpbcon.f +gfortran -O2 -frecursive -c -o cpbequ.o cpbequ.f +gfortran -O2 -frecursive -c -o cpbrfs.o cpbrfs.f +gfortran -O2 -frecursive -c -o cpbstf.o cpbstf.f +gfortran -O2 -frecursive -c -o cpbsv.o cpbsv.f +gfortran -O2 -frecursive -c -o cpbsvx.o cpbsvx.f +gfortran -O2 -frecursive -c -o cpbtf2.o cpbtf2.f +gfortran -O2 -frecursive -c -o cpbtrf.o cpbtrf.f +gfortran -O2 -frecursive -c -o cpbtrs.o cpbtrs.f +gfortran -O2 -frecursive -c -o cpocon.o cpocon.f +gfortran -O2 -frecursive -c -o cpoequ.o cpoequ.f +gfortran -O2 -frecursive -c -o cporfs.o cporfs.f +gfortran -O2 -frecursive -c -o cposv.o cposv.f +gfortran -O2 -frecursive -c -o cposvx.o cposvx.f +gfortran -O2 -frecursive -c -o cpotf2.o cpotf2.f +gfortran -O2 -frecursive -c -o cpotri.o cpotri.f +gfortran -O2 -frecursive -c -o cpstrf.o cpstrf.f +gfortran -O2 -frecursive -c -o cpstf2.o cpstf2.f +gfortran -O2 -frecursive -c -o cppcon.o cppcon.f +gfortran -O2 -frecursive -c -o cppequ.o cppequ.f +gfortran -O2 -frecursive -c -o cpprfs.o cpprfs.f +gfortran -O2 -frecursive -c -o cppsv.o cppsv.f +gfortran -O2 -frecursive -c -o cppsvx.o cppsvx.f +gfortran -O2 -frecursive -c -o cpptrf.o cpptrf.f +gfortran -O2 -frecursive -c -o cpptri.o cpptri.f +gfortran -O2 -frecursive -c -o cpptrs.o cpptrs.f +gfortran -O2 -frecursive -c -o cptcon.o cptcon.f +gfortran -O2 -frecursive -c -o cpteqr.o cpteqr.f +gfortran -O2 -frecursive -c -o cptrfs.o cptrfs.f +gfortran -O2 -frecursive -c -o cptsv.o cptsv.f +gfortran -O2 -frecursive -c -o cptsvx.o cptsvx.f +gfortran -O2 -frecursive -c -o cpttrf.o cpttrf.f +gfortran -O2 -frecursive -c -o cpttrs.o cpttrs.f +gfortran -O2 -frecursive -c -o cptts2.o cptts2.f +gfortran -O2 -frecursive -c -o crot.o crot.f +gfortran -O2 -frecursive -c -o cspcon.o cspcon.f +gfortran -O2 -frecursive -c -o cspmv.o cspmv.f +gfortran -O2 -frecursive -c -o cspr.o cspr.f +gfortran -O2 -frecursive -c -o csprfs.o csprfs.f +gfortran -O2 -frecursive -c -o cspsv.o cspsv.f +gfortran -O2 -frecursive -c -o cspsvx.o cspsvx.f +gfortran -O2 -frecursive -c -o csptrf.o csptrf.f +gfortran -O2 -frecursive -c -o csptri.o csptri.f +gfortran -O2 -frecursive -c -o csptrs.o csptrs.f +gfortran -O2 -frecursive -c -o csrscl.o csrscl.f +gfortran -O2 -frecursive -c -o crscl.o crscl.f +gfortran -O2 -frecursive -c -o cstedc.o cstedc.f +gfortran -O2 -frecursive -c -o cstegr.o cstegr.f +gfortran -O2 -frecursive -c -o cstein.o cstein.f +gfortran -O2 -frecursive -c -o csteqr.o csteqr.f +gfortran -O2 -frecursive -c -o csycon.o csycon.f +gfortran -O2 -frecursive -c -o csymv.o csymv.f +gfortran -O2 -frecursive -c -o csyr.o csyr.f +gfortran -O2 -frecursive -c -o csyrfs.o csyrfs.f +gfortran -O2 -frecursive -c -o csysv.o csysv.f +gfortran -O2 -frecursive -c -o csysvx.o csysvx.f +gfortran -O2 -frecursive -c -o csytf2.o csytf2.f +gfortran -O2 -frecursive -c -o csytrf.o csytrf.f +gfortran -O2 -frecursive -c -o csytri.o csytri.f +gfortran -O2 -frecursive -c -o csytri2.o csytri2.f +gfortran -O2 -frecursive -c -o csytri2x.o csytri2x.f +gfortran -O2 -frecursive -c -o csyswapr.o csyswapr.f +gfortran -O2 -frecursive -c -o csytrs.o csytrs.f +gfortran -O2 -frecursive -c -o csytrs2.o csytrs2.f +gfortran -O2 -frecursive -c -o csyconv.o csyconv.f +gfortran -O2 -frecursive -c -o csyconvf.o csyconvf.f +gfortran -O2 -frecursive -c -o csyconvf_rook.o csyconvf_rook.f +gfortran -O2 -frecursive -c -o csytf2_rook.o csytf2_rook.f +gfortran -O2 -frecursive -c -o csytrf_rook.o csytrf_rook.f +gfortran -O2 -frecursive -c -o csytrs_rook.o csytrs_rook.f +gfortran -O2 -frecursive -c -o csytri_rook.o csytri_rook.f +gfortran -O2 -frecursive -c -o csycon_rook.o csycon_rook.f +gfortran -O2 -frecursive -c -o csysv_rook.o csysv_rook.f +gfortran -O2 -frecursive -c -o csytf2_rk.o csytf2_rk.f +gfortran -O2 -frecursive -c -o csytrf_rk.o csytrf_rk.f +gfortran -O2 -frecursive -c -o csytrf_aa.o csytrf_aa.f +gfortran -O2 -frecursive -c -o csytrs_3.o csytrs_3.f +gfortran -O2 -frecursive -c -o csytrs_aa.o csytrs_aa.f +gfortran -O2 -frecursive -c -o csytri_3.o csytri_3.f +gfortran -O2 -frecursive -c -o csytri_3x.o csytri_3x.f +gfortran -O2 -frecursive -c -o csycon_3.o csycon_3.f +gfortran -O2 -frecursive -c -o csysv_rk.o csysv_rk.f +gfortran -O2 -frecursive -c -o csysv_aa.o csysv_aa.f +gfortran -O2 -frecursive -c -o csysv_aa_2stage.o csysv_aa_2stage.f +gfortran -O2 -frecursive -c -o csytrf_aa_2stage.o csytrf_aa_2stage.f +gfortran -O2 -frecursive -c -o csytrs_aa_2stage.o csytrs_aa_2stage.f +gfortran -O2 -frecursive -c -o ctbcon.o ctbcon.f +gfortran -O2 -frecursive -c -o ctbrfs.o ctbrfs.f +gfortran -O2 -frecursive -c -o ctbtrs.o ctbtrs.f +gfortran -O2 -frecursive -c -o ctgevc.o ctgevc.f +gfortran -O2 -frecursive -c -o ctgex2.o ctgex2.f +gfortran -O2 -frecursive -c -o ctgexc.o ctgexc.f +gfortran -O2 -frecursive -c -o ctgsen.o ctgsen.f +gfortran -O2 -frecursive -c -o ctgsja.o ctgsja.f +gfortran -O2 -frecursive -c -o ctgsna.o ctgsna.f +gfortran -O2 -frecursive -c -o ctgsy2.o ctgsy2.f +gfortran -O2 -frecursive -c -o ctgsyl.o ctgsyl.f +gfortran -O2 -frecursive -c -o ctpcon.o ctpcon.f +gfortran -O2 -frecursive -c -o ctprfs.o ctprfs.f +gfortran -O2 -frecursive -c -o ctptri.o ctptri.f +gfortran -O2 -frecursive -c -o ctptrs.o ctptrs.f +gfortran -O2 -frecursive -c -o ctrcon.o ctrcon.f +gfortran -O2 -frecursive -c -o ctrevc.o ctrevc.f +gfortran -O2 -frecursive -c -o ctrevc3.o ctrevc3.f +gfortran -O2 -frecursive -c -o ctrexc.o ctrexc.f +gfortran -O2 -frecursive -c -o ctrrfs.o ctrrfs.f +gfortran -O2 -frecursive -c -o ctrsen.o ctrsen.f +gfortran -O2 -frecursive -c -o ctrsna.o ctrsna.f +gfortran -O2 -frecursive -c -o ctrsyl.o ctrsyl.f +gfortran -O2 -frecursive -c -o ctrsyl3.o ctrsyl3.f +gfortran -O2 -frecursive -c -o ctrti2.o ctrti2.f +gfortran -O2 -frecursive -c -o ctrtri.o ctrtri.f +gfortran -O2 -frecursive -c -o ctrtrs.o ctrtrs.f +gfortran -O2 -frecursive -c -o ctzrzf.o ctzrzf.f +gfortran -O2 -frecursive -c -o cung2l.o cung2l.f +gfortran -O2 -frecursive -c -o cung2r.o cung2r.f +gfortran -O2 -frecursive -c -o cungbr.o cungbr.f +gfortran -O2 -frecursive -c -o cunghr.o cunghr.f +gfortran -O2 -frecursive -c -o cungl2.o cungl2.f +gfortran -O2 -frecursive -c -o cunglq.o cunglq.f +gfortran -O2 -frecursive -c -o cungql.o cungql.f +gfortran -O2 -frecursive -c -o cungqr.o cungqr.f +gfortran -O2 -frecursive -c -o cungr2.o cungr2.f +gfortran -O2 -frecursive -c -o cungrq.o cungrq.f +gfortran -O2 -frecursive -c -o cungtr.o cungtr.f +gfortran -O2 -frecursive -c -o cungtsqr.o cungtsqr.f +gfortran -O2 -frecursive -c -o cungtsqr_row.o cungtsqr_row.f +gfortran -O2 -frecursive -c -o cunm2l.o cunm2l.f +gfortran -O2 -frecursive -c -o cunm2r.o cunm2r.f +gfortran -O2 -frecursive -c -o cunmbr.o cunmbr.f +gfortran -O2 -frecursive -c -o cunmhr.o cunmhr.f +gfortran -O2 -frecursive -c -o cunml2.o cunml2.f +gfortran -O2 -frecursive -c -o cunm22.o cunm22.f +gfortran -O2 -frecursive -c -o cunmlq.o cunmlq.f +gfortran -O2 -frecursive -c -o cunmql.o cunmql.f +gfortran -O2 -frecursive -c -o cunmqr.o cunmqr.f +gfortran -O2 -frecursive -c -o cunmr2.o cunmr2.f +gfortran -O2 -frecursive -c -o cunmr3.o cunmr3.f +gfortran -O2 -frecursive -c -o cunmrq.o cunmrq.f +gfortran -O2 -frecursive -c -o cunmrz.o cunmrz.f +gfortran -O2 -frecursive -c -o cunmtr.o cunmtr.f +gfortran -O2 -frecursive -c -o cupgtr.o cupgtr.f +gfortran -O2 -frecursive -c -o cupmtr.o cupmtr.f +gfortran -O2 -frecursive -c -o icmax1.o icmax1.f +gfortran -O2 -frecursive -c -o scsum1.o scsum1.f +gfortran -O2 -frecursive -c -o cstemr.o cstemr.f +gfortran -O2 -frecursive -c -o chfrk.o chfrk.f +gfortran -O2 -frecursive -c -o ctfttp.o ctfttp.f +gfortran -O2 -frecursive -c -o clanhf.o clanhf.f +gfortran -O2 -frecursive -c -o cpftrf.o cpftrf.f +gfortran -O2 -frecursive -c -o cpftri.o cpftri.f +gfortran -O2 -frecursive -c -o cpftrs.o cpftrs.f +gfortran -O2 -frecursive -c -o ctfsm.o ctfsm.f +gfortran -O2 -frecursive -c -o ctftri.o ctftri.f +gfortran -O2 -frecursive -c -o ctfttr.o ctfttr.f +gfortran -O2 -frecursive -c -o ctpttf.o ctpttf.f +gfortran -O2 -frecursive -c -o ctpttr.o ctpttr.f +gfortran -O2 -frecursive -c -o ctrttf.o ctrttf.f +gfortran -O2 -frecursive -c -o ctrttp.o ctrttp.f +gfortran -O2 -frecursive -c -o cgeequb.o cgeequb.f +gfortran -O2 -frecursive -c -o cgbequb.o cgbequb.f +gfortran -O2 -frecursive -c -o csyequb.o csyequb.f +gfortran -O2 -frecursive -c -o cpoequb.o cpoequb.f +gfortran -O2 -frecursive -c -o cheequb.o cheequb.f +gfortran -O2 -frecursive -c -o cbbcsd.o cbbcsd.f +gfortran -O2 -frecursive -c -o clapmr.o clapmr.f +gfortran -O2 -frecursive -c -o cunbdb.o cunbdb.f +gfortran -O2 -frecursive -c -o cunbdb1.o cunbdb1.f +gfortran -O2 -frecursive -c -o cunbdb2.o cunbdb2.f +gfortran -O2 -frecursive -c -o cunbdb3.o cunbdb3.f +gfortran -O2 -frecursive -c -o cunbdb4.o cunbdb4.f +gfortran -O2 -frecursive -c -o cunbdb5.o cunbdb5.f +gfortran -O2 -frecursive -c -o cunbdb6.o cunbdb6.f +gfortran -O2 -frecursive -c -o cuncsd.o cuncsd.f +gfortran -O2 -frecursive -c -o cuncsd2by1.o cuncsd2by1.f +gfortran -O2 -frecursive -c -o cgeqrt.o cgeqrt.f +gfortran -O2 -frecursive -c -o cgeqrt2.o cgeqrt2.f +gfortran -O2 -frecursive -c -o cgeqrt3.o cgeqrt3.f +gfortran -O2 -frecursive -c -o cgemqrt.o cgemqrt.f +gfortran -O2 -frecursive -c -o ctpqrt.o ctpqrt.f +gfortran -O2 -frecursive -c -o ctpqrt2.o ctpqrt2.f +gfortran -O2 -frecursive -c -o ctpmqrt.o ctpmqrt.f +gfortran -O2 -frecursive -c -o ctprfb.o ctprfb.f +gfortran -O2 -frecursive -c -o cgelqt.o cgelqt.f +gfortran -O2 -frecursive -c -o cgelqt3.o cgelqt3.f +gfortran -O2 -frecursive -c -o cgemlqt.o cgemlqt.f +gfortran -O2 -frecursive -c -o cgetsls.o cgetsls.f +gfortran -O2 -frecursive -c -o cgetsqrhrt.o cgetsqrhrt.f +gfortran -O2 -frecursive -c -o cgeqr.o cgeqr.f +gfortran -O2 -frecursive -c -o clatsqr.o clatsqr.f +gfortran -O2 -frecursive -c -o clamtsqr.o clamtsqr.f +gfortran -O2 -frecursive -c -o cgemqr.o cgemqr.f +gfortran -O2 -frecursive -c -o cgelq.o cgelq.f +gfortran -O2 -frecursive -c -o claswlq.o claswlq.f +gfortran -O2 -frecursive -c -o clamswlq.o clamswlq.f +gfortran -O2 -frecursive -c -o cgemlq.o cgemlq.f +gfortran -O2 -frecursive -c -o ctplqt.o ctplqt.f +gfortran -O2 -frecursive -c -o ctplqt2.o ctplqt2.f +gfortran -O2 -frecursive -c -o ctpmlqt.o ctpmlqt.f +gfortran -O2 -frecursive -c -o cunhr_col.o cunhr_col.f +gfortran -O2 -frecursive -c -o claunhr_col_getrfnp.o claunhr_col_getrfnp.f +gfortran -O2 -frecursive -c -o claunhr_col_getrfnp2.o claunhr_col_getrfnp2.f +gfortran -O2 -frecursive -c -o chetrd_2stage.o chetrd_2stage.f +gfortran -O2 -frecursive -c -o chetrd_he2hb.o chetrd_he2hb.f +gfortran -O2 -frecursive -c -o chb2st_kernels.o chb2st_kernels.f +gfortran -O2 -frecursive -c -o cheevd_2stage.o cheevd_2stage.f +gfortran -O2 -frecursive -c -o cheev_2stage.o cheev_2stage.f +gfortran -O2 -frecursive -c -o cheevx_2stage.o cheevx_2stage.f +gfortran -O2 -frecursive -c -o cheevr_2stage.o cheevr_2stage.f +gfortran -O2 -frecursive -c -o chbev_2stage.o chbev_2stage.f +gfortran -O2 -frecursive -c -o chbevx_2stage.o chbevx_2stage.f +gfortran -O2 -frecursive -c -o chbevd_2stage.o chbevd_2stage.f +gfortran -O2 -frecursive -c -o chegv_2stage.o chegv_2stage.f +gfortran -O2 -frecursive -c -o cgesvdq.o cgesvdq.f +gfortran -O2 -frecursive -c -o zpotrf2.o zpotrf2.f +gfortran -O2 -frecursive -c -o zgetrf2.o zgetrf2.f +gfortran -O2 -frecursive -c -o zbdsqr.o zbdsqr.f +gfortran -O2 -frecursive -c -o zgbbrd.o zgbbrd.f +gfortran -O2 -frecursive -c -o zgbcon.o zgbcon.f +gfortran -O2 -frecursive -c -o zgbequ.o zgbequ.f +gfortran -O2 -frecursive -c -o zgbrfs.o zgbrfs.f +gfortran -O2 -frecursive -c -o zgbsv.o zgbsv.f +gfortran -O2 -frecursive -c -o zgbsvx.o zgbsvx.f +gfortran -O2 -frecursive -c -o zgbtf2.o zgbtf2.f +gfortran -O2 -frecursive -c -o zgbtrf.o zgbtrf.f +gfortran -O2 -frecursive -c -o zgbtrs.o zgbtrs.f +gfortran -O2 -frecursive -c -o zgebak.o zgebak.f +gfortran -O2 -frecursive -c -o zgebal.o zgebal.f +gfortran -O2 -frecursive -c -o zgebd2.o zgebd2.f +gfortran -O2 -frecursive -c -o zgebrd.o zgebrd.f +gfortran -O2 -frecursive -c -o zgecon.o zgecon.f +gfortran -O2 -frecursive -c -o zgeequ.o zgeequ.f +gfortran -O2 -frecursive -c -o zgees.o zgees.f +gfortran -O2 -frecursive -c -o zgeesx.o zgeesx.f +gfortran -O2 -frecursive -c -o zgeev.o zgeev.f +gfortran -O2 -frecursive -c -o zgeevx.o zgeevx.f +gfortran -O2 -frecursive -c -o zgehd2.o zgehd2.f +gfortran -O2 -frecursive -c -o zgehrd.o zgehrd.f +gfortran -O2 -frecursive -c -o zgelq2.o zgelq2.f +gfortran -O2 -frecursive -c -o zgelqf.o zgelqf.f +gfortran -O2 -frecursive -c -o zgels.o zgels.f +gfortran -O2 -frecursive -c -o zgelst.o zgelst.f +gfortran -O2 -frecursive -c -o zgelsd.o zgelsd.f +gfortran -O2 -frecursive -c -o zgelss.o zgelss.f +gfortran -O2 -frecursive -c -o zgelsy.o zgelsy.f +gfortran -O2 -frecursive -c -o zgeql2.o zgeql2.f +gfortran -O2 -frecursive -c -o zgeqlf.o zgeqlf.f +gfortran -O2 -frecursive -c -o zgeqp3.o zgeqp3.f +gfortran -O2 -frecursive -c -o zgeqp3rk.o zgeqp3rk.f +gfortran -O2 -frecursive -c -o zgeqr2.o zgeqr2.f +gfortran -O2 -frecursive -c -o zgeqr2p.o zgeqr2p.f +gfortran -O2 -frecursive -c -o zgeqrf.o zgeqrf.f +gfortran -O2 -frecursive -c -o zgeqrfp.o zgeqrfp.f +gfortran -O2 -frecursive -c -o zgerfs.o zgerfs.f +gfortran -O2 -frecursive -c -o zgerq2.o zgerq2.f +gfortran -O2 -frecursive -c -o zgerqf.o zgerqf.f +gfortran -O2 -frecursive -c -o zgesc2.o zgesc2.f +gfortran -O2 -frecursive -c -o zgesdd.o zgesdd.f +gfortran -O2 -frecursive -c -o zgesv.o zgesv.f +gfortran -O2 -frecursive -c -o zgesvd.o zgesvd.f +gfortran -O2 -frecursive -c -o zgesvdx.o zgesvdx.f +gfortran -O2 -frecursive -c -o zgesvj.o zgesvj.f +gfortran -O2 -frecursive -c -o zgejsv.o zgejsv.f +gfortran -O2 -frecursive -c -o zgsvj0.o zgsvj0.f +gfortran -O2 -frecursive -c -o zgsvj1.o zgsvj1.f +gfortran -O2 -frecursive -c -o zgesvx.o zgesvx.f +gfortran -O2 -frecursive -c -o zgetc2.o zgetc2.f +gfortran -O2 -frecursive -c -o zgetf2.o zgetf2.f +gfortran -O2 -frecursive -c -o zgetrf.o zgetrf.f +gfortran -O2 -frecursive -c -o zgetri.o zgetri.f +gfortran -O2 -frecursive -c -o zgetrs.o zgetrs.f +gfortran -O2 -frecursive -c -o zggbak.o zggbak.f +gfortran -O2 -frecursive -c -o zggbal.o zggbal.f +gfortran -O2 -frecursive -c -o zgges.o zgges.f +gfortran -O2 -frecursive -c -o zgges3.o zgges3.f +gfortran -O2 -frecursive -c -o zggesx.o zggesx.f +gfortran -O2 -frecursive -c -o zggev.o zggev.f +gfortran -O2 -frecursive -c -o zggev3.o zggev3.f +gfortran -O2 -frecursive -c -o zggevx.o zggevx.f +gfortran -O2 -frecursive -c -o zggglm.o zggglm.f +gfortran -O2 -frecursive -c -o zgghrd.o zgghrd.f +gfortran -O2 -frecursive -c -o zgghd3.o zgghd3.f +gfortran -O2 -frecursive -c -o zgglse.o zgglse.f +gfortran -O2 -frecursive -c -o zggqrf.o zggqrf.f +gfortran -O2 -frecursive -c -o zggrqf.o zggrqf.f +gfortran -O2 -frecursive -c -o zggsvd3.o zggsvd3.f +gfortran -O2 -frecursive -c -o zggsvp3.o zggsvp3.f +gfortran -O2 -frecursive -c -o zgtcon.o zgtcon.f +gfortran -O2 -frecursive -c -o zgtrfs.o zgtrfs.f +gfortran -O2 -frecursive -c -o zgtsv.o zgtsv.f +gfortran -O2 -frecursive -c -o zgtsvx.o zgtsvx.f +gfortran -O2 -frecursive -c -o zgttrf.o zgttrf.f +gfortran -O2 -frecursive -c -o zgttrs.o zgttrs.f +gfortran -O2 -frecursive -c -o zgtts2.o zgtts2.f +gfortran -O2 -frecursive -c -o zhbev.o zhbev.f +gfortran -O2 -frecursive -c -o zhbevd.o zhbevd.f +gfortran -O2 -frecursive -c -o zhbevx.o zhbevx.f +gfortran -O2 -frecursive -c -o zhbgst.o zhbgst.f +gfortran -O2 -frecursive -c -o zhbgv.o zhbgv.f +gfortran -O2 -frecursive -c -o zhbgvd.o zhbgvd.f +gfortran -O2 -frecursive -c -o zhbgvx.o zhbgvx.f +gfortran -O2 -frecursive -c -o zhbtrd.o zhbtrd.f +gfortran -O2 -frecursive -c -o zhecon.o zhecon.f +gfortran -O2 -frecursive -c -o zheev.o zheev.f +gfortran -O2 -frecursive -c -o zheevd.o zheevd.f +gfortran -O2 -frecursive -c -o zheevr.o zheevr.f +gfortran -O2 -frecursive -c -o zheevx.o zheevx.f +gfortran -O2 -frecursive -c -o zhegs2.o zhegs2.f +gfortran -O2 -frecursive -c -o zhegst.o zhegst.f +gfortran -O2 -frecursive -c -o zhegv.o zhegv.f +gfortran -O2 -frecursive -c -o zhegvd.o zhegvd.f +gfortran -O2 -frecursive -c -o zhegvx.o zhegvx.f +gfortran -O2 -frecursive -c -o zherfs.o zherfs.f +gfortran -O2 -frecursive -c -o zhesv.o zhesv.f +gfortran -O2 -frecursive -c -o zhesvx.o zhesvx.f +gfortran -O2 -frecursive -c -o zhetd2.o zhetd2.f +gfortran -O2 -frecursive -c -o zhetf2.o zhetf2.f +gfortran -O2 -frecursive -c -o zhetrd.o zhetrd.f +gfortran -O2 -frecursive -c -o zhetrf.o zhetrf.f +gfortran -O2 -frecursive -c -o zhetri.o zhetri.f +gfortran -O2 -frecursive -c -o zhetri2.o zhetri2.f +gfortran -O2 -frecursive -c -o zhetri2x.o zhetri2x.f +gfortran -O2 -frecursive -c -o zheswapr.o zheswapr.f +gfortran -O2 -frecursive -c -o zhetrs.o zhetrs.f +gfortran -O2 -frecursive -c -o zhetrs2.o zhetrs2.f +gfortran -O2 -frecursive -c -o zhetf2_rook.o zhetf2_rook.f +gfortran -O2 -frecursive -c -o zhetrf_rook.o zhetrf_rook.f +gfortran -O2 -frecursive -c -o zhetri_rook.o zhetri_rook.f +gfortran -O2 -frecursive -c -o zhetrs_rook.o zhetrs_rook.f +gfortran -O2 -frecursive -c -o zhecon_rook.o zhecon_rook.f +gfortran -O2 -frecursive -c -o zhesv_rook.o zhesv_rook.f +gfortran -O2 -frecursive -c -o zhetf2_rk.o zhetf2_rk.f +gfortran -O2 -frecursive -c -o zhetrf_rk.o zhetrf_rk.f +gfortran -O2 -frecursive -c -o zhetri_3.o zhetri_3.f +gfortran -O2 -frecursive -c -o zhetri_3x.o zhetri_3x.f +gfortran -O2 -frecursive -c -o zhetrs_3.o zhetrs_3.f +gfortran -O2 -frecursive -c -o zhecon_3.o zhecon_3.f +gfortran -O2 -frecursive -c -o zhesv_rk.o zhesv_rk.f +gfortran -O2 -frecursive -c -o zhesv_aa.o zhesv_aa.f +gfortran -O2 -frecursive -c -o zhetrf_aa.o zhetrf_aa.f +gfortran -O2 -frecursive -c -o zhetrs_aa.o zhetrs_aa.f +gfortran -O2 -frecursive -c -o zlahef_aa.o zlahef_aa.f +gfortran -O2 -frecursive -c -o zhesv_aa_2stage.o zhesv_aa_2stage.f +gfortran -O2 -frecursive -c -o zhetrf_aa_2stage.o zhetrf_aa_2stage.f +gfortran -O2 -frecursive -c -o zhetrs_aa_2stage.o zhetrs_aa_2stage.f +gfortran -O2 -frecursive -c -o zhgeqz.o zhgeqz.f +gfortran -O2 -frecursive -c -o zhpcon.o zhpcon.f +gfortran -O2 -frecursive -c -o zhpev.o zhpev.f +gfortran -O2 -frecursive -c -o zhpevd.o zhpevd.f +gfortran -O2 -frecursive -c -o zlaqz0.o zlaqz0.f +gfortran -O2 -frecursive -c -o zlaqz1.o zlaqz1.f +gfortran -O2 -frecursive -c -o zlaqz2.o zlaqz2.f +gfortran -O2 -frecursive -c -o zlaqz3.o zlaqz3.f +gfortran -O2 -frecursive -c -o zhpevx.o zhpevx.f +gfortran -O2 -frecursive -c -o zhpgst.o zhpgst.f +gfortran -O2 -frecursive -c -o zhpgv.o zhpgv.f +gfortran -O2 -frecursive -c -o zhpgvd.o zhpgvd.f +gfortran -O2 -frecursive -c -o zhpgvx.o zhpgvx.f +gfortran -O2 -frecursive -c -o zhprfs.o zhprfs.f +gfortran -O2 -frecursive -c -o zhpsv.o zhpsv.f +gfortran -O2 -frecursive -c -o zhpsvx.o zhpsvx.f +gfortran -O2 -frecursive -c -o zhptrd.o zhptrd.f +gfortran -O2 -frecursive -c -o zhptrf.o zhptrf.f +gfortran -O2 -frecursive -c -o zhptri.o zhptri.f +gfortran -O2 -frecursive -c -o zhptrs.o zhptrs.f +gfortran -O2 -frecursive -c -o zhsein.o zhsein.f +gfortran -O2 -frecursive -c -o zhseqr.o zhseqr.f +gfortran -O2 -frecursive -c -o zlabrd.o zlabrd.f +gfortran -O2 -frecursive -c -o zlacgv.o zlacgv.f +gfortran -O2 -frecursive -c -o zlacon.o zlacon.f +gfortran -O2 -frecursive -c -o zlacn2.o zlacn2.f +gfortran -O2 -frecursive -c -o zlacp2.o zlacp2.f +gfortran -O2 -frecursive -c -o zlacpy.o zlacpy.f +gfortran -O2 -frecursive -c -o zlacrm.o zlacrm.f +gfortran -O2 -frecursive -c -o zlacrt.o zlacrt.f +gfortran -O2 -frecursive -c -o zladiv.o zladiv.f +gfortran -O2 -frecursive -c -o zlaed0.o zlaed0.f +gfortran -O2 -frecursive -c -o zlaed7.o zlaed7.f +gfortran -O2 -frecursive -c -o zlaed8.o zlaed8.f +gfortran -O2 -frecursive -c -o zlaein.o zlaein.f +gfortran -O2 -frecursive -c -o zlaesy.o zlaesy.f +gfortran -O2 -frecursive -c -o zlaev2.o zlaev2.f +gfortran -O2 -frecursive -c -o zlags2.o zlags2.f +gfortran -O2 -frecursive -c -o zlagtm.o zlagtm.f +gfortran -O2 -frecursive -c -o zlahef.o zlahef.f +gfortran -O2 -frecursive -c -o zlahef_rook.o zlahef_rook.f +gfortran -O2 -frecursive -c -o zlahef_rk.o zlahef_rk.f +gfortran -O2 -frecursive -c -o zlahqr.o zlahqr.f +gfortran -O2 -frecursive -c -o zlahr2.o zlahr2.f +gfortran -O2 -frecursive -c -o zlaic1.o zlaic1.f +gfortran -O2 -frecursive -c -o zlals0.o zlals0.f +gfortran -O2 -frecursive -c -o zlalsa.o zlalsa.f +gfortran -O2 -frecursive -c -o zlalsd.o zlalsd.f +gfortran -O2 -frecursive -c -o zlangb.o zlangb.f +gfortran -O2 -frecursive -c -o zlange.o zlange.f +gfortran -O2 -frecursive -c -o zlangt.o zlangt.f +gfortran -O2 -frecursive -c -o zlanhb.o zlanhb.f +gfortran -O2 -frecursive -c -o zlanhe.o zlanhe.f +gfortran -O2 -frecursive -c -o zlanhp.o zlanhp.f +gfortran -O2 -frecursive -c -o zlanhs.o zlanhs.f +gfortran -O2 -frecursive -c -o zlanht.o zlanht.f +gfortran -O2 -frecursive -c -o zlansb.o zlansb.f +gfortran -O2 -frecursive -c -o zlansp.o zlansp.f +gfortran -O2 -frecursive -c -o zlansy.o zlansy.f +gfortran -O2 -frecursive -c -o zlantb.o zlantb.f +gfortran -O2 -frecursive -c -o zlantp.o zlantp.f +gfortran -O2 -frecursive -c -o zlantr.o zlantr.f +gfortran -O2 -frecursive -c -o zlapll.o zlapll.f +gfortran -O2 -frecursive -c -o zlapmt.o zlapmt.f +gfortran -O2 -frecursive -c -o zlaqgb.o zlaqgb.f +gfortran -O2 -frecursive -c -o zlaqge.o zlaqge.f +gfortran -O2 -frecursive -c -o zlaqhb.o zlaqhb.f +gfortran -O2 -frecursive -c -o zlaqhe.o zlaqhe.f +gfortran -O2 -frecursive -c -o zlaqhp.o zlaqhp.f +gfortran -O2 -frecursive -c -o zlaqp2.o zlaqp2.f +gfortran -O2 -frecursive -c -o zlaqps.o zlaqps.f +gfortran -O2 -frecursive -c -o zlaqp2rk.o zlaqp2rk.f +gfortran -O2 -frecursive -c -o zlaqp3rk.o zlaqp3rk.f +gfortran -O2 -frecursive -c -o zlaqsb.o zlaqsb.f +gfortran -O2 -frecursive -c -o zlaqr0.o zlaqr0.f +gfortran -O2 -frecursive -c -o zlaqr1.o zlaqr1.f +gfortran -O2 -frecursive -c -o zlaqr2.o zlaqr2.f +gfortran -O2 -frecursive -c -o zlaqr3.o zlaqr3.f +gfortran -O2 -frecursive -c -o zlaqr4.o zlaqr4.f +gfortran -O2 -frecursive -c -o zlaqr5.o zlaqr5.f +gfortran -O2 -frecursive -c -o zlaqsp.o zlaqsp.f +gfortran -O2 -frecursive -c -o zlaqsy.o zlaqsy.f +gfortran -O2 -frecursive -c -o zlar1v.o zlar1v.f +gfortran -O2 -frecursive -c -o zlar2v.o zlar2v.f +gfortran -O2 -frecursive -c -o ilazlr.o ilazlr.f +gfortran -O2 -frecursive -c -o ilazlc.o ilazlc.f +gfortran -O2 -frecursive -c -o zlarcm.o zlarcm.f +gfortran -O2 -frecursive -c -o zlarf.o zlarf.f +gfortran -O2 -frecursive -c -o zlarfb.o zlarfb.f +gfortran -O2 -frecursive -c -o zlarfb_gett.o zlarfb_gett.f +gfortran -O2 -frecursive -c -o zlarfg.o zlarfg.f +gfortran -O2 -frecursive -c -o zlarft.o zlarft.f +gfortran -O2 -frecursive -c -o zlarfgp.o zlarfgp.f +gfortran -O2 -frecursive -c -o zlarfx.o zlarfx.f +gfortran -O2 -frecursive -c -o zlarfy.o zlarfy.f +gfortran -O2 -frecursive -c -o zlargv.o zlargv.f +gfortran -O2 -frecursive -c -o zlarnv.o zlarnv.f +gfortran -O2 -frecursive -c -o zlarrv.o zlarrv.f +gfortran -O2 -frecursive -c -o zlartv.o zlartv.f +gfortran -O2 -frecursive -c -o zlarz.o zlarz.f +gfortran -O2 -frecursive -c -o zlarzb.o zlarzb.f +gfortran -O2 -frecursive -c -o zlarzt.o zlarzt.f +gfortran -O2 -frecursive -c -o zlascl.o zlascl.f +gfortran -O2 -frecursive -c -o zlaset.o zlaset.f +gfortran -O2 -frecursive -c -o zlasr.o zlasr.f +gfortran -O2 -frecursive -c -o zlaswp.o zlaswp.f +gfortran -O2 -frecursive -c -o zlasyf.o zlasyf.f +gfortran -O2 -frecursive -c -o zlasyf_rook.o zlasyf_rook.f +gfortran -O2 -frecursive -c -o zlasyf_rk.o zlasyf_rk.f +gfortran -O2 -frecursive -c -o zlasyf_aa.o zlasyf_aa.f +gfortran -O2 -frecursive -c -o zlatbs.o zlatbs.f +gfortran -O2 -frecursive -c -o zlatdf.o zlatdf.f +gfortran -O2 -frecursive -c -o zlatps.o zlatps.f +gfortran -O2 -frecursive -c -o zlatrd.o zlatrd.f +gfortran -O2 -frecursive -c -o zlatrs.o zlatrs.f +gfortran -O2 -frecursive -c -o zlatrs3.o zlatrs3.f +gfortran -O2 -frecursive -c -o zlatrz.o zlatrz.f +gfortran -O2 -frecursive -c -o zlauu2.o zlauu2.f +gfortran -O2 -frecursive -c -o zlauum.o zlauum.f +gfortran -O2 -frecursive -c -o zpbcon.o zpbcon.f +gfortran -O2 -frecursive -c -o zpbequ.o zpbequ.f +gfortran -O2 -frecursive -c -o zpbrfs.o zpbrfs.f +gfortran -O2 -frecursive -c -o zpbstf.o zpbstf.f +gfortran -O2 -frecursive -c -o zpbsv.o zpbsv.f +gfortran -O2 -frecursive -c -o zpbsvx.o zpbsvx.f +gfortran -O2 -frecursive -c -o zpbtf2.o zpbtf2.f +gfortran -O2 -frecursive -c -o zpbtrf.o zpbtrf.f +gfortran -O2 -frecursive -c -o zpbtrs.o zpbtrs.f +gfortran -O2 -frecursive -c -o zpocon.o zpocon.f +gfortran -O2 -frecursive -c -o zpoequ.o zpoequ.f +gfortran -O2 -frecursive -c -o zporfs.o zporfs.f +gfortran -O2 -frecursive -c -o zposv.o zposv.f +gfortran -O2 -frecursive -c -o zposvx.o zposvx.f +gfortran -O2 -frecursive -c -o zpotf2.o zpotf2.f +gfortran -O2 -frecursive -c -o zpotrf.o zpotrf.f +gfortran -O2 -frecursive -c -o zpotri.o zpotri.f +gfortran -O2 -frecursive -c -o zpotrs.o zpotrs.f +gfortran -O2 -frecursive -c -o zpstrf.o zpstrf.f +gfortran -O2 -frecursive -c -o zpstf2.o zpstf2.f +gfortran -O2 -frecursive -c -o zppcon.o zppcon.f +gfortran -O2 -frecursive -c -o zppequ.o zppequ.f +gfortran -O2 -frecursive -c -o zpprfs.o zpprfs.f +gfortran -O2 -frecursive -c -o zppsv.o zppsv.f +gfortran -O2 -frecursive -c -o zppsvx.o zppsvx.f +gfortran -O2 -frecursive -c -o zpptrf.o zpptrf.f +gfortran -O2 -frecursive -c -o zpptri.o zpptri.f +gfortran -O2 -frecursive -c -o zpptrs.o zpptrs.f +gfortran -O2 -frecursive -c -o zptcon.o zptcon.f +gfortran -O2 -frecursive -c -o zpteqr.o zpteqr.f +gfortran -O2 -frecursive -c -o zptrfs.o zptrfs.f +gfortran -O2 -frecursive -c -o zptsv.o zptsv.f +gfortran -O2 -frecursive -c -o zptsvx.o zptsvx.f +gfortran -O2 -frecursive -c -o zpttrf.o zpttrf.f +gfortran -O2 -frecursive -c -o zpttrs.o zpttrs.f +gfortran -O2 -frecursive -c -o zptts2.o zptts2.f +gfortran -O2 -frecursive -c -o zrot.o zrot.f +gfortran -O2 -frecursive -c -o zspcon.o zspcon.f +gfortran -O2 -frecursive -c -o zspmv.o zspmv.f +gfortran -O2 -frecursive -c -o zspr.o zspr.f +gfortran -O2 -frecursive -c -o zsprfs.o zsprfs.f +gfortran -O2 -frecursive -c -o zspsv.o zspsv.f +gfortran -O2 -frecursive -c -o zspsvx.o zspsvx.f +gfortran -O2 -frecursive -c -o zsptrf.o zsptrf.f +gfortran -O2 -frecursive -c -o zsptri.o zsptri.f +gfortran -O2 -frecursive -c -o zsptrs.o zsptrs.f +gfortran -O2 -frecursive -c -o zdrscl.o zdrscl.f +gfortran -O2 -frecursive -c -o zrscl.o zrscl.f +gfortran -O2 -frecursive -c -o zstedc.o zstedc.f +gfortran -O2 -frecursive -c -o zstegr.o zstegr.f +gfortran -O2 -frecursive -c -o zstein.o zstein.f +gfortran -O2 -frecursive -c -o zsteqr.o zsteqr.f +gfortran -O2 -frecursive -c -o zsycon.o zsycon.f +gfortran -O2 -frecursive -c -o zsymv.o zsymv.f +gfortran -O2 -frecursive -c -o zsyr.o zsyr.f +gfortran -O2 -frecursive -c -o zsyrfs.o zsyrfs.f +gfortran -O2 -frecursive -c -o zsysv.o zsysv.f +gfortran -O2 -frecursive -c -o zsysvx.o zsysvx.f +gfortran -O2 -frecursive -c -o zsytf2.o zsytf2.f +gfortran -O2 -frecursive -c -o zsytrf.o zsytrf.f +gfortran -O2 -frecursive -c -o zsytri.o zsytri.f +gfortran -O2 -frecursive -c -o zsytri2.o zsytri2.f +gfortran -O2 -frecursive -c -o zsytri2x.o zsytri2x.f +gfortran -O2 -frecursive -c -o zsyswapr.o zsyswapr.f +gfortran -O2 -frecursive -c -o zsytrs.o zsytrs.f +gfortran -O2 -frecursive -c -o zsytrs2.o zsytrs2.f +gfortran -O2 -frecursive -c -o zsyconv.o zsyconv.f +gfortran -O2 -frecursive -c -o zsyconvf.o zsyconvf.f +gfortran -O2 -frecursive -c -o zsyconvf_rook.o zsyconvf_rook.f +gfortran -O2 -frecursive -c -o zsytf2_rook.o zsytf2_rook.f +gfortran -O2 -frecursive -c -o zsytrf_rook.o zsytrf_rook.f +gfortran -O2 -frecursive -c -o zsytrs_rook.o zsytrs_rook.f +gfortran -O2 -frecursive -c -o zsytrs_aa.o zsytrs_aa.f +gfortran -O2 -frecursive -c -o zsytri_rook.o zsytri_rook.f +gfortran -O2 -frecursive -c -o zsycon_rook.o zsycon_rook.f +gfortran -O2 -frecursive -c -o zsysv_rook.o zsysv_rook.f +gfortran -O2 -frecursive -c -o zsysv_aa_2stage.o zsysv_aa_2stage.f +gfortran -O2 -frecursive -c -o zsytrf_aa_2stage.o zsytrf_aa_2stage.f +gfortran -O2 -frecursive -c -o zsytrs_aa_2stage.o zsytrs_aa_2stage.f +gfortran -O2 -frecursive -c -o zsytf2_rk.o zsytf2_rk.f +gfortran -O2 -frecursive -c -o zsytrf_rk.o zsytrf_rk.f +gfortran -O2 -frecursive -c -o zsytrf_aa.o zsytrf_aa.f +gfortran -O2 -frecursive -c -o zsytrs_3.o zsytrs_3.f +gfortran -O2 -frecursive -c -o zsytri_3.o zsytri_3.f +gfortran -O2 -frecursive -c -o zsytri_3x.o zsytri_3x.f +gfortran -O2 -frecursive -c -o zsycon_3.o zsycon_3.f +gfortran -O2 -frecursive -c -o zsysv_rk.o zsysv_rk.f +gfortran -O2 -frecursive -c -o zsysv_aa.o zsysv_aa.f +gfortran -O2 -frecursive -c -o ztbcon.o ztbcon.f +gfortran -O2 -frecursive -c -o ztbrfs.o ztbrfs.f +gfortran -O2 -frecursive -c -o ztbtrs.o ztbtrs.f +gfortran -O2 -frecursive -c -o ztgevc.o ztgevc.f +gfortran -O2 -frecursive -c -o ztgex2.o ztgex2.f +gfortran -O2 -frecursive -c -o ztgexc.o ztgexc.f +gfortran -O2 -frecursive -c -o ztgsen.o ztgsen.f +gfortran -O2 -frecursive -c -o ztgsja.o ztgsja.f +gfortran -O2 -frecursive -c -o ztgsna.o ztgsna.f +gfortran -O2 -frecursive -c -o ztgsy2.o ztgsy2.f +gfortran -O2 -frecursive -c -o ztgsyl.o ztgsyl.f +gfortran -O2 -frecursive -c -o ztpcon.o ztpcon.f +gfortran -O2 -frecursive -c -o ztprfs.o ztprfs.f +gfortran -O2 -frecursive -c -o ztptri.o ztptri.f +gfortran -O2 -frecursive -c -o ztptrs.o ztptrs.f +gfortran -O2 -frecursive -c -o ztrcon.o ztrcon.f +gfortran -O2 -frecursive -c -o ztrevc.o ztrevc.f +gfortran -O2 -frecursive -c -o ztrevc3.o ztrevc3.f +gfortran -O2 -frecursive -c -o ztrexc.o ztrexc.f +gfortran -O2 -frecursive -c -o ztrrfs.o ztrrfs.f +gfortran -O2 -frecursive -c -o ztrsen.o ztrsen.f +gfortran -O2 -frecursive -c -o ztrsna.o ztrsna.f +gfortran -O2 -frecursive -c -o ztrsyl.o ztrsyl.f +gfortran -O2 -frecursive -c -o ztrsyl3.o ztrsyl3.f +gfortran -O2 -frecursive -c -o ztrti2.o ztrti2.f +gfortran -O2 -frecursive -c -o ztrtri.o ztrtri.f +gfortran -O2 -frecursive -c -o ztrtrs.o ztrtrs.f +gfortran -O2 -frecursive -c -o ztzrzf.o ztzrzf.f +gfortran -O2 -frecursive -c -o zung2l.o zung2l.f +gfortran -O2 -frecursive -c -o zung2r.o zung2r.f +gfortran -O2 -frecursive -c -o zungbr.o zungbr.f +gfortran -O2 -frecursive -c -o zunghr.o zunghr.f +gfortran -O2 -frecursive -c -o zungl2.o zungl2.f +gfortran -O2 -frecursive -c -o zunglq.o zunglq.f +gfortran -O2 -frecursive -c -o zungql.o zungql.f +gfortran -O2 -frecursive -c -o zungqr.o zungqr.f +gfortran -O2 -frecursive -c -o zungr2.o zungr2.f +gfortran -O2 -frecursive -c -o zungrq.o zungrq.f +gfortran -O2 -frecursive -c -o zungtr.o zungtr.f +gfortran -O2 -frecursive -c -o zungtsqr.o zungtsqr.f +gfortran -O2 -frecursive -c -o zungtsqr_row.o zungtsqr_row.f +gfortran -O2 -frecursive -c -o zunm2l.o zunm2l.f +gfortran -O2 -frecursive -c -o zunm2r.o zunm2r.f +gfortran -O2 -frecursive -c -o zunmbr.o zunmbr.f +gfortran -O2 -frecursive -c -o zunmhr.o zunmhr.f +gfortran -O2 -frecursive -c -o zunml2.o zunml2.f +gfortran -O2 -frecursive -c -o zunm22.o zunm22.f +gfortran -O2 -frecursive -c -o zunmlq.o zunmlq.f +gfortran -O2 -frecursive -c -o zunmql.o zunmql.f +gfortran -O2 -frecursive -c -o zunmqr.o zunmqr.f +gfortran -O2 -frecursive -c -o zunmr2.o zunmr2.f +gfortran -O2 -frecursive -c -o zunmr3.o zunmr3.f +gfortran -O2 -frecursive -c -o zunmrq.o zunmrq.f +gfortran -O2 -frecursive -c -o zunmrz.o zunmrz.f +gfortran -O2 -frecursive -c -o zunmtr.o zunmtr.f +gfortran -O2 -frecursive -c -o zupgtr.o zupgtr.f +gfortran -O2 -frecursive -c -o zupmtr.o zupmtr.f +gfortran -O2 -frecursive -c -o izmax1.o izmax1.f +gfortran -O2 -frecursive -c -o dzsum1.o dzsum1.f +gfortran -O2 -frecursive -c -o zstemr.o zstemr.f +gfortran -O2 -frecursive -c -o zcgesv.o zcgesv.f +gfortran -O2 -frecursive -c -o zcposv.o zcposv.f +gfortran -O2 -frecursive -c -o zlag2c.o zlag2c.f +gfortran -O2 -frecursive -c -o clag2z.o clag2z.f +gfortran -O2 -frecursive -c -o zlat2c.o zlat2c.f +gfortran -O2 -frecursive -c -o zhfrk.o zhfrk.f +gfortran -O2 -frecursive -c -o ztfttp.o ztfttp.f +gfortran -O2 -frecursive -c -o zlanhf.o zlanhf.f +gfortran -O2 -frecursive -c -o zpftrf.o zpftrf.f +gfortran -O2 -frecursive -c -o zpftri.o zpftri.f +gfortran -O2 -frecursive -c -o zpftrs.o zpftrs.f +gfortran -O2 -frecursive -c -o ztfsm.o ztfsm.f +gfortran -O2 -frecursive -c -o ztftri.o ztftri.f +gfortran -O2 -frecursive -c -o ztfttr.o ztfttr.f +gfortran -O2 -frecursive -c -o ztpttf.o ztpttf.f +gfortran -O2 -frecursive -c -o ztpttr.o ztpttr.f +gfortran -O2 -frecursive -c -o ztrttf.o ztrttf.f +gfortran -O2 -frecursive -c -o ztrttp.o ztrttp.f +gfortran -O2 -frecursive -c -o zgeequb.o zgeequb.f +gfortran -O2 -frecursive -c -o zgbequb.o zgbequb.f +gfortran -O2 -frecursive -c -o zsyequb.o zsyequb.f +gfortran -O2 -frecursive -c -o zpoequb.o zpoequb.f +gfortran -O2 -frecursive -c -o zheequb.o zheequb.f +gfortran -O2 -frecursive -c -o zbbcsd.o zbbcsd.f +gfortran -O2 -frecursive -c -o zlapmr.o zlapmr.f +gfortran -O2 -frecursive -c -o zunbdb.o zunbdb.f +gfortran -O2 -frecursive -c -o zunbdb1.o zunbdb1.f +gfortran -O2 -frecursive -c -o zunbdb2.o zunbdb2.f +gfortran -O2 -frecursive -c -o zunbdb3.o zunbdb3.f +gfortran -O2 -frecursive -c -o zunbdb4.o zunbdb4.f +gfortran -O2 -frecursive -c -o zunbdb5.o zunbdb5.f +gfortran -O2 -frecursive -c -o zunbdb6.o zunbdb6.f +gfortran -O2 -frecursive -c -o zuncsd.o zuncsd.f +gfortran -O2 -frecursive -c -o zuncsd2by1.o zuncsd2by1.f +gfortran -O2 -frecursive -c -o zgeqrt.o zgeqrt.f +gfortran -O2 -frecursive -c -o zgeqrt2.o zgeqrt2.f +gfortran -O2 -frecursive -c -o zgeqrt3.o zgeqrt3.f +gfortran -O2 -frecursive -c -o zgemqrt.o zgemqrt.f +gfortran -O2 -frecursive -c -o ztpqrt.o ztpqrt.f +gfortran -O2 -frecursive -c -o ztpqrt2.o ztpqrt2.f +gfortran -O2 -frecursive -c -o ztpmqrt.o ztpmqrt.f +gfortran -O2 -frecursive -c -o ztprfb.o ztprfb.f +gfortran -O2 -frecursive -c -o ztplqt.o ztplqt.f +gfortran -O2 -frecursive -c -o ztplqt2.o ztplqt2.f +gfortran -O2 -frecursive -c -o ztpmlqt.o ztpmlqt.f +gfortran -O2 -frecursive -c -o zgelqt.o zgelqt.f +gfortran -O2 -frecursive -c -o zgelqt3.o zgelqt3.f +gfortran -O2 -frecursive -c -o zgemlqt.o zgemlqt.f +gfortran -O2 -frecursive -c -o zgetsls.o zgetsls.f +gfortran -O2 -frecursive -c -o zgetsqrhrt.o zgetsqrhrt.f +gfortran -O2 -frecursive -c -o zgeqr.o zgeqr.f +gfortran -O2 -frecursive -c -o zlatsqr.o zlatsqr.f +gfortran -O2 -frecursive -c -o zlamtsqr.o zlamtsqr.f +gfortran -O2 -frecursive -c -o zgemqr.o zgemqr.f +gfortran -O2 -frecursive -c -o zgelq.o zgelq.f +gfortran -O2 -frecursive -c -o zlaswlq.o zlaswlq.f +gfortran -O2 -frecursive -c -o zlamswlq.o zlamswlq.f +gfortran -O2 -frecursive -c -o zgemlq.o zgemlq.f +gfortran -O2 -frecursive -c -o zunhr_col.o zunhr_col.f +gfortran -O2 -frecursive -c -o zlaunhr_col_getrfnp.o zlaunhr_col_getrfnp.f +gfortran -O2 -frecursive -c -o zlaunhr_col_getrfnp2.o zlaunhr_col_getrfnp2.f +gfortran -O2 -frecursive -c -o zhetrd_2stage.o zhetrd_2stage.f +gfortran -O2 -frecursive -c -o zhetrd_he2hb.o zhetrd_he2hb.f +gfortran -O2 -frecursive -c -o zhb2st_kernels.o zhb2st_kernels.f +gfortran -O2 -frecursive -c -o zheevd_2stage.o zheevd_2stage.f +gfortran -O2 -frecursive -c -o zheev_2stage.o zheev_2stage.f +gfortran -O2 -frecursive -c -o zheevx_2stage.o zheevx_2stage.f +gfortran -O2 -frecursive -c -o zheevr_2stage.o zheevr_2stage.f +gfortran -O2 -frecursive -c -o zhbev_2stage.o zhbev_2stage.f +gfortran -O2 -frecursive -c -o zhbevx_2stage.o zhbevx_2stage.f +gfortran -O2 -frecursive -c -o zhbevd_2stage.o zhbevd_2stage.f +gfortran -O2 -frecursive -c -o zhegv_2stage.o zhegv_2stage.f +gfortran -O2 -frecursive -c -o zgesvdq.o zgesvdq.f +gfortran -O2 -frecursive -c -o cpotrs.o cpotrs.f +gfortran -O2 -frecursive -c -o cgetrs.o cgetrs.f +gfortran -O2 -frecursive -c -o cpotrf.o cpotrf.f +gfortran -O2 -frecursive -c -o cgetrf.o cgetrf.f +gfortran -O2 -frecursive -c -o sbdsdc.o sbdsdc.f +gfortran -O2 -frecursive -c -o sbdsqr.o sbdsqr.f +gfortran -O2 -frecursive -c -o sdisna.o sdisna.f +gfortran -O2 -frecursive -c -o slabad.o slabad.f +gfortran -O2 -frecursive -c -o slacpy.o slacpy.f +gfortran -O2 -frecursive -c -o sladiv.o sladiv.f +gfortran -O2 -frecursive -c -o slae2.o slae2.f +gfortran -O2 -frecursive -c -o slaebz.o slaebz.f +gfortran -O2 -frecursive -c -o slaed0.o slaed0.f +gfortran -O2 -frecursive -c -o slaed1.o slaed1.f +gfortran -O2 -frecursive -c -o slaed2.o slaed2.f +gfortran -O2 -frecursive -c -o slaed3.o slaed3.f +gfortran -O2 -frecursive -c -o slaed4.o slaed4.f +gfortran -O2 -frecursive -c -o slaed5.o slaed5.f +gfortran -O2 -frecursive -c -o slaed6.o slaed6.f +gfortran -O2 -frecursive -c -o slaed7.o slaed7.f +gfortran -O2 -frecursive -c -o slaed8.o slaed8.f +gfortran -O2 -frecursive -c -o slaed9.o slaed9.f +gfortran -O2 -frecursive -c -o slaeda.o slaeda.f +gfortran -O2 -frecursive -c -o slaev2.o slaev2.f +gfortran -O2 -frecursive -c -o slagtf.o slagtf.f +gfortran -O2 -frecursive -c -o slagts.o slagts.f +gfortran -O2 -frecursive -c -o slamrg.o slamrg.f +gfortran -O2 -frecursive -c -o slanst.o slanst.f +gfortran -O2 -frecursive -c -o slapy2.o slapy2.f +gfortran -O2 -frecursive -c -o slapy3.o slapy3.f +gfortran -O2 -frecursive -c -o slarnv.o slarnv.f +gfortran -O2 -frecursive -c -o slarra.o slarra.f +gfortran -O2 -frecursive -c -o slarrb.o slarrb.f +gfortran -O2 -frecursive -c -o slarrc.o slarrc.f +gfortran -O2 -frecursive -c -o slarrd.o slarrd.f +gfortran -O2 -frecursive -c -o slarre.o slarre.f +gfortran -O2 -frecursive -c -o slarrf.o slarrf.f +gfortran -O2 -frecursive -c -o slarrj.o slarrj.f +gfortran -O2 -frecursive -c -o slarrk.o slarrk.f +gfortran -O2 -frecursive -c -o slarrr.o slarrr.f +gfortran -O2 -frecursive -c -o slaneg.o slaneg.f +gfortran -O0 -frecursive -c -o slaruv.o slaruv.f +gfortran -O2 -frecursive -c -o slas2.o slas2.f +gfortran -O2 -frecursive -c -o slascl.o slascl.f +gfortran -O2 -frecursive -c -o slasd0.o slasd0.f +gfortran -O2 -frecursive -c -o slasd1.o slasd1.f +gfortran -O2 -frecursive -c -o slasd2.o slasd2.f +gfortran -O2 -frecursive -c -o slasd3.o slasd3.f +gfortran -O2 -frecursive -c -o slasd4.o slasd4.f +gfortran -O2 -frecursive -c -o slasd5.o slasd5.f +gfortran -O2 -frecursive -c -o slasd6.o slasd6.f +gfortran -O2 -frecursive -c -o slasd7.o slasd7.f +gfortran -O2 -frecursive -c -o slasd8.o slasd8.f +gfortran -O2 -frecursive -c -o slasda.o slasda.f +gfortran -O2 -frecursive -c -o slasdq.o slasdq.f +gfortran -O2 -frecursive -c -o slasdt.o slasdt.f +gfortran -O2 -frecursive -c -o slaset.o slaset.f +gfortran -O2 -frecursive -c -o slasq1.o slasq1.f +gfortran -O2 -frecursive -c -o slasq2.o slasq2.f +gfortran -O2 -frecursive -c -o slasq3.o slasq3.f +gfortran -O2 -frecursive -c -o slasq4.o slasq4.f +gfortran -O2 -frecursive -c -o slasq5.o slasq5.f +gfortran -O2 -frecursive -c -o slasq6.o slasq6.f +gfortran -O2 -frecursive -c -o slasr.o slasr.f +gfortran -O2 -frecursive -c -o slasrt.o slasrt.f +gfortran -O2 -frecursive -c -o slasv2.o slasv2.f +gfortran -O2 -frecursive -c -o spttrf.o spttrf.f +gfortran -O2 -frecursive -c -o sstebz.o sstebz.f +gfortran -O2 -frecursive -c -o sstedc.o sstedc.f +gfortran -O2 -frecursive -c -o ssteqr.o ssteqr.f +gfortran -O2 -frecursive -c -o ssterf.o ssterf.f +gfortran -O2 -frecursive -c -o slaisnan.o slaisnan.f +gfortran -O2 -frecursive -c -o sisnan.o sisnan.f +gfortran -O2 -frecursive -c -o slartgp.o slartgp.f +gfortran -O2 -frecursive -c -o slartgs.o slartgs.f +gfortran -O2 -frecursive -c -o ../INSTALL/sroundup_lwork.o ../INSTALL/sroundup_lwork.f +gfortran -O2 -frecursive -c -o ../INSTALL/second_INT_ETIME.o ../INSTALL/second_INT_ETIME.f +gfortran -O2 -frecursive -c -o dbdsdc.o dbdsdc.f +gfortran -O2 -frecursive -c -o dbdsqr.o dbdsqr.f +gfortran -O2 -frecursive -c -o ddisna.o ddisna.f +gfortran -O2 -frecursive -c -o dlabad.o dlabad.f +gfortran -O2 -frecursive -c -o dlacpy.o dlacpy.f +gfortran -O2 -frecursive -c -o dladiv.o dladiv.f +gfortran -O2 -frecursive -c -o dlae2.o dlae2.f +gfortran -O2 -frecursive -c -o dlaebz.o dlaebz.f +gfortran -O2 -frecursive -c -o dlaed0.o dlaed0.f +gfortran -O2 -frecursive -c -o dlaed1.o dlaed1.f +gfortran -O2 -frecursive -c -o dlaed2.o dlaed2.f +gfortran -O2 -frecursive -c -o dlaed3.o dlaed3.f +gfortran -O2 -frecursive -c -o dlaed4.o dlaed4.f +gfortran -O2 -frecursive -c -o dlaed5.o dlaed5.f +gfortran -O2 -frecursive -c -o dlaed6.o dlaed6.f +gfortran -O2 -frecursive -c -o dlaed7.o dlaed7.f +gfortran -O2 -frecursive -c -o dlaed8.o dlaed8.f +gfortran -O2 -frecursive -c -o dlaed9.o dlaed9.f +gfortran -O2 -frecursive -c -o dlaeda.o dlaeda.f +gfortran -O2 -frecursive -c -o dlaev2.o dlaev2.f +gfortran -O2 -frecursive -c -o dlagtf.o dlagtf.f +gfortran -O2 -frecursive -c -o dlagts.o dlagts.f +gfortran -O2 -frecursive -c -o dlamrg.o dlamrg.f +gfortran -O2 -frecursive -c -o dlanst.o dlanst.f +gfortran -O2 -frecursive -c -o dlapy2.o dlapy2.f +gfortran -O2 -frecursive -c -o dlapy3.o dlapy3.f +gfortran -O2 -frecursive -c -o dlarnv.o dlarnv.f +gfortran -O2 -frecursive -c -o dlarra.o dlarra.f +gfortran -O2 -frecursive -c -o dlarrb.o dlarrb.f +gfortran -O2 -frecursive -c -o dlarrc.o dlarrc.f +gfortran -O2 -frecursive -c -o dlarrd.o dlarrd.f +gfortran -O2 -frecursive -c -o dlarre.o dlarre.f +gfortran -O2 -frecursive -c -o dlarrf.o dlarrf.f +gfortran -O2 -frecursive -c -o dlarrj.o dlarrj.f +gfortran -O2 -frecursive -c -o dlarrk.o dlarrk.f +gfortran -O2 -frecursive -c -o dlarrr.o dlarrr.f +gfortran -O2 -frecursive -c -o dlaneg.o dlaneg.f +gfortran -O0 -frecursive -c -o dlaruv.o dlaruv.f +gfortran -O2 -frecursive -c -o dlas2.o dlas2.f +gfortran -O2 -frecursive -c -o dlascl.o dlascl.f +gfortran -O2 -frecursive -c -o dlasd0.o dlasd0.f +gfortran -O2 -frecursive -c -o dlasd1.o dlasd1.f +gfortran -O2 -frecursive -c -o dlasd2.o dlasd2.f +gfortran -O2 -frecursive -c -o dlasd3.o dlasd3.f +gfortran -O2 -frecursive -c -o dlasd4.o dlasd4.f +gfortran -O2 -frecursive -c -o dlasd5.o dlasd5.f +gfortran -O2 -frecursive -c -o dlasd6.o dlasd6.f +gfortran -O2 -frecursive -c -o dlasd7.o dlasd7.f +gfortran -O2 -frecursive -c -o dlasd8.o dlasd8.f +gfortran -O2 -frecursive -c -o dlasda.o dlasda.f +gfortran -O2 -frecursive -c -o dlasdq.o dlasdq.f +gfortran -O2 -frecursive -c -o dlasdt.o dlasdt.f +gfortran -O2 -frecursive -c -o dlaset.o dlaset.f +gfortran -O2 -frecursive -c -o dlasq1.o dlasq1.f +gfortran -O2 -frecursive -c -o dlasq2.o dlasq2.f +gfortran -O2 -frecursive -c -o dlasq3.o dlasq3.f +gfortran -O2 -frecursive -c -o dlasq4.o dlasq4.f +gfortran -O2 -frecursive -c -o dlasq5.o dlasq5.f +gfortran -O2 -frecursive -c -o dlasq6.o dlasq6.f +gfortran -O2 -frecursive -c -o dlasr.o dlasr.f +gfortran -O2 -frecursive -c -o dlasrt.o dlasrt.f +gfortran -O2 -frecursive -c -o dlasv2.o dlasv2.f +gfortran -O2 -frecursive -c -o dpttrf.o dpttrf.f +gfortran -O2 -frecursive -c -o dstebz.o dstebz.f +gfortran -O2 -frecursive -c -o dstedc.o dstedc.f +gfortran -O2 -frecursive -c -o dsteqr.o dsteqr.f +gfortran -O2 -frecursive -c -o dsterf.o dsterf.f +gfortran -O2 -frecursive -c -o dlaisnan.o dlaisnan.f +gfortran -O2 -frecursive -c -o disnan.o disnan.f +gfortran -O2 -frecursive -c -o dlartgp.o dlartgp.f +gfortran -O2 -frecursive -c -o dlartgs.o dlartgs.f +gfortran -O2 -frecursive -c -o ../INSTALL/droundup_lwork.o ../INSTALL/droundup_lwork.f +gfortran -O2 -frecursive -c -o ../INSTALL/dlamch.o ../INSTALL/dlamch.f +gfortran -O2 -frecursive -c -o ../INSTALL/dsecnd_INT_ETIME.o ../INSTALL/dsecnd_INT_ETIME.f +gfortran -O2 -frecursive -c -o ilaenv.o ilaenv.f +gfortran -O2 -frecursive -c -o ilaenv2stage.o ilaenv2stage.f +gfortran -O2 -frecursive -c -o ieeeck.o ieeeck.f +gfortran -O2 -frecursive -c -o lsamen.o lsamen.f +gfortran -O2 -frecursive -c -o xerbla.o xerbla.f +gfortran -O2 -frecursive -c -o xerbla_array.o xerbla_array.f +gfortran -O2 -frecursive -c -o iparmq.o iparmq.f +gfortran -O2 -frecursive -c -o ilaprec.o ilaprec.f +gfortran -O2 -frecursive -c -o ilatrans.o ilatrans.f +gfortran -O2 -frecursive -c -o ilauplo.o ilauplo.f +gfortran -O2 -frecursive -c -o iladiag.o iladiag.f +gfortran -O2 -frecursive -c -o chla_transtype.o chla_transtype.f +gfortran -O2 -frecursive -c -o ../INSTALL/ilaver.o ../INSTALL/ilaver.f +gfortran -O2 -frecursive -c -o ../INSTALL/lsame.o ../INSTALL/lsame.f +gfortran -O2 -frecursive -c -o ../INSTALL/slamch.o ../INSTALL/slamch.f +gfortran -O2 -frecursive -c -o la_xisnan.o la_xisnan.F90 +gfortran -O2 -frecursive -c -o sgedmd.o sgedmd.f90 +gfortran -O2 -frecursive -c -o sgedmdq.o sgedmdq.f90 +gfortran -O2 -frecursive -c -o dsytrd_sb2st.o dsytrd_sb2st.F +gfortran -O2 -frecursive -c -o dgedmd.o dgedmd.f90 +gfortran -O2 -frecursive -c -o dgedmdq.o dgedmdq.f90 +gfortran -O2 -frecursive -c -o clartg.o clartg.f90 +gfortran -O2 -frecursive -c -o classq.o classq.f90 +gfortran -O2 -frecursive -c -o chetrd_hb2st.o chetrd_hb2st.F +gfortran -O2 -frecursive -c -o cgedmd.o cgedmd.f90 +gfortran -O2 -frecursive -c -o cgedmdq.o cgedmdq.f90 +gfortran -O2 -frecursive -c -o zlartg.o zlartg.f90 +gfortran -O2 -frecursive -c -o zlassq.o zlassq.f90 +gfortran -O2 -frecursive -c -o zhetrd_hb2st.o zhetrd_hb2st.F +gfortran -O2 -frecursive -c -o zgedmd.o zgedmd.f90 +gfortran -O2 -frecursive -c -o zgedmdq.o zgedmdq.f90 +gfortran -O2 -frecursive -c -o slartg.o slartg.f90 +gfortran -O2 -frecursive -c -o slassq.o slassq.f90 +gfortran -O2 -frecursive -c -o dlartg.o dlartg.f90 +gfortran -O2 -frecursive -c -o dlassq.o dlassq.f90 +gfortran -O2 -frecursive -c -o iparam2stage.o iparam2stage.F +ar cr ../liblapack.a sbdsvdx.o spotrf2.o sgetrf2.o sgbbrd.o sgbcon.o sgbequ.o sgbrfs.o sgbsv.o sgbsvx.o sgbtf2.o sgbtrf.o sgbtrs.o sgebak.o sgebal.o sgebd2.o sgebrd.o sgecon.o sgeequ.o sgees.o sgeesx.o sgeev.o sgeevx.o sgehd2.o sgehrd.o sgelq2.o sgelqf.o sgels.o sgelst.o sgelsd.o sgelss.o sgelsy.o sgeql2.o sgeqlf.o sgeqp3.o sgeqp3rk.o sgeqr2.o sgeqr2p.o sgeqrf.o sgeqrfp.o sgerfs.o sgerq2.o sgerqf.o sgesc2.o sgesdd.o sgesv.o sgesvd.o sgesvdx.o sgesvx.o sgetc2.o sgetf2.o sgetri.o sggbak.o sggbal.o sgges.o sgges3.o sggesx.o sggev.o sggev3.o sggevx.o sggglm.o sgghrd.o sgghd3.o sgglse.o sggqrf.o sggrqf.o sggsvd3.o sggsvp3.o sgtcon.o sgtrfs.o sgtsv.o sgtsvx.o sgttrf.o sgttrs.o sgtts2.o shgeqz.o slaqz0.o slaqz1.o slaqz2.o slaqz3.o slaqz4.o shsein.o shseqr.o slabrd.o slacon.o slacn2.o slaein.o slaexc.o slag2.o slags2.o slagtm.o slagv2.o slahqr.o slahr2.o slaic1.o slaln2.o slals0.o slalsa.o slalsd.o slangb.o slange.o slangt.o slanhs.o slansb.o slansp.o slansy.o slantb.o slantp.o slantr.o slanv2.o slapll.o slapmt.o slaqgb.o slaqge.o slaqp2.o slaqps.o slaqp2rk.o slaqp3rk.o slaqsb.o slaqsp.o slaqsy.o slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o slarf.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o slargv.o slarmm.o slarrv.o slartv.o slarz.o slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o slasyf_rk.o slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrs3.o slatrz.o slauu2.o slauum.o sopgtr.o sopmtr.o sorg2l.o sorg2r.o sorgbr.o sorghr.o sorgl2.o sorglq.o sorgql.o sorgqr.o sorgr2.o sorgrq.o sorgtr.o sorgtsqr.o sorgtsqr_row.o sorm2l.o sorm2r.o sorm22.o sormbr.o sormhr.o sorml2.o sormlq.o sormql.o sormqr.o sormr2.o sormr3.o sormrq.o sormrz.o sormtr.o spbcon.o spbequ.o spbrfs.o spbstf.o spbsv.o spbsvx.o spbtf2.o spbtrf.o spbtrs.o spocon.o spoequ.o sporfs.o sposv.o sposvx.o spotf2.o spotri.o spstrf.o spstf2.o sppcon.o sppequ.o spprfs.o sppsv.o sppsvx.o spptrf.o spptri.o spptrs.o sptcon.o spteqr.o sptrfs.o sptsv.o sptsvx.o spttrs.o sptts2.o srscl.o ssbev.o ssbevd.o ssbevx.o ssbgst.o ssbgv.o ssbgvd.o ssbgvx.o ssbtrd.o sspcon.o sspev.o sspevd.o sspevx.o sspgst.o sspgv.o sspgvd.o sspgvx.o ssprfs.o sspsv.o sspsvx.o ssptrd.o ssptrf.o ssptri.o ssptrs.o sstegr.o sstein.o sstev.o sstevd.o sstevr.o sstevx.o ssycon.o ssyev.o ssyevd.o ssyevr.o ssyevx.o ssygs2.o ssygst.o ssygv.o ssygvd.o ssygvx.o ssyrfs.o ssysv.o ssysvx.o ssytd2.o ssytf2.o ssytrd.o ssytrf.o ssytri.o ssytri2.o ssytri2x.o ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o ssyconvf.o ssyconvf_rook.o ssytf2_rook.o ssytrf_rook.o ssytrs_rook.o ssytri_rook.o ssycon_rook.o ssysv_rook.o ssytf2_rk.o ssytrf_rk.o ssytrs_3.o ssytri_3.o ssytri_3x.o ssycon_3.o ssysv_rk.o slasyf_aa.o ssysv_aa.o ssytrf_aa.o ssytrs_aa.o ssysv_aa_2stage.o ssytrf_aa_2stage.o ssytrs_aa_2stage.o stbcon.o 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 strevc3.o strexc.o strrfs.o strsen.o strsna.o strsyl.o strsyl3.o strti2.o strtri.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 sgejsv.o sgesvj.o sgsvj0.o sgsvj1.o sgeequb.o ssyequb.o spoequb.o sgbequb.o sbbcsd.o slapmr.o sorbdb.o sorbdb1.o sorbdb2.o sorbdb3.o sorbdb4.o sorbdb5.o sorbdb6.o sorcsd.o sorcsd2by1.o sgeqrt.o sgeqrt2.o sgeqrt3.o sgemqrt.o stpqrt.o stpqrt2.o stpmqrt.o stprfb.o sgelqt.o sgelqt3.o sgemlqt.o sgetsls.o sgetsqrhrt.o sgeqr.o slatsqr.o slamtsqr.o sgemqr.o sgelq.o slaswlq.o slamswlq.o sgemlq.o stplqt.o stplqt2.o stpmlqt.o sorhr_col.o slaorhr_col_getrfnp.o slaorhr_col_getrfnp2.o ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o sgesvdq.o sgedmd.o sgedmdq.o dpotrf2.o dgetrf2.o dbdsvdx.o dgbbrd.o dgbcon.o dgbequ.o dgbrfs.o dgbsv.o dgbsvx.o dgbtf2.o dgbtrf.o dgbtrs.o dgebak.o dgebal.o dgebd2.o dgebrd.o dgecon.o dgeequ.o dgees.o dgeesx.o dgeev.o dgeevx.o dgehd2.o dgehrd.o dgelq2.o dgelqf.o dgels.o dgelst.o dgelsd.o dgelss.o dgelsy.o dgeql2.o dgeqlf.o dgeqp3.o dgeqp3rk.o dgeqr2.o dgeqr2p.o dgeqrf.o dgeqrfp.o dgerfs.o dgerq2.o dgerqf.o dgesc2.o dgesdd.o dgesv.o dgesvd.o dgesvdx.o dgesvx.o dgetc2.o dgetf2.o dgetrf.o dgetri.o dgetrs.o dggbak.o dggbal.o dgges.o dgges3.o dggesx.o dggev.o dggev3.o dggevx.o dggglm.o dgghrd.o dgghd3.o dgglse.o dggqrf.o dggrqf.o dggsvd3.o dggsvp3.o dgtcon.o dgtrfs.o dgtsv.o dgtsvx.o dgttrf.o dgttrs.o dgtts2.o dhgeqz.o dlaqz0.o dlaqz1.o dlaqz2.o dlaqz3.o dlaqz4.o dhsein.o dhseqr.o dlabrd.o dlacon.o dlacn2.o dlaein.o dlaexc.o dlag2.o dlags2.o dlagtm.o dlagv2.o dlahqr.o dlahr2.o dlaic1.o dlaln2.o dlals0.o dlalsa.o dlalsd.o dlangb.o dlange.o dlangt.o dlanhs.o dlansb.o dlansp.o dlansy.o dlantb.o dlantp.o dlantr.o dlanv2.o dlapll.o dlapmt.o dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o dlarf.o dlarf1.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o dlargv.o dlarmm.o dlarrv.o dlartv.o dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o dlasyf.o dlasyf_rook.o dlasyf_rk.o dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrs3.o dlatrz.o dlauu2.o dlauum.o dopgtr.o dopmtr.o dorg2l.o dorg2r.o dorgbr.o dorghr.o dorgl2.o dorglq.o dorgql.o dorgqr.o dorgr2.o dorgrq.o dorgtr.o dorgtsqr.o dorgtsqr_row.o dorm2l.o dorm2r.o dorm22.o dormbr.o dormhr.o dorml2.o dormlq.o dormql.o dormqr.o dormr2.o dormr3.o dormrq.o dormrz.o dormtr.o dpbcon.o dpbequ.o dpbrfs.o dpbstf.o dpbsv.o dpbsvx.o dpbtf2.o dpbtrf.o dpbtrs.o dpocon.o dpoequ.o dporfs.o dposv.o dposvx.o dpotf2.o dpotrf.o dpotri.o dpotrs.o dpstrf.o dpstf2.o dppcon.o dppequ.o dpprfs.o dppsv.o dppsvx.o dpptrf.o dpptri.o dpptrs.o dptcon.o dpteqr.o dptrfs.o dptsv.o dptsvx.o dpttrs.o dptts2.o drscl.o dsbev.o dsbevd.o dsbevx.o dsbgst.o dsbgv.o dsbgvd.o dsbgvx.o dsbtrd.o dspcon.o dspev.o dspevd.o dspevx.o dspgst.o dspgv.o dspgvd.o dspgvx.o dsprfs.o dspsv.o dspsvx.o dsptrd.o dsptrf.o dsptri.o dsptrs.o dstegr.o dstein.o dstev.o dstevd.o dstevr.o dstevx.o dsycon.o dsyev.o dsyevd.o dsyevr.o dsyevx.o dsygs2.o dsygst.o dsygv.o dsygvd.o dsygvx.o dsyrfs.o dsysv.o dsysvx.o dsytd2.o dsytf2.o dsytrd.o dsytrf.o dsytri.o dsytri2.o dsytri2x.o dsyswapr.o dsytrs.o dsytrs2.o dsyconv.o dsyconvf.o dsyconvf_rook.o dsytf2_rook.o dsytrf_rook.o dsytrs_rook.o dsytri_rook.o dsycon_rook.o dsysv_rook.o dsytf2_rk.o dsytrf_rk.o dsytrs_3.o dsytri_3.o dsytri_3x.o dsycon_3.o dsysv_rk.o dlasyf_aa.o dsysv_aa.o dsytrf_aa.o dsytrs_aa.o dsysv_aa_2stage.o dsytrf_aa_2stage.o dsytrs_aa_2stage.o 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 dtrevc3.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o dtrsyl3.o dtrti2.o dtrtri.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 dtfttr.o dtpttf.o dtpttr.o dtrttf.o dtrttp.o dgejsv.o dgesvj.o dgsvj0.o dgsvj1.o dgeequb.o dsyequb.o dpoequb.o dgbequb.o dbbcsd.o dlapmr.o dorbdb.o dorbdb1.o dorbdb2.o dorbdb3.o dorbdb4.o dorbdb5.o dorbdb6.o dorcsd.o dorcsd2by1.o dgeqrt.o dgeqrt2.o dgeqrt3.o dgemqrt.o dtpqrt.o dtpqrt2.o dtpmqrt.o dtprfb.o dgelqt.o dgelqt3.o dgemlqt.o dgetsls.o dgetsqrhrt.o dgeqr.o dlatsqr.o dlamtsqr.o dgemqr.o dgelq.o dlaswlq.o dlamswlq.o dgemlq.o dtplqt.o dtplqt2.o dtpmlqt.o dorhr_col.o dlaorhr_col_getrfnp.o dlaorhr_col_getrfnp2.o dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o dgesvdq.o dgedmd.o dgedmdq.o spotrs.o sgetrs.o spotrf.o sgetrf.o cpotrf2.o cgetrf2.o cbdsqr.o cgbbrd.o cgbcon.o cgbequ.o cgbrfs.o cgbsv.o cgbsvx.o cgbtf2.o cgbtrf.o cgbtrs.o cgebak.o cgebal.o cgebd2.o cgebrd.o cgecon.o cgeequ.o cgees.o cgeesx.o cgeev.o cgeevx.o cgehd2.o cgehrd.o cgelq2.o cgelqf.o cgels.o cgelst.o cgelsd.o cgelss.o cgelsy.o cgeql2.o cgeqlf.o cgeqp3.o cgeqp3rk.o cgeqr2.o cgeqr2p.o cgeqrf.o cgeqrfp.o cgerfs.o cgerq2.o cgerqf.o cgesc2.o cgesdd.o cgesv.o cgesvd.o cgesvdx.o cgesvj.o cgejsv.o cgsvj0.o cgsvj1.o cgesvx.o cgetc2.o cgetf2.o cgetri.o cggbak.o cggbal.o cgges.o cgges3.o cggesx.o cggev.o cggev3.o cggevx.o cggglm.o cgghrd.o cgghd3.o cgglse.o cggqrf.o cggrqf.o cggsvd3.o cggsvp3.o cgtcon.o cgtrfs.o cgtsv.o cgtsvx.o cgttrf.o cgttrs.o cgtts2.o chbev.o chbevd.o chbevx.o chbgst.o chbgv.o chbgvd.o chbgvx.o chbtrd.o checon.o cheev.o cheevd.o cheevr.o cheevx.o chegs2.o chegst.o chegv.o chegvd.o chegvx.o cherfs.o chesv.o chesvx.o chetd2.o chetf2.o chetrd.o chetrf.o chetri.o chetri2.o chetri2x.o cheswapr.o chetrs.o chetrs2.o chetf2_rook.o chetrf_rook.o chetri_rook.o chetrs_rook.o checon_rook.o chesv_rook.o chetf2_rk.o chetrf_rk.o chetri_3.o chetri_3x.o chetrs_3.o checon_3.o chesv_rk.o chesv_aa.o chetrf_aa.o chetrs_aa.o clahef_aa.o chesv_aa_2stage.o chetrf_aa_2stage.o chetrs_aa_2stage.o chgeqz.o chpcon.o chpev.o chpevd.o claqz0.o claqz1.o claqz2.o claqz3.o chpevx.o chpgst.o chpgv.o chpgvd.o chpgvx.o chprfs.o chpsv.o chpsvx.o chptrd.o chptrf.o chptri.o chptrs.o chsein.o chseqr.o clabrd.o clacgv.o clacon.o clacn2.o clacp2.o clacpy.o clacrm.o clacrt.o cladiv.o claed0.o claed7.o claed8.o claein.o claesy.o claev2.o clags2.o clagtm.o clahef.o clahef_rook.o clahef_rk.o clahqr.o clahr2.o claic1.o clals0.o clalsa.o clalsd.o clangb.o clange.o clangt.o clanhb.o clanhe.o clanhp.o clanhs.o clanht.o clansb.o clansp.o clansy.o clantb.o clantp.o clantr.o clapll.o clapmt.o clarcm.o claqgb.o claqge.o claqhb.o claqhe.o claqhp.o claqp2.o claqps.o claqp2rk.o claqp3rk.o claqsb.o claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o clarf.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o clatbs.o clatdf.o clatps.o clatrd.o clatrs.o clatrs3.o clatrz.o clauu2.o clauum.o cpbcon.o cpbequ.o cpbrfs.o cpbstf.o cpbsv.o cpbsvx.o cpbtf2.o cpbtrf.o cpbtrs.o cpocon.o cpoequ.o cporfs.o cposv.o cposvx.o cpotf2.o cpotri.o cpstrf.o cpstf2.o cppcon.o cppequ.o cpprfs.o cppsv.o cppsvx.o cpptrf.o cpptri.o cpptrs.o cptcon.o cpteqr.o cptrfs.o cptsv.o cptsvx.o cpttrf.o cpttrs.o cptts2.o crot.o cspcon.o cspmv.o cspr.o csprfs.o cspsv.o cspsvx.o csptrf.o csptri.o csptrs.o csrscl.o crscl.o cstedc.o cstegr.o cstein.o csteqr.o csycon.o csymv.o csyr.o csyrfs.o csysv.o csysvx.o csytf2.o csytrf.o csytri.o csytri2.o csytri2x.o csyswapr.o csytrs.o csytrs2.o csyconv.o csyconvf.o csyconvf_rook.o csytf2_rook.o csytrf_rook.o csytrs_rook.o csytri_rook.o csycon_rook.o csysv_rook.o csytf2_rk.o csytrf_rk.o csytrf_aa.o csytrs_3.o csytrs_aa.o csytri_3.o csytri_3x.o csycon_3.o csysv_rk.o csysv_aa.o csysv_aa_2stage.o csytrf_aa_2stage.o csytrs_aa_2stage.o 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 ctrevc3.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o ctrsyl.o ctrsyl3.o ctrti2.o ctrtri.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 cungtsqr.o cungtsqr_row.o cunm2l.o cunm2r.o cunmbr.o cunmhr.o cunml2.o cunm22.o cunmlq.o cunmql.o cunmqr.o cunmr2.o cunmr3.o cunmrq.o cunmrz.o cunmtr.o cupgtr.o cupmtr.o icmax1.o scsum1.o cstemr.o chfrk.o ctfttp.o clanhf.o cpftrf.o cpftri.o cpftrs.o ctfsm.o ctftri.o ctfttr.o ctpttf.o ctpttr.o ctrttf.o ctrttp.o cgeequb.o cgbequb.o csyequb.o cpoequb.o cheequb.o cbbcsd.o clapmr.o cunbdb.o cunbdb1.o cunbdb2.o cunbdb3.o cunbdb4.o cunbdb5.o cunbdb6.o cuncsd.o cuncsd2by1.o cgeqrt.o cgeqrt2.o cgeqrt3.o cgemqrt.o ctpqrt.o ctpqrt2.o ctpmqrt.o ctprfb.o cgelqt.o cgelqt3.o cgemlqt.o cgetsls.o cgetsqrhrt.o cgeqr.o clatsqr.o clamtsqr.o cgemqr.o cgelq.o claswlq.o clamswlq.o cgemlq.o ctplqt.o ctplqt2.o ctpmlqt.o cunhr_col.o claunhr_col_getrfnp.o claunhr_col_getrfnp2.o chetrd_2stage.o chetrd_he2hb.o chetrd_hb2st.o chb2st_kernels.o cheevd_2stage.o cheev_2stage.o cheevx_2stage.o cheevr_2stage.o chbev_2stage.o chbevx_2stage.o chbevd_2stage.o chegv_2stage.o cgesvdq.o cgedmd.o cgedmdq.o zpotrf2.o zgetrf2.o zbdsqr.o zgbbrd.o zgbcon.o zgbequ.o zgbrfs.o zgbsv.o zgbsvx.o zgbtf2.o zgbtrf.o zgbtrs.o zgebak.o zgebal.o zgebd2.o zgebrd.o zgecon.o zgeequ.o zgees.o zgeesx.o zgeev.o zgeevx.o zgehd2.o zgehrd.o zgelq2.o zgelqf.o zgels.o zgelst.o zgelsd.o zgelss.o zgelsy.o zgeql2.o zgeqlf.o zgeqp3.o zgeqp3rk.o zgeqr2.o zgeqr2p.o zgeqrf.o zgeqrfp.o zgerfs.o zgerq2.o zgerqf.o zgesc2.o zgesdd.o zgesv.o zgesvd.o zgesvdx.o zgesvj.o zgejsv.o zgsvj0.o zgsvj1.o zgesvx.o zgetc2.o zgetf2.o zgetrf.o zgetri.o zgetrs.o zggbak.o zggbal.o zgges.o zgges3.o zggesx.o zggev.o zggev3.o zggevx.o zggglm.o zgghrd.o zgghd3.o zgglse.o zggqrf.o zggrqf.o zggsvd3.o zggsvp3.o zgtcon.o zgtrfs.o zgtsv.o zgtsvx.o zgttrf.o zgttrs.o zgtts2.o zhbev.o zhbevd.o zhbevx.o zhbgst.o zhbgv.o zhbgvd.o zhbgvx.o zhbtrd.o zhecon.o zheev.o zheevd.o zheevr.o zheevx.o zhegs2.o zhegst.o zhegv.o zhegvd.o zhegvx.o zherfs.o zhesv.o zhesvx.o zhetd2.o zhetf2.o zhetrd.o zhetrf.o zhetri.o zhetri2.o zhetri2x.o zheswapr.o zhetrs.o zhetrs2.o zhetf2_rook.o zhetrf_rook.o zhetri_rook.o zhetrs_rook.o zhecon_rook.o zhesv_rook.o zhetf2_rk.o zhetrf_rk.o zhetri_3.o zhetri_3x.o zhetrs_3.o zhecon_3.o zhesv_rk.o zhesv_aa.o zhetrf_aa.o zhetrs_aa.o zlahef_aa.o zhesv_aa_2stage.o zhetrf_aa_2stage.o zhetrs_aa_2stage.o zhgeqz.o zhpcon.o zhpev.o zhpevd.o zlaqz0.o zlaqz1.o zlaqz2.o zlaqz3.o zhpevx.o zhpgst.o zhpgv.o zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o zhpsvx.o zhptrd.o zhptrf.o zhptri.o zhptrs.o zhsein.o zhseqr.o zlabrd.o zlacgv.o zlacon.o zlacn2.o zlacp2.o zlacpy.o zlacrm.o zlacrt.o zladiv.o zlaed0.o zlaed7.o zlaed8.o zlaein.o zlaesy.o zlaev2.o zlags2.o zlagtm.o zlahef.o zlahef_rook.o zlahef_rk.o zlahqr.o zlahr2.o zlaic1.o zlals0.o zlalsa.o zlalsd.o zlangb.o zlange.o zlangt.o zlanhb.o zlanhe.o zlanhp.o zlanhs.o zlanht.o zlansb.o zlansp.o zlansy.o zlantb.o zlantp.o zlantr.o zlapll.o zlapmt.o zlaqgb.o zlaqge.o zlaqhb.o zlaqhe.o zlaqhp.o zlaqp2.o zlaqps.o zlaqp2rk.o zlaqp3rk.o zlaqsb.o zlaqr0.o zlaqr1.o zlaqr2.o zlaqr3.o zlaqr4.o zlaqr5.o zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarfg.o zlarft.o zlarfgp.o zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o zlasyf_rk.o zlasyf_aa.o zlatbs.o zlatdf.o zlatps.o zlatrd.o zlatrs.o zlatrs3.o zlatrz.o zlauu2.o zlauum.o zpbcon.o zpbequ.o zpbrfs.o zpbstf.o zpbsv.o zpbsvx.o zpbtf2.o zpbtrf.o zpbtrs.o zpocon.o zpoequ.o zporfs.o zposv.o zposvx.o zpotf2.o zpotrf.o zpotri.o zpotrs.o zpstrf.o zpstf2.o zppcon.o zppequ.o zpprfs.o zppsv.o zppsvx.o zpptrf.o zpptri.o zpptrs.o zptcon.o zpteqr.o zptrfs.o zptsv.o zptsvx.o zpttrf.o zpttrs.o zptts2.o zrot.o zspcon.o zspmv.o zspr.o zsprfs.o zspsv.o zspsvx.o zsptrf.o zsptri.o zsptrs.o zdrscl.o zrscl.o zstedc.o zstegr.o zstein.o zsteqr.o zsycon.o zsymv.o zsyr.o zsyrfs.o zsysv.o zsysvx.o zsytf2.o zsytrf.o zsytri.o zsytri2.o zsytri2x.o zsyswapr.o zsytrs.o zsytrs2.o zsyconv.o zsyconvf.o zsyconvf_rook.o zsytf2_rook.o zsytrf_rook.o zsytrs_rook.o zsytrs_aa.o zsytri_rook.o zsycon_rook.o zsysv_rook.o zsysv_aa_2stage.o zsytrf_aa_2stage.o zsytrs_aa_2stage.o zsytf2_rk.o zsytrf_rk.o zsytrf_aa.o zsytrs_3.o zsytri_3.o zsytri_3x.o zsycon_3.o zsysv_rk.o zsysv_aa.o 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 ztrevc3.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o ztrsyl.o ztrsyl3.o ztrti2.o ztrtri.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 zungtsqr.o zungtsqr_row.o zunm2l.o zunm2r.o zunmbr.o zunmhr.o zunml2.o zunm22.o zunmlq.o zunmql.o zunmqr.o zunmr2.o zunmr3.o zunmrq.o zunmrz.o zunmtr.o zupgtr.o zupmtr.o izmax1.o dzsum1.o zstemr.o zcgesv.o zcposv.o zlag2c.o clag2z.o zlat2c.o zhfrk.o ztfttp.o zlanhf.o zpftrf.o zpftri.o zpftrs.o ztfsm.o ztftri.o ztfttr.o ztpttf.o ztpttr.o ztrttf.o ztrttp.o zgeequb.o zgbequb.o zsyequb.o zpoequb.o zheequb.o zbbcsd.o zlapmr.o zunbdb.o zunbdb1.o zunbdb2.o zunbdb3.o zunbdb4.o zunbdb5.o zunbdb6.o zuncsd.o zuncsd2by1.o zgeqrt.o zgeqrt2.o zgeqrt3.o zgemqrt.o ztpqrt.o ztpqrt2.o ztpmqrt.o ztprfb.o ztplqt.o ztplqt2.o ztpmlqt.o zgelqt.o zgelqt3.o zgemlqt.o zgetsls.o zgetsqrhrt.o zgeqr.o zlatsqr.o zlamtsqr.o zgemqr.o zgelq.o zlaswlq.o zlamswlq.o zgemlq.o zunhr_col.o zlaunhr_col_getrfnp.o zlaunhr_col_getrfnp2.o zhetrd_2stage.o zhetrd_he2hb.o zhetrd_hb2st.o zhb2st_kernels.o zheevd_2stage.o zheev_2stage.o zheevx_2stage.o zheevr_2stage.o zhbev_2stage.o zhbevx_2stage.o zhbevd_2stage.o zhegv_2stage.o zgesvdq.o zgedmd.o zgedmdq.o cpotrs.o cgetrs.o cpotrf.o cgetrf.o la_constants.o sbdsdc.o sbdsqr.o sdisna.o slabad.o slacpy.o sladiv.o slae2.o slaebz.o slaed0.o slaed1.o slaed2.o slaed3.o slaed4.o slaed5.o slaed6.o slaed7.o slaed8.o slaed9.o slaeda.o slaev2.o slagtf.o slagts.o slamrg.o slanst.o slapy2.o slapy3.o slarnv.o slarra.o slarrb.o slarrc.o slarrd.o slarre.o slarrf.o slarrj.o slarrk.o slarrr.o slaneg.o slartg.o slaruv.o slas2.o slascl.o slasd0.o slasd1.o slasd2.o slasd3.o slasd4.o slasd5.o slasd6.o slasd7.o slasd8.o slasda.o slasdq.o slasdt.o slaset.o slasq1.o slasq2.o slasq3.o slasq4.o slasq5.o slasq6.o slasr.o slasrt.o slassq.o slasv2.o spttrf.o sstebz.o sstedc.o ssteqr.o ssterf.o slaisnan.o sisnan.o slartgp.o slartgs.o ../INSTALL/sroundup_lwork.o ../INSTALL/second_INT_ETIME.o dbdsdc.o dbdsqr.o ddisna.o dlabad.o dlacpy.o dladiv.o dlae2.o dlaebz.o dlaed0.o dlaed1.o dlaed2.o dlaed3.o dlaed4.o dlaed5.o dlaed6.o dlaed7.o dlaed8.o dlaed9.o dlaeda.o dlaev2.o dlagtf.o dlagts.o dlamrg.o dlanst.o dlapy2.o dlapy3.o dlarnv.o dlarra.o dlarrb.o dlarrc.o dlarrd.o dlarre.o dlarrf.o dlarrj.o dlarrk.o dlarrr.o dlaneg.o dlartg.o dlaruv.o dlas2.o dlascl.o dlasd0.o dlasd1.o dlasd2.o dlasd3.o dlasd4.o dlasd5.o dlasd6.o dlasd7.o dlasd8.o dlasda.o dlasdq.o dlasdt.o dlaset.o dlasq1.o dlasq2.o dlasq3.o dlasq4.o dlasq5.o dlasq6.o dlasr.o dlasrt.o dlassq.o dlasv2.o dpttrf.o dstebz.o dstedc.o dsteqr.o dsterf.o dlaisnan.o disnan.o dlartgp.o dlartgs.o ../INSTALL/droundup_lwork.o ../INSTALL/dlamch.o ../INSTALL/dsecnd_INT_ETIME.o ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o iparam2stage.o la_xisnan.o ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o +ranlib ../liblapack.a +make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' From 4c8684d05bcc1132c23ce3a93fa1ca4c032dcf4b Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Thu, 16 May 2024 10:53:13 +0200 Subject: [PATCH 068/206] current state of testing implementation --- libCompile | 2016 ---------------------------------------------------- 1 file changed, 2016 deletions(-) delete mode 100644 libCompile diff --git a/libCompile b/libCompile deleted file mode 100644 index 44c45e89de..0000000000 --- a/libCompile +++ /dev/null @@ -1,2016 +0,0 @@ -make -C SRC -make -C TESTING/MATGEN -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' -gfortran -O2 -frecursive -c -o slatms.o slatms.f -gfortran -O2 -frecursive -c -o slatme.o slatme.f -gfortran -O2 -frecursive -c -o slatmr.o slatmr.f -gfortran -O2 -frecursive -c -o slatmt.o slatmt.f -gfortran -O2 -frecursive -c -o slagge.o slagge.f -gfortran -O2 -frecursive -c -o slagsy.o slagsy.f -gfortran -O2 -frecursive -c -o slakf2.o slakf2.f -gfortran -O2 -frecursive -c -o slarge.o slarge.f -gfortran -O2 -frecursive -c -o slaror.o slaror.f -gfortran -O2 -frecursive -c -o slarot.o slarot.f -gfortran -O2 -frecursive -c -o slatm2.o slatm2.f -make[1]: Entering directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' -gfortran -O2 -frecursive -c -o sbdsvdx.o sbdsvdx.f -gfortran -O2 -frecursive -c -o spotrf2.o spotrf2.f -gfortran -O2 -frecursive -c -o sgetrf2.o sgetrf2.f -gfortran -O2 -frecursive -c -o sgbbrd.o sgbbrd.f -gfortran -O2 -frecursive -c -o sgbcon.o sgbcon.f -gfortran -O2 -frecursive -c -o slatm3.o slatm3.f -gfortran -O2 -frecursive -c -o sgbequ.o sgbequ.f -gfortran -O2 -frecursive -c -o slatm5.o slatm5.f -gfortran -O2 -frecursive -c -o sgbrfs.o sgbrfs.f -gfortran -O2 -frecursive -c -o slatm6.o slatm6.f -gfortran -O2 -frecursive -c -o slahilb.o slahilb.f -gfortran -O2 -frecursive -c -o sgbsv.o sgbsv.f -gfortran -O2 -frecursive -c -o sgbsvx.o sgbsvx.f -gfortran -O2 -frecursive -c -o clatms.o clatms.f -gfortran -O2 -frecursive -c -o clatme.o clatme.f -gfortran -O2 -frecursive -c -o sgbtf2.o sgbtf2.f -gfortran -O2 -frecursive -c -o clatmr.o clatmr.f -gfortran -O2 -frecursive -c -o clatmt.o clatmt.f -gfortran -O2 -frecursive -c -o sgbtrf.o sgbtrf.f -gfortran -O2 -frecursive -c -o clagge.o clagge.f -gfortran -O2 -frecursive -c -o claghe.o claghe.f -gfortran -O2 -frecursive -c -o sgbtrs.o sgbtrs.f -gfortran -O2 -frecursive -c -o sgebak.o sgebak.f -gfortran -O2 -frecursive -c -o clagsy.o clagsy.f -gfortran -O2 -frecursive -c -o clakf2.o clakf2.f -gfortran -O2 -frecursive -c -o clarge.o clarge.f -gfortran -O2 -frecursive -c -o sgebal.o sgebal.f -gfortran -O2 -frecursive -c -o claror.o claror.f -gfortran -O2 -frecursive -c -o sgebd2.o sgebd2.f -gfortran -O2 -frecursive -c -o clarot.o clarot.f -gfortran -O2 -frecursive -c -o clatm1.o clatm1.f -gfortran -O2 -frecursive -c -o sgebrd.o sgebrd.f -gfortran -O2 -frecursive -c -o clarnd.o clarnd.f -gfortran -O2 -frecursive -c -o clatm2.o clatm2.f -gfortran -O2 -frecursive -c -o clatm3.o clatm3.f -gfortran -O2 -frecursive -c -o sgecon.o sgecon.f -gfortran -O2 -frecursive -c -o clatm5.o clatm5.f -gfortran -O2 -frecursive -c -o sgeequ.o sgeequ.f -gfortran -O2 -frecursive -c -o clatm6.o clatm6.f -gfortran -O2 -frecursive -c -o sgees.o sgees.f -gfortran -O2 -frecursive -c -o sgeesx.o sgeesx.f -gfortran -O2 -frecursive -c -o clahilb.o clahilb.f -gfortran -O2 -frecursive -c -o slatm1.o slatm1.f -gfortran -O2 -frecursive -c -o slatm7.o slatm7.f -gfortran -O2 -frecursive -c -o sgeev.o sgeev.f -gfortran -O0 -frecursive -c -o slaran.o slaran.f -gfortran -O2 -frecursive -c -o sgeevx.o sgeevx.f -gfortran -O2 -frecursive -c -o slarnd.o slarnd.f -gfortran -O2 -frecursive -c -o dlatms.o dlatms.f -gfortran -O2 -frecursive -c -o sgehd2.o sgehd2.f -gfortran -O2 -frecursive -c -o sgehrd.o sgehrd.f -gfortran -O2 -frecursive -c -o sgelq2.o sgelq2.f -gfortran -O2 -frecursive -c -o dlatme.o dlatme.f -gfortran -O2 -frecursive -c -o sgelqf.o sgelqf.f -gfortran -O2 -frecursive -c -o dlatmr.o dlatmr.f -gfortran -O2 -frecursive -c -o sgels.o sgels.f -gfortran -O2 -frecursive -c -o dlatmt.o dlatmt.f -gfortran -O2 -frecursive -c -o dlagge.o dlagge.f -gfortran -O2 -frecursive -c -o dlagsy.o dlagsy.f -gfortran -O2 -frecursive -c -o dlakf2.o dlakf2.f -gfortran -O2 -frecursive -c -o dlarge.o dlarge.f -gfortran -O2 -frecursive -c -o sgelst.o sgelst.f -gfortran -O2 -frecursive -c -o dlaror.o dlaror.f -gfortran -O2 -frecursive -c -o dlarot.o dlarot.f -gfortran -O2 -frecursive -c -o dlatm2.o dlatm2.f -gfortran -O2 -frecursive -c -o sgelsd.o sgelsd.f -gfortran -O2 -frecursive -c -o dlatm3.o dlatm3.f -gfortran -O2 -frecursive -c -o sgelss.o sgelss.f -gfortran -O2 -frecursive -c -o dlatm5.o dlatm5.f -gfortran -O2 -frecursive -c -o dlatm6.o dlatm6.f -gfortran -O2 -frecursive -c -o sgelsy.o sgelsy.f -gfortran -O2 -frecursive -c -o dlahilb.o dlahilb.f -gfortran -O2 -frecursive -c -o zlatms.o zlatms.f -gfortran -O2 -frecursive -c -o sgeql2.o sgeql2.f -gfortran -O2 -frecursive -c -o zlatme.o zlatme.f -gfortran -O2 -frecursive -c -o sgeqlf.o sgeqlf.f -gfortran -O2 -frecursive -c -o zlatmr.o zlatmr.f -gfortran -O2 -frecursive -c -o sgeqp3.o sgeqp3.f -gfortran -O2 -frecursive -c -o zlatmt.o zlatmt.f -gfortran -O2 -frecursive -c -o sgeqp3rk.o sgeqp3rk.f -gfortran -O2 -frecursive -c -o zlagge.o zlagge.f -gfortran -O2 -frecursive -c -o zlaghe.o zlaghe.f -gfortran -O2 -frecursive -c -o sgeqr2.o sgeqr2.f -gfortran -O2 -frecursive -c -o zlagsy.o zlagsy.f -gfortran -O2 -frecursive -c -o sgeqr2p.o sgeqr2p.f -gfortran -O2 -frecursive -c -o sgeqrf.o sgeqrf.f -gfortran -O2 -frecursive -c -o zlakf2.o zlakf2.f -gfortran -O2 -frecursive -c -o zlarge.o zlarge.f -gfortran -O2 -frecursive -c -o zlaror.o zlaror.f -gfortran -O2 -frecursive -c -o sgeqrfp.o sgeqrfp.f -gfortran -O2 -frecursive -c -o zlarot.o zlarot.f -gfortran -O2 -frecursive -c -o zlatm1.o zlatm1.f -gfortran -O2 -frecursive -c -o zlarnd.o zlarnd.f -gfortran -O2 -frecursive -c -o sgerfs.o sgerfs.f -gfortran -O2 -frecursive -c -o sgerq2.o sgerq2.f -gfortran -O2 -frecursive -c -o sgerqf.o sgerqf.f -gfortran -O2 -frecursive -c -o zlatm2.o zlatm2.f -gfortran -O2 -frecursive -c -o sgesc2.o sgesc2.f -gfortran -O2 -frecursive -c -o sgesdd.o sgesdd.f -gfortran -O2 -frecursive -c -o zlatm3.o zlatm3.f -gfortran -O2 -frecursive -c -o zlatm5.o zlatm5.f -gfortran -O2 -frecursive -c -o zlatm6.o zlatm6.f -gfortran -O2 -frecursive -c -o sgesv.o sgesv.f -gfortran -O2 -frecursive -c -o zlahilb.o zlahilb.f -gfortran -O2 -frecursive -c -o dlatm1.o dlatm1.f -gfortran -O2 -frecursive -c -o sgesvd.o sgesvd.f -gfortran -O2 -frecursive -c -o dlatm7.o dlatm7.f -gfortran -O0 -frecursive -c -o dlaran.o dlaran.f -gfortran -O2 -frecursive -c -o dlarnd.o dlarnd.f -gfortran -O2 -frecursive -c -o sgesvdx.o sgesvdx.f -gfortran -O2 -frecursive -c -o sgesvx.o sgesvx.f -gfortran -O2 -frecursive -c -o sgetc2.o sgetc2.f -gfortran -O2 -frecursive -c -o sgetf2.o sgetf2.f -gfortran -O2 -frecursive -c -o sgetri.o sgetri.f -gfortran -O2 -frecursive -c -o sggbak.o sggbak.f -gfortran -O2 -frecursive -c -o sggbal.o sggbal.f -gfortran -O2 -frecursive -c -o sgges.o sgges.f -gfortran -O2 -frecursive -c -o sgges3.o sgges3.f -gfortran -O2 -frecursive -c -o sggesx.o sggesx.f -gfortran -O2 -frecursive -c -o sggev.o sggev.f -gfortran -O2 -frecursive -c -o sggev3.o sggev3.f -gfortran -O2 -frecursive -c -o sggevx.o sggevx.f -gfortran -O2 -frecursive -c -o sggglm.o sggglm.f -gfortran -O2 -frecursive -c -o sgghrd.o sgghrd.f -gfortran -O2 -frecursive -c -o sgghd3.o sgghd3.f -gfortran -O2 -frecursive -c -o sgglse.o sgglse.f -gfortran -O2 -frecursive -c -o sggqrf.o sggqrf.f -gfortran -O2 -frecursive -c -o sggrqf.o sggrqf.f -gfortran -O2 -frecursive -c -o sggsvd3.o sggsvd3.f -gfortran -O2 -frecursive -c -o sggsvp3.o sggsvp3.f -gfortran -O2 -frecursive -c -o sgtcon.o sgtcon.f -gfortran -O2 -frecursive -c -o sgtrfs.o sgtrfs.f -gfortran -O2 -frecursive -c -o sgtsv.o sgtsv.f -gfortran -O2 -frecursive -c -o sgtsvx.o sgtsvx.f -gfortran -O2 -frecursive -c -o sgttrf.o sgttrf.f -gfortran -O2 -frecursive -c -o sgttrs.o sgttrs.f -gfortran -O2 -frecursive -c -o sgtts2.o sgtts2.f -gfortran -O2 -frecursive -c -o shgeqz.o shgeqz.f -gfortran -O2 -frecursive -c -o slaqz0.o slaqz0.f -gfortran -O2 -frecursive -c -o slaqz1.o slaqz1.f -gfortran -O2 -frecursive -c -o slaqz2.o slaqz2.f -gfortran -O2 -frecursive -c -o slaqz3.o slaqz3.f -gfortran -O2 -frecursive -c -o slaqz4.o slaqz4.f -gfortran -O2 -frecursive -c -o shsein.o shsein.f -gfortran -O2 -frecursive -c -o shseqr.o shseqr.f -gfortran -O2 -frecursive -c -o slabrd.o slabrd.f -gfortran -O2 -frecursive -c -o slacon.o slacon.f -ar cr ../../libtmglib.a slatms.o slatme.o slatmr.o slatmt.o slagge.o slagsy.o slakf2.o slarge.o slaror.o slarot.o slatm2.o slatm3.o slatm5.o slatm6.o slahilb.o clatms.o clatme.o clatmr.o clatmt.o clagge.o claghe.o clagsy.o clakf2.o clarge.o claror.o clarot.o clatm1.o clarnd.o clatm2.o clatm3.o clatm5.o clatm6.o clahilb.o slatm1.o slatm7.o slaran.o slarnd.o dlatms.o dlatme.o dlatmr.o dlatmt.o dlagge.o dlagsy.o dlakf2.o dlarge.o dlaror.o dlarot.o dlatm2.o dlatm3.o dlatm5.o dlatm6.o dlahilb.o zlatms.o zlatme.o zlatmr.o zlatmt.o zlagge.o zlaghe.o zlagsy.o zlakf2.o zlarge.o zlaror.o zlarot.o zlatm1.o zlarnd.o zlatm2.o zlatm3.o zlatm5.o zlatm6.o zlahilb.o dlatm1.o dlatm7.o dlaran.o dlarnd.o -gfortran -O2 -frecursive -c -o slacn2.o slacn2.f -gfortran -O2 -frecursive -c -o slaein.o slaein.f -gfortran -O2 -frecursive -c -o slaexc.o slaexc.f -ranlib ../../libtmglib.a -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/TESTING/MATGEN' -gfortran -O2 -frecursive -c -o slag2.o slag2.f -gfortran -O2 -frecursive -c -o slags2.o slags2.f -gfortran -O2 -frecursive -c -o slagtm.o slagtm.f -gfortran -O2 -frecursive -c -o slagv2.o slagv2.f -gfortran -O2 -frecursive -c -o slahqr.o slahqr.f -gfortran -O2 -frecursive -c -o slahr2.o slahr2.f -gfortran -O2 -frecursive -c -o slaic1.o slaic1.f -gfortran -O2 -frecursive -c -o slaln2.o slaln2.f -gfortran -O2 -frecursive -c -o slals0.o slals0.f -gfortran -O2 -frecursive -c -o slalsa.o slalsa.f -gfortran -O2 -frecursive -c -o slalsd.o slalsd.f -gfortran -O2 -frecursive -c -o slangb.o slangb.f -gfortran -O2 -frecursive -c -o slange.o slange.f -gfortran -O2 -frecursive -c -o slangt.o slangt.f -gfortran -O2 -frecursive -c -o slanhs.o slanhs.f -gfortran -O2 -frecursive -c -o slansb.o slansb.f -gfortran -O2 -frecursive -c -o slansp.o slansp.f -gfortran -O2 -frecursive -c -o slansy.o slansy.f -gfortran -O2 -frecursive -c -o slantb.o slantb.f -gfortran -O2 -frecursive -c -o slantp.o slantp.f -gfortran -O2 -frecursive -c -o slantr.o slantr.f -gfortran -O2 -frecursive -c -o slanv2.o slanv2.f -gfortran -O2 -frecursive -c -o slapll.o slapll.f -gfortran -O2 -frecursive -c -o slapmt.o slapmt.f -gfortran -O2 -frecursive -c -o slaqgb.o slaqgb.f -gfortran -O2 -frecursive -c -o slaqge.o slaqge.f -gfortran -O2 -frecursive -c -o slaqp2.o slaqp2.f -gfortran -O2 -frecursive -c -o slaqps.o slaqps.f -gfortran -O2 -frecursive -c -o slaqp2rk.o slaqp2rk.f -gfortran -O2 -frecursive -c -o slaqp3rk.o slaqp3rk.f -gfortran -O2 -frecursive -c -o slaqsb.o slaqsb.f -gfortran -O2 -frecursive -c -o slaqsp.o slaqsp.f -gfortran -O2 -frecursive -c -o slaqsy.o slaqsy.f -gfortran -O2 -frecursive -c -o slaqr0.o slaqr0.f -gfortran -O2 -frecursive -c -o slaqr1.o slaqr1.f -gfortran -O2 -frecursive -c -o slaqr2.o slaqr2.f -gfortran -O2 -frecursive -c -o slaqr3.o slaqr3.f -gfortran -O2 -frecursive -c -o slaqr4.o slaqr4.f -gfortran -O2 -frecursive -c -o slaqr5.o slaqr5.f -gfortran -O2 -frecursive -c -o slaqtr.o slaqtr.f -gfortran -O2 -frecursive -c -o slar1v.o slar1v.f -gfortran -O2 -frecursive -c -o slar2v.o slar2v.f -gfortran -O2 -frecursive -c -o ilaslr.o ilaslr.f -gfortran -O2 -frecursive -c -o ilaslc.o ilaslc.f -gfortran -O2 -frecursive -c -o slarf.o slarf.f -gfortran -O2 -frecursive -c -o slarfb.o slarfb.f -gfortran -O2 -frecursive -c -o slarfb_gett.o slarfb_gett.f -gfortran -O2 -frecursive -c -o slarfg.o slarfg.f -gfortran -O2 -frecursive -c -o slarfgp.o slarfgp.f -gfortran -O2 -frecursive -c -o slarft.o slarft.f -gfortran -O2 -frecursive -c -o slarfx.o slarfx.f -gfortran -O2 -frecursive -c -o slarfy.o slarfy.f -gfortran -O2 -frecursive -c -o slargv.o slargv.f -gfortran -O2 -frecursive -c -o slarmm.o slarmm.f -gfortran -O2 -frecursive -c -o slarrv.o slarrv.f -gfortran -O2 -frecursive -c -o slartv.o slartv.f -gfortran -O2 -frecursive -c -o slarz.o slarz.f -gfortran -O2 -frecursive -c -o slarzb.o slarzb.f -gfortran -O2 -frecursive -c -o slarzt.o slarzt.f -gfortran -O2 -frecursive -c -o slaswp.o slaswp.f -gfortran -O2 -frecursive -c -o slasy2.o slasy2.f -gfortran -O2 -frecursive -c -o slasyf.o slasyf.f -gfortran -O2 -frecursive -c -o slasyf_rook.o slasyf_rook.f -gfortran -O2 -frecursive -c -o slasyf_rk.o slasyf_rk.f -gfortran -O2 -frecursive -c -o slatbs.o slatbs.f -gfortran -O2 -frecursive -c -o slatdf.o slatdf.f -gfortran -O2 -frecursive -c -o slatps.o slatps.f -gfortran -O2 -frecursive -c -o slatrd.o slatrd.f -gfortran -O2 -frecursive -c -o slatrs.o slatrs.f -gfortran -O2 -frecursive -c -o slatrs3.o slatrs3.f -gfortran -O2 -frecursive -c -o slatrz.o slatrz.f -gfortran -O2 -frecursive -c -o slauu2.o slauu2.f -gfortran -O2 -frecursive -c -o slauum.o slauum.f -gfortran -O2 -frecursive -c -o sopgtr.o sopgtr.f -gfortran -O2 -frecursive -c -o sopmtr.o sopmtr.f -gfortran -O2 -frecursive -c -o sorg2l.o sorg2l.f -gfortran -O2 -frecursive -c -o sorg2r.o sorg2r.f -gfortran -O2 -frecursive -c -o sorgbr.o sorgbr.f -gfortran -O2 -frecursive -c -o sorghr.o sorghr.f -gfortran -O2 -frecursive -c -o sorgl2.o sorgl2.f -gfortran -O2 -frecursive -c -o sorglq.o sorglq.f -gfortran -O2 -frecursive -c -o sorgql.o sorgql.f -gfortran -O2 -frecursive -c -o sorgqr.o sorgqr.f -gfortran -O2 -frecursive -c -o sorgr2.o sorgr2.f -gfortran -O2 -frecursive -c -o sorgrq.o sorgrq.f -gfortran -O2 -frecursive -c -o sorgtr.o sorgtr.f -gfortran -O2 -frecursive -c -o sorgtsqr.o sorgtsqr.f -gfortran -O2 -frecursive -c -o sorgtsqr_row.o sorgtsqr_row.f -gfortran -O2 -frecursive -c -o sorm2l.o sorm2l.f -gfortran -O2 -frecursive -c -o sorm2r.o sorm2r.f -gfortran -O2 -frecursive -c -o sorm22.o sorm22.f -gfortran -O2 -frecursive -c -o sormbr.o sormbr.f -gfortran -O2 -frecursive -c -o sormhr.o sormhr.f -gfortran -O2 -frecursive -c -o sorml2.o sorml2.f -gfortran -O2 -frecursive -c -o sormlq.o sormlq.f -gfortran -O2 -frecursive -c -o sormql.o sormql.f -gfortran -O2 -frecursive -c -o sormqr.o sormqr.f -gfortran -O2 -frecursive -c -o sormr2.o sormr2.f -gfortran -O2 -frecursive -c -o sormr3.o sormr3.f -gfortran -O2 -frecursive -c -o sormrq.o sormrq.f -gfortran -O2 -frecursive -c -o sormrz.o sormrz.f -gfortran -O2 -frecursive -c -o sormtr.o sormtr.f -gfortran -O2 -frecursive -c -o spbcon.o spbcon.f -gfortran -O2 -frecursive -c -o spbequ.o spbequ.f -gfortran -O2 -frecursive -c -o spbrfs.o spbrfs.f -gfortran -O2 -frecursive -c -o spbstf.o spbstf.f -gfortran -O2 -frecursive -c -o spbsv.o spbsv.f -gfortran -O2 -frecursive -c -o spbsvx.o spbsvx.f -gfortran -O2 -frecursive -c -o spbtf2.o spbtf2.f -gfortran -O2 -frecursive -c -o spbtrf.o spbtrf.f -gfortran -O2 -frecursive -c -o spbtrs.o spbtrs.f -gfortran -O2 -frecursive -c -o spocon.o spocon.f -gfortran -O2 -frecursive -c -o spoequ.o spoequ.f -gfortran -O2 -frecursive -c -o sporfs.o sporfs.f -gfortran -O2 -frecursive -c -o sposv.o sposv.f -gfortran -O2 -frecursive -c -o sposvx.o sposvx.f -gfortran -O2 -frecursive -c -o spotf2.o spotf2.f -gfortran -O2 -frecursive -c -o spotri.o spotri.f -gfortran -O2 -frecursive -c -o spstrf.o spstrf.f -gfortran -O2 -frecursive -c -o spstf2.o spstf2.f -gfortran -O2 -frecursive -c -o sppcon.o sppcon.f -gfortran -O2 -frecursive -c -o sppequ.o sppequ.f -gfortran -O2 -frecursive -c -o spprfs.o spprfs.f -gfortran -O2 -frecursive -c -o sppsv.o sppsv.f -gfortran -O2 -frecursive -c -o sppsvx.o sppsvx.f -gfortran -O2 -frecursive -c -o spptrf.o spptrf.f -gfortran -O2 -frecursive -c -o spptri.o spptri.f -gfortran -O2 -frecursive -c -o spptrs.o spptrs.f -gfortran -O2 -frecursive -c -o sptcon.o sptcon.f -gfortran -O2 -frecursive -c -o spteqr.o spteqr.f -gfortran -O2 -frecursive -c -o sptrfs.o sptrfs.f -gfortran -O2 -frecursive -c -o sptsv.o sptsv.f -gfortran -O2 -frecursive -c -o sptsvx.o sptsvx.f -gfortran -O2 -frecursive -c -o spttrs.o spttrs.f -gfortran -O2 -frecursive -c -o sptts2.o sptts2.f -gfortran -O2 -frecursive -c -o srscl.o srscl.f -gfortran -O2 -frecursive -c -o ssbev.o ssbev.f -gfortran -O2 -frecursive -c -o ssbevd.o ssbevd.f -gfortran -O2 -frecursive -c -o ssbevx.o ssbevx.f -gfortran -O2 -frecursive -c -o ssbgst.o ssbgst.f -gfortran -O2 -frecursive -c -o ssbgv.o ssbgv.f -gfortran -O2 -frecursive -c -o ssbgvd.o ssbgvd.f -gfortran -O2 -frecursive -c -o ssbgvx.o ssbgvx.f -gfortran -O2 -frecursive -c -o ssbtrd.o ssbtrd.f -gfortran -O2 -frecursive -c -o sspcon.o sspcon.f -gfortran -O2 -frecursive -c -o sspev.o sspev.f -gfortran -O2 -frecursive -c -o sspevd.o sspevd.f -gfortran -O2 -frecursive -c -o sspevx.o sspevx.f -gfortran -O2 -frecursive -c -o sspgst.o sspgst.f -gfortran -O2 -frecursive -c -o sspgv.o sspgv.f -gfortran -O2 -frecursive -c -o sspgvd.o sspgvd.f -gfortran -O2 -frecursive -c -o sspgvx.o sspgvx.f -gfortran -O2 -frecursive -c -o ssprfs.o ssprfs.f -gfortran -O2 -frecursive -c -o sspsv.o sspsv.f -gfortran -O2 -frecursive -c -o sspsvx.o sspsvx.f -gfortran -O2 -frecursive -c -o ssptrd.o ssptrd.f -gfortran -O2 -frecursive -c -o ssptrf.o ssptrf.f -gfortran -O2 -frecursive -c -o ssptri.o ssptri.f -gfortran -O2 -frecursive -c -o ssptrs.o ssptrs.f -gfortran -O2 -frecursive -c -o sstegr.o sstegr.f -gfortran -O2 -frecursive -c -o sstein.o sstein.f -gfortran -O2 -frecursive -c -o sstev.o sstev.f -gfortran -O2 -frecursive -c -o sstevd.o sstevd.f -gfortran -O2 -frecursive -c -o sstevr.o sstevr.f -gfortran -O2 -frecursive -c -o sstevx.o sstevx.f -gfortran -O2 -frecursive -c -o ssycon.o ssycon.f -gfortran -O2 -frecursive -c -o ssyev.o ssyev.f -gfortran -O2 -frecursive -c -o ssyevd.o ssyevd.f -gfortran -O2 -frecursive -c -o ssyevr.o ssyevr.f -gfortran -O2 -frecursive -c -o ssyevx.o ssyevx.f -gfortran -O2 -frecursive -c -o ssygs2.o ssygs2.f -gfortran -O2 -frecursive -c -o ssygst.o ssygst.f -gfortran -O2 -frecursive -c -o ssygv.o ssygv.f -gfortran -O2 -frecursive -c -o ssygvd.o ssygvd.f -gfortran -O2 -frecursive -c -o ssygvx.o ssygvx.f -gfortran -O2 -frecursive -c -o ssyrfs.o ssyrfs.f -gfortran -O2 -frecursive -c -o ssysv.o ssysv.f -gfortran -O2 -frecursive -c -o ssysvx.o ssysvx.f -gfortran -O2 -frecursive -c -o ssytd2.o ssytd2.f -gfortran -O2 -frecursive -c -o ssytf2.o ssytf2.f -gfortran -O2 -frecursive -c -o ssytrd.o ssytrd.f -gfortran -O2 -frecursive -c -o ssytrf.o ssytrf.f -gfortran -O2 -frecursive -c -o ssytri.o ssytri.f -gfortran -O2 -frecursive -c -o ssytri2.o ssytri2.f -gfortran -O2 -frecursive -c -o ssytri2x.o ssytri2x.f -gfortran -O2 -frecursive -c -o ssyswapr.o ssyswapr.f -gfortran -O2 -frecursive -c -o ssytrs.o ssytrs.f -gfortran -O2 -frecursive -c -o ssytrs2.o ssytrs2.f -gfortran -O2 -frecursive -c -o ssyconv.o ssyconv.f -gfortran -O2 -frecursive -c -o ssyconvf.o ssyconvf.f -gfortran -O2 -frecursive -c -o ssyconvf_rook.o ssyconvf_rook.f -gfortran -O2 -frecursive -c -o ssytf2_rook.o ssytf2_rook.f -gfortran -O2 -frecursive -c -o ssytrf_rook.o ssytrf_rook.f -gfortran -O2 -frecursive -c -o ssytrs_rook.o ssytrs_rook.f -gfortran -O2 -frecursive -c -o ssytri_rook.o ssytri_rook.f -gfortran -O2 -frecursive -c -o ssycon_rook.o ssycon_rook.f -gfortran -O2 -frecursive -c -o ssysv_rook.o ssysv_rook.f -gfortran -O2 -frecursive -c -o ssytf2_rk.o ssytf2_rk.f -gfortran -O2 -frecursive -c -o ssytrf_rk.o ssytrf_rk.f -gfortran -O2 -frecursive -c -o ssytrs_3.o ssytrs_3.f -gfortran -O2 -frecursive -c -o ssytri_3.o ssytri_3.f -gfortran -O2 -frecursive -c -o ssytri_3x.o ssytri_3x.f -gfortran -O2 -frecursive -c -o ssycon_3.o ssycon_3.f -gfortran -O2 -frecursive -c -o ssysv_rk.o ssysv_rk.f -gfortran -O2 -frecursive -c -o slasyf_aa.o slasyf_aa.f -gfortran -O2 -frecursive -c -o ssysv_aa.o ssysv_aa.f -gfortran -O2 -frecursive -c -o ssytrf_aa.o ssytrf_aa.f -gfortran -O2 -frecursive -c -o ssytrs_aa.o ssytrs_aa.f -gfortran -O2 -frecursive -c -o ssysv_aa_2stage.o ssysv_aa_2stage.f -gfortran -O2 -frecursive -c -o ssytrf_aa_2stage.o ssytrf_aa_2stage.f -gfortran -O2 -frecursive -c -o ssytrs_aa_2stage.o ssytrs_aa_2stage.f -gfortran -O2 -frecursive -c -o stbcon.o stbcon.f -gfortran -O2 -frecursive -c -o stbrfs.o stbrfs.f -gfortran -O2 -frecursive -c -o stbtrs.o stbtrs.f -gfortran -O2 -frecursive -c -o stgevc.o stgevc.f -gfortran -O2 -frecursive -c -o stgex2.o stgex2.f -gfortran -O2 -frecursive -c -o stgexc.o stgexc.f -gfortran -O2 -frecursive -c -o stgsen.o stgsen.f -gfortran -O2 -frecursive -c -o stgsja.o stgsja.f -gfortran -O2 -frecursive -c -o stgsna.o stgsna.f -gfortran -O2 -frecursive -c -o stgsy2.o stgsy2.f -gfortran -O2 -frecursive -c -o stgsyl.o stgsyl.f -gfortran -O2 -frecursive -c -o stpcon.o stpcon.f -gfortran -O2 -frecursive -c -o stprfs.o stprfs.f -gfortran -O2 -frecursive -c -o stptri.o stptri.f -gfortran -O2 -frecursive -c -o stptrs.o stptrs.f -gfortran -O2 -frecursive -c -o strcon.o strcon.f -gfortran -O2 -frecursive -c -o strevc.o strevc.f -gfortran -O2 -frecursive -c -o strevc3.o strevc3.f -gfortran -O2 -frecursive -c -o strexc.o strexc.f -gfortran -O2 -frecursive -c -o strrfs.o strrfs.f -gfortran -O2 -frecursive -c -o strsen.o strsen.f -gfortran -O2 -frecursive -c -o strsna.o strsna.f -gfortran -O2 -frecursive -c -o strsyl.o strsyl.f -gfortran -O2 -frecursive -c -o strsyl3.o strsyl3.f -gfortran -O2 -frecursive -c -o strti2.o strti2.f -gfortran -O2 -frecursive -c -o strtri.o strtri.f -gfortran -O2 -frecursive -c -o strtrs.o strtrs.f -gfortran -O2 -frecursive -c -o stzrzf.o stzrzf.f -gfortran -O2 -frecursive -c -o sstemr.o sstemr.f -gfortran -O2 -frecursive -c -o slansf.o slansf.f -gfortran -O2 -frecursive -c -o spftrf.o spftrf.f -gfortran -O2 -frecursive -c -o spftri.o spftri.f -gfortran -O2 -frecursive -c -o spftrs.o spftrs.f -gfortran -O2 -frecursive -c -o ssfrk.o ssfrk.f -gfortran -O2 -frecursive -c -o stfsm.o stfsm.f -gfortran -O2 -frecursive -c -o stftri.o stftri.f -gfortran -O2 -frecursive -c -o stfttp.o stfttp.f -gfortran -O2 -frecursive -c -o stfttr.o stfttr.f -gfortran -O2 -frecursive -c -o stpttf.o stpttf.f -gfortran -O2 -frecursive -c -o stpttr.o stpttr.f -gfortran -O2 -frecursive -c -o strttf.o strttf.f -gfortran -O2 -frecursive -c -o strttp.o strttp.f -gfortran -O2 -frecursive -c -o sgejsv.o sgejsv.f -gfortran -O2 -frecursive -c -o sgesvj.o sgesvj.f -gfortran -O2 -frecursive -c -o sgsvj0.o sgsvj0.f -gfortran -O2 -frecursive -c -o sgsvj1.o sgsvj1.f -gfortran -O2 -frecursive -c -o sgeequb.o sgeequb.f -gfortran -O2 -frecursive -c -o ssyequb.o ssyequb.f -gfortran -O2 -frecursive -c -o spoequb.o spoequb.f -gfortran -O2 -frecursive -c -o sgbequb.o sgbequb.f -gfortran -O2 -frecursive -c -o sbbcsd.o sbbcsd.f -gfortran -O2 -frecursive -c -o slapmr.o slapmr.f -gfortran -O2 -frecursive -c -o sorbdb.o sorbdb.f -gfortran -O2 -frecursive -c -o sorbdb1.o sorbdb1.f -gfortran -O2 -frecursive -c -o sorbdb2.o sorbdb2.f -gfortran -O2 -frecursive -c -o sorbdb3.o sorbdb3.f -gfortran -O2 -frecursive -c -o sorbdb4.o sorbdb4.f -gfortran -O2 -frecursive -c -o sorbdb5.o sorbdb5.f -gfortran -O2 -frecursive -c -o sorbdb6.o sorbdb6.f -gfortran -O2 -frecursive -c -o sorcsd.o sorcsd.f -gfortran -O2 -frecursive -c -o sorcsd2by1.o sorcsd2by1.f -gfortran -O2 -frecursive -c -o sgeqrt.o sgeqrt.f -gfortran -O2 -frecursive -c -o sgeqrt2.o sgeqrt2.f -gfortran -O2 -frecursive -c -o sgeqrt3.o sgeqrt3.f -gfortran -O2 -frecursive -c -o sgemqrt.o sgemqrt.f -gfortran -O2 -frecursive -c -o stpqrt.o stpqrt.f -gfortran -O2 -frecursive -c -o stpqrt2.o stpqrt2.f -gfortran -O2 -frecursive -c -o stpmqrt.o stpmqrt.f -gfortran -O2 -frecursive -c -o stprfb.o stprfb.f -gfortran -O2 -frecursive -c -o sgelqt.o sgelqt.f -gfortran -O2 -frecursive -c -o sgelqt3.o sgelqt3.f -gfortran -O2 -frecursive -c -o sgemlqt.o sgemlqt.f -gfortran -O2 -frecursive -c -o sgetsls.o sgetsls.f -gfortran -O2 -frecursive -c -o sgetsqrhrt.o sgetsqrhrt.f -gfortran -O2 -frecursive -c -o sgeqr.o sgeqr.f -gfortran -O2 -frecursive -c -o slatsqr.o slatsqr.f -gfortran -O2 -frecursive -c -o slamtsqr.o slamtsqr.f -gfortran -O2 -frecursive -c -o sgemqr.o sgemqr.f -gfortran -O2 -frecursive -c -o sgelq.o sgelq.f -gfortran -O2 -frecursive -c -o slaswlq.o slaswlq.f -gfortran -O2 -frecursive -c -o slamswlq.o slamswlq.f -gfortran -O2 -frecursive -c -o sgemlq.o sgemlq.f -gfortran -O2 -frecursive -c -o stplqt.o stplqt.f -gfortran -O2 -frecursive -c -o stplqt2.o stplqt2.f -gfortran -O2 -frecursive -c -o stpmlqt.o stpmlqt.f -gfortran -O2 -frecursive -c -o sorhr_col.o sorhr_col.f -gfortran -O2 -frecursive -c -o slaorhr_col_getrfnp.o slaorhr_col_getrfnp.f -gfortran -O2 -frecursive -c -o slaorhr_col_getrfnp2.o slaorhr_col_getrfnp2.f -gfortran -O2 -frecursive -c -o ssytrd_2stage.o ssytrd_2stage.f -gfortran -O2 -frecursive -c -o ssytrd_sy2sb.o ssytrd_sy2sb.f -gfortran -O2 -frecursive -c -o ssytrd_sb2st.o ssytrd_sb2st.F -gfortran -O2 -frecursive -c -o ssb2st_kernels.o ssb2st_kernels.f -gfortran -O2 -frecursive -c -o ssyevd_2stage.o ssyevd_2stage.f -gfortran -O2 -frecursive -c -o ssyev_2stage.o ssyev_2stage.f -gfortran -O2 -frecursive -c -o ssyevx_2stage.o ssyevx_2stage.f -gfortran -O2 -frecursive -c -o ssyevr_2stage.o ssyevr_2stage.f -gfortran -O2 -frecursive -c -o ssbev_2stage.o ssbev_2stage.f -gfortran -O2 -frecursive -c -o ssbevx_2stage.o ssbevx_2stage.f -gfortran -O2 -frecursive -c -o ssbevd_2stage.o ssbevd_2stage.f -gfortran -O2 -frecursive -c -o ssygv_2stage.o ssygv_2stage.f -gfortran -O2 -frecursive -c -o sgesvdq.o sgesvdq.f -gfortran -O2 -frecursive -c -o la_constants.o la_constants.f90 -gfortran -O2 -frecursive -c -o dpotrf2.o dpotrf2.f -gfortran -O2 -frecursive -c -o dgetrf2.o dgetrf2.f -gfortran -O2 -frecursive -c -o dbdsvdx.o dbdsvdx.f -gfortran -O2 -frecursive -c -o dgbbrd.o dgbbrd.f -gfortran -O2 -frecursive -c -o dgbcon.o dgbcon.f -gfortran -O2 -frecursive -c -o dgbequ.o dgbequ.f -gfortran -O2 -frecursive -c -o dgbrfs.o dgbrfs.f -gfortran -O2 -frecursive -c -o dgbsv.o dgbsv.f -gfortran -O2 -frecursive -c -o dgbsvx.o dgbsvx.f -gfortran -O2 -frecursive -c -o dgbtf2.o dgbtf2.f -gfortran -O2 -frecursive -c -o dgbtrf.o dgbtrf.f -gfortran -O2 -frecursive -c -o dgbtrs.o dgbtrs.f -gfortran -O2 -frecursive -c -o dgebak.o dgebak.f -gfortran -O2 -frecursive -c -o dgebal.o dgebal.f -gfortran -O2 -frecursive -c -o dgebd2.o dgebd2.f -gfortran -O2 -frecursive -c -o dgebrd.o dgebrd.f -gfortran -O2 -frecursive -c -o dgecon.o dgecon.f -gfortran -O2 -frecursive -c -o dgeequ.o dgeequ.f -gfortran -O2 -frecursive -c -o dgees.o dgees.f -gfortran -O2 -frecursive -c -o dgeesx.o dgeesx.f -gfortran -O2 -frecursive -c -o dgeev.o dgeev.f -gfortran -O2 -frecursive -c -o dgeevx.o dgeevx.f -gfortran -O2 -frecursive -c -o dgehd2.o dgehd2.f -gfortran -O2 -frecursive -c -o dgehrd.o dgehrd.f -gfortran -O2 -frecursive -c -o dgelq2.o dgelq2.f -gfortran -O2 -frecursive -c -o dgelqf.o dgelqf.f -gfortran -O2 -frecursive -c -o dgels.o dgels.f -gfortran -O2 -frecursive -c -o dgelst.o dgelst.f -gfortran -O2 -frecursive -c -o dgelsd.o dgelsd.f -gfortran -O2 -frecursive -c -o dgelss.o dgelss.f -gfortran -O2 -frecursive -c -o dgelsy.o dgelsy.f -gfortran -O2 -frecursive -c -o dgeql2.o dgeql2.f -gfortran -O2 -frecursive -c -o dgeqlf.o dgeqlf.f -gfortran -O2 -frecursive -c -o dgeqp3.o dgeqp3.f -gfortran -O2 -frecursive -c -o dgeqp3rk.o dgeqp3rk.f -gfortran -O2 -frecursive -c -o dgeqr2.o dgeqr2.f -gfortran -O2 -frecursive -c -o dgeqr2p.o dgeqr2p.f -gfortran -O2 -frecursive -c -o dgeqrf.o dgeqrf.f -gfortran -O2 -frecursive -c -o dgeqrfp.o dgeqrfp.f -gfortran -O2 -frecursive -c -o dgerfs.o dgerfs.f -gfortran -O2 -frecursive -c -o dgerq2.o dgerq2.f -gfortran -O2 -frecursive -c -o dgerqf.o dgerqf.f -gfortran -O2 -frecursive -c -o dgesc2.o dgesc2.f -gfortran -O2 -frecursive -c -o dgesdd.o dgesdd.f -gfortran -O2 -frecursive -c -o dgesv.o dgesv.f -gfortran -O2 -frecursive -c -o dgesvd.o dgesvd.f -gfortran -O2 -frecursive -c -o dgesvdx.o dgesvdx.f -gfortran -O2 -frecursive -c -o dgesvx.o dgesvx.f -gfortran -O2 -frecursive -c -o dgetc2.o dgetc2.f -gfortran -O2 -frecursive -c -o dgetf2.o dgetf2.f -gfortran -O2 -frecursive -c -o dgetrf.o dgetrf.f -gfortran -O2 -frecursive -c -o dgetri.o dgetri.f -gfortran -O2 -frecursive -c -o dgetrs.o dgetrs.f -gfortran -O2 -frecursive -c -o dggbak.o dggbak.f -gfortran -O2 -frecursive -c -o dggbal.o dggbal.f -gfortran -O2 -frecursive -c -o dgges.o dgges.f -gfortran -O2 -frecursive -c -o dgges3.o dgges3.f -gfortran -O2 -frecursive -c -o dggesx.o dggesx.f -gfortran -O2 -frecursive -c -o dggev.o dggev.f -gfortran -O2 -frecursive -c -o dggev3.o dggev3.f -gfortran -O2 -frecursive -c -o dggevx.o dggevx.f -gfortran -O2 -frecursive -c -o dggglm.o dggglm.f -gfortran -O2 -frecursive -c -o dgghrd.o dgghrd.f -gfortran -O2 -frecursive -c -o dgghd3.o dgghd3.f -gfortran -O2 -frecursive -c -o dgglse.o dgglse.f -gfortran -O2 -frecursive -c -o dggqrf.o dggqrf.f -gfortran -O2 -frecursive -c -o dggrqf.o dggrqf.f -gfortran -O2 -frecursive -c -o dggsvd3.o dggsvd3.f -gfortran -O2 -frecursive -c -o dggsvp3.o dggsvp3.f -gfortran -O2 -frecursive -c -o dgtcon.o dgtcon.f -gfortran -O2 -frecursive -c -o dgtrfs.o dgtrfs.f -gfortran -O2 -frecursive -c -o dgtsv.o dgtsv.f -gfortran -O2 -frecursive -c -o dgtsvx.o dgtsvx.f -gfortran -O2 -frecursive -c -o dgttrf.o dgttrf.f -gfortran -O2 -frecursive -c -o dgttrs.o dgttrs.f -gfortran -O2 -frecursive -c -o dgtts2.o dgtts2.f -gfortran -O2 -frecursive -c -o dhgeqz.o dhgeqz.f -gfortran -O2 -frecursive -c -o dlaqz0.o dlaqz0.f -gfortran -O2 -frecursive -c -o dlaqz1.o dlaqz1.f -gfortran -O2 -frecursive -c -o dlaqz2.o dlaqz2.f -gfortran -O2 -frecursive -c -o dlaqz3.o dlaqz3.f -gfortran -O2 -frecursive -c -o dlaqz4.o dlaqz4.f -gfortran -O2 -frecursive -c -o dhsein.o dhsein.f -gfortran -O2 -frecursive -c -o dhseqr.o dhseqr.f -gfortran -O2 -frecursive -c -o dlabrd.o dlabrd.f -gfortran -O2 -frecursive -c -o dlacon.o dlacon.f -gfortran -O2 -frecursive -c -o dlacn2.o dlacn2.f -gfortran -O2 -frecursive -c -o dlaein.o dlaein.f -gfortran -O2 -frecursive -c -o dlaexc.o dlaexc.f -gfortran -O2 -frecursive -c -o dlag2.o dlag2.f -gfortran -O2 -frecursive -c -o dlags2.o dlags2.f -gfortran -O2 -frecursive -c -o dlagtm.o dlagtm.f -gfortran -O2 -frecursive -c -o dlagv2.o dlagv2.f -gfortran -O2 -frecursive -c -o dlahqr.o dlahqr.f -gfortran -O2 -frecursive -c -o dlahr2.o dlahr2.f -gfortran -O2 -frecursive -c -o dlaic1.o dlaic1.f -gfortran -O2 -frecursive -c -o dlaln2.o dlaln2.f -gfortran -O2 -frecursive -c -o dlals0.o dlals0.f -gfortran -O2 -frecursive -c -o dlalsa.o dlalsa.f -gfortran -O2 -frecursive -c -o dlalsd.o dlalsd.f -gfortran -O2 -frecursive -c -o dlangb.o dlangb.f -gfortran -O2 -frecursive -c -o dlange.o dlange.f -gfortran -O2 -frecursive -c -o dlangt.o dlangt.f -gfortran -O2 -frecursive -c -o dlanhs.o dlanhs.f -gfortran -O2 -frecursive -c -o dlansb.o dlansb.f -gfortran -O2 -frecursive -c -o dlansp.o dlansp.f -gfortran -O2 -frecursive -c -o dlansy.o dlansy.f -gfortran -O2 -frecursive -c -o dlantb.o dlantb.f -gfortran -O2 -frecursive -c -o dlantp.o dlantp.f -gfortran -O2 -frecursive -c -o dlantr.o dlantr.f -gfortran -O2 -frecursive -c -o dlanv2.o dlanv2.f -gfortran -O2 -frecursive -c -o dlapll.o dlapll.f -gfortran -O2 -frecursive -c -o dlapmt.o dlapmt.f -gfortran -O2 -frecursive -c -o dlaqgb.o dlaqgb.f -gfortran -O2 -frecursive -c -o dlaqge.o dlaqge.f -gfortran -O2 -frecursive -c -o dlaqp2.o dlaqp2.f -gfortran -O2 -frecursive -c -o dlaqps.o dlaqps.f -gfortran -O2 -frecursive -c -o dlaqp2rk.o dlaqp2rk.f -gfortran -O2 -frecursive -c -o dlaqp3rk.o dlaqp3rk.f -gfortran -O2 -frecursive -c -o dlaqsb.o dlaqsb.f -gfortran -O2 -frecursive -c -o dlaqsp.o dlaqsp.f -gfortran -O2 -frecursive -c -o dlaqsy.o dlaqsy.f -gfortran -O2 -frecursive -c -o dlaqr0.o dlaqr0.f -gfortran -O2 -frecursive -c -o dlaqr1.o dlaqr1.f -gfortran -O2 -frecursive -c -o dlaqr2.o dlaqr2.f -gfortran -O2 -frecursive -c -o dlaqr3.o dlaqr3.f -gfortran -O2 -frecursive -c -o dlaqr4.o dlaqr4.f -gfortran -O2 -frecursive -c -o dlaqr5.o dlaqr5.f -gfortran -O2 -frecursive -c -o dlaqtr.o dlaqtr.f -gfortran -O2 -frecursive -c -o dlar1v.o dlar1v.f -gfortran -O2 -frecursive -c -o dlar2v.o dlar2v.f -gfortran -O2 -frecursive -c -o iladlr.o iladlr.f -gfortran -O2 -frecursive -c -o iladlc.o iladlc.f -gfortran -O2 -frecursive -c -o dlarf.o dlarf.f -gfortran -O2 -frecursive -c -o dlarf1.o dlarf1.f -gfortran -O2 -frecursive -c -o dlarfb.o dlarfb.f -gfortran -O2 -frecursive -c -o dlarfb_gett.o dlarfb_gett.f -gfortran -O2 -frecursive -c -o dlarfg.o dlarfg.f -gfortran -O2 -frecursive -c -o dlarfgp.o dlarfgp.f -gfortran -O2 -frecursive -c -o dlarft.o dlarft.f -gfortran -O2 -frecursive -c -o dlarfx.o dlarfx.f -gfortran -O2 -frecursive -c -o dlarfy.o dlarfy.f -gfortran -O2 -frecursive -c -o dlargv.o dlargv.f -gfortran -O2 -frecursive -c -o dlarmm.o dlarmm.f -gfortran -O2 -frecursive -c -o dlarrv.o dlarrv.f -gfortran -O2 -frecursive -c -o dlartv.o dlartv.f -gfortran -O2 -frecursive -c -o dlarz.o dlarz.f -gfortran -O2 -frecursive -c -o dlarzb.o dlarzb.f -gfortran -O2 -frecursive -c -o dlarzt.o dlarzt.f -gfortran -O2 -frecursive -c -o dlaswp.o dlaswp.f -gfortran -O2 -frecursive -c -o dlasy2.o dlasy2.f -gfortran -O2 -frecursive -c -o dlasyf.o dlasyf.f -gfortran -O2 -frecursive -c -o dlasyf_rook.o dlasyf_rook.f -gfortran -O2 -frecursive -c -o dlasyf_rk.o dlasyf_rk.f -gfortran -O2 -frecursive -c -o dlatbs.o dlatbs.f -gfortran -O2 -frecursive -c -o dlatdf.o dlatdf.f -gfortran -O2 -frecursive -c -o dlatps.o dlatps.f -gfortran -O2 -frecursive -c -o dlatrd.o dlatrd.f -gfortran -O2 -frecursive -c -o dlatrs.o dlatrs.f -gfortran -O2 -frecursive -c -o dlatrs3.o dlatrs3.f -gfortran -O2 -frecursive -c -o dlatrz.o dlatrz.f -gfortran -O2 -frecursive -c -o dlauu2.o dlauu2.f -gfortran -O2 -frecursive -c -o dlauum.o dlauum.f -gfortran -O2 -frecursive -c -o dopgtr.o dopgtr.f -gfortran -O2 -frecursive -c -o dopmtr.o dopmtr.f -gfortran -O2 -frecursive -c -o dorg2l.o dorg2l.f -gfortran -O2 -frecursive -c -o dorg2r.o dorg2r.f -gfortran -O2 -frecursive -c -o dorgbr.o dorgbr.f -gfortran -O2 -frecursive -c -o dorghr.o dorghr.f -gfortran -O2 -frecursive -c -o dorgl2.o dorgl2.f -gfortran -O2 -frecursive -c -o dorglq.o dorglq.f -gfortran -O2 -frecursive -c -o dorgql.o dorgql.f -gfortran -O2 -frecursive -c -o dorgqr.o dorgqr.f -gfortran -O2 -frecursive -c -o dorgr2.o dorgr2.f -gfortran -O2 -frecursive -c -o dorgrq.o dorgrq.f -gfortran -O2 -frecursive -c -o dorgtr.o dorgtr.f -gfortran -O2 -frecursive -c -o dorgtsqr.o dorgtsqr.f -gfortran -O2 -frecursive -c -o dorgtsqr_row.o dorgtsqr_row.f -gfortran -O2 -frecursive -c -o dorm2l.o dorm2l.f -gfortran -O2 -frecursive -c -o dorm2r.o dorm2r.f -gfortran -O2 -frecursive -c -o dorm22.o dorm22.f -gfortran -O2 -frecursive -c -o dormbr.o dormbr.f -gfortran -O2 -frecursive -c -o dormhr.o dormhr.f -gfortran -O2 -frecursive -c -o dorml2.o dorml2.f -gfortran -O2 -frecursive -c -o dormlq.o dormlq.f -gfortran -O2 -frecursive -c -o dormql.o dormql.f -gfortran -O2 -frecursive -c -o dormqr.o dormqr.f -gfortran -O2 -frecursive -c -o dormr2.o dormr2.f -gfortran -O2 -frecursive -c -o dormr3.o dormr3.f -gfortran -O2 -frecursive -c -o dormrq.o dormrq.f -gfortran -O2 -frecursive -c -o dormrz.o dormrz.f -gfortran -O2 -frecursive -c -o dormtr.o dormtr.f -gfortran -O2 -frecursive -c -o dpbcon.o dpbcon.f -gfortran -O2 -frecursive -c -o dpbequ.o dpbequ.f -gfortran -O2 -frecursive -c -o dpbrfs.o dpbrfs.f -gfortran -O2 -frecursive -c -o dpbstf.o dpbstf.f -gfortran -O2 -frecursive -c -o dpbsv.o dpbsv.f -gfortran -O2 -frecursive -c -o dpbsvx.o dpbsvx.f -gfortran -O2 -frecursive -c -o dpbtf2.o dpbtf2.f -gfortran -O2 -frecursive -c -o dpbtrf.o dpbtrf.f -gfortran -O2 -frecursive -c -o dpbtrs.o dpbtrs.f -gfortran -O2 -frecursive -c -o dpocon.o dpocon.f -gfortran -O2 -frecursive -c -o dpoequ.o dpoequ.f -gfortran -O2 -frecursive -c -o dporfs.o dporfs.f -gfortran -O2 -frecursive -c -o dposv.o dposv.f -gfortran -O2 -frecursive -c -o dposvx.o dposvx.f -gfortran -O2 -frecursive -c -o dpotf2.o dpotf2.f -gfortran -O2 -frecursive -c -o dpotrf.o dpotrf.f -gfortran -O2 -frecursive -c -o dpotri.o dpotri.f -gfortran -O2 -frecursive -c -o dpotrs.o dpotrs.f -gfortran -O2 -frecursive -c -o dpstrf.o dpstrf.f -gfortran -O2 -frecursive -c -o dpstf2.o dpstf2.f -gfortran -O2 -frecursive -c -o dppcon.o dppcon.f -gfortran -O2 -frecursive -c -o dppequ.o dppequ.f -gfortran -O2 -frecursive -c -o dpprfs.o dpprfs.f -gfortran -O2 -frecursive -c -o dppsv.o dppsv.f -gfortran -O2 -frecursive -c -o dppsvx.o dppsvx.f -gfortran -O2 -frecursive -c -o dpptrf.o dpptrf.f -gfortran -O2 -frecursive -c -o dpptri.o dpptri.f -gfortran -O2 -frecursive -c -o dpptrs.o dpptrs.f -gfortran -O2 -frecursive -c -o dptcon.o dptcon.f -gfortran -O2 -frecursive -c -o dpteqr.o dpteqr.f -gfortran -O2 -frecursive -c -o dptrfs.o dptrfs.f -gfortran -O2 -frecursive -c -o dptsv.o dptsv.f -gfortran -O2 -frecursive -c -o dptsvx.o dptsvx.f -gfortran -O2 -frecursive -c -o dpttrs.o dpttrs.f -gfortran -O2 -frecursive -c -o dptts2.o dptts2.f -gfortran -O2 -frecursive -c -o drscl.o drscl.f -gfortran -O2 -frecursive -c -o dsbev.o dsbev.f -gfortran -O2 -frecursive -c -o dsbevd.o dsbevd.f -gfortran -O2 -frecursive -c -o dsbevx.o dsbevx.f -gfortran -O2 -frecursive -c -o dsbgst.o dsbgst.f -gfortran -O2 -frecursive -c -o dsbgv.o dsbgv.f -gfortran -O2 -frecursive -c -o dsbgvd.o dsbgvd.f -gfortran -O2 -frecursive -c -o dsbgvx.o dsbgvx.f -gfortran -O2 -frecursive -c -o dsbtrd.o dsbtrd.f -gfortran -O2 -frecursive -c -o dspcon.o dspcon.f -gfortran -O2 -frecursive -c -o dspev.o dspev.f -gfortran -O2 -frecursive -c -o dspevd.o dspevd.f -gfortran -O2 -frecursive -c -o dspevx.o dspevx.f -gfortran -O2 -frecursive -c -o dspgst.o dspgst.f -gfortran -O2 -frecursive -c -o dspgv.o dspgv.f -gfortran -O2 -frecursive -c -o dspgvd.o dspgvd.f -gfortran -O2 -frecursive -c -o dspgvx.o dspgvx.f -gfortran -O2 -frecursive -c -o dsprfs.o dsprfs.f -gfortran -O2 -frecursive -c -o dspsv.o dspsv.f -gfortran -O2 -frecursive -c -o dspsvx.o dspsvx.f -gfortran -O2 -frecursive -c -o dsptrd.o dsptrd.f -gfortran -O2 -frecursive -c -o dsptrf.o dsptrf.f -gfortran -O2 -frecursive -c -o dsptri.o dsptri.f -gfortran -O2 -frecursive -c -o dsptrs.o dsptrs.f -gfortran -O2 -frecursive -c -o dstegr.o dstegr.f -gfortran -O2 -frecursive -c -o dstein.o dstein.f -gfortran -O2 -frecursive -c -o dstev.o dstev.f -gfortran -O2 -frecursive -c -o dstevd.o dstevd.f -gfortran -O2 -frecursive -c -o dstevr.o dstevr.f -gfortran -O2 -frecursive -c -o dstevx.o dstevx.f -gfortran -O2 -frecursive -c -o dsycon.o dsycon.f -gfortran -O2 -frecursive -c -o dsyev.o dsyev.f -gfortran -O2 -frecursive -c -o dsyevd.o dsyevd.f -gfortran -O2 -frecursive -c -o dsyevr.o dsyevr.f -gfortran -O2 -frecursive -c -o dsyevx.o dsyevx.f -gfortran -O2 -frecursive -c -o dsygs2.o dsygs2.f -gfortran -O2 -frecursive -c -o dsygst.o dsygst.f -gfortran -O2 -frecursive -c -o dsygv.o dsygv.f -gfortran -O2 -frecursive -c -o dsygvd.o dsygvd.f -gfortran -O2 -frecursive -c -o dsygvx.o dsygvx.f -gfortran -O2 -frecursive -c -o dsyrfs.o dsyrfs.f -gfortran -O2 -frecursive -c -o dsysv.o dsysv.f -gfortran -O2 -frecursive -c -o dsysvx.o dsysvx.f -gfortran -O2 -frecursive -c -o dsytd2.o dsytd2.f -gfortran -O2 -frecursive -c -o dsytf2.o dsytf2.f -gfortran -O2 -frecursive -c -o dsytrd.o dsytrd.f -gfortran -O2 -frecursive -c -o dsytrf.o dsytrf.f -gfortran -O2 -frecursive -c -o dsytri.o dsytri.f -gfortran -O2 -frecursive -c -o dsytri2.o dsytri2.f -gfortran -O2 -frecursive -c -o dsytri2x.o dsytri2x.f -gfortran -O2 -frecursive -c -o dsyswapr.o dsyswapr.f -gfortran -O2 -frecursive -c -o dsytrs.o dsytrs.f -gfortran -O2 -frecursive -c -o dsytrs2.o dsytrs2.f -gfortran -O2 -frecursive -c -o dsyconv.o dsyconv.f -gfortran -O2 -frecursive -c -o dsyconvf.o dsyconvf.f -gfortran -O2 -frecursive -c -o dsyconvf_rook.o dsyconvf_rook.f -gfortran -O2 -frecursive -c -o dsytf2_rook.o dsytf2_rook.f -gfortran -O2 -frecursive -c -o dsytrf_rook.o dsytrf_rook.f -gfortran -O2 -frecursive -c -o dsytrs_rook.o dsytrs_rook.f -gfortran -O2 -frecursive -c -o dsytri_rook.o dsytri_rook.f -gfortran -O2 -frecursive -c -o dsycon_rook.o dsycon_rook.f -gfortran -O2 -frecursive -c -o dsysv_rook.o dsysv_rook.f -gfortran -O2 -frecursive -c -o dsytf2_rk.o dsytf2_rk.f -gfortran -O2 -frecursive -c -o dsytrf_rk.o dsytrf_rk.f -gfortran -O2 -frecursive -c -o dsytrs_3.o dsytrs_3.f -gfortran -O2 -frecursive -c -o dsytri_3.o dsytri_3.f -gfortran -O2 -frecursive -c -o dsytri_3x.o dsytri_3x.f -gfortran -O2 -frecursive -c -o dsycon_3.o dsycon_3.f -gfortran -O2 -frecursive -c -o dsysv_rk.o dsysv_rk.f -gfortran -O2 -frecursive -c -o dlasyf_aa.o dlasyf_aa.f -gfortran -O2 -frecursive -c -o dsysv_aa.o dsysv_aa.f -gfortran -O2 -frecursive -c -o dsytrf_aa.o dsytrf_aa.f -gfortran -O2 -frecursive -c -o dsytrs_aa.o dsytrs_aa.f -gfortran -O2 -frecursive -c -o dsysv_aa_2stage.o dsysv_aa_2stage.f -gfortran -O2 -frecursive -c -o dsytrf_aa_2stage.o dsytrf_aa_2stage.f -gfortran -O2 -frecursive -c -o dsytrs_aa_2stage.o dsytrs_aa_2stage.f -gfortran -O2 -frecursive -c -o dtbcon.o dtbcon.f -gfortran -O2 -frecursive -c -o dtbrfs.o dtbrfs.f -gfortran -O2 -frecursive -c -o dtbtrs.o dtbtrs.f -gfortran -O2 -frecursive -c -o dtgevc.o dtgevc.f -gfortran -O2 -frecursive -c -o dtgex2.o dtgex2.f -gfortran -O2 -frecursive -c -o dtgexc.o dtgexc.f -gfortran -O2 -frecursive -c -o dtgsen.o dtgsen.f -gfortran -O2 -frecursive -c -o dtgsja.o dtgsja.f -gfortran -O2 -frecursive -c -o dtgsna.o dtgsna.f -gfortran -O2 -frecursive -c -o dtgsy2.o dtgsy2.f -gfortran -O2 -frecursive -c -o dtgsyl.o dtgsyl.f -gfortran -O2 -frecursive -c -o dtpcon.o dtpcon.f -gfortran -O2 -frecursive -c -o dtprfs.o dtprfs.f -gfortran -O2 -frecursive -c -o dtptri.o dtptri.f -gfortran -O2 -frecursive -c -o dtptrs.o dtptrs.f -gfortran -O2 -frecursive -c -o dtrcon.o dtrcon.f -gfortran -O2 -frecursive -c -o dtrevc.o dtrevc.f -gfortran -O2 -frecursive -c -o dtrevc3.o dtrevc3.f -gfortran -O2 -frecursive -c -o dtrexc.o dtrexc.f -gfortran -O2 -frecursive -c -o dtrrfs.o dtrrfs.f -gfortran -O2 -frecursive -c -o dtrsen.o dtrsen.f -gfortran -O2 -frecursive -c -o dtrsna.o dtrsna.f -gfortran -O2 -frecursive -c -o dtrsyl.o dtrsyl.f -gfortran -O2 -frecursive -c -o dtrsyl3.o dtrsyl3.f -gfortran -O2 -frecursive -c -o dtrti2.o dtrti2.f -gfortran -O2 -frecursive -c -o dtrtri.o dtrtri.f -gfortran -O2 -frecursive -c -o dtrtrs.o dtrtrs.f -gfortran -O2 -frecursive -c -o dtzrzf.o dtzrzf.f -gfortran -O2 -frecursive -c -o dstemr.o dstemr.f -gfortran -O2 -frecursive -c -o dsgesv.o dsgesv.f -gfortran -O2 -frecursive -c -o dsposv.o dsposv.f -gfortran -O2 -frecursive -c -o dlag2s.o dlag2s.f -gfortran -O2 -frecursive -c -o slag2d.o slag2d.f -gfortran -O2 -frecursive -c -o dlat2s.o dlat2s.f -gfortran -O2 -frecursive -c -o dlansf.o dlansf.f -gfortran -O2 -frecursive -c -o dpftrf.o dpftrf.f -gfortran -O2 -frecursive -c -o dpftri.o dpftri.f -gfortran -O2 -frecursive -c -o dpftrs.o dpftrs.f -gfortran -O2 -frecursive -c -o dsfrk.o dsfrk.f -gfortran -O2 -frecursive -c -o dtfsm.o dtfsm.f -gfortran -O2 -frecursive -c -o dtftri.o dtftri.f -gfortran -O2 -frecursive -c -o dtfttp.o dtfttp.f -gfortran -O2 -frecursive -c -o dtfttr.o dtfttr.f -gfortran -O2 -frecursive -c -o dtpttf.o dtpttf.f -gfortran -O2 -frecursive -c -o dtpttr.o dtpttr.f -gfortran -O2 -frecursive -c -o dtrttf.o dtrttf.f -gfortran -O2 -frecursive -c -o dtrttp.o dtrttp.f -gfortran -O2 -frecursive -c -o dgejsv.o dgejsv.f -gfortran -O2 -frecursive -c -o dgesvj.o dgesvj.f -gfortran -O2 -frecursive -c -o dgsvj0.o dgsvj0.f -gfortran -O2 -frecursive -c -o dgsvj1.o dgsvj1.f -gfortran -O2 -frecursive -c -o dgeequb.o dgeequb.f -gfortran -O2 -frecursive -c -o dsyequb.o dsyequb.f -gfortran -O2 -frecursive -c -o dpoequb.o dpoequb.f -gfortran -O2 -frecursive -c -o dgbequb.o dgbequb.f -gfortran -O2 -frecursive -c -o dbbcsd.o dbbcsd.f -gfortran -O2 -frecursive -c -o dlapmr.o dlapmr.f -gfortran -O2 -frecursive -c -o dorbdb.o dorbdb.f -gfortran -O2 -frecursive -c -o dorbdb1.o dorbdb1.f -gfortran -O2 -frecursive -c -o dorbdb2.o dorbdb2.f -gfortran -O2 -frecursive -c -o dorbdb3.o dorbdb3.f -gfortran -O2 -frecursive -c -o dorbdb4.o dorbdb4.f -gfortran -O2 -frecursive -c -o dorbdb5.o dorbdb5.f -gfortran -O2 -frecursive -c -o dorbdb6.o dorbdb6.f -gfortran -O2 -frecursive -c -o dorcsd.o dorcsd.f -gfortran -O2 -frecursive -c -o dorcsd2by1.o dorcsd2by1.f -gfortran -O2 -frecursive -c -o dgeqrt.o dgeqrt.f -gfortran -O2 -frecursive -c -o dgeqrt2.o dgeqrt2.f -gfortran -O2 -frecursive -c -o dgeqrt3.o dgeqrt3.f -gfortran -O2 -frecursive -c -o dgemqrt.o dgemqrt.f -gfortran -O2 -frecursive -c -o dtpqrt.o dtpqrt.f -gfortran -O2 -frecursive -c -o dtpqrt2.o dtpqrt2.f -gfortran -O2 -frecursive -c -o dtpmqrt.o dtpmqrt.f -gfortran -O2 -frecursive -c -o dtprfb.o dtprfb.f -gfortran -O2 -frecursive -c -o dgelqt.o dgelqt.f -gfortran -O2 -frecursive -c -o dgelqt3.o dgelqt3.f -gfortran -O2 -frecursive -c -o dgemlqt.o dgemlqt.f -gfortran -O2 -frecursive -c -o dgetsls.o dgetsls.f -gfortran -O2 -frecursive -c -o dgetsqrhrt.o dgetsqrhrt.f -gfortran -O2 -frecursive -c -o dgeqr.o dgeqr.f -gfortran -O2 -frecursive -c -o dlatsqr.o dlatsqr.f -gfortran -O2 -frecursive -c -o dlamtsqr.o dlamtsqr.f -gfortran -O2 -frecursive -c -o dgemqr.o dgemqr.f -gfortran -O2 -frecursive -c -o dgelq.o dgelq.f -gfortran -O2 -frecursive -c -o dlaswlq.o dlaswlq.f -gfortran -O2 -frecursive -c -o dlamswlq.o dlamswlq.f -gfortran -O2 -frecursive -c -o dgemlq.o dgemlq.f -gfortran -O2 -frecursive -c -o dtplqt.o dtplqt.f -gfortran -O2 -frecursive -c -o dtplqt2.o dtplqt2.f -gfortran -O2 -frecursive -c -o dtpmlqt.o dtpmlqt.f -gfortran -O2 -frecursive -c -o dorhr_col.o dorhr_col.f -gfortran -O2 -frecursive -c -o dlaorhr_col_getrfnp.o dlaorhr_col_getrfnp.f -gfortran -O2 -frecursive -c -o dlaorhr_col_getrfnp2.o dlaorhr_col_getrfnp2.f -gfortran -O2 -frecursive -c -o dsytrd_2stage.o dsytrd_2stage.f -gfortran -O2 -frecursive -c -o dsytrd_sy2sb.o dsytrd_sy2sb.f -gfortran -O2 -frecursive -c -o dsb2st_kernels.o dsb2st_kernels.f -gfortran -O2 -frecursive -c -o dsyevd_2stage.o dsyevd_2stage.f -gfortran -O2 -frecursive -c -o dsyev_2stage.o dsyev_2stage.f -gfortran -O2 -frecursive -c -o dsyevx_2stage.o dsyevx_2stage.f -gfortran -O2 -frecursive -c -o dsyevr_2stage.o dsyevr_2stage.f -gfortran -O2 -frecursive -c -o dsbev_2stage.o dsbev_2stage.f -gfortran -O2 -frecursive -c -o dsbevx_2stage.o dsbevx_2stage.f -gfortran -O2 -frecursive -c -o dsbevd_2stage.o dsbevd_2stage.f -gfortran -O2 -frecursive -c -o dsygv_2stage.o dsygv_2stage.f -gfortran -O2 -frecursive -c -o dgesvdq.o dgesvdq.f -gfortran -O2 -frecursive -c -o spotrs.o spotrs.f -gfortran -O2 -frecursive -c -o sgetrs.o sgetrs.f -gfortran -O2 -frecursive -c -o spotrf.o spotrf.f -gfortran -O2 -frecursive -c -o sgetrf.o sgetrf.f -gfortran -O2 -frecursive -c -o cpotrf2.o cpotrf2.f -gfortran -O2 -frecursive -c -o cgetrf2.o cgetrf2.f -gfortran -O2 -frecursive -c -o cbdsqr.o cbdsqr.f -gfortran -O2 -frecursive -c -o cgbbrd.o cgbbrd.f -gfortran -O2 -frecursive -c -o cgbcon.o cgbcon.f -gfortran -O2 -frecursive -c -o cgbequ.o cgbequ.f -gfortran -O2 -frecursive -c -o cgbrfs.o cgbrfs.f -gfortran -O2 -frecursive -c -o cgbsv.o cgbsv.f -gfortran -O2 -frecursive -c -o cgbsvx.o cgbsvx.f -gfortran -O2 -frecursive -c -o cgbtf2.o cgbtf2.f -gfortran -O2 -frecursive -c -o cgbtrf.o cgbtrf.f -gfortran -O2 -frecursive -c -o cgbtrs.o cgbtrs.f -gfortran -O2 -frecursive -c -o cgebak.o cgebak.f -gfortran -O2 -frecursive -c -o cgebal.o cgebal.f -gfortran -O2 -frecursive -c -o cgebd2.o cgebd2.f -gfortran -O2 -frecursive -c -o cgebrd.o cgebrd.f -gfortran -O2 -frecursive -c -o cgecon.o cgecon.f -gfortran -O2 -frecursive -c -o cgeequ.o cgeequ.f -gfortran -O2 -frecursive -c -o cgees.o cgees.f -gfortran -O2 -frecursive -c -o cgeesx.o cgeesx.f -gfortran -O2 -frecursive -c -o cgeev.o cgeev.f -gfortran -O2 -frecursive -c -o cgeevx.o cgeevx.f -gfortran -O2 -frecursive -c -o cgehd2.o cgehd2.f -gfortran -O2 -frecursive -c -o cgehrd.o cgehrd.f -gfortran -O2 -frecursive -c -o cgelq2.o cgelq2.f -gfortran -O2 -frecursive -c -o cgelqf.o cgelqf.f -gfortran -O2 -frecursive -c -o cgels.o cgels.f -gfortran -O2 -frecursive -c -o cgelst.o cgelst.f -gfortran -O2 -frecursive -c -o cgelsd.o cgelsd.f -gfortran -O2 -frecursive -c -o cgelss.o cgelss.f -gfortran -O2 -frecursive -c -o cgelsy.o cgelsy.f -gfortran -O2 -frecursive -c -o cgeql2.o cgeql2.f -gfortran -O2 -frecursive -c -o cgeqlf.o cgeqlf.f -gfortran -O2 -frecursive -c -o cgeqp3.o cgeqp3.f -gfortran -O2 -frecursive -c -o cgeqp3rk.o cgeqp3rk.f -gfortran -O2 -frecursive -c -o cgeqr2.o cgeqr2.f -gfortran -O2 -frecursive -c -o cgeqr2p.o cgeqr2p.f -gfortran -O2 -frecursive -c -o cgeqrf.o cgeqrf.f -gfortran -O2 -frecursive -c -o cgeqrfp.o cgeqrfp.f -gfortran -O2 -frecursive -c -o cgerfs.o cgerfs.f -gfortran -O2 -frecursive -c -o cgerq2.o cgerq2.f -gfortran -O2 -frecursive -c -o cgerqf.o cgerqf.f -gfortran -O2 -frecursive -c -o cgesc2.o cgesc2.f -gfortran -O2 -frecursive -c -o cgesdd.o cgesdd.f -gfortran -O2 -frecursive -c -o cgesv.o cgesv.f -gfortran -O2 -frecursive -c -o cgesvd.o cgesvd.f -gfortran -O2 -frecursive -c -o cgesvdx.o cgesvdx.f -gfortran -O2 -frecursive -c -o cgesvj.o cgesvj.f -gfortran -O2 -frecursive -c -o cgejsv.o cgejsv.f -gfortran -O2 -frecursive -c -o cgsvj0.o cgsvj0.f -gfortran -O2 -frecursive -c -o cgsvj1.o cgsvj1.f -gfortran -O2 -frecursive -c -o cgesvx.o cgesvx.f -gfortran -O2 -frecursive -c -o cgetc2.o cgetc2.f -gfortran -O2 -frecursive -c -o cgetf2.o cgetf2.f -gfortran -O2 -frecursive -c -o cgetri.o cgetri.f -gfortran -O2 -frecursive -c -o cggbak.o cggbak.f -gfortran -O2 -frecursive -c -o cggbal.o cggbal.f -gfortran -O2 -frecursive -c -o cgges.o cgges.f -gfortran -O2 -frecursive -c -o cgges3.o cgges3.f -gfortran -O2 -frecursive -c -o cggesx.o cggesx.f -gfortran -O2 -frecursive -c -o cggev.o cggev.f -gfortran -O2 -frecursive -c -o cggev3.o cggev3.f -gfortran -O2 -frecursive -c -o cggevx.o cggevx.f -gfortran -O2 -frecursive -c -o cggglm.o cggglm.f -gfortran -O2 -frecursive -c -o cgghrd.o cgghrd.f -gfortran -O2 -frecursive -c -o cgghd3.o cgghd3.f -gfortran -O2 -frecursive -c -o cgglse.o cgglse.f -gfortran -O2 -frecursive -c -o cggqrf.o cggqrf.f -gfortran -O2 -frecursive -c -o cggrqf.o cggrqf.f -gfortran -O2 -frecursive -c -o cggsvd3.o cggsvd3.f -gfortran -O2 -frecursive -c -o cggsvp3.o cggsvp3.f -gfortran -O2 -frecursive -c -o cgtcon.o cgtcon.f -gfortran -O2 -frecursive -c -o cgtrfs.o cgtrfs.f -gfortran -O2 -frecursive -c -o cgtsv.o cgtsv.f -gfortran -O2 -frecursive -c -o cgtsvx.o cgtsvx.f -gfortran -O2 -frecursive -c -o cgttrf.o cgttrf.f -gfortran -O2 -frecursive -c -o cgttrs.o cgttrs.f -gfortran -O2 -frecursive -c -o cgtts2.o cgtts2.f -gfortran -O2 -frecursive -c -o chbev.o chbev.f -gfortran -O2 -frecursive -c -o chbevd.o chbevd.f -gfortran -O2 -frecursive -c -o chbevx.o chbevx.f -gfortran -O2 -frecursive -c -o chbgst.o chbgst.f -gfortran -O2 -frecursive -c -o chbgv.o chbgv.f -gfortran -O2 -frecursive -c -o chbgvd.o chbgvd.f -gfortran -O2 -frecursive -c -o chbgvx.o chbgvx.f -gfortran -O2 -frecursive -c -o chbtrd.o chbtrd.f -gfortran -O2 -frecursive -c -o checon.o checon.f -gfortran -O2 -frecursive -c -o cheev.o cheev.f -gfortran -O2 -frecursive -c -o cheevd.o cheevd.f -gfortran -O2 -frecursive -c -o cheevr.o cheevr.f -gfortran -O2 -frecursive -c -o cheevx.o cheevx.f -gfortran -O2 -frecursive -c -o chegs2.o chegs2.f -gfortran -O2 -frecursive -c -o chegst.o chegst.f -gfortran -O2 -frecursive -c -o chegv.o chegv.f -gfortran -O2 -frecursive -c -o chegvd.o chegvd.f -gfortran -O2 -frecursive -c -o chegvx.o chegvx.f -gfortran -O2 -frecursive -c -o cherfs.o cherfs.f -gfortran -O2 -frecursive -c -o chesv.o chesv.f -gfortran -O2 -frecursive -c -o chesvx.o chesvx.f -gfortran -O2 -frecursive -c -o chetd2.o chetd2.f -gfortran -O2 -frecursive -c -o chetf2.o chetf2.f -gfortran -O2 -frecursive -c -o chetrd.o chetrd.f -gfortran -O2 -frecursive -c -o chetrf.o chetrf.f -gfortran -O2 -frecursive -c -o chetri.o chetri.f -gfortran -O2 -frecursive -c -o chetri2.o chetri2.f -gfortran -O2 -frecursive -c -o chetri2x.o chetri2x.f -gfortran -O2 -frecursive -c -o cheswapr.o cheswapr.f -gfortran -O2 -frecursive -c -o chetrs.o chetrs.f -gfortran -O2 -frecursive -c -o chetrs2.o chetrs2.f -gfortran -O2 -frecursive -c -o chetf2_rook.o chetf2_rook.f -gfortran -O2 -frecursive -c -o chetrf_rook.o chetrf_rook.f -gfortran -O2 -frecursive -c -o chetri_rook.o chetri_rook.f -gfortran -O2 -frecursive -c -o chetrs_rook.o chetrs_rook.f -gfortran -O2 -frecursive -c -o checon_rook.o checon_rook.f -gfortran -O2 -frecursive -c -o chesv_rook.o chesv_rook.f -gfortran -O2 -frecursive -c -o chetf2_rk.o chetf2_rk.f -gfortran -O2 -frecursive -c -o chetrf_rk.o chetrf_rk.f -gfortran -O2 -frecursive -c -o chetri_3.o chetri_3.f -gfortran -O2 -frecursive -c -o chetri_3x.o chetri_3x.f -gfortran -O2 -frecursive -c -o chetrs_3.o chetrs_3.f -gfortran -O2 -frecursive -c -o checon_3.o checon_3.f -gfortran -O2 -frecursive -c -o chesv_rk.o chesv_rk.f -gfortran -O2 -frecursive -c -o chesv_aa.o chesv_aa.f -gfortran -O2 -frecursive -c -o chetrf_aa.o chetrf_aa.f -gfortran -O2 -frecursive -c -o chetrs_aa.o chetrs_aa.f -gfortran -O2 -frecursive -c -o clahef_aa.o clahef_aa.f -gfortran -O2 -frecursive -c -o chesv_aa_2stage.o chesv_aa_2stage.f -gfortran -O2 -frecursive -c -o chetrf_aa_2stage.o chetrf_aa_2stage.f -gfortran -O2 -frecursive -c -o chetrs_aa_2stage.o chetrs_aa_2stage.f -gfortran -O2 -frecursive -c -o chgeqz.o chgeqz.f -gfortran -O2 -frecursive -c -o chpcon.o chpcon.f -gfortran -O2 -frecursive -c -o chpev.o chpev.f -gfortran -O2 -frecursive -c -o chpevd.o chpevd.f -gfortran -O2 -frecursive -c -o claqz0.o claqz0.f -gfortran -O2 -frecursive -c -o claqz1.o claqz1.f -gfortran -O2 -frecursive -c -o claqz2.o claqz2.f -gfortran -O2 -frecursive -c -o claqz3.o claqz3.f -gfortran -O2 -frecursive -c -o chpevx.o chpevx.f -gfortran -O2 -frecursive -c -o chpgst.o chpgst.f -gfortran -O2 -frecursive -c -o chpgv.o chpgv.f -gfortran -O2 -frecursive -c -o chpgvd.o chpgvd.f -gfortran -O2 -frecursive -c -o chpgvx.o chpgvx.f -gfortran -O2 -frecursive -c -o chprfs.o chprfs.f -gfortran -O2 -frecursive -c -o chpsv.o chpsv.f -gfortran -O2 -frecursive -c -o chpsvx.o chpsvx.f -gfortran -O2 -frecursive -c -o chptrd.o chptrd.f -gfortran -O2 -frecursive -c -o chptrf.o chptrf.f -gfortran -O2 -frecursive -c -o chptri.o chptri.f -gfortran -O2 -frecursive -c -o chptrs.o chptrs.f -gfortran -O2 -frecursive -c -o chsein.o chsein.f -gfortran -O2 -frecursive -c -o chseqr.o chseqr.f -gfortran -O2 -frecursive -c -o clabrd.o clabrd.f -gfortran -O2 -frecursive -c -o clacgv.o clacgv.f -gfortran -O2 -frecursive -c -o clacon.o clacon.f -gfortran -O2 -frecursive -c -o clacn2.o clacn2.f -gfortran -O2 -frecursive -c -o clacp2.o clacp2.f -gfortran -O2 -frecursive -c -o clacpy.o clacpy.f -gfortran -O2 -frecursive -c -o clacrm.o clacrm.f -gfortran -O2 -frecursive -c -o clacrt.o clacrt.f -gfortran -O2 -frecursive -c -o cladiv.o cladiv.f -gfortran -O2 -frecursive -c -o claed0.o claed0.f -gfortran -O2 -frecursive -c -o claed7.o claed7.f -gfortran -O2 -frecursive -c -o claed8.o claed8.f -gfortran -O2 -frecursive -c -o claein.o claein.f -gfortran -O2 -frecursive -c -o claesy.o claesy.f -gfortran -O2 -frecursive -c -o claev2.o claev2.f -gfortran -O2 -frecursive -c -o clags2.o clags2.f -gfortran -O2 -frecursive -c -o clagtm.o clagtm.f -gfortran -O2 -frecursive -c -o clahef.o clahef.f -gfortran -O2 -frecursive -c -o clahef_rook.o clahef_rook.f -gfortran -O2 -frecursive -c -o clahef_rk.o clahef_rk.f -gfortran -O2 -frecursive -c -o clahqr.o clahqr.f -gfortran -O2 -frecursive -c -o clahr2.o clahr2.f -gfortran -O2 -frecursive -c -o claic1.o claic1.f -gfortran -O2 -frecursive -c -o clals0.o clals0.f -gfortran -O2 -frecursive -c -o clalsa.o clalsa.f -gfortran -O2 -frecursive -c -o clalsd.o clalsd.f -gfortran -O2 -frecursive -c -o clangb.o clangb.f -gfortran -O2 -frecursive -c -o clange.o clange.f -gfortran -O2 -frecursive -c -o clangt.o clangt.f -gfortran -O2 -frecursive -c -o clanhb.o clanhb.f -gfortran -O2 -frecursive -c -o clanhe.o clanhe.f -gfortran -O2 -frecursive -c -o clanhp.o clanhp.f -gfortran -O2 -frecursive -c -o clanhs.o clanhs.f -gfortran -O2 -frecursive -c -o clanht.o clanht.f -gfortran -O2 -frecursive -c -o clansb.o clansb.f -gfortran -O2 -frecursive -c -o clansp.o clansp.f -gfortran -O2 -frecursive -c -o clansy.o clansy.f -gfortran -O2 -frecursive -c -o clantb.o clantb.f -gfortran -O2 -frecursive -c -o clantp.o clantp.f -gfortran -O2 -frecursive -c -o clantr.o clantr.f -gfortran -O2 -frecursive -c -o clapll.o clapll.f -gfortran -O2 -frecursive -c -o clapmt.o clapmt.f -gfortran -O2 -frecursive -c -o clarcm.o clarcm.f -gfortran -O2 -frecursive -c -o claqgb.o claqgb.f -gfortran -O2 -frecursive -c -o claqge.o claqge.f -gfortran -O2 -frecursive -c -o claqhb.o claqhb.f -gfortran -O2 -frecursive -c -o claqhe.o claqhe.f -gfortran -O2 -frecursive -c -o claqhp.o claqhp.f -gfortran -O2 -frecursive -c -o claqp2.o claqp2.f -gfortran -O2 -frecursive -c -o claqps.o claqps.f -gfortran -O2 -frecursive -c -o claqp2rk.o claqp2rk.f -gfortran -O2 -frecursive -c -o claqp3rk.o claqp3rk.f -gfortran -O2 -frecursive -c -o claqsb.o claqsb.f -gfortran -O2 -frecursive -c -o claqr0.o claqr0.f -gfortran -O2 -frecursive -c -o claqr1.o claqr1.f -gfortran -O2 -frecursive -c -o claqr2.o claqr2.f -gfortran -O2 -frecursive -c -o claqr3.o claqr3.f -gfortran -O2 -frecursive -c -o claqr4.o claqr4.f -gfortran -O2 -frecursive -c -o claqr5.o claqr5.f -gfortran -O2 -frecursive -c -o claqsp.o claqsp.f -gfortran -O2 -frecursive -c -o claqsy.o claqsy.f -gfortran -O2 -frecursive -c -o clar1v.o clar1v.f -gfortran -O2 -frecursive -c -o clar2v.o clar2v.f -gfortran -O2 -frecursive -c -o ilaclr.o ilaclr.f -gfortran -O2 -frecursive -c -o ilaclc.o ilaclc.f -gfortran -O2 -frecursive -c -o clarf.o clarf.f -gfortran -O2 -frecursive -c -o clarfb.o clarfb.f -gfortran -O2 -frecursive -c -o clarfb_gett.o clarfb_gett.f -gfortran -O2 -frecursive -c -o clarfg.o clarfg.f -gfortran -O2 -frecursive -c -o clarft.o clarft.f -gfortran -O2 -frecursive -c -o clarfgp.o clarfgp.f -gfortran -O2 -frecursive -c -o clarfx.o clarfx.f -gfortran -O2 -frecursive -c -o clarfy.o clarfy.f -gfortran -O2 -frecursive -c -o clargv.o clargv.f -gfortran -O2 -frecursive -c -o clarnv.o clarnv.f -gfortran -O2 -frecursive -c -o clarrv.o clarrv.f -gfortran -O2 -frecursive -c -o clartv.o clartv.f -gfortran -O2 -frecursive -c -o clarz.o clarz.f -gfortran -O2 -frecursive -c -o clarzb.o clarzb.f -gfortran -O2 -frecursive -c -o clarzt.o clarzt.f -gfortran -O2 -frecursive -c -o clascl.o clascl.f -gfortran -O2 -frecursive -c -o claset.o claset.f -gfortran -O2 -frecursive -c -o clasr.o clasr.f -gfortran -O2 -frecursive -c -o claswp.o claswp.f -gfortran -O2 -frecursive -c -o clasyf.o clasyf.f -gfortran -O2 -frecursive -c -o clasyf_rook.o clasyf_rook.f -gfortran -O2 -frecursive -c -o clasyf_rk.o clasyf_rk.f -gfortran -O2 -frecursive -c -o clasyf_aa.o clasyf_aa.f -gfortran -O2 -frecursive -c -o clatbs.o clatbs.f -gfortran -O2 -frecursive -c -o clatdf.o clatdf.f -gfortran -O2 -frecursive -c -o clatps.o clatps.f -gfortran -O2 -frecursive -c -o clatrd.o clatrd.f -gfortran -O2 -frecursive -c -o clatrs.o clatrs.f -gfortran -O2 -frecursive -c -o clatrs3.o clatrs3.f -gfortran -O2 -frecursive -c -o clatrz.o clatrz.f -gfortran -O2 -frecursive -c -o clauu2.o clauu2.f -gfortran -O2 -frecursive -c -o clauum.o clauum.f -gfortran -O2 -frecursive -c -o cpbcon.o cpbcon.f -gfortran -O2 -frecursive -c -o cpbequ.o cpbequ.f -gfortran -O2 -frecursive -c -o cpbrfs.o cpbrfs.f -gfortran -O2 -frecursive -c -o cpbstf.o cpbstf.f -gfortran -O2 -frecursive -c -o cpbsv.o cpbsv.f -gfortran -O2 -frecursive -c -o cpbsvx.o cpbsvx.f -gfortran -O2 -frecursive -c -o cpbtf2.o cpbtf2.f -gfortran -O2 -frecursive -c -o cpbtrf.o cpbtrf.f -gfortran -O2 -frecursive -c -o cpbtrs.o cpbtrs.f -gfortran -O2 -frecursive -c -o cpocon.o cpocon.f -gfortran -O2 -frecursive -c -o cpoequ.o cpoequ.f -gfortran -O2 -frecursive -c -o cporfs.o cporfs.f -gfortran -O2 -frecursive -c -o cposv.o cposv.f -gfortran -O2 -frecursive -c -o cposvx.o cposvx.f -gfortran -O2 -frecursive -c -o cpotf2.o cpotf2.f -gfortran -O2 -frecursive -c -o cpotri.o cpotri.f -gfortran -O2 -frecursive -c -o cpstrf.o cpstrf.f -gfortran -O2 -frecursive -c -o cpstf2.o cpstf2.f -gfortran -O2 -frecursive -c -o cppcon.o cppcon.f -gfortran -O2 -frecursive -c -o cppequ.o cppequ.f -gfortran -O2 -frecursive -c -o cpprfs.o cpprfs.f -gfortran -O2 -frecursive -c -o cppsv.o cppsv.f -gfortran -O2 -frecursive -c -o cppsvx.o cppsvx.f -gfortran -O2 -frecursive -c -o cpptrf.o cpptrf.f -gfortran -O2 -frecursive -c -o cpptri.o cpptri.f -gfortran -O2 -frecursive -c -o cpptrs.o cpptrs.f -gfortran -O2 -frecursive -c -o cptcon.o cptcon.f -gfortran -O2 -frecursive -c -o cpteqr.o cpteqr.f -gfortran -O2 -frecursive -c -o cptrfs.o cptrfs.f -gfortran -O2 -frecursive -c -o cptsv.o cptsv.f -gfortran -O2 -frecursive -c -o cptsvx.o cptsvx.f -gfortran -O2 -frecursive -c -o cpttrf.o cpttrf.f -gfortran -O2 -frecursive -c -o cpttrs.o cpttrs.f -gfortran -O2 -frecursive -c -o cptts2.o cptts2.f -gfortran -O2 -frecursive -c -o crot.o crot.f -gfortran -O2 -frecursive -c -o cspcon.o cspcon.f -gfortran -O2 -frecursive -c -o cspmv.o cspmv.f -gfortran -O2 -frecursive -c -o cspr.o cspr.f -gfortran -O2 -frecursive -c -o csprfs.o csprfs.f -gfortran -O2 -frecursive -c -o cspsv.o cspsv.f -gfortran -O2 -frecursive -c -o cspsvx.o cspsvx.f -gfortran -O2 -frecursive -c -o csptrf.o csptrf.f -gfortran -O2 -frecursive -c -o csptri.o csptri.f -gfortran -O2 -frecursive -c -o csptrs.o csptrs.f -gfortran -O2 -frecursive -c -o csrscl.o csrscl.f -gfortran -O2 -frecursive -c -o crscl.o crscl.f -gfortran -O2 -frecursive -c -o cstedc.o cstedc.f -gfortran -O2 -frecursive -c -o cstegr.o cstegr.f -gfortran -O2 -frecursive -c -o cstein.o cstein.f -gfortran -O2 -frecursive -c -o csteqr.o csteqr.f -gfortran -O2 -frecursive -c -o csycon.o csycon.f -gfortran -O2 -frecursive -c -o csymv.o csymv.f -gfortran -O2 -frecursive -c -o csyr.o csyr.f -gfortran -O2 -frecursive -c -o csyrfs.o csyrfs.f -gfortran -O2 -frecursive -c -o csysv.o csysv.f -gfortran -O2 -frecursive -c -o csysvx.o csysvx.f -gfortran -O2 -frecursive -c -o csytf2.o csytf2.f -gfortran -O2 -frecursive -c -o csytrf.o csytrf.f -gfortran -O2 -frecursive -c -o csytri.o csytri.f -gfortran -O2 -frecursive -c -o csytri2.o csytri2.f -gfortran -O2 -frecursive -c -o csytri2x.o csytri2x.f -gfortran -O2 -frecursive -c -o csyswapr.o csyswapr.f -gfortran -O2 -frecursive -c -o csytrs.o csytrs.f -gfortran -O2 -frecursive -c -o csytrs2.o csytrs2.f -gfortran -O2 -frecursive -c -o csyconv.o csyconv.f -gfortran -O2 -frecursive -c -o csyconvf.o csyconvf.f -gfortran -O2 -frecursive -c -o csyconvf_rook.o csyconvf_rook.f -gfortran -O2 -frecursive -c -o csytf2_rook.o csytf2_rook.f -gfortran -O2 -frecursive -c -o csytrf_rook.o csytrf_rook.f -gfortran -O2 -frecursive -c -o csytrs_rook.o csytrs_rook.f -gfortran -O2 -frecursive -c -o csytri_rook.o csytri_rook.f -gfortran -O2 -frecursive -c -o csycon_rook.o csycon_rook.f -gfortran -O2 -frecursive -c -o csysv_rook.o csysv_rook.f -gfortran -O2 -frecursive -c -o csytf2_rk.o csytf2_rk.f -gfortran -O2 -frecursive -c -o csytrf_rk.o csytrf_rk.f -gfortran -O2 -frecursive -c -o csytrf_aa.o csytrf_aa.f -gfortran -O2 -frecursive -c -o csytrs_3.o csytrs_3.f -gfortran -O2 -frecursive -c -o csytrs_aa.o csytrs_aa.f -gfortran -O2 -frecursive -c -o csytri_3.o csytri_3.f -gfortran -O2 -frecursive -c -o csytri_3x.o csytri_3x.f -gfortran -O2 -frecursive -c -o csycon_3.o csycon_3.f -gfortran -O2 -frecursive -c -o csysv_rk.o csysv_rk.f -gfortran -O2 -frecursive -c -o csysv_aa.o csysv_aa.f -gfortran -O2 -frecursive -c -o csysv_aa_2stage.o csysv_aa_2stage.f -gfortran -O2 -frecursive -c -o csytrf_aa_2stage.o csytrf_aa_2stage.f -gfortran -O2 -frecursive -c -o csytrs_aa_2stage.o csytrs_aa_2stage.f -gfortran -O2 -frecursive -c -o ctbcon.o ctbcon.f -gfortran -O2 -frecursive -c -o ctbrfs.o ctbrfs.f -gfortran -O2 -frecursive -c -o ctbtrs.o ctbtrs.f -gfortran -O2 -frecursive -c -o ctgevc.o ctgevc.f -gfortran -O2 -frecursive -c -o ctgex2.o ctgex2.f -gfortran -O2 -frecursive -c -o ctgexc.o ctgexc.f -gfortran -O2 -frecursive -c -o ctgsen.o ctgsen.f -gfortran -O2 -frecursive -c -o ctgsja.o ctgsja.f -gfortran -O2 -frecursive -c -o ctgsna.o ctgsna.f -gfortran -O2 -frecursive -c -o ctgsy2.o ctgsy2.f -gfortran -O2 -frecursive -c -o ctgsyl.o ctgsyl.f -gfortran -O2 -frecursive -c -o ctpcon.o ctpcon.f -gfortran -O2 -frecursive -c -o ctprfs.o ctprfs.f -gfortran -O2 -frecursive -c -o ctptri.o ctptri.f -gfortran -O2 -frecursive -c -o ctptrs.o ctptrs.f -gfortran -O2 -frecursive -c -o ctrcon.o ctrcon.f -gfortran -O2 -frecursive -c -o ctrevc.o ctrevc.f -gfortran -O2 -frecursive -c -o ctrevc3.o ctrevc3.f -gfortran -O2 -frecursive -c -o ctrexc.o ctrexc.f -gfortran -O2 -frecursive -c -o ctrrfs.o ctrrfs.f -gfortran -O2 -frecursive -c -o ctrsen.o ctrsen.f -gfortran -O2 -frecursive -c -o ctrsna.o ctrsna.f -gfortran -O2 -frecursive -c -o ctrsyl.o ctrsyl.f -gfortran -O2 -frecursive -c -o ctrsyl3.o ctrsyl3.f -gfortran -O2 -frecursive -c -o ctrti2.o ctrti2.f -gfortran -O2 -frecursive -c -o ctrtri.o ctrtri.f -gfortran -O2 -frecursive -c -o ctrtrs.o ctrtrs.f -gfortran -O2 -frecursive -c -o ctzrzf.o ctzrzf.f -gfortran -O2 -frecursive -c -o cung2l.o cung2l.f -gfortran -O2 -frecursive -c -o cung2r.o cung2r.f -gfortran -O2 -frecursive -c -o cungbr.o cungbr.f -gfortran -O2 -frecursive -c -o cunghr.o cunghr.f -gfortran -O2 -frecursive -c -o cungl2.o cungl2.f -gfortran -O2 -frecursive -c -o cunglq.o cunglq.f -gfortran -O2 -frecursive -c -o cungql.o cungql.f -gfortran -O2 -frecursive -c -o cungqr.o cungqr.f -gfortran -O2 -frecursive -c -o cungr2.o cungr2.f -gfortran -O2 -frecursive -c -o cungrq.o cungrq.f -gfortran -O2 -frecursive -c -o cungtr.o cungtr.f -gfortran -O2 -frecursive -c -o cungtsqr.o cungtsqr.f -gfortran -O2 -frecursive -c -o cungtsqr_row.o cungtsqr_row.f -gfortran -O2 -frecursive -c -o cunm2l.o cunm2l.f -gfortran -O2 -frecursive -c -o cunm2r.o cunm2r.f -gfortran -O2 -frecursive -c -o cunmbr.o cunmbr.f -gfortran -O2 -frecursive -c -o cunmhr.o cunmhr.f -gfortran -O2 -frecursive -c -o cunml2.o cunml2.f -gfortran -O2 -frecursive -c -o cunm22.o cunm22.f -gfortran -O2 -frecursive -c -o cunmlq.o cunmlq.f -gfortran -O2 -frecursive -c -o cunmql.o cunmql.f -gfortran -O2 -frecursive -c -o cunmqr.o cunmqr.f -gfortran -O2 -frecursive -c -o cunmr2.o cunmr2.f -gfortran -O2 -frecursive -c -o cunmr3.o cunmr3.f -gfortran -O2 -frecursive -c -o cunmrq.o cunmrq.f -gfortran -O2 -frecursive -c -o cunmrz.o cunmrz.f -gfortran -O2 -frecursive -c -o cunmtr.o cunmtr.f -gfortran -O2 -frecursive -c -o cupgtr.o cupgtr.f -gfortran -O2 -frecursive -c -o cupmtr.o cupmtr.f -gfortran -O2 -frecursive -c -o icmax1.o icmax1.f -gfortran -O2 -frecursive -c -o scsum1.o scsum1.f -gfortran -O2 -frecursive -c -o cstemr.o cstemr.f -gfortran -O2 -frecursive -c -o chfrk.o chfrk.f -gfortran -O2 -frecursive -c -o ctfttp.o ctfttp.f -gfortran -O2 -frecursive -c -o clanhf.o clanhf.f -gfortran -O2 -frecursive -c -o cpftrf.o cpftrf.f -gfortran -O2 -frecursive -c -o cpftri.o cpftri.f -gfortran -O2 -frecursive -c -o cpftrs.o cpftrs.f -gfortran -O2 -frecursive -c -o ctfsm.o ctfsm.f -gfortran -O2 -frecursive -c -o ctftri.o ctftri.f -gfortran -O2 -frecursive -c -o ctfttr.o ctfttr.f -gfortran -O2 -frecursive -c -o ctpttf.o ctpttf.f -gfortran -O2 -frecursive -c -o ctpttr.o ctpttr.f -gfortran -O2 -frecursive -c -o ctrttf.o ctrttf.f -gfortran -O2 -frecursive -c -o ctrttp.o ctrttp.f -gfortran -O2 -frecursive -c -o cgeequb.o cgeequb.f -gfortran -O2 -frecursive -c -o cgbequb.o cgbequb.f -gfortran -O2 -frecursive -c -o csyequb.o csyequb.f -gfortran -O2 -frecursive -c -o cpoequb.o cpoequb.f -gfortran -O2 -frecursive -c -o cheequb.o cheequb.f -gfortran -O2 -frecursive -c -o cbbcsd.o cbbcsd.f -gfortran -O2 -frecursive -c -o clapmr.o clapmr.f -gfortran -O2 -frecursive -c -o cunbdb.o cunbdb.f -gfortran -O2 -frecursive -c -o cunbdb1.o cunbdb1.f -gfortran -O2 -frecursive -c -o cunbdb2.o cunbdb2.f -gfortran -O2 -frecursive -c -o cunbdb3.o cunbdb3.f -gfortran -O2 -frecursive -c -o cunbdb4.o cunbdb4.f -gfortran -O2 -frecursive -c -o cunbdb5.o cunbdb5.f -gfortran -O2 -frecursive -c -o cunbdb6.o cunbdb6.f -gfortran -O2 -frecursive -c -o cuncsd.o cuncsd.f -gfortran -O2 -frecursive -c -o cuncsd2by1.o cuncsd2by1.f -gfortran -O2 -frecursive -c -o cgeqrt.o cgeqrt.f -gfortran -O2 -frecursive -c -o cgeqrt2.o cgeqrt2.f -gfortran -O2 -frecursive -c -o cgeqrt3.o cgeqrt3.f -gfortran -O2 -frecursive -c -o cgemqrt.o cgemqrt.f -gfortran -O2 -frecursive -c -o ctpqrt.o ctpqrt.f -gfortran -O2 -frecursive -c -o ctpqrt2.o ctpqrt2.f -gfortran -O2 -frecursive -c -o ctpmqrt.o ctpmqrt.f -gfortran -O2 -frecursive -c -o ctprfb.o ctprfb.f -gfortran -O2 -frecursive -c -o cgelqt.o cgelqt.f -gfortran -O2 -frecursive -c -o cgelqt3.o cgelqt3.f -gfortran -O2 -frecursive -c -o cgemlqt.o cgemlqt.f -gfortran -O2 -frecursive -c -o cgetsls.o cgetsls.f -gfortran -O2 -frecursive -c -o cgetsqrhrt.o cgetsqrhrt.f -gfortran -O2 -frecursive -c -o cgeqr.o cgeqr.f -gfortran -O2 -frecursive -c -o clatsqr.o clatsqr.f -gfortran -O2 -frecursive -c -o clamtsqr.o clamtsqr.f -gfortran -O2 -frecursive -c -o cgemqr.o cgemqr.f -gfortran -O2 -frecursive -c -o cgelq.o cgelq.f -gfortran -O2 -frecursive -c -o claswlq.o claswlq.f -gfortran -O2 -frecursive -c -o clamswlq.o clamswlq.f -gfortran -O2 -frecursive -c -o cgemlq.o cgemlq.f -gfortran -O2 -frecursive -c -o ctplqt.o ctplqt.f -gfortran -O2 -frecursive -c -o ctplqt2.o ctplqt2.f -gfortran -O2 -frecursive -c -o ctpmlqt.o ctpmlqt.f -gfortran -O2 -frecursive -c -o cunhr_col.o cunhr_col.f -gfortran -O2 -frecursive -c -o claunhr_col_getrfnp.o claunhr_col_getrfnp.f -gfortran -O2 -frecursive -c -o claunhr_col_getrfnp2.o claunhr_col_getrfnp2.f -gfortran -O2 -frecursive -c -o chetrd_2stage.o chetrd_2stage.f -gfortran -O2 -frecursive -c -o chetrd_he2hb.o chetrd_he2hb.f -gfortran -O2 -frecursive -c -o chb2st_kernels.o chb2st_kernels.f -gfortran -O2 -frecursive -c -o cheevd_2stage.o cheevd_2stage.f -gfortran -O2 -frecursive -c -o cheev_2stage.o cheev_2stage.f -gfortran -O2 -frecursive -c -o cheevx_2stage.o cheevx_2stage.f -gfortran -O2 -frecursive -c -o cheevr_2stage.o cheevr_2stage.f -gfortran -O2 -frecursive -c -o chbev_2stage.o chbev_2stage.f -gfortran -O2 -frecursive -c -o chbevx_2stage.o chbevx_2stage.f -gfortran -O2 -frecursive -c -o chbevd_2stage.o chbevd_2stage.f -gfortran -O2 -frecursive -c -o chegv_2stage.o chegv_2stage.f -gfortran -O2 -frecursive -c -o cgesvdq.o cgesvdq.f -gfortran -O2 -frecursive -c -o zpotrf2.o zpotrf2.f -gfortran -O2 -frecursive -c -o zgetrf2.o zgetrf2.f -gfortran -O2 -frecursive -c -o zbdsqr.o zbdsqr.f -gfortran -O2 -frecursive -c -o zgbbrd.o zgbbrd.f -gfortran -O2 -frecursive -c -o zgbcon.o zgbcon.f -gfortran -O2 -frecursive -c -o zgbequ.o zgbequ.f -gfortran -O2 -frecursive -c -o zgbrfs.o zgbrfs.f -gfortran -O2 -frecursive -c -o zgbsv.o zgbsv.f -gfortran -O2 -frecursive -c -o zgbsvx.o zgbsvx.f -gfortran -O2 -frecursive -c -o zgbtf2.o zgbtf2.f -gfortran -O2 -frecursive -c -o zgbtrf.o zgbtrf.f -gfortran -O2 -frecursive -c -o zgbtrs.o zgbtrs.f -gfortran -O2 -frecursive -c -o zgebak.o zgebak.f -gfortran -O2 -frecursive -c -o zgebal.o zgebal.f -gfortran -O2 -frecursive -c -o zgebd2.o zgebd2.f -gfortran -O2 -frecursive -c -o zgebrd.o zgebrd.f -gfortran -O2 -frecursive -c -o zgecon.o zgecon.f -gfortran -O2 -frecursive -c -o zgeequ.o zgeequ.f -gfortran -O2 -frecursive -c -o zgees.o zgees.f -gfortran -O2 -frecursive -c -o zgeesx.o zgeesx.f -gfortran -O2 -frecursive -c -o zgeev.o zgeev.f -gfortran -O2 -frecursive -c -o zgeevx.o zgeevx.f -gfortran -O2 -frecursive -c -o zgehd2.o zgehd2.f -gfortran -O2 -frecursive -c -o zgehrd.o zgehrd.f -gfortran -O2 -frecursive -c -o zgelq2.o zgelq2.f -gfortran -O2 -frecursive -c -o zgelqf.o zgelqf.f -gfortran -O2 -frecursive -c -o zgels.o zgels.f -gfortran -O2 -frecursive -c -o zgelst.o zgelst.f -gfortran -O2 -frecursive -c -o zgelsd.o zgelsd.f -gfortran -O2 -frecursive -c -o zgelss.o zgelss.f -gfortran -O2 -frecursive -c -o zgelsy.o zgelsy.f -gfortran -O2 -frecursive -c -o zgeql2.o zgeql2.f -gfortran -O2 -frecursive -c -o zgeqlf.o zgeqlf.f -gfortran -O2 -frecursive -c -o zgeqp3.o zgeqp3.f -gfortran -O2 -frecursive -c -o zgeqp3rk.o zgeqp3rk.f -gfortran -O2 -frecursive -c -o zgeqr2.o zgeqr2.f -gfortran -O2 -frecursive -c -o zgeqr2p.o zgeqr2p.f -gfortran -O2 -frecursive -c -o zgeqrf.o zgeqrf.f -gfortran -O2 -frecursive -c -o zgeqrfp.o zgeqrfp.f -gfortran -O2 -frecursive -c -o zgerfs.o zgerfs.f -gfortran -O2 -frecursive -c -o zgerq2.o zgerq2.f -gfortran -O2 -frecursive -c -o zgerqf.o zgerqf.f -gfortran -O2 -frecursive -c -o zgesc2.o zgesc2.f -gfortran -O2 -frecursive -c -o zgesdd.o zgesdd.f -gfortran -O2 -frecursive -c -o zgesv.o zgesv.f -gfortran -O2 -frecursive -c -o zgesvd.o zgesvd.f -gfortran -O2 -frecursive -c -o zgesvdx.o zgesvdx.f -gfortran -O2 -frecursive -c -o zgesvj.o zgesvj.f -gfortran -O2 -frecursive -c -o zgejsv.o zgejsv.f -gfortran -O2 -frecursive -c -o zgsvj0.o zgsvj0.f -gfortran -O2 -frecursive -c -o zgsvj1.o zgsvj1.f -gfortran -O2 -frecursive -c -o zgesvx.o zgesvx.f -gfortran -O2 -frecursive -c -o zgetc2.o zgetc2.f -gfortran -O2 -frecursive -c -o zgetf2.o zgetf2.f -gfortran -O2 -frecursive -c -o zgetrf.o zgetrf.f -gfortran -O2 -frecursive -c -o zgetri.o zgetri.f -gfortran -O2 -frecursive -c -o zgetrs.o zgetrs.f -gfortran -O2 -frecursive -c -o zggbak.o zggbak.f -gfortran -O2 -frecursive -c -o zggbal.o zggbal.f -gfortran -O2 -frecursive -c -o zgges.o zgges.f -gfortran -O2 -frecursive -c -o zgges3.o zgges3.f -gfortran -O2 -frecursive -c -o zggesx.o zggesx.f -gfortran -O2 -frecursive -c -o zggev.o zggev.f -gfortran -O2 -frecursive -c -o zggev3.o zggev3.f -gfortran -O2 -frecursive -c -o zggevx.o zggevx.f -gfortran -O2 -frecursive -c -o zggglm.o zggglm.f -gfortran -O2 -frecursive -c -o zgghrd.o zgghrd.f -gfortran -O2 -frecursive -c -o zgghd3.o zgghd3.f -gfortran -O2 -frecursive -c -o zgglse.o zgglse.f -gfortran -O2 -frecursive -c -o zggqrf.o zggqrf.f -gfortran -O2 -frecursive -c -o zggrqf.o zggrqf.f -gfortran -O2 -frecursive -c -o zggsvd3.o zggsvd3.f -gfortran -O2 -frecursive -c -o zggsvp3.o zggsvp3.f -gfortran -O2 -frecursive -c -o zgtcon.o zgtcon.f -gfortran -O2 -frecursive -c -o zgtrfs.o zgtrfs.f -gfortran -O2 -frecursive -c -o zgtsv.o zgtsv.f -gfortran -O2 -frecursive -c -o zgtsvx.o zgtsvx.f -gfortran -O2 -frecursive -c -o zgttrf.o zgttrf.f -gfortran -O2 -frecursive -c -o zgttrs.o zgttrs.f -gfortran -O2 -frecursive -c -o zgtts2.o zgtts2.f -gfortran -O2 -frecursive -c -o zhbev.o zhbev.f -gfortran -O2 -frecursive -c -o zhbevd.o zhbevd.f -gfortran -O2 -frecursive -c -o zhbevx.o zhbevx.f -gfortran -O2 -frecursive -c -o zhbgst.o zhbgst.f -gfortran -O2 -frecursive -c -o zhbgv.o zhbgv.f -gfortran -O2 -frecursive -c -o zhbgvd.o zhbgvd.f -gfortran -O2 -frecursive -c -o zhbgvx.o zhbgvx.f -gfortran -O2 -frecursive -c -o zhbtrd.o zhbtrd.f -gfortran -O2 -frecursive -c -o zhecon.o zhecon.f -gfortran -O2 -frecursive -c -o zheev.o zheev.f -gfortran -O2 -frecursive -c -o zheevd.o zheevd.f -gfortran -O2 -frecursive -c -o zheevr.o zheevr.f -gfortran -O2 -frecursive -c -o zheevx.o zheevx.f -gfortran -O2 -frecursive -c -o zhegs2.o zhegs2.f -gfortran -O2 -frecursive -c -o zhegst.o zhegst.f -gfortran -O2 -frecursive -c -o zhegv.o zhegv.f -gfortran -O2 -frecursive -c -o zhegvd.o zhegvd.f -gfortran -O2 -frecursive -c -o zhegvx.o zhegvx.f -gfortran -O2 -frecursive -c -o zherfs.o zherfs.f -gfortran -O2 -frecursive -c -o zhesv.o zhesv.f -gfortran -O2 -frecursive -c -o zhesvx.o zhesvx.f -gfortran -O2 -frecursive -c -o zhetd2.o zhetd2.f -gfortran -O2 -frecursive -c -o zhetf2.o zhetf2.f -gfortran -O2 -frecursive -c -o zhetrd.o zhetrd.f -gfortran -O2 -frecursive -c -o zhetrf.o zhetrf.f -gfortran -O2 -frecursive -c -o zhetri.o zhetri.f -gfortran -O2 -frecursive -c -o zhetri2.o zhetri2.f -gfortran -O2 -frecursive -c -o zhetri2x.o zhetri2x.f -gfortran -O2 -frecursive -c -o zheswapr.o zheswapr.f -gfortran -O2 -frecursive -c -o zhetrs.o zhetrs.f -gfortran -O2 -frecursive -c -o zhetrs2.o zhetrs2.f -gfortran -O2 -frecursive -c -o zhetf2_rook.o zhetf2_rook.f -gfortran -O2 -frecursive -c -o zhetrf_rook.o zhetrf_rook.f -gfortran -O2 -frecursive -c -o zhetri_rook.o zhetri_rook.f -gfortran -O2 -frecursive -c -o zhetrs_rook.o zhetrs_rook.f -gfortran -O2 -frecursive -c -o zhecon_rook.o zhecon_rook.f -gfortran -O2 -frecursive -c -o zhesv_rook.o zhesv_rook.f -gfortran -O2 -frecursive -c -o zhetf2_rk.o zhetf2_rk.f -gfortran -O2 -frecursive -c -o zhetrf_rk.o zhetrf_rk.f -gfortran -O2 -frecursive -c -o zhetri_3.o zhetri_3.f -gfortran -O2 -frecursive -c -o zhetri_3x.o zhetri_3x.f -gfortran -O2 -frecursive -c -o zhetrs_3.o zhetrs_3.f -gfortran -O2 -frecursive -c -o zhecon_3.o zhecon_3.f -gfortran -O2 -frecursive -c -o zhesv_rk.o zhesv_rk.f -gfortran -O2 -frecursive -c -o zhesv_aa.o zhesv_aa.f -gfortran -O2 -frecursive -c -o zhetrf_aa.o zhetrf_aa.f -gfortran -O2 -frecursive -c -o zhetrs_aa.o zhetrs_aa.f -gfortran -O2 -frecursive -c -o zlahef_aa.o zlahef_aa.f -gfortran -O2 -frecursive -c -o zhesv_aa_2stage.o zhesv_aa_2stage.f -gfortran -O2 -frecursive -c -o zhetrf_aa_2stage.o zhetrf_aa_2stage.f -gfortran -O2 -frecursive -c -o zhetrs_aa_2stage.o zhetrs_aa_2stage.f -gfortran -O2 -frecursive -c -o zhgeqz.o zhgeqz.f -gfortran -O2 -frecursive -c -o zhpcon.o zhpcon.f -gfortran -O2 -frecursive -c -o zhpev.o zhpev.f -gfortran -O2 -frecursive -c -o zhpevd.o zhpevd.f -gfortran -O2 -frecursive -c -o zlaqz0.o zlaqz0.f -gfortran -O2 -frecursive -c -o zlaqz1.o zlaqz1.f -gfortran -O2 -frecursive -c -o zlaqz2.o zlaqz2.f -gfortran -O2 -frecursive -c -o zlaqz3.o zlaqz3.f -gfortran -O2 -frecursive -c -o zhpevx.o zhpevx.f -gfortran -O2 -frecursive -c -o zhpgst.o zhpgst.f -gfortran -O2 -frecursive -c -o zhpgv.o zhpgv.f -gfortran -O2 -frecursive -c -o zhpgvd.o zhpgvd.f -gfortran -O2 -frecursive -c -o zhpgvx.o zhpgvx.f -gfortran -O2 -frecursive -c -o zhprfs.o zhprfs.f -gfortran -O2 -frecursive -c -o zhpsv.o zhpsv.f -gfortran -O2 -frecursive -c -o zhpsvx.o zhpsvx.f -gfortran -O2 -frecursive -c -o zhptrd.o zhptrd.f -gfortran -O2 -frecursive -c -o zhptrf.o zhptrf.f -gfortran -O2 -frecursive -c -o zhptri.o zhptri.f -gfortran -O2 -frecursive -c -o zhptrs.o zhptrs.f -gfortran -O2 -frecursive -c -o zhsein.o zhsein.f -gfortran -O2 -frecursive -c -o zhseqr.o zhseqr.f -gfortran -O2 -frecursive -c -o zlabrd.o zlabrd.f -gfortran -O2 -frecursive -c -o zlacgv.o zlacgv.f -gfortran -O2 -frecursive -c -o zlacon.o zlacon.f -gfortran -O2 -frecursive -c -o zlacn2.o zlacn2.f -gfortran -O2 -frecursive -c -o zlacp2.o zlacp2.f -gfortran -O2 -frecursive -c -o zlacpy.o zlacpy.f -gfortran -O2 -frecursive -c -o zlacrm.o zlacrm.f -gfortran -O2 -frecursive -c -o zlacrt.o zlacrt.f -gfortran -O2 -frecursive -c -o zladiv.o zladiv.f -gfortran -O2 -frecursive -c -o zlaed0.o zlaed0.f -gfortran -O2 -frecursive -c -o zlaed7.o zlaed7.f -gfortran -O2 -frecursive -c -o zlaed8.o zlaed8.f -gfortran -O2 -frecursive -c -o zlaein.o zlaein.f -gfortran -O2 -frecursive -c -o zlaesy.o zlaesy.f -gfortran -O2 -frecursive -c -o zlaev2.o zlaev2.f -gfortran -O2 -frecursive -c -o zlags2.o zlags2.f -gfortran -O2 -frecursive -c -o zlagtm.o zlagtm.f -gfortran -O2 -frecursive -c -o zlahef.o zlahef.f -gfortran -O2 -frecursive -c -o zlahef_rook.o zlahef_rook.f -gfortran -O2 -frecursive -c -o zlahef_rk.o zlahef_rk.f -gfortran -O2 -frecursive -c -o zlahqr.o zlahqr.f -gfortran -O2 -frecursive -c -o zlahr2.o zlahr2.f -gfortran -O2 -frecursive -c -o zlaic1.o zlaic1.f -gfortran -O2 -frecursive -c -o zlals0.o zlals0.f -gfortran -O2 -frecursive -c -o zlalsa.o zlalsa.f -gfortran -O2 -frecursive -c -o zlalsd.o zlalsd.f -gfortran -O2 -frecursive -c -o zlangb.o zlangb.f -gfortran -O2 -frecursive -c -o zlange.o zlange.f -gfortran -O2 -frecursive -c -o zlangt.o zlangt.f -gfortran -O2 -frecursive -c -o zlanhb.o zlanhb.f -gfortran -O2 -frecursive -c -o zlanhe.o zlanhe.f -gfortran -O2 -frecursive -c -o zlanhp.o zlanhp.f -gfortran -O2 -frecursive -c -o zlanhs.o zlanhs.f -gfortran -O2 -frecursive -c -o zlanht.o zlanht.f -gfortran -O2 -frecursive -c -o zlansb.o zlansb.f -gfortran -O2 -frecursive -c -o zlansp.o zlansp.f -gfortran -O2 -frecursive -c -o zlansy.o zlansy.f -gfortran -O2 -frecursive -c -o zlantb.o zlantb.f -gfortran -O2 -frecursive -c -o zlantp.o zlantp.f -gfortran -O2 -frecursive -c -o zlantr.o zlantr.f -gfortran -O2 -frecursive -c -o zlapll.o zlapll.f -gfortran -O2 -frecursive -c -o zlapmt.o zlapmt.f -gfortran -O2 -frecursive -c -o zlaqgb.o zlaqgb.f -gfortran -O2 -frecursive -c -o zlaqge.o zlaqge.f -gfortran -O2 -frecursive -c -o zlaqhb.o zlaqhb.f -gfortran -O2 -frecursive -c -o zlaqhe.o zlaqhe.f -gfortran -O2 -frecursive -c -o zlaqhp.o zlaqhp.f -gfortran -O2 -frecursive -c -o zlaqp2.o zlaqp2.f -gfortran -O2 -frecursive -c -o zlaqps.o zlaqps.f -gfortran -O2 -frecursive -c -o zlaqp2rk.o zlaqp2rk.f -gfortran -O2 -frecursive -c -o zlaqp3rk.o zlaqp3rk.f -gfortran -O2 -frecursive -c -o zlaqsb.o zlaqsb.f -gfortran -O2 -frecursive -c -o zlaqr0.o zlaqr0.f -gfortran -O2 -frecursive -c -o zlaqr1.o zlaqr1.f -gfortran -O2 -frecursive -c -o zlaqr2.o zlaqr2.f -gfortran -O2 -frecursive -c -o zlaqr3.o zlaqr3.f -gfortran -O2 -frecursive -c -o zlaqr4.o zlaqr4.f -gfortran -O2 -frecursive -c -o zlaqr5.o zlaqr5.f -gfortran -O2 -frecursive -c -o zlaqsp.o zlaqsp.f -gfortran -O2 -frecursive -c -o zlaqsy.o zlaqsy.f -gfortran -O2 -frecursive -c -o zlar1v.o zlar1v.f -gfortran -O2 -frecursive -c -o zlar2v.o zlar2v.f -gfortran -O2 -frecursive -c -o ilazlr.o ilazlr.f -gfortran -O2 -frecursive -c -o ilazlc.o ilazlc.f -gfortran -O2 -frecursive -c -o zlarcm.o zlarcm.f -gfortran -O2 -frecursive -c -o zlarf.o zlarf.f -gfortran -O2 -frecursive -c -o zlarfb.o zlarfb.f -gfortran -O2 -frecursive -c -o zlarfb_gett.o zlarfb_gett.f -gfortran -O2 -frecursive -c -o zlarfg.o zlarfg.f -gfortran -O2 -frecursive -c -o zlarft.o zlarft.f -gfortran -O2 -frecursive -c -o zlarfgp.o zlarfgp.f -gfortran -O2 -frecursive -c -o zlarfx.o zlarfx.f -gfortran -O2 -frecursive -c -o zlarfy.o zlarfy.f -gfortran -O2 -frecursive -c -o zlargv.o zlargv.f -gfortran -O2 -frecursive -c -o zlarnv.o zlarnv.f -gfortran -O2 -frecursive -c -o zlarrv.o zlarrv.f -gfortran -O2 -frecursive -c -o zlartv.o zlartv.f -gfortran -O2 -frecursive -c -o zlarz.o zlarz.f -gfortran -O2 -frecursive -c -o zlarzb.o zlarzb.f -gfortran -O2 -frecursive -c -o zlarzt.o zlarzt.f -gfortran -O2 -frecursive -c -o zlascl.o zlascl.f -gfortran -O2 -frecursive -c -o zlaset.o zlaset.f -gfortran -O2 -frecursive -c -o zlasr.o zlasr.f -gfortran -O2 -frecursive -c -o zlaswp.o zlaswp.f -gfortran -O2 -frecursive -c -o zlasyf.o zlasyf.f -gfortran -O2 -frecursive -c -o zlasyf_rook.o zlasyf_rook.f -gfortran -O2 -frecursive -c -o zlasyf_rk.o zlasyf_rk.f -gfortran -O2 -frecursive -c -o zlasyf_aa.o zlasyf_aa.f -gfortran -O2 -frecursive -c -o zlatbs.o zlatbs.f -gfortran -O2 -frecursive -c -o zlatdf.o zlatdf.f -gfortran -O2 -frecursive -c -o zlatps.o zlatps.f -gfortran -O2 -frecursive -c -o zlatrd.o zlatrd.f -gfortran -O2 -frecursive -c -o zlatrs.o zlatrs.f -gfortran -O2 -frecursive -c -o zlatrs3.o zlatrs3.f -gfortran -O2 -frecursive -c -o zlatrz.o zlatrz.f -gfortran -O2 -frecursive -c -o zlauu2.o zlauu2.f -gfortran -O2 -frecursive -c -o zlauum.o zlauum.f -gfortran -O2 -frecursive -c -o zpbcon.o zpbcon.f -gfortran -O2 -frecursive -c -o zpbequ.o zpbequ.f -gfortran -O2 -frecursive -c -o zpbrfs.o zpbrfs.f -gfortran -O2 -frecursive -c -o zpbstf.o zpbstf.f -gfortran -O2 -frecursive -c -o zpbsv.o zpbsv.f -gfortran -O2 -frecursive -c -o zpbsvx.o zpbsvx.f -gfortran -O2 -frecursive -c -o zpbtf2.o zpbtf2.f -gfortran -O2 -frecursive -c -o zpbtrf.o zpbtrf.f -gfortran -O2 -frecursive -c -o zpbtrs.o zpbtrs.f -gfortran -O2 -frecursive -c -o zpocon.o zpocon.f -gfortran -O2 -frecursive -c -o zpoequ.o zpoequ.f -gfortran -O2 -frecursive -c -o zporfs.o zporfs.f -gfortran -O2 -frecursive -c -o zposv.o zposv.f -gfortran -O2 -frecursive -c -o zposvx.o zposvx.f -gfortran -O2 -frecursive -c -o zpotf2.o zpotf2.f -gfortran -O2 -frecursive -c -o zpotrf.o zpotrf.f -gfortran -O2 -frecursive -c -o zpotri.o zpotri.f -gfortran -O2 -frecursive -c -o zpotrs.o zpotrs.f -gfortran -O2 -frecursive -c -o zpstrf.o zpstrf.f -gfortran -O2 -frecursive -c -o zpstf2.o zpstf2.f -gfortran -O2 -frecursive -c -o zppcon.o zppcon.f -gfortran -O2 -frecursive -c -o zppequ.o zppequ.f -gfortran -O2 -frecursive -c -o zpprfs.o zpprfs.f -gfortran -O2 -frecursive -c -o zppsv.o zppsv.f -gfortran -O2 -frecursive -c -o zppsvx.o zppsvx.f -gfortran -O2 -frecursive -c -o zpptrf.o zpptrf.f -gfortran -O2 -frecursive -c -o zpptri.o zpptri.f -gfortran -O2 -frecursive -c -o zpptrs.o zpptrs.f -gfortran -O2 -frecursive -c -o zptcon.o zptcon.f -gfortran -O2 -frecursive -c -o zpteqr.o zpteqr.f -gfortran -O2 -frecursive -c -o zptrfs.o zptrfs.f -gfortran -O2 -frecursive -c -o zptsv.o zptsv.f -gfortran -O2 -frecursive -c -o zptsvx.o zptsvx.f -gfortran -O2 -frecursive -c -o zpttrf.o zpttrf.f -gfortran -O2 -frecursive -c -o zpttrs.o zpttrs.f -gfortran -O2 -frecursive -c -o zptts2.o zptts2.f -gfortran -O2 -frecursive -c -o zrot.o zrot.f -gfortran -O2 -frecursive -c -o zspcon.o zspcon.f -gfortran -O2 -frecursive -c -o zspmv.o zspmv.f -gfortran -O2 -frecursive -c -o zspr.o zspr.f -gfortran -O2 -frecursive -c -o zsprfs.o zsprfs.f -gfortran -O2 -frecursive -c -o zspsv.o zspsv.f -gfortran -O2 -frecursive -c -o zspsvx.o zspsvx.f -gfortran -O2 -frecursive -c -o zsptrf.o zsptrf.f -gfortran -O2 -frecursive -c -o zsptri.o zsptri.f -gfortran -O2 -frecursive -c -o zsptrs.o zsptrs.f -gfortran -O2 -frecursive -c -o zdrscl.o zdrscl.f -gfortran -O2 -frecursive -c -o zrscl.o zrscl.f -gfortran -O2 -frecursive -c -o zstedc.o zstedc.f -gfortran -O2 -frecursive -c -o zstegr.o zstegr.f -gfortran -O2 -frecursive -c -o zstein.o zstein.f -gfortran -O2 -frecursive -c -o zsteqr.o zsteqr.f -gfortran -O2 -frecursive -c -o zsycon.o zsycon.f -gfortran -O2 -frecursive -c -o zsymv.o zsymv.f -gfortran -O2 -frecursive -c -o zsyr.o zsyr.f -gfortran -O2 -frecursive -c -o zsyrfs.o zsyrfs.f -gfortran -O2 -frecursive -c -o zsysv.o zsysv.f -gfortran -O2 -frecursive -c -o zsysvx.o zsysvx.f -gfortran -O2 -frecursive -c -o zsytf2.o zsytf2.f -gfortran -O2 -frecursive -c -o zsytrf.o zsytrf.f -gfortran -O2 -frecursive -c -o zsytri.o zsytri.f -gfortran -O2 -frecursive -c -o zsytri2.o zsytri2.f -gfortran -O2 -frecursive -c -o zsytri2x.o zsytri2x.f -gfortran -O2 -frecursive -c -o zsyswapr.o zsyswapr.f -gfortran -O2 -frecursive -c -o zsytrs.o zsytrs.f -gfortran -O2 -frecursive -c -o zsytrs2.o zsytrs2.f -gfortran -O2 -frecursive -c -o zsyconv.o zsyconv.f -gfortran -O2 -frecursive -c -o zsyconvf.o zsyconvf.f -gfortran -O2 -frecursive -c -o zsyconvf_rook.o zsyconvf_rook.f -gfortran -O2 -frecursive -c -o zsytf2_rook.o zsytf2_rook.f -gfortran -O2 -frecursive -c -o zsytrf_rook.o zsytrf_rook.f -gfortran -O2 -frecursive -c -o zsytrs_rook.o zsytrs_rook.f -gfortran -O2 -frecursive -c -o zsytrs_aa.o zsytrs_aa.f -gfortran -O2 -frecursive -c -o zsytri_rook.o zsytri_rook.f -gfortran -O2 -frecursive -c -o zsycon_rook.o zsycon_rook.f -gfortran -O2 -frecursive -c -o zsysv_rook.o zsysv_rook.f -gfortran -O2 -frecursive -c -o zsysv_aa_2stage.o zsysv_aa_2stage.f -gfortran -O2 -frecursive -c -o zsytrf_aa_2stage.o zsytrf_aa_2stage.f -gfortran -O2 -frecursive -c -o zsytrs_aa_2stage.o zsytrs_aa_2stage.f -gfortran -O2 -frecursive -c -o zsytf2_rk.o zsytf2_rk.f -gfortran -O2 -frecursive -c -o zsytrf_rk.o zsytrf_rk.f -gfortran -O2 -frecursive -c -o zsytrf_aa.o zsytrf_aa.f -gfortran -O2 -frecursive -c -o zsytrs_3.o zsytrs_3.f -gfortran -O2 -frecursive -c -o zsytri_3.o zsytri_3.f -gfortran -O2 -frecursive -c -o zsytri_3x.o zsytri_3x.f -gfortran -O2 -frecursive -c -o zsycon_3.o zsycon_3.f -gfortran -O2 -frecursive -c -o zsysv_rk.o zsysv_rk.f -gfortran -O2 -frecursive -c -o zsysv_aa.o zsysv_aa.f -gfortran -O2 -frecursive -c -o ztbcon.o ztbcon.f -gfortran -O2 -frecursive -c -o ztbrfs.o ztbrfs.f -gfortran -O2 -frecursive -c -o ztbtrs.o ztbtrs.f -gfortran -O2 -frecursive -c -o ztgevc.o ztgevc.f -gfortran -O2 -frecursive -c -o ztgex2.o ztgex2.f -gfortran -O2 -frecursive -c -o ztgexc.o ztgexc.f -gfortran -O2 -frecursive -c -o ztgsen.o ztgsen.f -gfortran -O2 -frecursive -c -o ztgsja.o ztgsja.f -gfortran -O2 -frecursive -c -o ztgsna.o ztgsna.f -gfortran -O2 -frecursive -c -o ztgsy2.o ztgsy2.f -gfortran -O2 -frecursive -c -o ztgsyl.o ztgsyl.f -gfortran -O2 -frecursive -c -o ztpcon.o ztpcon.f -gfortran -O2 -frecursive -c -o ztprfs.o ztprfs.f -gfortran -O2 -frecursive -c -o ztptri.o ztptri.f -gfortran -O2 -frecursive -c -o ztptrs.o ztptrs.f -gfortran -O2 -frecursive -c -o ztrcon.o ztrcon.f -gfortran -O2 -frecursive -c -o ztrevc.o ztrevc.f -gfortran -O2 -frecursive -c -o ztrevc3.o ztrevc3.f -gfortran -O2 -frecursive -c -o ztrexc.o ztrexc.f -gfortran -O2 -frecursive -c -o ztrrfs.o ztrrfs.f -gfortran -O2 -frecursive -c -o ztrsen.o ztrsen.f -gfortran -O2 -frecursive -c -o ztrsna.o ztrsna.f -gfortran -O2 -frecursive -c -o ztrsyl.o ztrsyl.f -gfortran -O2 -frecursive -c -o ztrsyl3.o ztrsyl3.f -gfortran -O2 -frecursive -c -o ztrti2.o ztrti2.f -gfortran -O2 -frecursive -c -o ztrtri.o ztrtri.f -gfortran -O2 -frecursive -c -o ztrtrs.o ztrtrs.f -gfortran -O2 -frecursive -c -o ztzrzf.o ztzrzf.f -gfortran -O2 -frecursive -c -o zung2l.o zung2l.f -gfortran -O2 -frecursive -c -o zung2r.o zung2r.f -gfortran -O2 -frecursive -c -o zungbr.o zungbr.f -gfortran -O2 -frecursive -c -o zunghr.o zunghr.f -gfortran -O2 -frecursive -c -o zungl2.o zungl2.f -gfortran -O2 -frecursive -c -o zunglq.o zunglq.f -gfortran -O2 -frecursive -c -o zungql.o zungql.f -gfortran -O2 -frecursive -c -o zungqr.o zungqr.f -gfortran -O2 -frecursive -c -o zungr2.o zungr2.f -gfortran -O2 -frecursive -c -o zungrq.o zungrq.f -gfortran -O2 -frecursive -c -o zungtr.o zungtr.f -gfortran -O2 -frecursive -c -o zungtsqr.o zungtsqr.f -gfortran -O2 -frecursive -c -o zungtsqr_row.o zungtsqr_row.f -gfortran -O2 -frecursive -c -o zunm2l.o zunm2l.f -gfortran -O2 -frecursive -c -o zunm2r.o zunm2r.f -gfortran -O2 -frecursive -c -o zunmbr.o zunmbr.f -gfortran -O2 -frecursive -c -o zunmhr.o zunmhr.f -gfortran -O2 -frecursive -c -o zunml2.o zunml2.f -gfortran -O2 -frecursive -c -o zunm22.o zunm22.f -gfortran -O2 -frecursive -c -o zunmlq.o zunmlq.f -gfortran -O2 -frecursive -c -o zunmql.o zunmql.f -gfortran -O2 -frecursive -c -o zunmqr.o zunmqr.f -gfortran -O2 -frecursive -c -o zunmr2.o zunmr2.f -gfortran -O2 -frecursive -c -o zunmr3.o zunmr3.f -gfortran -O2 -frecursive -c -o zunmrq.o zunmrq.f -gfortran -O2 -frecursive -c -o zunmrz.o zunmrz.f -gfortran -O2 -frecursive -c -o zunmtr.o zunmtr.f -gfortran -O2 -frecursive -c -o zupgtr.o zupgtr.f -gfortran -O2 -frecursive -c -o zupmtr.o zupmtr.f -gfortran -O2 -frecursive -c -o izmax1.o izmax1.f -gfortran -O2 -frecursive -c -o dzsum1.o dzsum1.f -gfortran -O2 -frecursive -c -o zstemr.o zstemr.f -gfortran -O2 -frecursive -c -o zcgesv.o zcgesv.f -gfortran -O2 -frecursive -c -o zcposv.o zcposv.f -gfortran -O2 -frecursive -c -o zlag2c.o zlag2c.f -gfortran -O2 -frecursive -c -o clag2z.o clag2z.f -gfortran -O2 -frecursive -c -o zlat2c.o zlat2c.f -gfortran -O2 -frecursive -c -o zhfrk.o zhfrk.f -gfortran -O2 -frecursive -c -o ztfttp.o ztfttp.f -gfortran -O2 -frecursive -c -o zlanhf.o zlanhf.f -gfortran -O2 -frecursive -c -o zpftrf.o zpftrf.f -gfortran -O2 -frecursive -c -o zpftri.o zpftri.f -gfortran -O2 -frecursive -c -o zpftrs.o zpftrs.f -gfortran -O2 -frecursive -c -o ztfsm.o ztfsm.f -gfortran -O2 -frecursive -c -o ztftri.o ztftri.f -gfortran -O2 -frecursive -c -o ztfttr.o ztfttr.f -gfortran -O2 -frecursive -c -o ztpttf.o ztpttf.f -gfortran -O2 -frecursive -c -o ztpttr.o ztpttr.f -gfortran -O2 -frecursive -c -o ztrttf.o ztrttf.f -gfortran -O2 -frecursive -c -o ztrttp.o ztrttp.f -gfortran -O2 -frecursive -c -o zgeequb.o zgeequb.f -gfortran -O2 -frecursive -c -o zgbequb.o zgbequb.f -gfortran -O2 -frecursive -c -o zsyequb.o zsyequb.f -gfortran -O2 -frecursive -c -o zpoequb.o zpoequb.f -gfortran -O2 -frecursive -c -o zheequb.o zheequb.f -gfortran -O2 -frecursive -c -o zbbcsd.o zbbcsd.f -gfortran -O2 -frecursive -c -o zlapmr.o zlapmr.f -gfortran -O2 -frecursive -c -o zunbdb.o zunbdb.f -gfortran -O2 -frecursive -c -o zunbdb1.o zunbdb1.f -gfortran -O2 -frecursive -c -o zunbdb2.o zunbdb2.f -gfortran -O2 -frecursive -c -o zunbdb3.o zunbdb3.f -gfortran -O2 -frecursive -c -o zunbdb4.o zunbdb4.f -gfortran -O2 -frecursive -c -o zunbdb5.o zunbdb5.f -gfortran -O2 -frecursive -c -o zunbdb6.o zunbdb6.f -gfortran -O2 -frecursive -c -o zuncsd.o zuncsd.f -gfortran -O2 -frecursive -c -o zuncsd2by1.o zuncsd2by1.f -gfortran -O2 -frecursive -c -o zgeqrt.o zgeqrt.f -gfortran -O2 -frecursive -c -o zgeqrt2.o zgeqrt2.f -gfortran -O2 -frecursive -c -o zgeqrt3.o zgeqrt3.f -gfortran -O2 -frecursive -c -o zgemqrt.o zgemqrt.f -gfortran -O2 -frecursive -c -o ztpqrt.o ztpqrt.f -gfortran -O2 -frecursive -c -o ztpqrt2.o ztpqrt2.f -gfortran -O2 -frecursive -c -o ztpmqrt.o ztpmqrt.f -gfortran -O2 -frecursive -c -o ztprfb.o ztprfb.f -gfortran -O2 -frecursive -c -o ztplqt.o ztplqt.f -gfortran -O2 -frecursive -c -o ztplqt2.o ztplqt2.f -gfortran -O2 -frecursive -c -o ztpmlqt.o ztpmlqt.f -gfortran -O2 -frecursive -c -o zgelqt.o zgelqt.f -gfortran -O2 -frecursive -c -o zgelqt3.o zgelqt3.f -gfortran -O2 -frecursive -c -o zgemlqt.o zgemlqt.f -gfortran -O2 -frecursive -c -o zgetsls.o zgetsls.f -gfortran -O2 -frecursive -c -o zgetsqrhrt.o zgetsqrhrt.f -gfortran -O2 -frecursive -c -o zgeqr.o zgeqr.f -gfortran -O2 -frecursive -c -o zlatsqr.o zlatsqr.f -gfortran -O2 -frecursive -c -o zlamtsqr.o zlamtsqr.f -gfortran -O2 -frecursive -c -o zgemqr.o zgemqr.f -gfortran -O2 -frecursive -c -o zgelq.o zgelq.f -gfortran -O2 -frecursive -c -o zlaswlq.o zlaswlq.f -gfortran -O2 -frecursive -c -o zlamswlq.o zlamswlq.f -gfortran -O2 -frecursive -c -o zgemlq.o zgemlq.f -gfortran -O2 -frecursive -c -o zunhr_col.o zunhr_col.f -gfortran -O2 -frecursive -c -o zlaunhr_col_getrfnp.o zlaunhr_col_getrfnp.f -gfortran -O2 -frecursive -c -o zlaunhr_col_getrfnp2.o zlaunhr_col_getrfnp2.f -gfortran -O2 -frecursive -c -o zhetrd_2stage.o zhetrd_2stage.f -gfortran -O2 -frecursive -c -o zhetrd_he2hb.o zhetrd_he2hb.f -gfortran -O2 -frecursive -c -o zhb2st_kernels.o zhb2st_kernels.f -gfortran -O2 -frecursive -c -o zheevd_2stage.o zheevd_2stage.f -gfortran -O2 -frecursive -c -o zheev_2stage.o zheev_2stage.f -gfortran -O2 -frecursive -c -o zheevx_2stage.o zheevx_2stage.f -gfortran -O2 -frecursive -c -o zheevr_2stage.o zheevr_2stage.f -gfortran -O2 -frecursive -c -o zhbev_2stage.o zhbev_2stage.f -gfortran -O2 -frecursive -c -o zhbevx_2stage.o zhbevx_2stage.f -gfortran -O2 -frecursive -c -o zhbevd_2stage.o zhbevd_2stage.f -gfortran -O2 -frecursive -c -o zhegv_2stage.o zhegv_2stage.f -gfortran -O2 -frecursive -c -o zgesvdq.o zgesvdq.f -gfortran -O2 -frecursive -c -o cpotrs.o cpotrs.f -gfortran -O2 -frecursive -c -o cgetrs.o cgetrs.f -gfortran -O2 -frecursive -c -o cpotrf.o cpotrf.f -gfortran -O2 -frecursive -c -o cgetrf.o cgetrf.f -gfortran -O2 -frecursive -c -o sbdsdc.o sbdsdc.f -gfortran -O2 -frecursive -c -o sbdsqr.o sbdsqr.f -gfortran -O2 -frecursive -c -o sdisna.o sdisna.f -gfortran -O2 -frecursive -c -o slabad.o slabad.f -gfortran -O2 -frecursive -c -o slacpy.o slacpy.f -gfortran -O2 -frecursive -c -o sladiv.o sladiv.f -gfortran -O2 -frecursive -c -o slae2.o slae2.f -gfortran -O2 -frecursive -c -o slaebz.o slaebz.f -gfortran -O2 -frecursive -c -o slaed0.o slaed0.f -gfortran -O2 -frecursive -c -o slaed1.o slaed1.f -gfortran -O2 -frecursive -c -o slaed2.o slaed2.f -gfortran -O2 -frecursive -c -o slaed3.o slaed3.f -gfortran -O2 -frecursive -c -o slaed4.o slaed4.f -gfortran -O2 -frecursive -c -o slaed5.o slaed5.f -gfortran -O2 -frecursive -c -o slaed6.o slaed6.f -gfortran -O2 -frecursive -c -o slaed7.o slaed7.f -gfortran -O2 -frecursive -c -o slaed8.o slaed8.f -gfortran -O2 -frecursive -c -o slaed9.o slaed9.f -gfortran -O2 -frecursive -c -o slaeda.o slaeda.f -gfortran -O2 -frecursive -c -o slaev2.o slaev2.f -gfortran -O2 -frecursive -c -o slagtf.o slagtf.f -gfortran -O2 -frecursive -c -o slagts.o slagts.f -gfortran -O2 -frecursive -c -o slamrg.o slamrg.f -gfortran -O2 -frecursive -c -o slanst.o slanst.f -gfortran -O2 -frecursive -c -o slapy2.o slapy2.f -gfortran -O2 -frecursive -c -o slapy3.o slapy3.f -gfortran -O2 -frecursive -c -o slarnv.o slarnv.f -gfortran -O2 -frecursive -c -o slarra.o slarra.f -gfortran -O2 -frecursive -c -o slarrb.o slarrb.f -gfortran -O2 -frecursive -c -o slarrc.o slarrc.f -gfortran -O2 -frecursive -c -o slarrd.o slarrd.f -gfortran -O2 -frecursive -c -o slarre.o slarre.f -gfortran -O2 -frecursive -c -o slarrf.o slarrf.f -gfortran -O2 -frecursive -c -o slarrj.o slarrj.f -gfortran -O2 -frecursive -c -o slarrk.o slarrk.f -gfortran -O2 -frecursive -c -o slarrr.o slarrr.f -gfortran -O2 -frecursive -c -o slaneg.o slaneg.f -gfortran -O0 -frecursive -c -o slaruv.o slaruv.f -gfortran -O2 -frecursive -c -o slas2.o slas2.f -gfortran -O2 -frecursive -c -o slascl.o slascl.f -gfortran -O2 -frecursive -c -o slasd0.o slasd0.f -gfortran -O2 -frecursive -c -o slasd1.o slasd1.f -gfortran -O2 -frecursive -c -o slasd2.o slasd2.f -gfortran -O2 -frecursive -c -o slasd3.o slasd3.f -gfortran -O2 -frecursive -c -o slasd4.o slasd4.f -gfortran -O2 -frecursive -c -o slasd5.o slasd5.f -gfortran -O2 -frecursive -c -o slasd6.o slasd6.f -gfortran -O2 -frecursive -c -o slasd7.o slasd7.f -gfortran -O2 -frecursive -c -o slasd8.o slasd8.f -gfortran -O2 -frecursive -c -o slasda.o slasda.f -gfortran -O2 -frecursive -c -o slasdq.o slasdq.f -gfortran -O2 -frecursive -c -o slasdt.o slasdt.f -gfortran -O2 -frecursive -c -o slaset.o slaset.f -gfortran -O2 -frecursive -c -o slasq1.o slasq1.f -gfortran -O2 -frecursive -c -o slasq2.o slasq2.f -gfortran -O2 -frecursive -c -o slasq3.o slasq3.f -gfortran -O2 -frecursive -c -o slasq4.o slasq4.f -gfortran -O2 -frecursive -c -o slasq5.o slasq5.f -gfortran -O2 -frecursive -c -o slasq6.o slasq6.f -gfortran -O2 -frecursive -c -o slasr.o slasr.f -gfortran -O2 -frecursive -c -o slasrt.o slasrt.f -gfortran -O2 -frecursive -c -o slasv2.o slasv2.f -gfortran -O2 -frecursive -c -o spttrf.o spttrf.f -gfortran -O2 -frecursive -c -o sstebz.o sstebz.f -gfortran -O2 -frecursive -c -o sstedc.o sstedc.f -gfortran -O2 -frecursive -c -o ssteqr.o ssteqr.f -gfortran -O2 -frecursive -c -o ssterf.o ssterf.f -gfortran -O2 -frecursive -c -o slaisnan.o slaisnan.f -gfortran -O2 -frecursive -c -o sisnan.o sisnan.f -gfortran -O2 -frecursive -c -o slartgp.o slartgp.f -gfortran -O2 -frecursive -c -o slartgs.o slartgs.f -gfortran -O2 -frecursive -c -o ../INSTALL/sroundup_lwork.o ../INSTALL/sroundup_lwork.f -gfortran -O2 -frecursive -c -o ../INSTALL/second_INT_ETIME.o ../INSTALL/second_INT_ETIME.f -gfortran -O2 -frecursive -c -o dbdsdc.o dbdsdc.f -gfortran -O2 -frecursive -c -o dbdsqr.o dbdsqr.f -gfortran -O2 -frecursive -c -o ddisna.o ddisna.f -gfortran -O2 -frecursive -c -o dlabad.o dlabad.f -gfortran -O2 -frecursive -c -o dlacpy.o dlacpy.f -gfortran -O2 -frecursive -c -o dladiv.o dladiv.f -gfortran -O2 -frecursive -c -o dlae2.o dlae2.f -gfortran -O2 -frecursive -c -o dlaebz.o dlaebz.f -gfortran -O2 -frecursive -c -o dlaed0.o dlaed0.f -gfortran -O2 -frecursive -c -o dlaed1.o dlaed1.f -gfortran -O2 -frecursive -c -o dlaed2.o dlaed2.f -gfortran -O2 -frecursive -c -o dlaed3.o dlaed3.f -gfortran -O2 -frecursive -c -o dlaed4.o dlaed4.f -gfortran -O2 -frecursive -c -o dlaed5.o dlaed5.f -gfortran -O2 -frecursive -c -o dlaed6.o dlaed6.f -gfortran -O2 -frecursive -c -o dlaed7.o dlaed7.f -gfortran -O2 -frecursive -c -o dlaed8.o dlaed8.f -gfortran -O2 -frecursive -c -o dlaed9.o dlaed9.f -gfortran -O2 -frecursive -c -o dlaeda.o dlaeda.f -gfortran -O2 -frecursive -c -o dlaev2.o dlaev2.f -gfortran -O2 -frecursive -c -o dlagtf.o dlagtf.f -gfortran -O2 -frecursive -c -o dlagts.o dlagts.f -gfortran -O2 -frecursive -c -o dlamrg.o dlamrg.f -gfortran -O2 -frecursive -c -o dlanst.o dlanst.f -gfortran -O2 -frecursive -c -o dlapy2.o dlapy2.f -gfortran -O2 -frecursive -c -o dlapy3.o dlapy3.f -gfortran -O2 -frecursive -c -o dlarnv.o dlarnv.f -gfortran -O2 -frecursive -c -o dlarra.o dlarra.f -gfortran -O2 -frecursive -c -o dlarrb.o dlarrb.f -gfortran -O2 -frecursive -c -o dlarrc.o dlarrc.f -gfortran -O2 -frecursive -c -o dlarrd.o dlarrd.f -gfortran -O2 -frecursive -c -o dlarre.o dlarre.f -gfortran -O2 -frecursive -c -o dlarrf.o dlarrf.f -gfortran -O2 -frecursive -c -o dlarrj.o dlarrj.f -gfortran -O2 -frecursive -c -o dlarrk.o dlarrk.f -gfortran -O2 -frecursive -c -o dlarrr.o dlarrr.f -gfortran -O2 -frecursive -c -o dlaneg.o dlaneg.f -gfortran -O0 -frecursive -c -o dlaruv.o dlaruv.f -gfortran -O2 -frecursive -c -o dlas2.o dlas2.f -gfortran -O2 -frecursive -c -o dlascl.o dlascl.f -gfortran -O2 -frecursive -c -o dlasd0.o dlasd0.f -gfortran -O2 -frecursive -c -o dlasd1.o dlasd1.f -gfortran -O2 -frecursive -c -o dlasd2.o dlasd2.f -gfortran -O2 -frecursive -c -o dlasd3.o dlasd3.f -gfortran -O2 -frecursive -c -o dlasd4.o dlasd4.f -gfortran -O2 -frecursive -c -o dlasd5.o dlasd5.f -gfortran -O2 -frecursive -c -o dlasd6.o dlasd6.f -gfortran -O2 -frecursive -c -o dlasd7.o dlasd7.f -gfortran -O2 -frecursive -c -o dlasd8.o dlasd8.f -gfortran -O2 -frecursive -c -o dlasda.o dlasda.f -gfortran -O2 -frecursive -c -o dlasdq.o dlasdq.f -gfortran -O2 -frecursive -c -o dlasdt.o dlasdt.f -gfortran -O2 -frecursive -c -o dlaset.o dlaset.f -gfortran -O2 -frecursive -c -o dlasq1.o dlasq1.f -gfortran -O2 -frecursive -c -o dlasq2.o dlasq2.f -gfortran -O2 -frecursive -c -o dlasq3.o dlasq3.f -gfortran -O2 -frecursive -c -o dlasq4.o dlasq4.f -gfortran -O2 -frecursive -c -o dlasq5.o dlasq5.f -gfortran -O2 -frecursive -c -o dlasq6.o dlasq6.f -gfortran -O2 -frecursive -c -o dlasr.o dlasr.f -gfortran -O2 -frecursive -c -o dlasrt.o dlasrt.f -gfortran -O2 -frecursive -c -o dlasv2.o dlasv2.f -gfortran -O2 -frecursive -c -o dpttrf.o dpttrf.f -gfortran -O2 -frecursive -c -o dstebz.o dstebz.f -gfortran -O2 -frecursive -c -o dstedc.o dstedc.f -gfortran -O2 -frecursive -c -o dsteqr.o dsteqr.f -gfortran -O2 -frecursive -c -o dsterf.o dsterf.f -gfortran -O2 -frecursive -c -o dlaisnan.o dlaisnan.f -gfortran -O2 -frecursive -c -o disnan.o disnan.f -gfortran -O2 -frecursive -c -o dlartgp.o dlartgp.f -gfortran -O2 -frecursive -c -o dlartgs.o dlartgs.f -gfortran -O2 -frecursive -c -o ../INSTALL/droundup_lwork.o ../INSTALL/droundup_lwork.f -gfortran -O2 -frecursive -c -o ../INSTALL/dlamch.o ../INSTALL/dlamch.f -gfortran -O2 -frecursive -c -o ../INSTALL/dsecnd_INT_ETIME.o ../INSTALL/dsecnd_INT_ETIME.f -gfortran -O2 -frecursive -c -o ilaenv.o ilaenv.f -gfortran -O2 -frecursive -c -o ilaenv2stage.o ilaenv2stage.f -gfortran -O2 -frecursive -c -o ieeeck.o ieeeck.f -gfortran -O2 -frecursive -c -o lsamen.o lsamen.f -gfortran -O2 -frecursive -c -o xerbla.o xerbla.f -gfortran -O2 -frecursive -c -o xerbla_array.o xerbla_array.f -gfortran -O2 -frecursive -c -o iparmq.o iparmq.f -gfortran -O2 -frecursive -c -o ilaprec.o ilaprec.f -gfortran -O2 -frecursive -c -o ilatrans.o ilatrans.f -gfortran -O2 -frecursive -c -o ilauplo.o ilauplo.f -gfortran -O2 -frecursive -c -o iladiag.o iladiag.f -gfortran -O2 -frecursive -c -o chla_transtype.o chla_transtype.f -gfortran -O2 -frecursive -c -o ../INSTALL/ilaver.o ../INSTALL/ilaver.f -gfortran -O2 -frecursive -c -o ../INSTALL/lsame.o ../INSTALL/lsame.f -gfortran -O2 -frecursive -c -o ../INSTALL/slamch.o ../INSTALL/slamch.f -gfortran -O2 -frecursive -c -o la_xisnan.o la_xisnan.F90 -gfortran -O2 -frecursive -c -o sgedmd.o sgedmd.f90 -gfortran -O2 -frecursive -c -o sgedmdq.o sgedmdq.f90 -gfortran -O2 -frecursive -c -o dsytrd_sb2st.o dsytrd_sb2st.F -gfortran -O2 -frecursive -c -o dgedmd.o dgedmd.f90 -gfortran -O2 -frecursive -c -o dgedmdq.o dgedmdq.f90 -gfortran -O2 -frecursive -c -o clartg.o clartg.f90 -gfortran -O2 -frecursive -c -o classq.o classq.f90 -gfortran -O2 -frecursive -c -o chetrd_hb2st.o chetrd_hb2st.F -gfortran -O2 -frecursive -c -o cgedmd.o cgedmd.f90 -gfortran -O2 -frecursive -c -o cgedmdq.o cgedmdq.f90 -gfortran -O2 -frecursive -c -o zlartg.o zlartg.f90 -gfortran -O2 -frecursive -c -o zlassq.o zlassq.f90 -gfortran -O2 -frecursive -c -o zhetrd_hb2st.o zhetrd_hb2st.F -gfortran -O2 -frecursive -c -o zgedmd.o zgedmd.f90 -gfortran -O2 -frecursive -c -o zgedmdq.o zgedmdq.f90 -gfortran -O2 -frecursive -c -o slartg.o slartg.f90 -gfortran -O2 -frecursive -c -o slassq.o slassq.f90 -gfortran -O2 -frecursive -c -o dlartg.o dlartg.f90 -gfortran -O2 -frecursive -c -o dlassq.o dlassq.f90 -gfortran -O2 -frecursive -c -o iparam2stage.o iparam2stage.F -ar cr ../liblapack.a sbdsvdx.o spotrf2.o sgetrf2.o sgbbrd.o sgbcon.o sgbequ.o sgbrfs.o sgbsv.o sgbsvx.o sgbtf2.o sgbtrf.o sgbtrs.o sgebak.o sgebal.o sgebd2.o sgebrd.o sgecon.o sgeequ.o sgees.o sgeesx.o sgeev.o sgeevx.o sgehd2.o sgehrd.o sgelq2.o sgelqf.o sgels.o sgelst.o sgelsd.o sgelss.o sgelsy.o sgeql2.o sgeqlf.o sgeqp3.o sgeqp3rk.o sgeqr2.o sgeqr2p.o sgeqrf.o sgeqrfp.o sgerfs.o sgerq2.o sgerqf.o sgesc2.o sgesdd.o sgesv.o sgesvd.o sgesvdx.o sgesvx.o sgetc2.o sgetf2.o sgetri.o sggbak.o sggbal.o sgges.o sgges3.o sggesx.o sggev.o sggev3.o sggevx.o sggglm.o sgghrd.o sgghd3.o sgglse.o sggqrf.o sggrqf.o sggsvd3.o sggsvp3.o sgtcon.o sgtrfs.o sgtsv.o sgtsvx.o sgttrf.o sgttrs.o sgtts2.o shgeqz.o slaqz0.o slaqz1.o slaqz2.o slaqz3.o slaqz4.o shsein.o shseqr.o slabrd.o slacon.o slacn2.o slaein.o slaexc.o slag2.o slags2.o slagtm.o slagv2.o slahqr.o slahr2.o slaic1.o slaln2.o slals0.o slalsa.o slalsd.o slangb.o slange.o slangt.o slanhs.o slansb.o slansp.o slansy.o slantb.o slantp.o slantr.o slanv2.o slapll.o slapmt.o slaqgb.o slaqge.o slaqp2.o slaqps.o slaqp2rk.o slaqp3rk.o slaqsb.o slaqsp.o slaqsy.o slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o slarf.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o slargv.o slarmm.o slarrv.o slartv.o slarz.o slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o slasyf_rk.o slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrs3.o slatrz.o slauu2.o slauum.o sopgtr.o sopmtr.o sorg2l.o sorg2r.o sorgbr.o sorghr.o sorgl2.o sorglq.o sorgql.o sorgqr.o sorgr2.o sorgrq.o sorgtr.o sorgtsqr.o sorgtsqr_row.o sorm2l.o sorm2r.o sorm22.o sormbr.o sormhr.o sorml2.o sormlq.o sormql.o sormqr.o sormr2.o sormr3.o sormrq.o sormrz.o sormtr.o spbcon.o spbequ.o spbrfs.o spbstf.o spbsv.o spbsvx.o spbtf2.o spbtrf.o spbtrs.o spocon.o spoequ.o sporfs.o sposv.o sposvx.o spotf2.o spotri.o spstrf.o spstf2.o sppcon.o sppequ.o spprfs.o sppsv.o sppsvx.o spptrf.o spptri.o spptrs.o sptcon.o spteqr.o sptrfs.o sptsv.o sptsvx.o spttrs.o sptts2.o srscl.o ssbev.o ssbevd.o ssbevx.o ssbgst.o ssbgv.o ssbgvd.o ssbgvx.o ssbtrd.o sspcon.o sspev.o sspevd.o sspevx.o sspgst.o sspgv.o sspgvd.o sspgvx.o ssprfs.o sspsv.o sspsvx.o ssptrd.o ssptrf.o ssptri.o ssptrs.o sstegr.o sstein.o sstev.o sstevd.o sstevr.o sstevx.o ssycon.o ssyev.o ssyevd.o ssyevr.o ssyevx.o ssygs2.o ssygst.o ssygv.o ssygvd.o ssygvx.o ssyrfs.o ssysv.o ssysvx.o ssytd2.o ssytf2.o ssytrd.o ssytrf.o ssytri.o ssytri2.o ssytri2x.o ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o ssyconvf.o ssyconvf_rook.o ssytf2_rook.o ssytrf_rook.o ssytrs_rook.o ssytri_rook.o ssycon_rook.o ssysv_rook.o ssytf2_rk.o ssytrf_rk.o ssytrs_3.o ssytri_3.o ssytri_3x.o ssycon_3.o ssysv_rk.o slasyf_aa.o ssysv_aa.o ssytrf_aa.o ssytrs_aa.o ssysv_aa_2stage.o ssytrf_aa_2stage.o ssytrs_aa_2stage.o stbcon.o 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 strevc3.o strexc.o strrfs.o strsen.o strsna.o strsyl.o strsyl3.o strti2.o strtri.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 sgejsv.o sgesvj.o sgsvj0.o sgsvj1.o sgeequb.o ssyequb.o spoequb.o sgbequb.o sbbcsd.o slapmr.o sorbdb.o sorbdb1.o sorbdb2.o sorbdb3.o sorbdb4.o sorbdb5.o sorbdb6.o sorcsd.o sorcsd2by1.o sgeqrt.o sgeqrt2.o sgeqrt3.o sgemqrt.o stpqrt.o stpqrt2.o stpmqrt.o stprfb.o sgelqt.o sgelqt3.o sgemlqt.o sgetsls.o sgetsqrhrt.o sgeqr.o slatsqr.o slamtsqr.o sgemqr.o sgelq.o slaswlq.o slamswlq.o sgemlq.o stplqt.o stplqt2.o stpmlqt.o sorhr_col.o slaorhr_col_getrfnp.o slaorhr_col_getrfnp2.o ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o sgesvdq.o sgedmd.o sgedmdq.o dpotrf2.o dgetrf2.o dbdsvdx.o dgbbrd.o dgbcon.o dgbequ.o dgbrfs.o dgbsv.o dgbsvx.o dgbtf2.o dgbtrf.o dgbtrs.o dgebak.o dgebal.o dgebd2.o dgebrd.o dgecon.o dgeequ.o dgees.o dgeesx.o dgeev.o dgeevx.o dgehd2.o dgehrd.o dgelq2.o dgelqf.o dgels.o dgelst.o dgelsd.o dgelss.o dgelsy.o dgeql2.o dgeqlf.o dgeqp3.o dgeqp3rk.o dgeqr2.o dgeqr2p.o dgeqrf.o dgeqrfp.o dgerfs.o dgerq2.o dgerqf.o dgesc2.o dgesdd.o dgesv.o dgesvd.o dgesvdx.o dgesvx.o dgetc2.o dgetf2.o dgetrf.o dgetri.o dgetrs.o dggbak.o dggbal.o dgges.o dgges3.o dggesx.o dggev.o dggev3.o dggevx.o dggglm.o dgghrd.o dgghd3.o dgglse.o dggqrf.o dggrqf.o dggsvd3.o dggsvp3.o dgtcon.o dgtrfs.o dgtsv.o dgtsvx.o dgttrf.o dgttrs.o dgtts2.o dhgeqz.o dlaqz0.o dlaqz1.o dlaqz2.o dlaqz3.o dlaqz4.o dhsein.o dhseqr.o dlabrd.o dlacon.o dlacn2.o dlaein.o dlaexc.o dlag2.o dlags2.o dlagtm.o dlagv2.o dlahqr.o dlahr2.o dlaic1.o dlaln2.o dlals0.o dlalsa.o dlalsd.o dlangb.o dlange.o dlangt.o dlanhs.o dlansb.o dlansp.o dlansy.o dlantb.o dlantp.o dlantr.o dlanv2.o dlapll.o dlapmt.o dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o dlarf.o dlarf1.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o dlargv.o dlarmm.o dlarrv.o dlartv.o dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o dlasyf.o dlasyf_rook.o dlasyf_rk.o dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrs3.o dlatrz.o dlauu2.o dlauum.o dopgtr.o dopmtr.o dorg2l.o dorg2r.o dorgbr.o dorghr.o dorgl2.o dorglq.o dorgql.o dorgqr.o dorgr2.o dorgrq.o dorgtr.o dorgtsqr.o dorgtsqr_row.o dorm2l.o dorm2r.o dorm22.o dormbr.o dormhr.o dorml2.o dormlq.o dormql.o dormqr.o dormr2.o dormr3.o dormrq.o dormrz.o dormtr.o dpbcon.o dpbequ.o dpbrfs.o dpbstf.o dpbsv.o dpbsvx.o dpbtf2.o dpbtrf.o dpbtrs.o dpocon.o dpoequ.o dporfs.o dposv.o dposvx.o dpotf2.o dpotrf.o dpotri.o dpotrs.o dpstrf.o dpstf2.o dppcon.o dppequ.o dpprfs.o dppsv.o dppsvx.o dpptrf.o dpptri.o dpptrs.o dptcon.o dpteqr.o dptrfs.o dptsv.o dptsvx.o dpttrs.o dptts2.o drscl.o dsbev.o dsbevd.o dsbevx.o dsbgst.o dsbgv.o dsbgvd.o dsbgvx.o dsbtrd.o dspcon.o dspev.o dspevd.o dspevx.o dspgst.o dspgv.o dspgvd.o dspgvx.o dsprfs.o dspsv.o dspsvx.o dsptrd.o dsptrf.o dsptri.o dsptrs.o dstegr.o dstein.o dstev.o dstevd.o dstevr.o dstevx.o dsycon.o dsyev.o dsyevd.o dsyevr.o dsyevx.o dsygs2.o dsygst.o dsygv.o dsygvd.o dsygvx.o dsyrfs.o dsysv.o dsysvx.o dsytd2.o dsytf2.o dsytrd.o dsytrf.o dsytri.o dsytri2.o dsytri2x.o dsyswapr.o dsytrs.o dsytrs2.o dsyconv.o dsyconvf.o dsyconvf_rook.o dsytf2_rook.o dsytrf_rook.o dsytrs_rook.o dsytri_rook.o dsycon_rook.o dsysv_rook.o dsytf2_rk.o dsytrf_rk.o dsytrs_3.o dsytri_3.o dsytri_3x.o dsycon_3.o dsysv_rk.o dlasyf_aa.o dsysv_aa.o dsytrf_aa.o dsytrs_aa.o dsysv_aa_2stage.o dsytrf_aa_2stage.o dsytrs_aa_2stage.o 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 dtrevc3.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o dtrsyl3.o dtrti2.o dtrtri.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 dtfttr.o dtpttf.o dtpttr.o dtrttf.o dtrttp.o dgejsv.o dgesvj.o dgsvj0.o dgsvj1.o dgeequb.o dsyequb.o dpoequb.o dgbequb.o dbbcsd.o dlapmr.o dorbdb.o dorbdb1.o dorbdb2.o dorbdb3.o dorbdb4.o dorbdb5.o dorbdb6.o dorcsd.o dorcsd2by1.o dgeqrt.o dgeqrt2.o dgeqrt3.o dgemqrt.o dtpqrt.o dtpqrt2.o dtpmqrt.o dtprfb.o dgelqt.o dgelqt3.o dgemlqt.o dgetsls.o dgetsqrhrt.o dgeqr.o dlatsqr.o dlamtsqr.o dgemqr.o dgelq.o dlaswlq.o dlamswlq.o dgemlq.o dtplqt.o dtplqt2.o dtpmlqt.o dorhr_col.o dlaorhr_col_getrfnp.o dlaorhr_col_getrfnp2.o dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o dgesvdq.o dgedmd.o dgedmdq.o spotrs.o sgetrs.o spotrf.o sgetrf.o cpotrf2.o cgetrf2.o cbdsqr.o cgbbrd.o cgbcon.o cgbequ.o cgbrfs.o cgbsv.o cgbsvx.o cgbtf2.o cgbtrf.o cgbtrs.o cgebak.o cgebal.o cgebd2.o cgebrd.o cgecon.o cgeequ.o cgees.o cgeesx.o cgeev.o cgeevx.o cgehd2.o cgehrd.o cgelq2.o cgelqf.o cgels.o cgelst.o cgelsd.o cgelss.o cgelsy.o cgeql2.o cgeqlf.o cgeqp3.o cgeqp3rk.o cgeqr2.o cgeqr2p.o cgeqrf.o cgeqrfp.o cgerfs.o cgerq2.o cgerqf.o cgesc2.o cgesdd.o cgesv.o cgesvd.o cgesvdx.o cgesvj.o cgejsv.o cgsvj0.o cgsvj1.o cgesvx.o cgetc2.o cgetf2.o cgetri.o cggbak.o cggbal.o cgges.o cgges3.o cggesx.o cggev.o cggev3.o cggevx.o cggglm.o cgghrd.o cgghd3.o cgglse.o cggqrf.o cggrqf.o cggsvd3.o cggsvp3.o cgtcon.o cgtrfs.o cgtsv.o cgtsvx.o cgttrf.o cgttrs.o cgtts2.o chbev.o chbevd.o chbevx.o chbgst.o chbgv.o chbgvd.o chbgvx.o chbtrd.o checon.o cheev.o cheevd.o cheevr.o cheevx.o chegs2.o chegst.o chegv.o chegvd.o chegvx.o cherfs.o chesv.o chesvx.o chetd2.o chetf2.o chetrd.o chetrf.o chetri.o chetri2.o chetri2x.o cheswapr.o chetrs.o chetrs2.o chetf2_rook.o chetrf_rook.o chetri_rook.o chetrs_rook.o checon_rook.o chesv_rook.o chetf2_rk.o chetrf_rk.o chetri_3.o chetri_3x.o chetrs_3.o checon_3.o chesv_rk.o chesv_aa.o chetrf_aa.o chetrs_aa.o clahef_aa.o chesv_aa_2stage.o chetrf_aa_2stage.o chetrs_aa_2stage.o chgeqz.o chpcon.o chpev.o chpevd.o claqz0.o claqz1.o claqz2.o claqz3.o chpevx.o chpgst.o chpgv.o chpgvd.o chpgvx.o chprfs.o chpsv.o chpsvx.o chptrd.o chptrf.o chptri.o chptrs.o chsein.o chseqr.o clabrd.o clacgv.o clacon.o clacn2.o clacp2.o clacpy.o clacrm.o clacrt.o cladiv.o claed0.o claed7.o claed8.o claein.o claesy.o claev2.o clags2.o clagtm.o clahef.o clahef_rook.o clahef_rk.o clahqr.o clahr2.o claic1.o clals0.o clalsa.o clalsd.o clangb.o clange.o clangt.o clanhb.o clanhe.o clanhp.o clanhs.o clanht.o clansb.o clansp.o clansy.o clantb.o clantp.o clantr.o clapll.o clapmt.o clarcm.o claqgb.o claqge.o claqhb.o claqhe.o claqhp.o claqp2.o claqps.o claqp2rk.o claqp3rk.o claqsb.o claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o clarf.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o clatbs.o clatdf.o clatps.o clatrd.o clatrs.o clatrs3.o clatrz.o clauu2.o clauum.o cpbcon.o cpbequ.o cpbrfs.o cpbstf.o cpbsv.o cpbsvx.o cpbtf2.o cpbtrf.o cpbtrs.o cpocon.o cpoequ.o cporfs.o cposv.o cposvx.o cpotf2.o cpotri.o cpstrf.o cpstf2.o cppcon.o cppequ.o cpprfs.o cppsv.o cppsvx.o cpptrf.o cpptri.o cpptrs.o cptcon.o cpteqr.o cptrfs.o cptsv.o cptsvx.o cpttrf.o cpttrs.o cptts2.o crot.o cspcon.o cspmv.o cspr.o csprfs.o cspsv.o cspsvx.o csptrf.o csptri.o csptrs.o csrscl.o crscl.o cstedc.o cstegr.o cstein.o csteqr.o csycon.o csymv.o csyr.o csyrfs.o csysv.o csysvx.o csytf2.o csytrf.o csytri.o csytri2.o csytri2x.o csyswapr.o csytrs.o csytrs2.o csyconv.o csyconvf.o csyconvf_rook.o csytf2_rook.o csytrf_rook.o csytrs_rook.o csytri_rook.o csycon_rook.o csysv_rook.o csytf2_rk.o csytrf_rk.o csytrf_aa.o csytrs_3.o csytrs_aa.o csytri_3.o csytri_3x.o csycon_3.o csysv_rk.o csysv_aa.o csysv_aa_2stage.o csytrf_aa_2stage.o csytrs_aa_2stage.o 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 ctrevc3.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o ctrsyl.o ctrsyl3.o ctrti2.o ctrtri.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 cungtsqr.o cungtsqr_row.o cunm2l.o cunm2r.o cunmbr.o cunmhr.o cunml2.o cunm22.o cunmlq.o cunmql.o cunmqr.o cunmr2.o cunmr3.o cunmrq.o cunmrz.o cunmtr.o cupgtr.o cupmtr.o icmax1.o scsum1.o cstemr.o chfrk.o ctfttp.o clanhf.o cpftrf.o cpftri.o cpftrs.o ctfsm.o ctftri.o ctfttr.o ctpttf.o ctpttr.o ctrttf.o ctrttp.o cgeequb.o cgbequb.o csyequb.o cpoequb.o cheequb.o cbbcsd.o clapmr.o cunbdb.o cunbdb1.o cunbdb2.o cunbdb3.o cunbdb4.o cunbdb5.o cunbdb6.o cuncsd.o cuncsd2by1.o cgeqrt.o cgeqrt2.o cgeqrt3.o cgemqrt.o ctpqrt.o ctpqrt2.o ctpmqrt.o ctprfb.o cgelqt.o cgelqt3.o cgemlqt.o cgetsls.o cgetsqrhrt.o cgeqr.o clatsqr.o clamtsqr.o cgemqr.o cgelq.o claswlq.o clamswlq.o cgemlq.o ctplqt.o ctplqt2.o ctpmlqt.o cunhr_col.o claunhr_col_getrfnp.o claunhr_col_getrfnp2.o chetrd_2stage.o chetrd_he2hb.o chetrd_hb2st.o chb2st_kernels.o cheevd_2stage.o cheev_2stage.o cheevx_2stage.o cheevr_2stage.o chbev_2stage.o chbevx_2stage.o chbevd_2stage.o chegv_2stage.o cgesvdq.o cgedmd.o cgedmdq.o zpotrf2.o zgetrf2.o zbdsqr.o zgbbrd.o zgbcon.o zgbequ.o zgbrfs.o zgbsv.o zgbsvx.o zgbtf2.o zgbtrf.o zgbtrs.o zgebak.o zgebal.o zgebd2.o zgebrd.o zgecon.o zgeequ.o zgees.o zgeesx.o zgeev.o zgeevx.o zgehd2.o zgehrd.o zgelq2.o zgelqf.o zgels.o zgelst.o zgelsd.o zgelss.o zgelsy.o zgeql2.o zgeqlf.o zgeqp3.o zgeqp3rk.o zgeqr2.o zgeqr2p.o zgeqrf.o zgeqrfp.o zgerfs.o zgerq2.o zgerqf.o zgesc2.o zgesdd.o zgesv.o zgesvd.o zgesvdx.o zgesvj.o zgejsv.o zgsvj0.o zgsvj1.o zgesvx.o zgetc2.o zgetf2.o zgetrf.o zgetri.o zgetrs.o zggbak.o zggbal.o zgges.o zgges3.o zggesx.o zggev.o zggev3.o zggevx.o zggglm.o zgghrd.o zgghd3.o zgglse.o zggqrf.o zggrqf.o zggsvd3.o zggsvp3.o zgtcon.o zgtrfs.o zgtsv.o zgtsvx.o zgttrf.o zgttrs.o zgtts2.o zhbev.o zhbevd.o zhbevx.o zhbgst.o zhbgv.o zhbgvd.o zhbgvx.o zhbtrd.o zhecon.o zheev.o zheevd.o zheevr.o zheevx.o zhegs2.o zhegst.o zhegv.o zhegvd.o zhegvx.o zherfs.o zhesv.o zhesvx.o zhetd2.o zhetf2.o zhetrd.o zhetrf.o zhetri.o zhetri2.o zhetri2x.o zheswapr.o zhetrs.o zhetrs2.o zhetf2_rook.o zhetrf_rook.o zhetri_rook.o zhetrs_rook.o zhecon_rook.o zhesv_rook.o zhetf2_rk.o zhetrf_rk.o zhetri_3.o zhetri_3x.o zhetrs_3.o zhecon_3.o zhesv_rk.o zhesv_aa.o zhetrf_aa.o zhetrs_aa.o zlahef_aa.o zhesv_aa_2stage.o zhetrf_aa_2stage.o zhetrs_aa_2stage.o zhgeqz.o zhpcon.o zhpev.o zhpevd.o zlaqz0.o zlaqz1.o zlaqz2.o zlaqz3.o zhpevx.o zhpgst.o zhpgv.o zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o zhpsvx.o zhptrd.o zhptrf.o zhptri.o zhptrs.o zhsein.o zhseqr.o zlabrd.o zlacgv.o zlacon.o zlacn2.o zlacp2.o zlacpy.o zlacrm.o zlacrt.o zladiv.o zlaed0.o zlaed7.o zlaed8.o zlaein.o zlaesy.o zlaev2.o zlags2.o zlagtm.o zlahef.o zlahef_rook.o zlahef_rk.o zlahqr.o zlahr2.o zlaic1.o zlals0.o zlalsa.o zlalsd.o zlangb.o zlange.o zlangt.o zlanhb.o zlanhe.o zlanhp.o zlanhs.o zlanht.o zlansb.o zlansp.o zlansy.o zlantb.o zlantp.o zlantr.o zlapll.o zlapmt.o zlaqgb.o zlaqge.o zlaqhb.o zlaqhe.o zlaqhp.o zlaqp2.o zlaqps.o zlaqp2rk.o zlaqp3rk.o zlaqsb.o zlaqr0.o zlaqr1.o zlaqr2.o zlaqr3.o zlaqr4.o zlaqr5.o zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarfg.o zlarft.o zlarfgp.o zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o zlasyf_rk.o zlasyf_aa.o zlatbs.o zlatdf.o zlatps.o zlatrd.o zlatrs.o zlatrs3.o zlatrz.o zlauu2.o zlauum.o zpbcon.o zpbequ.o zpbrfs.o zpbstf.o zpbsv.o zpbsvx.o zpbtf2.o zpbtrf.o zpbtrs.o zpocon.o zpoequ.o zporfs.o zposv.o zposvx.o zpotf2.o zpotrf.o zpotri.o zpotrs.o zpstrf.o zpstf2.o zppcon.o zppequ.o zpprfs.o zppsv.o zppsvx.o zpptrf.o zpptri.o zpptrs.o zptcon.o zpteqr.o zptrfs.o zptsv.o zptsvx.o zpttrf.o zpttrs.o zptts2.o zrot.o zspcon.o zspmv.o zspr.o zsprfs.o zspsv.o zspsvx.o zsptrf.o zsptri.o zsptrs.o zdrscl.o zrscl.o zstedc.o zstegr.o zstein.o zsteqr.o zsycon.o zsymv.o zsyr.o zsyrfs.o zsysv.o zsysvx.o zsytf2.o zsytrf.o zsytri.o zsytri2.o zsytri2x.o zsyswapr.o zsytrs.o zsytrs2.o zsyconv.o zsyconvf.o zsyconvf_rook.o zsytf2_rook.o zsytrf_rook.o zsytrs_rook.o zsytrs_aa.o zsytri_rook.o zsycon_rook.o zsysv_rook.o zsysv_aa_2stage.o zsytrf_aa_2stage.o zsytrs_aa_2stage.o zsytf2_rk.o zsytrf_rk.o zsytrf_aa.o zsytrs_3.o zsytri_3.o zsytri_3x.o zsycon_3.o zsysv_rk.o zsysv_aa.o 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 ztrevc3.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o ztrsyl.o ztrsyl3.o ztrti2.o ztrtri.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 zungtsqr.o zungtsqr_row.o zunm2l.o zunm2r.o zunmbr.o zunmhr.o zunml2.o zunm22.o zunmlq.o zunmql.o zunmqr.o zunmr2.o zunmr3.o zunmrq.o zunmrz.o zunmtr.o zupgtr.o zupmtr.o izmax1.o dzsum1.o zstemr.o zcgesv.o zcposv.o zlag2c.o clag2z.o zlat2c.o zhfrk.o ztfttp.o zlanhf.o zpftrf.o zpftri.o zpftrs.o ztfsm.o ztftri.o ztfttr.o ztpttf.o ztpttr.o ztrttf.o ztrttp.o zgeequb.o zgbequb.o zsyequb.o zpoequb.o zheequb.o zbbcsd.o zlapmr.o zunbdb.o zunbdb1.o zunbdb2.o zunbdb3.o zunbdb4.o zunbdb5.o zunbdb6.o zuncsd.o zuncsd2by1.o zgeqrt.o zgeqrt2.o zgeqrt3.o zgemqrt.o ztpqrt.o ztpqrt2.o ztpmqrt.o ztprfb.o ztplqt.o ztplqt2.o ztpmlqt.o zgelqt.o zgelqt3.o zgemlqt.o zgetsls.o zgetsqrhrt.o zgeqr.o zlatsqr.o zlamtsqr.o zgemqr.o zgelq.o zlaswlq.o zlamswlq.o zgemlq.o zunhr_col.o zlaunhr_col_getrfnp.o zlaunhr_col_getrfnp2.o zhetrd_2stage.o zhetrd_he2hb.o zhetrd_hb2st.o zhb2st_kernels.o zheevd_2stage.o zheev_2stage.o zheevx_2stage.o zheevr_2stage.o zhbev_2stage.o zhbevx_2stage.o zhbevd_2stage.o zhegv_2stage.o zgesvdq.o zgedmd.o zgedmdq.o cpotrs.o cgetrs.o cpotrf.o cgetrf.o la_constants.o sbdsdc.o sbdsqr.o sdisna.o slabad.o slacpy.o sladiv.o slae2.o slaebz.o slaed0.o slaed1.o slaed2.o slaed3.o slaed4.o slaed5.o slaed6.o slaed7.o slaed8.o slaed9.o slaeda.o slaev2.o slagtf.o slagts.o slamrg.o slanst.o slapy2.o slapy3.o slarnv.o slarra.o slarrb.o slarrc.o slarrd.o slarre.o slarrf.o slarrj.o slarrk.o slarrr.o slaneg.o slartg.o slaruv.o slas2.o slascl.o slasd0.o slasd1.o slasd2.o slasd3.o slasd4.o slasd5.o slasd6.o slasd7.o slasd8.o slasda.o slasdq.o slasdt.o slaset.o slasq1.o slasq2.o slasq3.o slasq4.o slasq5.o slasq6.o slasr.o slasrt.o slassq.o slasv2.o spttrf.o sstebz.o sstedc.o ssteqr.o ssterf.o slaisnan.o sisnan.o slartgp.o slartgs.o ../INSTALL/sroundup_lwork.o ../INSTALL/second_INT_ETIME.o dbdsdc.o dbdsqr.o ddisna.o dlabad.o dlacpy.o dladiv.o dlae2.o dlaebz.o dlaed0.o dlaed1.o dlaed2.o dlaed3.o dlaed4.o dlaed5.o dlaed6.o dlaed7.o dlaed8.o dlaed9.o dlaeda.o dlaev2.o dlagtf.o dlagts.o dlamrg.o dlanst.o dlapy2.o dlapy3.o dlarnv.o dlarra.o dlarrb.o dlarrc.o dlarrd.o dlarre.o dlarrf.o dlarrj.o dlarrk.o dlarrr.o dlaneg.o dlartg.o dlaruv.o dlas2.o dlascl.o dlasd0.o dlasd1.o dlasd2.o dlasd3.o dlasd4.o dlasd5.o dlasd6.o dlasd7.o dlasd8.o dlasda.o dlasdq.o dlasdt.o dlaset.o dlasq1.o dlasq2.o dlasq3.o dlasq4.o dlasq5.o dlasq6.o dlasr.o dlasrt.o dlassq.o dlasv2.o dpttrf.o dstebz.o dstedc.o dsteqr.o dsterf.o dlaisnan.o disnan.o dlartgp.o dlartgs.o ../INSTALL/droundup_lwork.o ../INSTALL/dlamch.o ../INSTALL/dsecnd_INT_ETIME.o ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o iparam2stage.o la_xisnan.o ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o ../INSTALL/ilaver.o ../INSTALL/lsame.o ../INSTALL/slamch.o -ranlib ../liblapack.a -make[1]: Leaving directory '/home/lidesia/Documents/CUDenver/RAShip/gitRepos/lapack/SRC' From 201a5c49f69fa616282fcc72e121d0024929d914 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Mon, 20 May 2024 12:57:46 +0700 Subject: [PATCH 069/206] fix LARFB documentation, #1011 --- SRC/clarfb.f | 5 ++--- SRC/dlarfb.f | 5 ++--- SRC/slarfb.f | 5 ++--- SRC/zlarfb.f | 5 ++--- 4 files changed, 8 insertions(+), 12 deletions(-) diff --git a/SRC/clarfb.f b/SRC/clarfb.f index 8abf14f652..8438d0e89d 100644 --- a/SRC/clarfb.f +++ b/SRC/clarfb.f @@ -170,9 +170,8 @@ *> *> The shape of the matrix V and the storage of the vectors which define *> the H(i) is best illustrated by the following example with n = 5 and -*> k = 3. The elements equal to 1 are not stored; the corresponding -*> array elements are modified but restored on exit. The rest of the -*> array is not used. +*> k = 3. The triangular part of V (including its diagonal) is not +*> referenced. *> *> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': *> diff --git a/SRC/dlarfb.f b/SRC/dlarfb.f index a5298e7182..f0e101a3ba 100644 --- a/SRC/dlarfb.f +++ b/SRC/dlarfb.f @@ -170,9 +170,8 @@ *> *> The shape of the matrix V and the storage of the vectors which define *> the H(i) is best illustrated by the following example with n = 5 and -*> k = 3. The elements equal to 1 are not stored; the corresponding -*> array elements are modified but restored on exit. The rest of the -*> array is not used. +*> k = 3. The triangular part of V (including its diagonal) is not +*> referenced. *> *> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': *> diff --git a/SRC/slarfb.f b/SRC/slarfb.f index 8c073cdcef..d8c824d18a 100644 --- a/SRC/slarfb.f +++ b/SRC/slarfb.f @@ -170,9 +170,8 @@ *> *> The shape of the matrix V and the storage of the vectors which define *> the H(i) is best illustrated by the following example with n = 5 and -*> k = 3. The elements equal to 1 are not stored; the corresponding -*> array elements are modified but restored on exit. The rest of the -*> array is not used. +*> k = 3. The triangular part of V (including its diagonal) is not +*> referenced. *> *> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': *> diff --git a/SRC/zlarfb.f b/SRC/zlarfb.f index 1a495fc183..a066265944 100644 --- a/SRC/zlarfb.f +++ b/SRC/zlarfb.f @@ -170,9 +170,8 @@ *> *> The shape of the matrix V and the storage of the vectors which define *> the H(i) is best illustrated by the following example with n = 5 and -*> k = 3. The elements equal to 1 are not stored; the corresponding -*> array elements are modified but restored on exit. The rest of the -*> array is not used. +*> k = 3. The triangular part of V (including its diagonal) is not +*> referenced. *> *> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': *> From ffc3a93c221d3026bf418aefbd5cd56623ecc523 Mon Sep 17 00:00:00 2001 From: Ahnaf Tahmid Chowdhury Date: Wed, 22 May 2024 23:29:07 +0600 Subject: [PATCH 070/206] CMAKE_INSTALL_FULL_LIBDIR --- CMakeLists.txt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f310eb1267..9934d57331 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -129,7 +129,9 @@ message(STATUS "Build with install RPATH: ${CMAKE_BUILD_WITH_INSTALL_RPATH}") list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir) if ("${isSystemDir}" STREQUAL "-1") - option(CMAKE_INSTALL_RPATH "Install RPATH" ${CMAKE_INSTALL_FULL_LIBDIR}) + if(${CMAKE_INSTALL_FULL_LIBDIR}) + set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR}) + endif() message(STATUS "Install RPATH: ${CMAKE_INSTALL_RPATH}") option(CMAKE_INSTALL_RPATH_USE_LINK_PATH "Use link path for RPATH" ON) message(STATUS "Install RPATH use link path: ${CMAKE_INSTALL_RPATH_USE_LINK_PATH}") From c308ea602e22aec940ccd8e205354287c7602a80 Mon Sep 17 00:00:00 2001 From: Ahnaf Tahmid Chowdhury Date: Wed, 22 May 2024 23:47:19 +0600 Subject: [PATCH 071/206] CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9934d57331..2f443104f4 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -133,7 +133,7 @@ if ("${isSystemDir}" STREQUAL "-1") set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR}) endif() message(STATUS "Install RPATH: ${CMAKE_INSTALL_RPATH}") - option(CMAKE_INSTALL_RPATH_USE_LINK_PATH "Use link path for RPATH" ON) + option(CMAKE_INSTALL_RPATH_USE_LINK_PATH "Use link path for RPATH" TRUE) message(STATUS "Install RPATH use link path: ${CMAKE_INSTALL_RPATH_USE_LINK_PATH}") endif() From 0d2d60173bf600567d143f20c898307a3240171e Mon Sep 17 00:00:00 2001 From: Mark Gates Date: Thu, 23 May 2024 14:55:06 -0400 Subject: [PATCH 072/206] fix out-of-bounds access in orhr_col --- SRC/cunhr_col.f | 2 +- SRC/dorhr_col.f | 2 +- SRC/sorhr_col.f | 2 +- SRC/zunhr_col.f | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/SRC/cunhr_col.f b/SRC/cunhr_col.f index 49bc3f5071..edc4002d83 100644 --- a/SRC/cunhr_col.f +++ b/SRC/cunhr_col.f @@ -421,7 +421,7 @@ SUBROUTINE CUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) * JBTEMP2 = JB - 2 DO J = JB, JB+JNB-2 - DO I = J-JBTEMP2, NB + DO I = J-JBTEMP2, MIN( NB, N ) T( I, J ) = CZERO END DO END DO diff --git a/SRC/dorhr_col.f b/SRC/dorhr_col.f index c9fcb391cf..2c7a0aee6a 100644 --- a/SRC/dorhr_col.f +++ b/SRC/dorhr_col.f @@ -420,7 +420,7 @@ SUBROUTINE DORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) * JBTEMP2 = JB - 2 DO J = JB, JB+JNB-2 - DO I = J-JBTEMP2, NB + DO I = J-JBTEMP2, MIN( NB, N ) T( I, J ) = ZERO END DO END DO diff --git a/SRC/sorhr_col.f b/SRC/sorhr_col.f index cf9d985af8..d1d5f131d3 100644 --- a/SRC/sorhr_col.f +++ b/SRC/sorhr_col.f @@ -420,7 +420,7 @@ SUBROUTINE SORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) * JBTEMP2 = JB - 2 DO J = JB, JB+JNB-2 - DO I = J-JBTEMP2, NB + DO I = J-JBTEMP2, MIN( NB, N ) T( I, J ) = ZERO END DO END DO diff --git a/SRC/zunhr_col.f b/SRC/zunhr_col.f index 44a5ef74bb..fab17eefd7 100644 --- a/SRC/zunhr_col.f +++ b/SRC/zunhr_col.f @@ -421,7 +421,7 @@ SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) * JBTEMP2 = JB - 2 DO J = JB, JB+JNB-2 - DO I = J-JBTEMP2, NB + DO I = J-JBTEMP2, MIN( NB, N ) T( I, J ) = CZERO END DO END DO From af491a4d35175caa7fe7e9986b725ff42315c5a8 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 28 May 2024 01:05:35 -0400 Subject: [PATCH 073/206] fixed dlarf1f and dorm2r implementation --- SRC/Makefile | 2 +- SRC/{dlarf1.f => dlarf1f.f} | 90 +++++++++++++++++++++---------------- SRC/dorm2r.f | 10 ++--- 3 files changed, 57 insertions(+), 45 deletions(-) rename SRC/{dlarf1.f => dlarf1f.f} (68%) diff --git a/SRC/Makefile b/SRC/Makefile index 106943b9ec..ae3a7d3f42 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -339,7 +339,7 @@ DLASRC = \ dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ - dlarf.o dlarf1.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ + dlarf.o dlarf1f.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dlarf1.f b/SRC/dlarf1f.f similarity index 68% rename from SRC/dlarf1.f rename to SRC/dlarf1f.f index 20e7f91ca7..ead75fdf78 100644 --- a/SRC/dlarf1.f +++ b/SRC/dlarf1f.f @@ -1,4 +1,5 @@ -*> \brief \b DLARF applies an elementary reflector to a general rectangular matrix. +*> \brief \b DLARF1F applies an elementary reflector to a general rectangular +* matrix assuming v(1) = 1. * * =========== DOCUMENTATION =========== * @@ -18,7 +19,7 @@ * Definition: * =========== * -* SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * .. Scalar Arguments .. * CHARACTER SIDE @@ -120,7 +121,7 @@ *> \ingroup larf * * ===================================================================== - SUBROUTINE DLARF1( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) + SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -192,48 +193,59 @@ SUBROUTINE DLARF1( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.GT.0 .AND. LASTC.GT.0) THEN -* -* w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) -* -! CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), LDC, -! $ V(1+INCV), INCV, ZERO, WORK, 1 ) -! DO I = 1, LASTC -! WORK(I) = ZERO -! DO J = 2, LASTV -! WORK(I) = WORK(I) + V(1 + (J-1)*INCV) * C(J,I) -! END DO -! END DO - CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(2,1), LDC, - $ v(1+INCV), INCV, ZERO, WORK, 1) -* -* w(1:lastc,1) := w(1:lastc,1) + C(1,1:lastc)**T * v(1,1) -* = w(1:lastc,1) + C(1,1:lastc)**T -* - ! Now, do w(1:lastc,1) += C(1,1:lastc)**T -! DO I = 1, LASTC -! WORK(I) = WORK(I) + C(1,I) -! END DO - CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) -* -* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T -* - CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) + IF( LASTV.GT.0 ) THEN + ! Check if m = 1. This means v = 1, So we just need to compute + ! C := HC = (1-\tau)C. + IF( M.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, LDC) + ELSE +* +* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) +* + ! w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) + CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), + $ LDC, V(1+INCV), INCV, ZERO, WORK, 1) + ! w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) = C(1,1:lastc)**T + CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) +* +* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T +* + ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T + ! = C(...) - tau * w(1:lastc,1)**T + CALL DAXPY(LASTC, -TAU, WORK, 1, C, LDC) + ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T + CALL DGER(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, 1, + $ C(1+1,1), LDC) + END IF END IF ELSE * * Form C * H * IF( LASTV.GT.0 ) THEN -* -* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) -* - CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC, - $ V, INCV, ZERO, WORK, 1 ) -* -* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T -* - CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) + ! Check if n = 1. This means v = 1, so we just need to compute + ! C := CH = C(1-\tau). + IF( N.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, 1) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) + CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, + $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) + ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) + CALL DAXPY(LASTC, ONE, C, 1, WORK, 1) +* +* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T +* + ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL DAXPY(LASTC, -TAU, WORK, 1, C, 1) + ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T + CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), + $ INCV, C(1,1+1), LDC ) + END IF END IF END IF RETURN diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index ebf9c39e00..f6592e7838 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -185,7 +185,7 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF, XERBLA, DLARF1 + EXTERNAL XERBLA, DLARF1F * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -266,12 +266,12 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF1( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, +! AII = A( I, I ) +! A( I, I ) = ONE + CALL DLARF1F( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, $ JC ), $ LDC, WORK ) - A( I, I ) = AII +! A( I, I ) = AII 10 CONTINUE RETURN * From 559a7e9a6264ae18cc3188ff5737cea02b7e39a6 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 28 May 2024 01:06:26 -0400 Subject: [PATCH 074/206] fixed dlarf1f and dorm2r implementation --- SRC/dlarf1f.f | 2 -- 1 file changed, 2 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index ead75fdf78..9bcd929b00 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -141,8 +141,6 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER IONE - PARAMETER ( IONE = 1 ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT From b8a644358e0c6e4b3c945591a4b5fa69ffa38eec Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Wed, 29 May 2024 18:49:34 +0700 Subject: [PATCH 075/206] develop DLARF1F and implement in ORM2R, #1011 --- SRC/CMakeLists.txt | 2 +- SRC/dlarf1f.f | 288 +++++++++++++++++++++++++++++++++++++++++++++ SRC/dorm2r.f | 8 +- 3 files changed, 291 insertions(+), 7 deletions(-) create mode 100644 SRC/dlarf1f.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index a2f396bae2..d368da2e15 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -307,7 +307,7 @@ set(DLASRC dlaqgb.f dlaqge.f dlaqp2.f dlaqps.f dlaqp2rk.f dlaqp3rk.f dlaqsb.f dlaqsp.f dlaqsy.f dlaqr0.f dlaqr1.f dlaqr2.f dlaqr3.f dlaqr4.f dlaqr5.f dlaqtr.f dlar1v.f dlar2v.f iladlr.f iladlc.f - dlarf.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f + dlarf.f dlarf1f.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f dlargv.f dlarmm.f dlarrv.f dlartv.f dlarz.f dlarzb.f dlarzt.f dlaswp.f dlasy2.f dlasyf.f dlasyf_rook.f dlasyf_rk.f dlasyf_aa.f diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f new file mode 100644 index 0000000000..626e0db490 --- /dev/null +++ b/SRC/dlarf1f.f @@ -0,0 +1,288 @@ +*> \brief \b DLARF1F applies an elementary reflector to a general rectangular matrix. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARF + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. +* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLARF1F applies a real elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a real scalar and v is a real vector. +*> It is assumed that v(1) = 1. v(1) is not referenced. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is DOUBLE PRECISION +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf1f +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm update matrix C by blocks. +*> C is presected in the form of 4 blocks: +*> C11 - 1-by-1, C12 - 1-by-n, C21 - m-by-1 and C22 - (m-1)-by-(n-1) +*> +*> C = ( C11 | C12 ) +*> (_____|___________________) +*> ( | ) +*> ( | ) +*> ( C21 | C22 ) +*> ( | ) +*> ( | ) +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC + DOUBLE PRECISION C11, DOT1, DDOT +* .. +* .. External Subroutines .. + EXTERNAL DGEMV, DGER, DDOT, DAXPY, DCOPY +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILADLR, ILADLC + EXTERNAL LSAME, ILADLR, ILADLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILADLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILADLR(M, LASTV, C, LDC) + END IF + END IF + + IF( LASTC.EQ.0 ) THEN + RETURN + END IF + + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.GT.0 ) THEN + DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, + $ C( 2, 1 ), 1 ) + + C11 = (ONE - TAU) * C( 1, 1 ) + DOT1 +* +* Prepare WORK +* + CALL DCOPY( LASTC - 1, C( 1, 2 ), LDC, WORK, 1 ) + + CALL DGEMV( 'Transpose', LASTV - 1, LASTC - 1, -TAU, + $ C( 2, 2 ), LDC, V( 1 + INCV ), INCV, -TAU, WORK, 1 ) +* +* Update C12 +* + CALL DAXPY( LASTC - 1, ONE, WORK, 1, C( 1, 2 ), LDC ) +* +* Update C21 +* + CALL DAXPY( LASTV - 1, -TAU * C( 1, 1 ) + DOT1, + $ V( 1 + INCV ), INCV, C( 2, 1 ), 1 ) +* +* Update C11 +* + C( 1, 1 ) = C11 +* +* Update C22 +* + CALL DGER( LASTV - 1, LASTC - 1, ONE, V( 1 + INCV ), + $ INCV, WORK, 1, C( 2, 2 ), LDC ) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.GT.0 ) THEN + DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, + $ C( 1, 2 ), LDC ) + + C11 = (ONE - TAU) * C( 1, 1 ) + DOT1 +* +* Prepare WORK +* + CALL DCOPY( LASTC - 1, C( 2, 1 ), 1, WORK, 1 ) + + CALL DGEMV( 'No transpose', LASTC - 1, LASTV - 1, -TAU, + $ C( 2, 2 ), LDC, V( 1 + INCV ), INCV, -TAU, WORK, 1 ) +* +* Update C12 +* + CALL DAXPY( LASTV - 1, -TAU * C( 1, 1 ) + DOT1, + $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) +* +* Update C11 +* + C( 1, 1 ) = C11 +* +* Update C21 +* + CALL DAXPY( LASTC - 1, ONE, WORK, 1, C( 2, 1 ), 1 ) +* +* Update C22 +* + CALL DGER( LASTC - 1, LASTV - 1, ONE, WORK, 1, + $ V( 1 + INCV ), INCV, C( 2, 2 ), LDC ) + END IF + END IF + RETURN +* +* End of DLARF1F +* + END diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index d894a806c3..334d12b1f7 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -178,14 +178,13 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - DOUBLE PRECISION AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF, XERBLA + EXTERNAL DLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -266,12 +265,9 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + CALL DLARF1F( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, $ JC ), $ LDC, WORK ) - A( I, I ) = AII 10 CONTINUE RETURN * From 8a338cf2bae25dba394660484f2a3de44930dbf2 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 29 May 2024 17:28:45 -0400 Subject: [PATCH 076/206] a --- SRC/la_constants.mod | Bin 0 -> 1563 bytes SRC/la_xisnan.mod | Bin 0 -> 321 bytes 2 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 SRC/la_constants.mod create mode 100644 SRC/la_xisnan.mod diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod new file mode 100644 index 0000000000000000000000000000000000000000..b8006a566979124de13911e5efcec9baedca2f6f GIT binary patch literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) literal 0 HcmV?d00001 diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod new file mode 100644 index 0000000000000000000000000000000000000000..1b5610476a459fda31282807dce61ffd51c6d396 GIT binary patch literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< literal 0 HcmV?d00001 From 3267d4143c2181e1716748579e0198ce08b34be8 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 29 May 2024 17:30:20 -0400 Subject: [PATCH 077/206] small change for tau --- SRC/dlarf1f.f | 3 +++ 1 file changed, 3 insertions(+) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index 9bcd929b00..d3541674e8 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -159,6 +159,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) APPLYLEFT = LSAME( SIDE, 'L' ) LASTV = 0 LASTC = 0 + IF( TAU.EQ.ZERO ) THEN + RETURN + END IF IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end ! of V. From 0d2bff7886c43f1918c373b96284082f953e0492 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Thu, 30 May 2024 15:37:46 +0700 Subject: [PATCH 078/206] fix DLARF1F in case lastv = 1, #1011 --- SRC/dlarf1f.f | 36 ++++++++++-------------------------- 1 file changed, 10 insertions(+), 26 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index 626e0db490..a8c1cb9866 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -35,13 +35,12 @@ *> *> \verbatim *> -*> DLARF1F applies a real elementary reflector H to a real m by n matrix +*> DLARF applies a real elementary reflector H to a real m by n matrix *> C, from either the left or the right. H is represented in the form *> *> H = I - tau * v * v**T *> *> where tau is a real scalar and v is a real vector. -*> It is assumed that v(1) = 1. v(1) is not referenced. *> *> If tau = 0, then H is taken to be the unit matrix. *> \endverbatim @@ -118,26 +117,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup larf1f -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> The algorithm update matrix C by blocks. -*> C is presected in the form of 4 blocks: -*> C11 - 1-by-1, C12 - 1-by-n, C21 - m-by-1 and C22 - (m-1)-by-(n-1) -*> -*> C = ( C11 | C12 ) -*> (_____|___________________) -*> ( | ) -*> ( | ) -*> ( C21 | C22 ) -*> ( | ) -*> ( | ) -*> -*> \endverbatim +*> \ingroup larf * * ===================================================================== SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) @@ -167,7 +147,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) DOUBLE PRECISION C11, DOT1, DDOT * .. * .. External Subroutines .. - EXTERNAL DGEMV, DGER, DDOT, DAXPY, DCOPY + EXTERNAL DGEMV, DGER, DDOT, DAXPY, DCOPY, DSCAL * .. * .. External Functions .. LOGICAL LSAME @@ -206,7 +186,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END IF END IF - IF( LASTC.EQ.0 ) THEN + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN RETURN END IF @@ -214,7 +194,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.GT.0 ) THEN + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, LDC) + ELSE DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, $ C( 2, 1 ), 1 ) @@ -249,7 +231,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form C * H * - IF( LASTV.GT.0 ) THEN + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, 1) + ELSE DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, $ C( 1, 2 ), LDC ) From 648d221026b2fd46d065173ed532b1d3ff49e75c Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Thu, 30 May 2024 08:57:31 -0400 Subject: [PATCH 079/206] updated check for if we are a trivial case from m/n=1 to lastv=1 --- SRC/dlarf1f.f | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index d3541674e8..d3458fd274 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -159,9 +159,6 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) APPLYLEFT = LSAME( SIDE, 'L' ) LASTV = 0 LASTC = 0 - IF( TAU.EQ.ZERO ) THEN - RETURN - END IF IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end ! of V. @@ -188,8 +185,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILADLR(M, LASTV, C, LDC) END IF END IF -! Note that lastc.eq.0 renders the BLAS operations null; no special -! case is needed at this level. + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + RETURN + END IF IF( APPLYLEFT ) THEN * * Form H * C @@ -197,7 +195,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) IF( LASTV.GT.0 ) THEN ! Check if m = 1. This means v = 1, So we just need to compute ! C := HC = (1-\tau)C. - IF( M.EQ.1 ) THEN + IF(LASTV.EQ.1) THEN CALL DSCAL(LASTC, ONE - TAU, C, LDC) ELSE * @@ -226,7 +224,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) IF( LASTV.GT.0 ) THEN ! Check if n = 1. This means v = 1, so we just need to compute ! C := CH = C(1-\tau). - IF( N.EQ.1 ) THEN + IF(LASTV.EQ.1) THEN CALL DSCAL(LASTC, ONE - TAU, C, 1) ELSE * From 2a8775845d4de570e991434be541f6909ae97466 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Thu, 30 May 2024 09:04:33 -0400 Subject: [PATCH 080/206] updated CMakeLists and added dlarf1l.f --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 2 +- SRC/dlarf1l.f | 256 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 258 insertions(+), 2 deletions(-) create mode 100644 SRC/dlarf1l.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index a2f396bae2..166aed8645 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -307,7 +307,7 @@ set(DLASRC dlaqgb.f dlaqge.f dlaqp2.f dlaqps.f dlaqp2rk.f dlaqp3rk.f dlaqsb.f dlaqsp.f dlaqsy.f dlaqr0.f dlaqr1.f dlaqr2.f dlaqr3.f dlaqr4.f dlaqr5.f dlaqtr.f dlar1v.f dlar2v.f iladlr.f iladlc.f - dlarf.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f + dlarf.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f dlarf1f.f dlarf1l.f dlargv.f dlarmm.f dlarrv.f dlartv.f dlarz.f dlarzb.f dlarzt.f dlaswp.f dlasy2.f dlasyf.f dlasyf_rook.f dlasyf_rk.f dlasyf_aa.f diff --git a/SRC/Makefile b/SRC/Makefile index ae3a7d3f42..673fa99d32 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -339,7 +339,7 @@ DLASRC = \ dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ - dlarf.o dlarf1f.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ + dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o dlarf1f.o dlarf1l.o\ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f new file mode 100644 index 0000000000..9b5483da6c --- /dev/null +++ b/SRC/dlarf1l.f @@ -0,0 +1,256 @@ +*> \brief \b DLARF1L applies an elementary reflector to a general rectangular +* matrix assuming v(lastv) = 1 where lastv is the last non-zero +* element +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARF + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. +* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLARF1L applies a real elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a real scalar and v is a real vector. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is DOUBLE PRECISION +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf +* +* ===================================================================== + SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + INTEGER IONE + PARAMETER ( IONE = 1 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC, J +* .. +* .. External Subroutines .. + EXTERNAL DGEMV, DGER +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILADLR, ILADLC + EXTERNAL LSAME, ILADLR, ILADLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILADLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILADLR(M, LASTV, C, LDC) + END IF + END IF +! Note that lastc.eq.0 renders the BLAS operations null; no special +! case is needed at this level. + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.GT.0 ) THEN + ! Check if m = 1. This means v = 1, So we just need to compute + ! C := HC = (1-\tau)C. + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, LDC) + ELSE +* +* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) + CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1,1), + $ LDC, V(1), INCV, ZERO, WORK, 1) + ! w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) = C(lastv,1:lastc)**T + CALL DAXPY(LASTC, ONE, C(LASTV,1), LDC, WORK, 1) +* +* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T +* + ! C(lastv, 1:lastc) := C(...) - tau * v(lastv,1) * w(1:lastc,1)**T + ! = C(...) - tau * w(1:lastc,1)**T + CALL DAXPY(LASTC, -TAU, WORK, 1, C(LASTV,1), LDC) + ! C(1:lastv-1,1:lastc) := C(...) - tau * v(1:lastv-1,1)*w(1:lastc,1)**T + CALL DGER(LASTV-1, LASTC, -TAU, V(1), INCV, WORK, 1, + $ C(1,1), LDC) + END IF + END IF + ELSE +* +* Form C * H +* + IF( LASTV.GT.0 ) THEN + ! Check if n = 1. This means v = 1, so we just need to compute + ! C := CH = C(1-\tau). + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, 1) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) + CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, + $ C(1,1), LDC, V(1), INCV, ZERO, WORK, 1 ) + ! w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) = C(1:lastc,lastv) + CALL DAXPY(LASTC, ONE, C(1,LASTV), 1, WORK, 1) +* +* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T +* + ! C(1:lastc,lastv) := C(...) - tau * w(1:lastc,1) * v(lastv,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL DAXPY(LASTC, -TAU, WORK, 1, C(1,LASTV), 1) + ! C(1:lastc,1:lastv-1) := C(...) - tau * w(1:lastc,1) * v(1:lastv-1)**T + CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1), + $ INCV, C(1,1), LDC ) + END IF + END IF + END IF + RETURN +* +* End of DLARF +* + END From a4698c3c9c215af4241a541fb157f569f73ca967 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Fri, 31 May 2024 17:15:51 +0700 Subject: [PATCH 081/206] align DLARF1F versions, #1011 --- SRC/Makefile | 2 +- SRC/dlarf1f.f | 84 ++++++++++++++++++++------------------------------- 2 files changed, 34 insertions(+), 52 deletions(-) diff --git a/SRC/Makefile b/SRC/Makefile index 5662d2ab00..5d73c59251 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -339,7 +339,7 @@ DLASRC = \ dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ - dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ + dlarf.o dlarf1f.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index a8c1cb9866..33d242baa9 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -1,4 +1,5 @@ -*> \brief \b DLARF1F applies an elementary reflector to a general rectangular matrix. +*> \brief \b DLARF1F applies an elementary reflector to a general rectangular +* matrix assuming v(1) = 1. * * =========== DOCUMENTATION =========== * @@ -35,12 +36,12 @@ *> *> \verbatim *> -*> DLARF applies a real elementary reflector H to a real m by n matrix +*> DLARF1F applies a real elementary reflector H to a real m by n matrix *> C, from either the left or the right. H is represented in the form *> *> H = I - tau * v * v**T *> -*> where tau is a real scalar and v is a real vector. +*> where tau is a real scalar and v is a real vector assuming v(1) = 1. *> *> If tau = 0, then H is taken to be the unit matrix. *> \endverbatim @@ -117,7 +118,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup larf +*> \ingroup larf1f * * ===================================================================== SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) @@ -144,10 +145,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Local Scalars .. LOGICAL APPLYLEFT INTEGER I, LASTV, LASTC - DOUBLE PRECISION C11, DOT1, DDOT * .. * .. External Subroutines .. - EXTERNAL DGEMV, DGER, DDOT, DAXPY, DCOPY, DSCAL + EXTERNAL DGEMV, DGER, DAXPY * .. * .. External Functions .. LOGICAL LSAME @@ -185,84 +185,66 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILADLR(M, LASTV, C, LDC) END IF END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN RETURN END IF - IF( APPLYLEFT ) THEN * * Form H * C * IF( LASTV.EQ.1 ) THEN - CALL DSCAL(LASTC, ONE - TAU, C, LDC) - ELSE - DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, - $ C( 2, 1 ), 1 ) - - C11 = (ONE - TAU) * C( 1, 1 ) + DOT1 * -* Prepare WORK +* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) * - CALL DCOPY( LASTC - 1, C( 1, 2 ), LDC, WORK, 1 ) - - CALL DGEMV( 'Transpose', LASTV - 1, LASTC - 1, -TAU, - $ C( 2, 2 ), LDC, V( 1 + INCV ), INCV, -TAU, WORK, 1 ) + CALL DSCAL( LASTC, ONE - TAU, C, LDC ) + ELSE * -* Update C12 +* w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) * - CALL DAXPY( LASTC - 1, ONE, WORK, 1, C( 1, 2 ), LDC ) + CALL DGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C( 2, 1 ), + $ LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) * -* Update C21 +* w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) * - CALL DAXPY( LASTV - 1, -TAU * C( 1, 1 ) + DOT1, - $ V( 1 + INCV ), INCV, C( 2, 1 ), 1 ) + CALL DAXPY( LASTC, ONE, C, LDC, WORK, 1 ) * -* Update C11 +* C(1, 1:lastc) := C(...) - tau * w(1:lastc,1)**T * - C( 1, 1 ) = C11 + CALL DAXPY( LASTC, -TAU, WORK, 1, C, LDC ) * -* Update C22 +* C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T * - CALL DGER( LASTV - 1, LASTC - 1, ONE, V( 1 + INCV ), - $ INCV, WORK, 1, C( 2, 2 ), LDC ) - END IF + CALL DGER( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, WORK, + $ 1, C( 2, 1 ), LDC ) + END IF ELSE * * Form C * H * IF( LASTV.EQ.1 ) THEN - CALL DSCAL(LASTC, ONE - TAU, C, 1) - ELSE - DOT1 = - TAU * DDOT( LASTV - 1, V( 1 + INCV ), INCV, - $ C( 1, 2 ), LDC ) - - C11 = (ONE - TAU) * C( 1, 1 ) + DOT1 * -* Prepare WORK +* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) * - CALL DCOPY( LASTC - 1, C( 2, 1 ), 1, WORK, 1 ) - - CALL DGEMV( 'No transpose', LASTC - 1, LASTV - 1, -TAU, - $ C( 2, 2 ), LDC, V( 1 + INCV ), INCV, -TAU, WORK, 1 ) + CALL DSCAL( LASTC, ONE - TAU, C, 1 ) + ELSE * -* Update C12 +* w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) * - CALL DAXPY( LASTV - 1, -TAU * C( 1, 1 ) + DOT1, - $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) + CALL DGEMV( 'No transpose', LASTC, LASTV - 1, ONE, + $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) * -* Update C11 +* w(1:lastc,1) += C(1:lastc,1) * v(1,1) * - C( 1, 1 ) = C11 + CALL DAXPY( LASTC, ONE, C, 1, WORK, 1 ) * -* Update C21 +* C(1:lastc,1) := C(1:lastc,1) - tau * w(1:lastc,1) * - CALL DAXPY( LASTC - 1, ONE, WORK, 1, C( 2, 1 ), 1 ) + CALL DAXPY( LASTC, -TAU, WORK, 1, C, 1 ) * -* Update C22 +* C(1:lastc,2:lastv) := C(1:lastc,2:lastv) - tau * w(1:lastc,1) * v(2:lastv)**T * - CALL DGER( LASTC - 1, LASTV - 1, ONE, WORK, 1, - $ V( 1 + INCV ), INCV, C( 2, 2 ), LDC ) + CALL DGER( LASTC, LASTV - 1, -TAU, WORK, 1, V( 1 + INCV ), + $ INCV, C( 1, 2 ), LDC ) END IF END IF RETURN From 0be01da03e569ce557a4be448eb127933e3fbcc3 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Fri, 31 May 2024 08:54:09 -0400 Subject: [PATCH 082/206] implementing into dorm2l.f --- SRC/dlarf1f.f | 254 -------------------------------------------------- SRC/dorm2l.f | 8 +- 2 files changed, 4 insertions(+), 258 deletions(-) delete mode 100644 SRC/dlarf1f.f diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f deleted file mode 100644 index d3458fd274..0000000000 --- a/SRC/dlarf1f.f +++ /dev/null @@ -1,254 +0,0 @@ -*> \brief \b DLARF1F applies an elementary reflector to a general rectangular -* matrix assuming v(1) = 1. -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download DLARF + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) -* -* .. Scalar Arguments .. -* CHARACTER SIDE -* INTEGER INCV, LDC, M, N -* DOUBLE PRECISION TAU -* .. -* .. Array Arguments .. -* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DLARF applies a real elementary reflector H to a real m by n matrix -*> C, from either the left or the right. H is represented in the form -*> -*> H = I - tau * v * v**T -*> -*> where tau is a real scalar and v is a real vector. -*> -*> If tau = 0, then H is taken to be the unit matrix. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] SIDE -*> \verbatim -*> SIDE is CHARACTER*1 -*> = 'L': form H * C -*> = 'R': form C * H -*> \endverbatim -*> -*> \param[in] M -*> \verbatim -*> M is INTEGER -*> The number of rows of the matrix C. -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of columns of the matrix C. -*> \endverbatim -*> -*> \param[in] V -*> \verbatim -*> V is DOUBLE PRECISION array, dimension -*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' -*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' -*> The vector v in the representation of H. V is not used if -*> TAU = 0. -*> \endverbatim -*> -*> \param[in] INCV -*> \verbatim -*> INCV is INTEGER -*> The increment between elements of v. INCV <> 0. -*> \endverbatim -*> -*> \param[in] TAU -*> \verbatim -*> TAU is DOUBLE PRECISION -*> The value tau in the representation of H. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is DOUBLE PRECISION array, dimension (LDC,N) -*> On entry, the m by n matrix C. -*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', -*> or C * H if SIDE = 'R'. -*> \endverbatim -*> -*> \param[in] LDC -*> \verbatim -*> LDC is INTEGER -*> The leading dimension of the array C. LDC >= max(1,M). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is DOUBLE PRECISION array, dimension -*> (N) if SIDE = 'L' -*> or (M) if SIDE = 'R' -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup larf -* -* ===================================================================== - SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) -* -* -- LAPACK auxiliary routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER SIDE - INTEGER INCV, LDC, M, N - DOUBLE PRECISION TAU -* .. -* .. Array Arguments .. - DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC, J -* .. -* .. External Subroutines .. - EXTERNAL DGEMV, DGER -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILADLR, ILADLC - EXTERNAL LSAME, ILADLR, ILADLC -* .. -* .. Executable Statements .. -* - APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 - LASTC = 0 - IF( TAU.NE.ZERO ) THEN -! Set up variables for scanning V. LASTV begins pointing to the end -! of V. - IF( APPLYLEFT ) THEN - LASTV = M - ELSE - LASTV = N - END IF - IF( INCV.GT.0 ) THEN - I = 1 + (LASTV-1) * INCV - ELSE - I = 1 - END IF -! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) - LASTV = LASTV - 1 - I = I - INCV - END DO - IF( APPLYLEFT ) THEN -! Scan for the last non-zero column in C(1:lastv,:). - LASTC = ILADLC(LASTV, N, C, LDC) - ELSE -! Scan for the last non-zero row in C(:,1:lastv). - LASTC = ILADLR(M, LASTV, C, LDC) - END IF - END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN - RETURN - END IF - IF( APPLYLEFT ) THEN -* -* Form H * C -* - IF( LASTV.GT.0 ) THEN - ! Check if m = 1. This means v = 1, So we just need to compute - ! C := HC = (1-\tau)C. - IF(LASTV.EQ.1) THEN - CALL DSCAL(LASTC, ONE - TAU, C, LDC) - ELSE -* -* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) -* - ! w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) - CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), - $ LDC, V(1+INCV), INCV, ZERO, WORK, 1) - ! w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) = C(1,1:lastc)**T - CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) -* -* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T -* - ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T - ! = C(...) - tau * w(1:lastc,1)**T - CALL DAXPY(LASTC, -TAU, WORK, 1, C, LDC) - ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T - CALL DGER(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, 1, - $ C(1+1,1), LDC) - END IF - END IF - ELSE -* -* Form C * H -* - IF( LASTV.GT.0 ) THEN - ! Check if n = 1. This means v = 1, so we just need to compute - ! C := CH = C(1-\tau). - IF(LASTV.EQ.1) THEN - CALL DSCAL(LASTC, ONE - TAU, C, 1) - ELSE -* -* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) -* - ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) - CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, - $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) - ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) - CALL DAXPY(LASTC, ONE, C, 1, WORK, 1) -* -* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T -* - ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T - ! = C(...) - tau * w(1:lastc,1) - CALL DAXPY(LASTC, -TAU, WORK, 1, C, 1) - ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T - CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), - $ INCV, C(1,1+1), LDC ) - END IF - END IF - END IF - RETURN -* -* End of DLARF -* - END diff --git a/SRC/dorm2l.f b/SRC/dorm2l.f index b1a27ab21b..694b1a62ba 100644 --- a/SRC/dorm2l.f +++ b/SRC/dorm2l.f @@ -262,11 +262,11 @@ SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( NQ-K+I, I ) - A( NQ-K+I, I ) = ONE - CALL DLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC, + !AII = A( NQ-K+I, I ) + !A( NQ-K+I, I ) = ONE + CALL DLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC, $ WORK ) - A( NQ-K+I, I ) = AII + !A( NQ-K+I, I ) = AII 10 CONTINUE RETURN * From 2d8314f59ec9bdfb9f681387f495b5d48c5c8ace Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Mon, 3 Jun 2024 04:30:08 -0400 Subject: [PATCH 083/206] updating double precision routines to use dlarf1f and dlarf1l. Still developing zlarf1f.f --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 2 +- SRC/dgebd2.f | 18 +-- SRC/dgehd2.f | 10 +- SRC/dgelq2.f | 8 +- SRC/dgeql2.f | 8 +- SRC/dgeqr2.f | 8 +- SRC/dgeqr2p.f | 8 +- SRC/dgerq2.f | 8 +- SRC/dlaqp2.f | 7 +- SRC/dlaqp2rk.f | 7 +- SRC/dlaqr2.f | 9 +- SRC/dlaqr3.f | 9 +- SRC/dlarf1f.f | 256 +++++++++++++++++++++++++++++++++++++++++++ SRC/dopmtr.f | 5 +- SRC/dorbdb.f | 58 ++++------ SRC/dorbdb1.f | 13 +-- SRC/dorbdb2.f | 16 +-- SRC/dorbdb3.f | 16 +-- SRC/dorbdb4.f | 25 ++--- SRC/dorg2l.f | 4 +- SRC/dorg2r.f | 5 +- SRC/dorgl2.f | 5 +- SRC/dorgr2.f | 4 +- SRC/dorm2l.f | 7 +- SRC/dorm2r.f | 5 - SRC/dorml2.f | 9 +- SRC/zlarf1f.f | 265 +++++++++++++++++++++++++++++++++++++++++++++ 28 files changed, 614 insertions(+), 183 deletions(-) create mode 100644 SRC/dlarf1f.f create mode 100644 SRC/zlarf1f.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 166aed8645..c3a1889a0b 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -418,7 +418,7 @@ set(ZLASRC zlaqhb.f zlaqhe.f zlaqhp.f zlaqp2.f zlaqps.f zlaqp2rk.f zlaqp3rk.f zlaqsb.f zlaqr0.f zlaqr1.f zlaqr2.f zlaqr3.f zlaqr4.f zlaqr5.f zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f - zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f + zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.f zlarfg.f zlarfgp.f zlarft.f zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f90 zlartv.f zlarz.f zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f diff --git a/SRC/Makefile b/SRC/Makefile index 673fa99d32..ddf26f46f3 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -453,7 +453,7 @@ ZLASRC = \ zlaqhb.o zlaqhe.o zlaqhp.o zlaqp2.o zlaqps.o zlaqp2rk.o zlaqp3rk.o zlaqsb.o \ zlaqr0.o zlaqr1.o zlaqr2.o zlaqr3.o zlaqr4.o zlaqr5.o \ zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \ - zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o \ + zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.o\ zlarfg.o zlarft.o zlarfgp.o \ zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \ zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \ diff --git a/SRC/dgebd2.f b/SRC/dgebd2.f index 98559fadee..5677ef382b 100644 --- a/SRC/dgebd2.f +++ b/SRC/dgebd2.f @@ -209,7 +209,7 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) INTEGER I * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1F, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -242,15 +242,13 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1, $ TAUQ( I ) ) D( I ) = A( I, I ) - A( I, I ) = ONE * * Apply H(i) to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, $ TAUQ( I ), $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = D( I ) * IF( I.LT.N ) THEN * @@ -260,13 +258,11 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ), $ LDA, TAUP( I ) ) E( I ) = A( I, I+1 ) - A( I, I+1 ) = ONE * * Apply G(i) to A(i+1:m,i+1:n) from the right * - CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA, + CALL DLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA, $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) - A( I, I+1 ) = E( I ) ELSE TAUP( I ) = ZERO END IF @@ -283,14 +279,12 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) - A( I, I ) = ONE * * Apply G(i) to A(i+1:m,i:n) from the right * IF( I.LT.M ) - $ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, $ TAUP( I ), A( I+1, I ), LDA, WORK ) - A( I, I ) = D( I ) * IF( I.LT.M ) THEN * @@ -301,14 +295,12 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) - A( I+1, I ) = ONE * * Apply H(i) to A(i+1:m,i+1:n) from the left * - CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, + CALL DLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1, $ TAUQ( I ), $ A( I+1, I+1 ), LDA, WORK ) - A( I+1, I ) = E( I ) ELSE TAUQ( I ) = ZERO END IF diff --git a/SRC/dgehd2.f b/SRC/dgehd2.f index 62417aa8c1..4b18455a5c 100644 --- a/SRC/dgehd2.f +++ b/SRC/dgehd2.f @@ -166,10 +166,9 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1F, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -199,20 +198,17 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - AII = A( I+1, I ) - A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right * - CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), + CALL DLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), $ A( 1, I+1 ), LDA, WORK ) * * Apply H(i) to A(i+1:ihi,i+1:n) from the left * - CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ), + CALL DLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ), $ A( I+1, I+1 ), LDA, WORK ) * - A( I+1, I ) = AII 10 CONTINUE * RETURN diff --git a/SRC/dgelq2.f b/SRC/dgelq2.f index 31dfc07a1d..79af37b4ee 100644 --- a/SRC/dgelq2.f +++ b/SRC/dgelq2.f @@ -146,10 +146,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1F, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -183,12 +182,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i+1:m,i:n) from the right * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, $ TAU( I ), $ A( I+1, I ), LDA, WORK ) - A( I, I ) = AII END IF 10 CONTINUE RETURN diff --git a/SRC/dgeql2.f b/SRC/dgeql2.f index dfb08ff316..18c14618fb 100644 --- a/SRC/dgeql2.f +++ b/SRC/dgeql2.f @@ -140,10 +140,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1L, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,12 +176,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left * - AII = A( M-K+I, N-K+I ) - A( M-K+I, N-K+I ) = ONE - CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + CALL DLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, $ TAU( I ), $ A, LDA, WORK ) - A( M-K+I, N-K+I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/dgeqr2.f b/SRC/dgeqr2.f index bd4facfce7..f42f8decb3 100644 --- a/SRC/dgeqr2.f +++ b/SRC/dgeqr2.f @@ -147,10 +147,9 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1F, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -184,11 +183,8 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i:m,i+1:n) from the left * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = AII END IF 10 CONTINUE RETURN diff --git a/SRC/dgeqr2p.f b/SRC/dgeqr2p.f index b2f3188f3f..b6f910f507 100644 --- a/SRC/dgeqr2p.f +++ b/SRC/dgeqr2p.f @@ -151,10 +151,9 @@ SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, XERBLA + EXTERNAL DLARF1F, DLARFGP, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -188,11 +187,8 @@ SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i:m,i+1:n) from the left * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = AII END IF 10 CONTINUE RETURN diff --git a/SRC/dgerq2.f b/SRC/dgerq2.f index a4ef46d854..7106fe0293 100644 --- a/SRC/dgerq2.f +++ b/SRC/dgerq2.f @@ -140,10 +140,9 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - DOUBLE PRECISION AII * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, XERBLA + EXTERNAL DLARF1L, DLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,11 +176,8 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right * - AII = A( M-K+I, N-K+I ) - A( M-K+I, N-K+I ) = ONE - CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, + CALL DLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, $ TAU( I ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/dlaqp2.f b/SRC/dlaqp2.f index 5bfa967ee9..a4edebf64e 100644 --- a/SRC/dlaqp2.f +++ b/SRC/dlaqp2.f @@ -168,7 +168,7 @@ SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * .. * .. Local Scalars .. INTEGER I, ITEMP, J, MN, OFFPI, PVT - DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z + DOUBLE PRECISION TEMP, TEMP2, TOL3Z * .. * .. External Subroutines .. EXTERNAL DLARF, DLARFG, DSWAP @@ -219,11 +219,8 @@ SUBROUTINE DLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * * Apply H(i)**T to A(offset+i:m,i+1:n) from the left. * - AII = A( OFFPI, I ) - A( OFFPI, I ) = ONE - CALL DLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, + CALL DLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, $ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) ) - A( OFFPI, I ) = AII END IF * * Update partial column norms. diff --git a/SRC/dlaqp2rk.f b/SRC/dlaqp2rk.f index aecd6bb69c..8b834aca4e 100644 --- a/SRC/dlaqp2rk.f +++ b/SRC/dlaqp2rk.f @@ -367,7 +367,7 @@ SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * .. Local Scalars .. INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT, $ MINMNUPDT - DOUBLE PRECISION AIKK, HUGEVAL, TEMP, TEMP2, TOL3Z + DOUBLE PRECISION HUGEVAL, TEMP, TEMP2, TOL3Z * .. * .. External Subroutines .. EXTERNAL DLARF, DLARFG, DSWAP @@ -621,11 +621,8 @@ SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * condition is satisfied, not only KK < N+NRHS ) * IF( KK.LT.MINMNUPDT ) THEN - AIKK = A( I, KK ) - A( I, KK ) = ONE - CALL DLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, + CALL DLARF1F( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, $ TAU( KK ), A( I, KK+1 ), LDA, WORK( 1 ) ) - A( I, KK ) = AIKK END IF * IF( KK.LT.MINMNFACT ) THEN diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index 8591d5d3be..a7a8392d15 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -312,7 +312,7 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, $ DLAHQR, - $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC + $ DLANV2, DLARF1F, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT @@ -597,16 +597,15 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, CALL DCOPY( NS, V, LDV, WORK, 1 ) BETA = WORK( 1 ) CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE * CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, + CALL DLARF1F( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) - CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, + CALL DLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) - CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, + CALL DLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, $ WORK( JW+1 ) ) * CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), diff --git a/SRC/dlaqr3.f b/SRC/dlaqr3.f index f8b0bc2665..5ec2351341 100644 --- a/SRC/dlaqr3.f +++ b/SRC/dlaqr3.f @@ -310,7 +310,7 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, $ DLANV2, - $ DLAQR4, DLARF, DLARFG, DLASET, DORMHR, DTREXC + $ DLAQR4, DLARF1F, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT @@ -608,16 +608,15 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, CALL DCOPY( NS, V, LDV, WORK, 1 ) BETA = WORK( 1 ) CALL DLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE * CALL DLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL DLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, + CALL DLARF1F( 'L', NS, JW, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) - CALL DLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, + CALL DLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, $ WORK( JW+1 ) ) - CALL DLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, + CALL DLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, $ WORK( JW+1 ) ) * CALL DGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f new file mode 100644 index 0000000000..8a27526dd8 --- /dev/null +++ b/SRC/dlarf1f.f @@ -0,0 +1,256 @@ +*> \brief \b DLARF1F applies an elementary reflector to a general rectangular +* matrix assuming v(1) = 1. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARF + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. +* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLARF applies a real elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a real scalar and v is a real vector. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is DOUBLE PRECISION +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf +* +* ===================================================================== + SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + DOUBLE PRECISION TAU +* .. +* .. Array Arguments .. + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + INTEGER IONE + PARAMETER ( IONE = 1 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC, J +* .. +* .. External Subroutines .. + EXTERNAL DGEMV, DGER +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILADLR, ILADLC + EXTERNAL LSAME, ILADLR, ILADLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILADLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILADLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.GT.0 ) THEN + ! Check if m = 1. This means v = 1, So we just need to compute + ! C := HC = (1-\tau)C. + IF( M.EQ.1 .OR. LASTV.EQ.1) THEN + CALL DSCAL(LASTC, ONE - TAU, C, LDC) + ELSE +* +* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) +* + ! w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) + CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), + $ LDC, V(1+INCV), INCV, ZERO, WORK, 1) + ! w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) = C(1,1:lastc)**T + CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) +* +* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T +* + ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T + ! = C(...) - tau * w(1:lastc,1)**T + CALL DAXPY(LASTC, -TAU, WORK, 1, C, LDC) + ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T + CALL DGER(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, 1, + $ C(1+1,1), LDC) + END IF + END IF + ELSE +* +* Form C * H +* + IF( LASTV.GT.0 ) THEN + ! Check if n = 1. This means v = 1, so we just need to compute + ! C := CH = C(1-\tau). + IF( N.EQ.1 .OR. LASTV.EQ.1) THEN + CALL DSCAL(LASTC, ONE - TAU, C, 1) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) + CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, + $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) + ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) + CALL DAXPY(LASTC, ONE, C, 1, WORK, 1) +* +* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T +* + ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL DAXPY(LASTC, -TAU, WORK, 1, C, 1) + ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T + CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), + $ INCV, C(1,1+1), LDC ) + END IF + END IF + END IF + RETURN +* +* End of DLARF +* + END diff --git a/SRC/dopmtr.f b/SRC/dopmtr.f index fd2fd9c239..6289a2daea 100644 --- a/SRC/dopmtr.f +++ b/SRC/dopmtr.f @@ -261,12 +261,9 @@ SUBROUTINE DOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * * Apply H(i) * - AII = AP( II ) - AP( II ) = ONE - CALL DLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, + CALL DLARF1L( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, $ LDC, $ WORK ) - AP( II ) = AII * IF( FORWRD ) THEN II = II + I + 2 diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f index f70813bdb3..2def0a5147 100644 --- a/SRC/dorbdb.f +++ b/SRC/dorbdb.f @@ -316,7 +316,7 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, DOUBLE PRECISION Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DLARF, DLARFGP, DSCAL, + EXTERNAL DAXPY, DLARF1F, DLARFGP, DSCAL, $ XERBLA * .. * .. External Functions .. @@ -422,7 +422,6 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, ELSE IF( P .EQ. I ) THEN CALL DLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF - X11(I,I) = ONE IF ( M-P .GT. I ) THEN CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) @@ -430,23 +429,22 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), + CALL DLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), $ X11(I,I+1), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + CALL DLARF1F( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, $ TAUP1(I), $ X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + CALL DLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, $ TAUP2(I), $ X22(I,I), LDX22, WORK ) END IF @@ -476,7 +474,6 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, $ TAUQ1(I) ) END IF - X11(I,I+1) = ONE END IF IF ( Q+I-1 .LT. M ) THEN IF ( M-Q .EQ. I ) THEN @@ -487,23 +484,22 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ TAUQ2(I) ) END IF END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL DLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, + CALL DLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, $ TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + CALL DLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, $ TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + CALL DLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN - CALL DLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, + CALL DLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) END IF * @@ -521,15 +517,14 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + CALL DLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL DLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, + $ CALL DLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) * END DO @@ -546,9 +541,8 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1), $ LDX22, TAUQ2(P+I) ) END IF - X22(Q+I,P+I) = ONE IF ( I .LT. M-P-Q ) THEN - CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + CALL DLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), $ LDX22, $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) END IF @@ -584,7 +578,6 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, $ TAUP1(I) ) - X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, $ TAUP2(I) ) @@ -592,24 +585,23 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, + CALL DLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, $ TAUP1(I), $ X11(I+1,I), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + CALL DLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, $ TAUP1(I), X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + CALL DLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, $ TAUP2(I), $ X21(I+1,I), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL DLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, + CALL DLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, $ TAUP2(I), X22(I,I), LDX22, WORK ) END IF * @@ -634,7 +626,6 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, $ TAUQ1(I) ) END IF - X11(I+1,I) = ONE END IF IF ( M-Q .GT. I ) THEN CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, @@ -643,18 +634,17 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I), 1, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL DLARF( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), + CALL DLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL DLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), + CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF - CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), + CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN - CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + CALL DLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, $ TAUQ2(I), $ X22(I,I+1), LDX22, WORK ) END IF @@ -668,14 +658,13 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 ) CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), + CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ CALL DLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, $ TAUQ2(I), $ X22(I,Q+1), LDX22, WORK ) * @@ -694,10 +683,9 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), $ 1, $ TAUQ2(P+I) ) - CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, + CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK ) END IF - X22(P+I,Q+I) = ONE * END DO * diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f index 7dceca9bc1..a4095e9096 100644 --- a/SRC/dorbdb1.f +++ b/SRC/dorbdb1.f @@ -228,7 +228,7 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, + EXTERNAL DLARF1F, DLARFGP, DORBDB5, DROT, $ XERBLA * .. * .. External Functions .. @@ -287,12 +287,10 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( X21(I,I), X11(I,I) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I) = ONE - X21(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + CALL DLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, $ I+1), $ LDX11, WORK(ILARF) ) - CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN @@ -301,10 +299,9 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL DLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, $ TAUQ1(I) ) S = X21(I,I+1) - X21(I,I+1) = ONE - CALL DLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), + CALL DLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) - CALL DLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), + CALL DLARF1F( '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 )**2 $ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f index e6b1b97107..56204a0b6c 100644 --- a/SRC/dorbdb2.f +++ b/SRC/dorbdb2.f @@ -227,7 +227,7 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, DSCAL, + EXTERNAL DLARF1F, DLARFGP, DORBDB5, DROT, DSCAL, $ XERBLA * .. * .. External Functions .. @@ -287,10 +287,9 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, END IF CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = X11(I,I) - X11(I,I) = ONE - CALL DLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + CALL DLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL DLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + CALL DLARF1F( '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 )**2 $ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 ) @@ -306,12 +305,10 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( X11(I+1,I), X21(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X11(I+1,I) = ONE - CALL DLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I), + CALL DLARF1F( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF - X21(I,I) = ONE - CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) * END DO @@ -320,8 +317,7 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = P + 1, Q CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) - X21(I,I) = ONE - CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) END DO * diff --git a/SRC/dorbdb3.f b/SRC/dorbdb3.f index 1914ce496a..3c64d52265 100644 --- a/SRC/dorbdb3.f +++ b/SRC/dorbdb3.f @@ -226,7 +226,7 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFGP, DORBDB5, DROT, + EXTERNAL DLARF1F, DLARFGP, DORBDB5, DROT, $ XERBLA * .. * .. External Functions .. @@ -287,10 +287,9 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) S = X21(I,I) - X21(I,I) = ONE - CALL DLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + CALL DLARF1F( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X11(I,I), LDX11, WORK(ILARF) ) - CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + CALL DLARF1F( '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 )**2 $ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 ) @@ -306,12 +305,10 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( X21(I+1,I), X11(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X21(I+1,I) = ONE - CALL DLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF - X11(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + CALL DLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, $ I+1), $ LDX11, WORK(ILARF) ) * @@ -321,8 +318,7 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = M-P + 1, Q CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) - X11(I,I) = ONE - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + CALL DLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, $ I+1), $ LDX11, WORK(ILARF) ) END DO diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f index c0150cb967..14dca198ea 100644 --- a/SRC/dorbdb4.f +++ b/SRC/dorbdb4.f @@ -307,12 +307,10 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( PHANTOM(1), PHANTOM(P+1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - PHANTOM(1) = ONE - PHANTOM(P+1) = ONE - CALL DLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, + CALL DLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, $ LDX11, $ WORK(ILARF) ) - CALL DLARF( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, + CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, $ LDX21, WORK(ILARF) ) ELSE CALL DORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, @@ -326,21 +324,18 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( X11(I,I-1), X21(I,I-1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I-1) = ONE - X21(I,I-1) = ONE - CALL DLARF( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), + CALL DLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), $ X11(I,I), LDX11, WORK(ILARF) ) - CALL DLARF( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I), + CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I), $ X21(I,I), LDX21, WORK(ILARF) ) END IF * CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) CALL DLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) C = X21(I,I) - X21(I,I) = ONE - CALL DLARF( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + CALL DLARF1F( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + CALL DLARF1F( '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 )**2 @@ -354,10 +349,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = M - Q + 1, P CALL DLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) - X11(I,I) = ONE - CALL DLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + CALL DLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL DLARF( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + CALL DLARF1F( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) END DO * @@ -367,8 +361,7 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL DLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), $ LDX21, $ TAUQ1(I) ) - X21(M-Q+I-P,I) = ONE - CALL DLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + CALL DLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, $ TAUQ1(I), $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) END DO diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index af8831085b..d5106b53d0 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -133,7 +133,7 @@ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL DLARF, DSCAL, XERBLA + EXTERNAL DLARF1L, DSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -177,7 +177,7 @@ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL DLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + CALL DLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), $ A, $ LDA, WORK ) CALL DSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) diff --git a/SRC/dorg2r.f b/SRC/dorg2r.f index 221b52bb8c..0d293486f1 100644 --- a/SRC/dorg2r.f +++ b/SRC/dorg2r.f @@ -133,7 +133,7 @@ SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL DLARF, DSCAL, XERBLA + EXTERNAL DLARF1F, DSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -176,8 +176,7 @@ SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i:m,i:n) from the left * IF( I.LT.N ) THEN - A( I, I ) = ONE - CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), $ A( I, I+1 ), LDA, WORK ) END IF IF( I.LT.M ) diff --git a/SRC/dorgl2.f b/SRC/dorgl2.f index 98128b25d5..3d71e33266 100644 --- a/SRC/dorgl2.f +++ b/SRC/dorgl2.f @@ -132,7 +132,7 @@ SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL DLARF, DSCAL, XERBLA + EXTERNAL DLARF1F, DSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -180,8 +180,7 @@ SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * IF( I.LT.N ) THEN IF( I.LT.M ) THEN - A( I, I ) = ONE - CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, $ TAU( I ), A( I+1, I ), LDA, WORK ) END IF CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA ) diff --git a/SRC/dorgr2.f b/SRC/dorgr2.f index 211db4f8db..ae317489b2 100644 --- a/SRC/dorgr2.f +++ b/SRC/dorgr2.f @@ -180,8 +180,8 @@ SUBROUTINE DORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i,1:n-k+i) from the right * - A( II, N-M+II ) = ONE - CALL DLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + !A( II, N-M+II ) = ONE + CALL DLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA, $ TAU( I ), $ A, LDA, WORK ) CALL DSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) diff --git a/SRC/dorm2l.f b/SRC/dorm2l.f index 694b1a62ba..37866ed0cf 100644 --- a/SRC/dorm2l.f +++ b/SRC/dorm2l.f @@ -98,7 +98,6 @@ *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DGEQLF in the last k columns of its array argument A. -*> A is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDA @@ -178,14 +177,13 @@ SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - DOUBLE PRECISION AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF, XERBLA + EXTERNAL DLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -262,11 +260,8 @@ SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - !AII = A( NQ-K+I, I ) - !A( NQ-K+I, I ) = ONE CALL DLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC, $ WORK ) - !A( NQ-K+I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index f6592e7838..e6e40a718c 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -98,7 +98,6 @@ *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DGEQRF in the first k columns of its array argument A. -*> A is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDA @@ -178,7 +177,6 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - DOUBLE PRECISION AII * .. * .. External Functions .. LOGICAL LSAME @@ -266,12 +264,9 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * -! AII = A( I, I ) -! A( I, I ) = ONE CALL DLARF1F( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, $ JC ), $ LDC, WORK ) -! A( I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/dorml2.f b/SRC/dorml2.f index fcdf5b1b13..dfdab973cc 100644 --- a/SRC/dorml2.f +++ b/SRC/dorml2.f @@ -100,7 +100,6 @@ *> The i-th row must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DGELQF in the first k rows of its array argument A. -*> A is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDA @@ -178,14 +177,13 @@ SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - DOUBLE PRECISION AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF, XERBLA + EXTERNAL DLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -266,11 +264,8 @@ SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, I ) - A( I, I ) = ONE - CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ), + CALL DLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAU( I ), $ C( IC, JC ), LDC, WORK ) - A( I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f new file mode 100644 index 0000000000..d0515a037e --- /dev/null +++ b/SRC/zlarf1f.f @@ -0,0 +1,265 @@ +*> \brief \b ZLARF1F applies an elementary reflector to a general rectangular +* matrix assuming v(1) = 1. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARF + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* COMPLEX*16 TAU +* .. +* .. Array Arguments .. +* COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLARF1F applies a complex elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a complex scalar and v is a complex vector. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> +*> To apply H**H, supply conjg(tau) instead +*> tau. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX*16 array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf +* +* ===================================================================== + SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + COMPLEX*16 TAU +* .. +* .. Array Arguments .. + COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE, ZERO + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), + $ ZERO = ( 0.0D+0, 0.0D+0 ) ) + INTEGER IONE + PARAMETER ( IONE = 1 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC, J +* .. +* .. External Subroutines .. + EXTERNAL ZGEMV, ZGERC +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILADLR, ILADLC + EXTERNAL LSAME, ILADLR, ILADLC +* .. +* .. Intrinsic Functions .. + INTRINSIC DCONJG +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILADLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILADLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.GT.0 ) THEN + ! Check if m = 1. This means v = 1, So we just need to compute + ! C := HC = (1-\tau)C. + IF( M.EQ.1 .OR. LASTV.EQ.1) THEN + CALL ZSCAL(LASTC, ONE - TAU, C, LDC) + ELSE +* +* w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1) +* + ! w(1:lastc,1) := C(2:lastv,1:lastc)**H * v(2:lastv,1) + CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, + $ V(1+INCV), INCV, ZERO, WORK, 1) + ! w(1:lastc,1) += C(1,1:lastc) * v(1,1) = C(1,1:lastc) + DO I = 1, LASTC + WORK(I) = WORK(I) + DCONJG(C(1,I)) + END DO +* +* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T +* + ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL ZAXPY(LASTC, -TAU, WORK, 1, C, LDC) + ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T + CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, + $ 1, C(1+1,1), LDC) + END IF + END IF + ELSE +* +* Form C * H +* + IF( LASTV.GT.0 ) THEN + ! Check if n = 1. This means v = 1, so we just need to compute + ! C := CH = C(1-\tau). + IF( N.EQ.1 .OR. LASTV.EQ.1) THEN + CALL ZSCAL(LASTC, ONE - TAU, C, 1) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) + CALL ZGEMV( 'No transpose', LASTC, LASTV-1, ONE, + $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) + ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) + CALL ZAXPY(LASTC, ONE, C, 1, WORK, 1) +* +* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T +* + ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL ZAXPY(LASTC, -TAU, WORK, 1, C, 1) + ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T + CALL ZGERC( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), + $ INCV, C(1,1+1), LDC ) + END IF + END IF + END IF + RETURN +* +* End of DLARF +* + END From 5e7dad37c9190ccf7d8ddd6c6195e7fb0efeb564 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Mon, 3 Jun 2024 15:23:37 +0700 Subject: [PATCH 084/206] remove dlarf1f prototype and add slarf1f, slarf1l, #1011 --- SRC/CMakeLists.txt | 4 +- SRC/Makefile | 4 +- SRC/dorm2r.f | 8 +- SRC/{dlarf1f.f => slarf1f.f} | 88 ++++++------ SRC/slarf1l.f | 256 +++++++++++++++++++++++++++++++++++ SRC/sorm2l.f | 8 +- SRC/sorm2r.f | 11 +- 7 files changed, 315 insertions(+), 64 deletions(-) rename SRC/{dlarf1f.f => slarf1f.f} (67%) create mode 100644 SRC/slarf1l.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index d368da2e15..ba83a6bcb0 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -106,7 +106,7 @@ set(SLASRC slaqgb.f slaqge.f slaqp2.f slaqps.f slaqp2rk.f slaqp3rk.f slaqsb.f slaqsp.f slaqsy.f slaqr0.f slaqr1.f slaqr2.f slaqr3.f slaqr4.f slaqr5.f slaqtr.f slar1v.f slar2v.f ilaslr.f ilaslc.f - slarf.f slarfb.f slarfb_gett.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f + slarf.f slarf1f.f slarf1l.f slarfb.f slarfb_gett.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f slargv.f slarmm.f slarrv.f slartv.f slarz.f slarzb.f slarzt.f slasy2.f slasyf.f slasyf_rook.f slasyf_rk.f slasyf_aa.f @@ -307,7 +307,7 @@ set(DLASRC dlaqgb.f dlaqge.f dlaqp2.f dlaqps.f dlaqp2rk.f dlaqp3rk.f dlaqsb.f dlaqsp.f dlaqsy.f dlaqr0.f dlaqr1.f dlaqr2.f dlaqr3.f dlaqr4.f dlaqr5.f dlaqtr.f dlar1v.f dlar2v.f iladlr.f iladlc.f - dlarf.f dlarf1f.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f + dlarf.f dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f dlargv.f dlarmm.f dlarrv.f dlartv.f dlarz.f dlarzb.f dlarzt.f dlaswp.f dlasy2.f dlasyf.f dlasyf_rook.f dlasyf_rk.f dlasyf_aa.f diff --git a/SRC/Makefile b/SRC/Makefile index 5d73c59251..4c3867f686 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -137,7 +137,7 @@ SLASRC = \ slaqgb.o slaqge.o slaqp2.o slaqps.o slaqp2rk.o slaqp3rk.o slaqsb.o slaqsp.o slaqsy.o \ slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o \ slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o \ - slarf.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o \ + slarf.o slarf1f.o slarf1l.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o \ slargv.o slarmm.o slarrv.o slartv.o \ slarz.o slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o \ slasyf_rk.o \ @@ -339,7 +339,7 @@ DLASRC = \ dlaqgb.o dlaqge.o dlaqp2.o dlaqps.o dlaqp2rk.o dlaqp3rk.o dlaqsb.o dlaqsp.o dlaqsy.o \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ - dlarf.o dlarf1f.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ + dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dorm2r.f b/SRC/dorm2r.f index 334d12b1f7..d894a806c3 100644 --- a/SRC/dorm2r.f +++ b/SRC/dorm2r.f @@ -178,13 +178,14 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ + DOUBLE PRECISION AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL DLARF1F, XERBLA + EXTERNAL DLARF, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -265,9 +266,12 @@ SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - CALL DLARF1F( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + AII = A( I, I ) + A( I, I ) = ONE + CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, $ JC ), $ LDC, WORK ) + A( I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/dlarf1f.f b/SRC/slarf1f.f similarity index 67% rename from SRC/dlarf1f.f rename to SRC/slarf1f.f index 33d242baa9..493e57bb21 100644 --- a/SRC/dlarf1f.f +++ b/SRC/slarf1f.f @@ -1,4 +1,4 @@ -*> \brief \b DLARF1F applies an elementary reflector to a general rectangular +*> \brief \b SLARF1F applies an elementary reflector to a general rectangular * matrix assuming v(1) = 1. * * =========== DOCUMENTATION =========== @@ -7,27 +7,27 @@ * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DLARF + dependencies -*> +*> Download SLARF1F + dependencies +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * .. Scalar Arguments .. * CHARACTER SIDE * INTEGER INCV, LDC, M, N -* DOUBLE PRECISION TAU +* REAL TAU * .. * .. Array Arguments .. -* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) +* REAL C( LDC, * ), V( * ), WORK( * ) * .. * * @@ -36,7 +36,7 @@ *> *> \verbatim *> -*> DLARF1F applies a real elementary reflector H to a real m by n matrix +*> SLARF1F applies a real elementary reflector H to a real m by n matrix *> C, from either the left or the right. H is represented in the form *> *> H = I - tau * v * v**T @@ -70,7 +70,7 @@ *> *> \param[in] V *> \verbatim -*> V is DOUBLE PRECISION array, dimension +*> V is REAL array, dimension *> (1 + (M-1)*abs(INCV)) if SIDE = 'L' *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' *> The vector v in the representation of H. V is not used if @@ -85,13 +85,13 @@ *> *> \param[in] TAU *> \verbatim -*> TAU is DOUBLE PRECISION +*> TAU is REAL *> The value tau in the representation of H. *> \endverbatim *> *> \param[in,out] C *> \verbatim -*> C is DOUBLE PRECISION array, dimension (LDC,N) +*> C is REAL array, dimension (LDC,N) *> On entry, the m by n matrix C. *> On exit, C is overwritten by the matrix H * C if SIDE = 'L', *> or C * H if SIDE = 'R'. @@ -105,7 +105,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension +*> WORK is REAL array, dimension *> (N) if SIDE = 'L' *> or (M) if SIDE = 'R' *> \endverbatim @@ -121,7 +121,7 @@ *> \ingroup larf1f * * ===================================================================== - SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) + SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -130,29 +130,29 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Scalar Arguments .. CHARACTER SIDE INTEGER INCV, LDC, M, N - DOUBLE PRECISION TAU + REAL TAU * .. * .. Array Arguments .. - DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) + REAL C( LDC, * ), V( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) + REAL ONE, ZERO + PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT INTEGER I, LASTV, LASTC * .. * .. External Subroutines .. - EXTERNAL DGEMV, DGER, DAXPY + EXTERNAL SGEMV, SGER, SAXPY, SSCAL * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILADLR, ILADLC - EXTERNAL LSAME, ILADLR, ILADLC + INTEGER ILASLR, ILASLC + EXTERNAL LSAME, ILASLR, ILASLC * .. * .. Executable Statements .. * @@ -179,10 +179,10 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). - LASTC = ILADLC(LASTV, N, C, LDC) + LASTC = ILASLC(LASTV, N, C, LDC) ELSE ! Scan for the last non-zero row in C(:,1:lastv). - LASTC = ILADLR(M, LASTV, C, LDC) + LASTC = ILASLR(M, LASTV, C, LDC) END IF END IF IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN @@ -196,26 +196,26 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) * - CALL DSCAL( LASTC, ONE - TAU, C, LDC ) + CALL SSCAL( LASTC, ONE - TAU, C, LDC ) ELSE * * w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) * - CALL DGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C( 2, 1 ), - $ LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) + CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C( 2, 1 ), + $ LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) * -* w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) +* w(1:lastc,1) += v(1,1) * C(1,1:lastc)**T * - CALL DAXPY( LASTC, ONE, C, LDC, WORK, 1 ) + CALL SAXPY( LASTC, ONE, C, LDC, WORK, 1 ) * -* C(1, 1:lastc) := C(...) - tau * w(1:lastc,1)**T +* C(1, 1:lastc) += - tau * v(1,1) * w(1:lastc,1)**T * - CALL DAXPY( LASTC, -TAU, WORK, 1, C, LDC ) + CALL SAXPY( LASTC, -TAU, WORK, 1, C, LDC ) * -* C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T +* C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**T * - CALL DGER( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, WORK, - $ 1, C( 2, 1 ), LDC ) + CALL SGER( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, WORK, + $ 1, C( 2, 1 ), LDC ) END IF ELSE * @@ -225,30 +225,30 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) * - CALL DSCAL( LASTC, ONE - TAU, C, 1 ) + CALL SSCAL( LASTC, ONE - TAU, C, 1 ) ELSE * * w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) * - CALL DGEMV( 'No transpose', LASTC, LASTV - 1, ONE, - $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) + CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, + $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) * -* w(1:lastc,1) += C(1:lastc,1) * v(1,1) +* w(1:lastc,1) += v(1,1) * C(1:lastc,1) * - CALL DAXPY( LASTC, ONE, C, 1, WORK, 1 ) + CALL SAXPY( LASTC, ONE, C, 1, WORK, 1 ) * -* C(1:lastc,1) := C(1:lastc,1) - tau * w(1:lastc,1) +* C(1:lastc,1) += - tau * v(1,1) * w(1:lastc,1) * - CALL DAXPY( LASTC, -TAU, WORK, 1, C, 1 ) + CALL SAXPY( LASTC, -TAU, WORK, 1, C, 1 ) * -* C(1:lastc,2:lastv) := C(1:lastc,2:lastv) - tau * w(1:lastc,1) * v(2:lastv)**T +* C(1:lastc,2:lastv) += - tau * w(1:lastc,1) * v(2:lastv)**T * - CALL DGER( LASTC, LASTV - 1, -TAU, WORK, 1, V( 1 + INCV ), - $ INCV, C( 1, 2 ), LDC ) + CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, + $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) END IF END IF RETURN * -* End of DLARF1F +* End of SLARF1F * END diff --git a/SRC/slarf1l.f b/SRC/slarf1l.f new file mode 100644 index 0000000000..901b01dce2 --- /dev/null +++ b/SRC/slarf1l.f @@ -0,0 +1,256 @@ +*> \brief \b SLARF1L applies an elementary reflector to a general rectangular +* matrix assuming v(lastv) = 1, where lastv is the last non-zero +* element +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SLARF1L + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* REAL TAU +* .. +* .. Array Arguments .. +* REAL C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SLARF1L applies a real elementary reflector H to a real m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**T +*> +*> where tau is a real scalar and v is a real vector assuming v(lastv) = 1, +*> where lastv is the last non-zero element. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is REAL array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is REAL +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is REAL array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is REAL array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf1l +* +* ===================================================================== + SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + REAL TAU +* .. +* .. Array Arguments .. + REAL C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE, ZERO + PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC +* .. +* .. External Subroutines .. + EXTERNAL SGEMV, SGER, SAXPY, SSCAL +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILASLR, ILASLC + EXTERNAL LSAME, ILASLR, ILASLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILASLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILASLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.EQ.1 ) THEN +* +* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* + CALL SSCAL( LASTC, ONE - TAU, C, LDC ) + ELSE +* +* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) +* + CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C, LDC, + $ V, INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) +* + CALL SAXPY( LASTC, ONE, C( LASTV, 1 ), LDC, WORK, 1 ) +* +* C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**T +* + CALL SAXPY( LASTC, -TAU, WORK, 1, C( LASTV, 1 ), LDC ) +* +* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**T +* + CALL SGER( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C, + $ LDC) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.EQ.1 ) THEN +* +* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* + CALL SSCAL( LASTC, ONE - TAU, C, 1 ) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) +* + CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, + $ LDC, V, INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) +* + CALL SAXPY( LASTC, ONE, C( 1, LASTV ), 1, WORK, 1 ) +* +* C(1:lastc,lastv) += - tau * v(lastv,1) * w(1:lastc,1) +* + CALL SAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 ) +* +* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**T +* + CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, V, + $ INCV, C, LDC ) + END IF + END IF + RETURN +* +* End of SLARF1L +* + END diff --git a/SRC/sorm2l.f b/SRC/sorm2l.f index bdd883c6c7..ff2e0b1c87 100644 --- a/SRC/sorm2l.f +++ b/SRC/sorm2l.f @@ -178,14 +178,13 @@ SUBROUTINE SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - REAL AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SLARF, XERBLA + EXTERNAL SLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -262,11 +261,8 @@ SUBROUTINE SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( NQ-K+I, I ) - A( NQ-K+I, I ) = ONE - CALL SLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC, + CALL SLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC, $ WORK ) - A( NQ-K+I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/sorm2r.f b/SRC/sorm2r.f index 4f53cbd3a0..360770a5bf 100644 --- a/SRC/sorm2r.f +++ b/SRC/sorm2r.f @@ -178,14 +178,13 @@ SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - REAL AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SLARF, XERBLA + EXTERNAL SLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -266,12 +265,8 @@ SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, I ) - A( I, I ) = ONE - CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, - $ JC ), - $ LDC, WORK ) - A( I, I ) = AII + CALL SLARF1F( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, + $ JC ), LDC, WORK ) 10 CONTINUE RETURN * From 491c0cf770725268199dc98dd06ad2c3f511584f Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 4 Jun 2024 03:20:42 -0400 Subject: [PATCH 085/206] updating zlarf1f.f --- SRC/zlarf1f.f | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index d0515a037e..133dd1db58 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -39,7 +39,7 @@ *> ZLARF1F applies a complex elementary reflector H to a real m by n matrix *> C, from either the left or the right. H is represented in the form *> -*> H = I - tau * v * v**T +*> H = I - tau * v * v**H *> *> where tau is a complex scalar and v is a complex vector. *> @@ -56,8 +56,6 @@ *> \verbatim *> SIDE is CHARACTER*1 *> = 'L': form H * C -*> = 'R': form C * H -*> \endverbatim *> *> \param[in] M *> \verbatim @@ -160,9 +158,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) INTEGER ILADLR, ILADLC EXTERNAL LSAME, ILADLR, ILADLC * .. -* .. Intrinsic Functions .. - INTRINSIC DCONJG -* .. * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) @@ -210,20 +205,26 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1) * - ! w(1:lastc,1) := C(2:lastv,1:lastc)**H * v(2:lastv,1) - CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, - $ V(1+INCV), INCV, ZERO, WORK, 1) - ! w(1:lastc,1) += C(1,1:lastc) * v(1,1) = C(1,1:lastc) - DO I = 1, LASTC - WORK(I) = WORK(I) + DCONJG(C(1,I)) + ! (I - tvv**H)C = C - tvv**H C + ! First compute w**H = v**H c -> w = C**H v + ! C = [ C_1 C_2 ]**T, v = [1 v_2]**T + ! w = C_1**H + C_2**Hv_2 + ! w = C_1**H + DO I = 1, LASTC + WORK(I) = DCONJG(C(1,I)) END DO + ! w += C_2**Hv_2 + CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, + $ V(1+INCV), INCV, ONE, WORK, 1) * -* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T +* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H * ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T - ! = C(...) - tau * w(1:lastc,1) - CALL ZAXPY(LASTC, -TAU, WORK, 1, C, LDC) - ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T + ! = C(...) - tau * Conj(w(1:lastc,1)) + DO I = 1, LASTC + C(1,I) = C(1,I) - TAU * DCONJG(WORK(I)) + END DO + ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, $ 1, C(1+1,1), LDC) END IF From 15ec3327ec85de49a7a24943b1dd9ab2e0138453 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 4 Jun 2024 03:21:36 -0400 Subject: [PATCH 086/206] updating comment on zlarf1f.f --- SRC/zlarf1f.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index 133dd1db58..d4e50567c0 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -219,7 +219,7 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H * - ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T + ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**H ! = C(...) - tau * Conj(w(1:lastc,1)) DO I = 1, LASTC C(1,I) = C(1,I) - TAU * DCONJG(WORK(I)) From 468cb59c9be54195f1cc237b4564f096e908c7a6 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 4 Jun 2024 03:39:05 -0400 Subject: [PATCH 087/206] alternative formulation more similar to dlarf1f.f --- SRC/zlarf1f.f | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index d4e50567c0..da3dd305ec 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -209,18 +209,20 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! First compute w**H = v**H c -> w = C**H v ! C = [ C_1 C_2 ]**T, v = [1 v_2]**T ! w = C_1**H + C_2**Hv_2 - ! w = C_1**H + ! w = C_2**Hv_2 + CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, + $ V(1+INCV), INCV, ZERO, WORK, 1) + ! w += C_1**H + ! This is essentially a zaxpyc DO I = 1, LASTC - WORK(I) = DCONJG(C(1,I)) + WORK(I) = WORK(I) + DCONJG(C(1,I)) END DO - ! w += C_2**Hv_2 - CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, - $ V(1+INCV), INCV, ONE, WORK, 1) * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H * ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**H ! = C(...) - tau * Conj(w(1:lastc,1)) + ! This is essentially a zaxpyc DO I = 1, LASTC C(1,I) = C(1,I) - TAU * DCONJG(WORK(I)) END DO From 8dd7e138a9aadc22124781499f7239c35b1ce31e Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Tue, 4 Jun 2024 16:56:49 +0700 Subject: [PATCH 088/206] update single precision routines to use slarf1f and slarf1l, #1011 --- SRC/sgebd2.f | 30 +++++------- SRC/sgehd2.f | 14 ++---- SRC/sgelq2.f | 12 ++--- SRC/sgeql2.f | 12 ++--- SRC/sgeqp3rk.f | 4 +- SRC/sgeqr2.f | 10 ++-- SRC/sgeqr2p.f | 10 ++-- SRC/sgerq2.f | 10 ++-- SRC/slaqp2.f | 11 ++--- SRC/slaqp2rk.f | 13 ++--- SRC/slaqr2.f | 21 ++++---- SRC/slaqr3.f | 21 ++++---- SRC/sopmtr.f | 19 +++----- SRC/sorbdb.f | 128 +++++++++++++++++++++++-------------------------- SRC/sorbdb1.f | 22 ++++----- SRC/sorbdb2.f | 27 +++++------ SRC/sorbdb3.f | 30 +++++------- SRC/sorbdb4.f | 51 +++++++++----------- SRC/sorg2l.f | 8 ++-- SRC/sorg2r.f | 7 ++- SRC/sorgl2.f | 7 ++- SRC/sorgr2.f | 8 ++-- SRC/sorml2.f | 10 ++-- SRC/sormr2.f | 11 ++--- 24 files changed, 208 insertions(+), 288 deletions(-) diff --git a/SRC/sgebd2.f b/SRC/sgebd2.f index 978ec9f369..c0ff242297 100644 --- a/SRC/sgebd2.f +++ b/SRC/sgebd2.f @@ -209,7 +209,7 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) INTEGER I * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1F, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -242,15 +242,13 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1, $ TAUQ( I ) ) D( I ) = A( I, I ) - A( I, I ) = ONE * * Apply H(i) to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ TAUQ( I ), - $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = D( I ) + $ CALL SLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ TAUQ( I ), + $ A( I, I+1 ), LDA, WORK ) * IF( I.LT.N ) THEN * @@ -260,13 +258,11 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL SLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ), $ LDA, TAUP( I ) ) E( I ) = A( I, I+1 ) - A( I, I+1 ) = ONE * * Apply G(i) to A(i+1:m,i+1:n) from the right * - CALL SLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA, - $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) - A( I, I+1 ) = E( I ) + CALL SLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA, + $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) ELSE TAUP( I ) = ZERO END IF @@ -283,14 +279,12 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) $ LDA, $ TAUP( I ) ) D( I ) = A( I, I ) - A( I, I ) = ONE * * Apply G(i) to A(i+1:m,i:n) from the right * IF( I.LT.M ) - $ CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAUP( I ), A( I+1, I ), LDA, WORK ) - A( I, I ) = D( I ) + $ CALL SLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAUP( I ), A( I+1, I ), LDA, WORK ) * IF( I.LT.M ) THEN * @@ -301,14 +295,12 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) $ 1, $ TAUQ( I ) ) E( I ) = A( I+1, I ) - A( I+1, I ) = ONE * * Apply H(i) to A(i+1:m,i+1:n) from the left * - CALL SLARF( 'Left', M-I, N-I, A( I+1, I ), 1, - $ TAUQ( I ), - $ A( I+1, I+1 ), LDA, WORK ) - A( I+1, I ) = E( I ) + CALL SLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1, + $ TAUQ( I ), + $ A( I+1, I+1 ), LDA, WORK ) ELSE TAUQ( I ) = ZERO END IF diff --git a/SRC/sgehd2.f b/SRC/sgehd2.f index 2692e68273..e513502130 100644 --- a/SRC/sgehd2.f +++ b/SRC/sgehd2.f @@ -166,10 +166,9 @@ SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1F, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -199,20 +198,17 @@ SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * CALL SLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - AII = A( I+1, I ) - A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right * - CALL SLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), - $ A( 1, I+1 ), LDA, WORK ) + CALL SLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), + $ A( 1, I+1 ), LDA, WORK ) * * Apply H(i) to A(i+1:ihi,i+1:n) from the left * - CALL SLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ), - $ A( I+1, I+1 ), LDA, WORK ) + CALL SLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ), + $ A( I+1, I+1 ), LDA, WORK ) * - A( I+1, I ) = AII 10 CONTINUE * RETURN diff --git a/SRC/sgelq2.f b/SRC/sgelq2.f index 14c345bf39..3e431c3927 100644 --- a/SRC/sgelq2.f +++ b/SRC/sgelq2.f @@ -146,10 +146,9 @@ SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1F, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -183,12 +182,9 @@ SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i+1:m,i:n) from the right * - AII = A( I, I ) - A( I, I ) = ONE - CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), - $ A( I+1, I ), LDA, WORK ) - A( I, I ) = AII + CALL SLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), + $ A( I+1, I ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/sgeql2.f b/SRC/sgeql2.f index c727c3611f..ec58dc2269 100644 --- a/SRC/sgeql2.f +++ b/SRC/sgeql2.f @@ -140,10 +140,9 @@ SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1L, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,12 +176,9 @@ SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left * - AII = A( M-K+I, N-K+I ) - A( M-K+I, N-K+I ) = ONE - CALL SLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, - $ TAU( I ), - $ A, LDA, WORK ) - A( M-K+I, N-K+I ) = AII + CALL SLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + $ TAU( I ), + $ A, LDA, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f index e5b3e4cd86..191cbcffab 100644 --- a/SRC/sgeqp3rk.f +++ b/SRC/sgeqp3rk.f @@ -671,7 +671,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) SGEQP3RK and SLAQP2RK: 2*N to store full and partial * column 2-norms. * 2) SLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in SLARF subroutine inside SLAQP2RK to apply an +* in SLARF1F subroutine inside SLAQP2RK to apply an * elementary reflector from the left. * TOTAL_WORK_SIZE = 3*N + NRHS - 1 * @@ -687,7 +687,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) SGEQP3RK, SLAQP2RK, SLAQP3RK: 2*N to store full and * partial column 2-norms. * 2) SLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in SLARF subroutine to apply an elementary reflector +* in SLARF1F subroutine to apply an elementary reflector * from the left. * 3) SLAQP3RK: NB*(N+NRHS) to use in the work array F that * is used to apply a block reflector from diff --git a/SRC/sgeqr2.f b/SRC/sgeqr2.f index 3a78733b7d..1868b204c6 100644 --- a/SRC/sgeqr2.f +++ b/SRC/sgeqr2.f @@ -147,10 +147,9 @@ SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1F, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -184,11 +183,8 @@ SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i:m,i+1:n) from the left * - AII = A( I, I ) - A( I, I ) = ONE - CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = AII + CALL SLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + $ A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/sgeqr2p.f b/SRC/sgeqr2p.f index 9f3693a631..02fe30826d 100644 --- a/SRC/sgeqr2p.f +++ b/SRC/sgeqr2p.f @@ -151,10 +151,9 @@ SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, XERBLA + EXTERNAL SLARF1F, SLARFGP, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -188,11 +187,8 @@ SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(i:m,i+1:n) from the left * - AII = A( I, I ) - A( I, I ) = ONE - CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK ) - A( I, I ) = AII + CALL SLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + $ A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/sgerq2.f b/SRC/sgerq2.f index 1c612f8f27..036f979cb5 100644 --- a/SRC/sgerq2.f +++ b/SRC/sgerq2.f @@ -140,10 +140,9 @@ SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - REAL AII * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, XERBLA + EXTERNAL SLARF1L, SLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,11 +176,8 @@ SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right * - AII = A( M-K+I, N-K+I ) - A( M-K+I, N-K+I ) = ONE - CALL SLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, - $ TAU( I ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = AII + CALL SLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, + $ TAU( I ), A, LDA, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/slaqp2.f b/SRC/slaqp2.f index c88e2e5e85..22e296b008 100644 --- a/SRC/slaqp2.f +++ b/SRC/slaqp2.f @@ -168,10 +168,10 @@ SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * .. * .. Local Scalars .. INTEGER I, ITEMP, J, MN, OFFPI, PVT - REAL AII, TEMP, TEMP2, TOL3Z + REAL TEMP, TEMP2, TOL3Z * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, SSWAP + EXTERNAL SLARF1F, SLARFG, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -219,11 +219,8 @@ SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * * Apply H(i)**T to A(offset+i:m,i+1:n) from the left. * - AII = A( OFFPI, I ) - A( OFFPI, I ) = ONE - CALL SLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, - $ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) ) - A( OFFPI, I ) = AII + CALL SLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, + $ TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) ) END IF * * Update partial column norms. diff --git a/SRC/slaqp2rk.f b/SRC/slaqp2rk.f index f88b0ce909..3a19c5d746 100644 --- a/SRC/slaqp2rk.f +++ b/SRC/slaqp2rk.f @@ -253,7 +253,7 @@ *> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (N-1) -*> Used in SLARF subroutine to apply an elementary +*> Used in SLARF1F subroutine to apply an elementary *> reflector from the left. *> \endverbatim *> @@ -367,10 +367,10 @@ SUBROUTINE SLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * .. Local Scalars .. INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT, $ MINMNUPDT - REAL AIKK, HUGEVAL, TEMP, TEMP2, TOL3Z + REAL HUGEVAL, TEMP, TEMP2, TOL3Z * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFG, SSWAP + EXTERNAL SLARF1F, SLARFG, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -621,11 +621,8 @@ SUBROUTINE SLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * condition is satisfied, not only KK < N+NRHS ) * IF( KK.LT.MINMNUPDT ) THEN - AIKK = A( I, KK ) - A( I, KK ) = ONE - CALL SLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, - $ TAU( KK ), A( I, KK+1 ), LDA, WORK( 1 ) ) - A( I, KK ) = AIKK + CALL SLARF1F( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, + $ TAU( KK ), A( I, KK+1 ), LDA, WORK( 1 ) ) END IF * IF( KK.LT.MINMNFACT ) THEN diff --git a/SRC/slaqr2.f b/SRC/slaqr2.f index cc160b9bf3..e60eb80fea 100644 --- a/SRC/slaqr2.f +++ b/SRC/slaqr2.f @@ -298,7 +298,7 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 ) * .. * .. Local Scalars .. - REAL AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S, + REAL AA, BB, CC, CS, DD, EVI, EVK, FOO, S, $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL, $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, @@ -312,7 +312,8 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, $ SLAHQR, - $ SLANV2, SLARF, SLARFG, SLASET, SORMHR, STREXC + $ SLANV2, SLARF1L, SLARFG, SLASET, SORMHR, + $ STREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, MAX, MIN, REAL, SQRT @@ -595,19 +596,17 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * ==== Reflect spike back into lower triangle ==== * CALL SCOPY( NS, V, LDV, WORK, 1 ) - BETA = WORK( 1 ) - CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL SLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL SLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL SLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL SLARF1F( 'L', NS, JW, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL SLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL SLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL SGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/slaqr3.f b/SRC/slaqr3.f index 7e53564a2b..21b958f308 100644 --- a/SRC/slaqr3.f +++ b/SRC/slaqr3.f @@ -295,7 +295,7 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( ZERO = 0.0e0, ONE = 1.0e0 ) * .. * .. Local Scalars .. - REAL AA, BB, BETA, CC, CS, DD, EVI, EVK, FOO, S, + REAL AA, BB, CC, CS, DD, EVI, EVK, FOO, S, $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL, $ KEND, KLN, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3, @@ -310,7 +310,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, $ SLANV2, - $ SLAQR4, SLARF, SLARFG, SLASET, SORMHR, STREXC + $ SLAQR4, SLARF1F, SLARFG, SLASET, SORMHR, + $ STREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, MAX, MIN, REAL, SQRT @@ -606,19 +607,17 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * ==== Reflect spike back into lower triangle ==== * CALL SCOPY( NS, V, LDV, WORK, 1 ) - BETA = WORK( 1 ) - CALL SLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL SLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL SLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL SLARF( 'L', NS, JW, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL SLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL SLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL SLARF1F( 'L', NS, JW, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL SLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL SLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL SGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/sopmtr.f b/SRC/sopmtr.f index e8542f3473..14749c29d7 100644 --- a/SRC/sopmtr.f +++ b/SRC/sopmtr.f @@ -170,14 +170,13 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * .. Local Scalars .. LOGICAL FORWRD, LEFT, NOTRAN, UPPER INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ - REAL AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SLARF, XERBLA + EXTERNAL SLARF1F, SLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -261,12 +260,9 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * * Apply H(i) * - AII = AP( II ) - AP( II ) = ONE - CALL SLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, - $ LDC, - $ WORK ) - AP( II ) = AII + CALL SLARF1L( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, + $ LDC, + $ WORK ) * IF( FORWRD ) THEN II = II + I + 2 @@ -302,8 +298,6 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, END IF * DO 20 I = I1, I2, I3 - AII = AP( II ) - AP( II ) = ONE IF( LEFT ) THEN * * H(i) is applied to C(i+1:m,1:n) @@ -320,9 +314,8 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * * Apply H(i) * - CALL SLARF( SIDE, MI, NI, AP( II ), 1, TAU( I ), - $ C( IC, JC ), LDC, WORK ) - AP( II ) = AII + CALL SLARF1F( SIDE, MI, NI, AP( II ), 1, TAU( I ), + $ C( IC, JC ), LDC, WORK ) * IF( FORWRD ) THEN II = II + NQ - I + 1 diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index 46f7a496a3..a401342e1c 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -316,7 +316,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, REAL Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SLARF, SLARFGP, SSCAL, + EXTERNAL SAXPY, SLARF1F, SLARFGP, SSCAL, $ XERBLA * .. * .. External Functions .. @@ -422,7 +422,6 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, ELSE IF( P .EQ. I ) THEN CALL SLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF - X11(I,I) = ONE IF ( M-P .GT. I ) THEN CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) @@ -430,25 +429,25 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), - $ X11(I,I+1), LDX11, WORK ) + CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), + $ X11(I,I+1), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, - $ TAUP1(I), - $ X12(I,I), LDX12, WORK ) + CALL SLARF1F( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ TAUP1(I), + $ X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK ) + CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ TAUP2(I), + $ X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ TAUP2(I), - $ X22(I,I), LDX22, WORK ) + CALL SLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ TAUP2(I), + $ X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -476,7 +475,6 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, $ TAUQ1(I) ) END IF - X11(I,I+1) = ONE END IF IF ( Q+I-1 .LT. M ) THEN IF ( M-Q .EQ. I ) THEN @@ -487,24 +485,23 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ TAUQ2(I) ) END IF END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL SLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) - CALL SLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL SLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK ) + CALL SLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL SLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN - CALL SLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) + CALL SLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) END IF * END DO @@ -521,16 +518,15 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL SLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL SLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL SLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) + $ CALL SLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) * END DO * @@ -546,11 +542,10 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1), $ LDX22, TAUQ2(P+I) ) END IF - X22(Q+I,P+I) = ONE IF ( I .LT. M-P-Q ) THEN - CALL SLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), - $ LDX22, - $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) + CALL SLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + $ LDX22, TAUQ2(P+I), X22(Q+I+1,P+I), + $ LDX22, WORK ) END IF * END DO @@ -584,7 +579,6 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * CALL SLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, $ TAUP1(I) ) - X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, $ TAUP2(I) ) @@ -592,25 +586,24 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL SLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), - $ X11(I+1,I), LDX11, WORK ) + CALL SLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), + $ X11(I+1,I), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), X12(I,I), LDX12, WORK ) + CALL SLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL SLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), - $ X21(I+1,I), LDX21, WORK ) + CALL SLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), + $ X21(I+1,I), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL SLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), X22(I,I), LDX22, WORK ) + CALL SLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -634,7 +627,6 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, $ TAUQ1(I) ) END IF - X11(I+1,I) = ONE END IF IF ( M-Q .GT. I ) THEN CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, @@ -643,20 +635,19 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I,I), 1, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL SLARF( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) - CALL SLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL SLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK ) + CALL SLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), + $ X21(I+1,I+1), LDX21, WORK ) END IF - CALL SLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), - $ X12(I,I+1), LDX12, WORK ) + CALL SLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), + $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN - CALL SLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,I+1), LDX22, WORK ) + CALL SLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ TAUQ2(I), + $ X22(I,I+1), LDX22, WORK ) END IF * END DO @@ -668,16 +659,16 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), 1 ) CALL SLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL SLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), - $ X12(I,I+1), LDX12, WORK ) + CALL SLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ TAUQ2(I), + $ X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL SLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,Q+1), LDX22, WORK ) + $ CALL SLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ TAUQ2(I), + $ X22(I,Q+1), LDX22, WORK ) * END DO * @@ -690,14 +681,13 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), $ 1, $ TAUQ2(P+I) ) - X22(P+I,Q+I) = ONE ELSE CALL SLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), $ 1, $ TAUQ2(P+I) ) - X22(P+I,Q+I) = ONE - CALL SLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, - $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK ) + CALL SLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), + $ 1, TAUQ2(P+I), X22(P+I,Q+I+1), + $ LDX22, WORK ) END IF * * diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index 20e38371e0..1ce1bc8a6d 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -228,7 +228,7 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, + EXTERNAL SLARF1F, SLARFGP, SORBDB5, SROT, $ XERBLA * .. * .. External Functions .. @@ -287,12 +287,10 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( X21(I,I), X11(I,I) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I) = ONE - X21(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) - CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), + $ LDX11, WORK(ILARF) ) + CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN @@ -301,11 +299,11 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL SLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, $ TAUQ1(I) ) S = X21(I,I+1) - X21(I,I+1) = ONE - CALL SLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ 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) ) + CALL SLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL SLARF1F( '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 )**2 $ + SNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index 02f6611a86..c785305c8c 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -226,7 +226,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, + EXTERNAL SLARF1F, SLARFGP, SORBDB5, SROT, SSCAL, $ XERBLA * .. * .. External Functions .. @@ -286,11 +286,11 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, END IF CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = X11(I,I) - X11(I,I) = ONE - CALL SLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ 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) ) + CALL SLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL SLARF1F( '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 )**2 $ + SNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) @@ -305,13 +305,11 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( X11(I+1,I), X21(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X11(I+1,I) = ONE - CALL SLARF( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL SLARF1F( 'L', P-I, Q-I, X11(I+1,I), 1, TAUP1(I), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF - X21(I,I) = ONE - CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + $ X21(I,I+1), LDX21, WORK(ILARF) ) * END DO * @@ -319,9 +317,8 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = P + 1, Q CALL SLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) - X21(I,I) = ONE - CALL SLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), + $ X21(I,I+1), LDX21, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index ba12eda1aa..d064723e6a 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -227,7 +227,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, + EXTERNAL SLARF1F, SLARFGP, SORBDB5, SROT, $ XERBLA * .. * .. External Functions .. @@ -288,11 +288,10 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) S = X21(I,I) - X21(I,I) = ONE - CALL SLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ 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) ) + CALL SLARF1F( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I,I), LDX11, WORK(ILARF) ) + CALL SLARF1F( '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 )**2 $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) @@ -307,14 +306,12 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( X21(I+1,I), X11(I,I) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X21(I+1,I) = ONE - CALL SLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'L', M-P-I, Q-I, X21(I+1,I), 1, TAUP2(I), + $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF - X11(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) + CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), + $ LDX11, WORK(ILARF) ) * END DO * @@ -322,10 +319,9 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = M-P + 1, Q CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) - X11(I,I) = ONE - CALL SLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) + CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, + $ I+1), + $ LDX11, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index fc352c5555..0eb9edd658 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -239,7 +239,7 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL SLARF, SLARFGP, SORBDB5, SROT, SSCAL, + EXTERNAL SLARF1F, SLARFGP, SORBDB5, SROT, SSCAL, $ XERBLA * .. * .. External Functions .. @@ -308,13 +308,12 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( PHANTOM(1), PHANTOM(P+1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - PHANTOM(1) = ONE - PHANTOM(P+1) = ONE - CALL SLARF( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, - $ LDX11, - $ WORK(ILARF) ) - CALL SLARF( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, - $ LDX21, WORK(ILARF) ) + CALL SLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, + $ LDX11, + $ WORK(ILARF) ) + CALL SLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), + $ X21, + $ LDX21, WORK(ILARF) ) ELSE CALL SORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -327,22 +326,20 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( X11(I,I-1), X21(I,I-1) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I-1) = ONE - X21(I,I-1) = ONE - CALL SLARF( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), - $ X11(I,I), LDX11, WORK(ILARF) ) - CALL SLARF( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), + $ X11(I,I), LDX11, WORK(ILARF) ) + CALL SLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, + $ TAUP2(I), + $ X21(I,I), LDX21, WORK(ILARF) ) END IF * CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) CALL SLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) C = X21(I,I) - X21(I,I) = ONE - CALL SLARF( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X11(I+1,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) ) + CALL SLARF1F( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL SLARF1F( '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 )**2 $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) @@ -355,11 +352,10 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = M - Q + 1, P CALL SLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) - X11(I,I) = ONE - CALL SLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL SLARF( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL SLARF1F( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) END DO * * Reduce the bottom-right portion of X21 to [ 0 I ] @@ -368,10 +364,9 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL SLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), $ LDX21, $ TAUQ1(I) ) - X21(M-Q+I-P,I) = ONE - CALL SLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, - $ TAUQ1(I), - $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) + CALL SLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), + $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/sorg2l.f b/SRC/sorg2l.f index 0a3c96697a..32bbbaabb9 100644 --- a/SRC/sorg2l.f +++ b/SRC/sorg2l.f @@ -133,7 +133,7 @@ SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL SLARF, SSCAL, XERBLA + EXTERNAL SLARF1L, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -177,9 +177,9 @@ SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL SLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), - $ A, - $ LDA, WORK ) + CALL SLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, + $ LDA, WORK ) CALL SSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) * diff --git a/SRC/sorg2r.f b/SRC/sorg2r.f index 67d35d950e..7c22013814 100644 --- a/SRC/sorg2r.f +++ b/SRC/sorg2r.f @@ -133,7 +133,7 @@ SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL SLARF, SSCAL, XERBLA + EXTERNAL SLARF1F, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -176,9 +176,8 @@ SUBROUTINE SORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i:m,i:n) from the left * IF( I.LT.N ) THEN - A( I, I ) = ONE - CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK ) + CALL SLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + $ A( I, I+1 ), LDA, WORK ) END IF IF( I.LT.M ) $ CALL SSCAL( M-I, -TAU( I ), A( I+1, I ), 1 ) diff --git a/SRC/sorgl2.f b/SRC/sorgl2.f index 2f03d32e53..0ea0ed9714 100644 --- a/SRC/sorgl2.f +++ b/SRC/sorgl2.f @@ -132,7 +132,7 @@ SUBROUTINE SORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL SLARF, SSCAL, XERBLA + EXTERNAL SLARF1F, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -180,9 +180,8 @@ SUBROUTINE SORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) * IF( I.LT.N ) THEN IF( I.LT.M ) THEN - A( I, I ) = ONE - CALL SLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), A( I+1, I ), LDA, WORK ) + CALL SLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), A( I+1, I ), LDA, WORK ) END IF CALL SSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA ) END IF diff --git a/SRC/sorgr2.f b/SRC/sorgr2.f index 73caec659a..3435d3586f 100644 --- a/SRC/sorgr2.f +++ b/SRC/sorgr2.f @@ -133,7 +133,7 @@ SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL SLARF, SSCAL, XERBLA + EXTERNAL SLARF1L, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -181,9 +181,9 @@ SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the right * A( II, N-M+II ) = ONE - CALL SLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, - $ TAU( I ), - $ A, LDA, WORK ) + CALL SLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + $ TAU( I ), + $ A, LDA, WORK ) CALL SSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - TAU( I ) * diff --git a/SRC/sorml2.f b/SRC/sorml2.f index 27f970fcdb..7ebd0caf8a 100644 --- a/SRC/sorml2.f +++ b/SRC/sorml2.f @@ -178,14 +178,13 @@ SUBROUTINE SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - REAL AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SLARF, XERBLA + EXTERNAL SLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -266,11 +265,8 @@ SUBROUTINE SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, I ) - A( I, I ) = ONE - CALL SLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ), - $ C( IC, JC ), LDC, WORK ) - A( I, I ) = AII + CALL SLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAU( I ), + $ C( IC, JC ), LDC, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/sormr2.f b/SRC/sormr2.f index 5e71a483aa..e0e4f73311 100644 --- a/SRC/sormr2.f +++ b/SRC/sormr2.f @@ -178,14 +178,13 @@ SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - REAL AII * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL SLARF, XERBLA + EXTERNAL SLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -262,11 +261,9 @@ SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * Apply H(i) * - AII = A( I, NQ-K+I ) - A( I, NQ-K+I ) = ONE - CALL SLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC, - $ WORK ) - A( I, NQ-K+I ) = AII + CALL SLARF1L( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, + $ LDC, + $ WORK ) 10 CONTINUE RETURN * From 6c0a98f8c4097b3fb86e9069b8b1ac01574f59fa Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Wed, 5 Jun 2024 17:50:09 +0700 Subject: [PATCH 089/206] implement clarf1f, #1011 --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 2 +- SRC/clarf1f.f | 267 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 269 insertions(+), 2 deletions(-) create mode 100644 SRC/clarf1f.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index ba83a6bcb0..fe7670e146 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -218,7 +218,7 @@ set(CLASRC claqhb.f claqhe.f claqhp.f claqp2.f claqps.f claqp2rk.f claqp3rk.f claqsb.f claqr0.f claqr1.f claqr2.f claqr3.f claqr4.f claqr5.f claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f - clarf.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f + clarf.f clarf1f.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f90 clartv.f clarz.f clarzb.f clarzt.f clascl.f claset.f clasr.f classq.f90 claswp.f clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f diff --git a/SRC/Makefile b/SRC/Makefile index 4c3867f686..6fbebc544d 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -249,7 +249,7 @@ CLASRC = \ claqhb.o claqhe.o claqhp.o claqp2.o claqps.o claqp2rk.o claqp3rk.o claqsb.o \ claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o \ claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \ - clarf.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \ + clarf.o clarf1f.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \ clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \ clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o \ claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \ diff --git a/SRC/clarf1f.f b/SRC/clarf1f.f new file mode 100644 index 0000000000..b1cc9e9792 --- /dev/null +++ b/SRC/clarf1f.f @@ -0,0 +1,267 @@ +*> \brief \b CLARF1F applies an elementary reflector to a general rectangular +* matrix assuming v(1) = 1. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CLARF1F + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* COMPLEX TAU +* .. +* .. Array Arguments .. +* COMPLEX C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CLARF1F applies a complex elementary reflector H to a complex m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**H +*> +*> where tau is a complex scalar and v is a complex vector assuming v(1) = 1. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> +*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead +*> tau. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf1f +* +* ===================================================================== + SUBROUTINE CLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + COMPLEX TAU +* .. +* .. Array Arguments .. + COMPLEX C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX ONE, ZERO + PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), + $ ZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC +* .. +* .. External Subroutines .. + EXTERNAL CGEMV, CGER, CSCAL +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILACLR, ILACLC + EXTERNAL LSAME, ILACLR, ILACLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 0 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V. + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILACLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILACLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.EQ.1 ) THEN +* +* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* + CALL CSCAL( LASTC, ONE - TAU, C, LDC ) + ELSE +* +* w(1:lastc,1) := C(2:lastv,1:lastc)**H * v(2:lastv,1) +* + CALL CGEMV( 'Conjugate transpose', LASTV - 1, LASTC, ONE, + $ C( 2, 1 ), LDC, V( 1 + INCV ), INCV, ZERO, + $ WORK, 1 ) +* +* w(1:lastc,1) += v(1,1) * C(1,1:lastc)**H +* + DO I = 1, LASTC + WORK( I ) = WORK( I ) + CONJG( C( 1, I ) ) + END DO +* +* C(1, 1:lastc) += - tau * v(1,1) * w(1:lastc,1)**H +* + DO I = 1, LASTC + C( 1, I ) = C( 1, I ) - TAU * CONJG( WORK( I ) ) + END DO +* +* C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**H +* + CALL CGERC( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, + $ WORK, 1, C( 2, 1 ), LDC ) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.EQ.1 ) THEN +* +* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* + CALL CSCAL( LASTC, ONE - TAU, C, 1 ) + ELSE +* +* w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) +* + CALL CGEMV( 'No transpose', LASTC, LASTV - 1, ONE, + $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, + $ WORK, 1 ) +* +* w(1:lastc,1) += v(1,1) * C(1:lastc,1) +* + CALL CAXPY( LASTC, ONE, C, 1, WORK, 1 ) +* +* C(1:lastc,1) += - tau * v(1,1) * w(1:lastc,1) +* + CALL CAXPY( LASTC, -TAU, WORK, 1, C, 1 ) +* +* C(1:lastc,2:lastv) += - tau * w(1:lastc,1) * v(2:lastv)**H +* + CALL CGERC( LASTC, LASTV - 1, -TAU, WORK, 1, + $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) + END IF + END IF + RETURN +* +* End of CLARF1F +* + END From 5889e3e22fb236b720f43882f070f766ea8f2520 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Wed, 5 Jun 2024 17:54:22 +0700 Subject: [PATCH 090/206] try clarf1f in cunm2r, #1011 --- SRC/cunm2r.f | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index 0682381be3..094a15bf7c 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -178,14 +178,14 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - COMPLEX AII, TAUI + COMPLEX TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CLARF, XERBLA + EXTERNAL CLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -270,12 +270,10 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, ELSE TAUI = CONJG( TAU( I ) ) END IF - AII = A( I, I ) A( I, I ) = ONE - CALL CLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), - $ LDC, - $ WORK ) - A( I, I ) = AII + CALL CLARF1F( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), + $ LDC, + $ WORK ) 10 CONTINUE RETURN * From 231db955f22d438fd7559d319d9bde5b3e328f74 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 5 Jun 2024 13:12:09 +0200 Subject: [PATCH 091/206] Use `add_compile_options(...)` and `add_link_options(...)` instead of appending flags to CACHE variables. --- CMAKE/CheckLAPACKCompilerFlags.cmake | 354 +++++++++++---------------- CMakeLists.txt | 20 +- INSTALL/CMakeLists.txt | 8 + 3 files changed, 155 insertions(+), 227 deletions(-) diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index 653b817583..2cf62c18fa 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -10,34 +10,32 @@ # Copyright 2011 #============================================================================= -macro( CheckLAPACKCompilerFlags ) +macro(CheckLAPACKCompilerFlags) -set( FPE_EXIT FALSE ) - -# FORTRAN ILP default -set(FOPT_ILP64) -if( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) - if ( WIN32 ) - set(FOPT_ILP64 /integer-size:64) - else () - set(FOPT_ILP64 "-integer-size 64") + # FORTRAN ILP default + set(FOPT_ILP64) + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + if(WIN32) + set(FOPT_ILP64 /integer-size:64) + else() + set(FOPT_ILP64 "-integer-size 64") endif() -elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6 - (CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8 + elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6 + (CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8 set(FOPT_ILP64 -qintsize=8) -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" ) - if ( WIN32 ) - set(FOPT_ILP64 /i8) - else () - set(FOPT_ILP64 -i8) + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + if(WIN32) + set(FOPT_ILP64 /i8) + else() + set(FOPT_ILP64 -i8) endif() -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC" ) - if ( WIN32 ) - set(FOPT_ILP64 /i8) - else () - set(FOPT_ILP64 -i8) + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + if(WIN32) + set(FOPT_ILP64 /i8) + else() + set(FOPT_ILP64 -i8) endif() -else() + else() set(CPE_ENV $ENV{PE_ENV}) if(CPE_ENV STREQUAL "CRAY") set(FOPT_ILP64 -sinteger64) @@ -46,210 +44,148 @@ else() else() set(FOPT_ILP64 -fdefault-integer-8) endif() -endif() -if ( FORTRAN_ILP ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${FOPT_ILP64}") -endif() - -# GNU Fortran -if( CMAKE_Fortran_COMPILER_ID STREQUAL "GNU" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "-ffpe-trap=[izoupd]") - set( FPE_EXIT TRUE ) - endif() - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-frecursive") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -frecursive" - CACHE STRING "Recursive flag must be set" FORCE) - endif() - -# Intel Fortran -elseif( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]fpe(-all=|)0" ) - set( FPE_EXIT TRUE ) - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-recursive") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -recursive" - CACHE STRING "Recursive flag must be set" FORCE) - endif() - - if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-fp-model[ \t]strict") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict") - endif() - -# SunPro F95 -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro" ) - if( ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=") AND - NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-ftrap=(%|)none") ) - set( FPE_EXIT TRUE ) - elseif( NOT (CMAKE_Fortran_FLAGS MATCHES "-ftrap=") ) - message( STATUS "Disabling FPE trap handlers with -ftrap=%none" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ftrap=%none" - CACHE STRING "Flags for Fortran compiler." FORCE ) - endif() - - if(UNIX) - # Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler. - # This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin - string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") - endif() - -# IBM XL Fortran -elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6 - (CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8 - if( "${CMAKE_Fortran_FLAGS}" MATCHES "-qflttrap=[a-zA-Z:]:enable" ) - set( FPE_EXIT TRUE ) - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qrecur") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qrecur" - CACHE STRING "Recursive flag must be set" FORCE) endif() - - if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qnosave") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave") + if(FORTRAN_ILP) + add_compile_options("$<$:${FOPT_ILP64}>") endif() + # GNU Fortran + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set(FPE_EXIT_FLAG "-ffpe-trap=[izoupd]") - if( UNIX AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-qstrict") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qstrict") - endif() - -# HP Fortran -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "HP" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "\\+fp_exception" ) - set( FPE_EXIT TRUE ) - endif() + add_compile_options("$<$:-frecursive>") - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "\\+fltconst_strict") ) - message( STATUS "Enabling strict float conversion with +fltconst_strict" ) - set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} +fltconst_strict" - CACHE STRING "Flags for Fortran compiler." FORCE ) - endif() - - # Most versions of cmake don't have good default options for the HP compiler - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -g" - CACHE STRING "Flags used by the compiler during debug builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_MINSIZEREL} +Osize" - CACHE STRING "Flags used by the compiler during release minsize builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELEASE} +O2" - CACHE STRING "Flags used by the compiler during release builds" FORCE ) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} +O2 -g" - CACHE STRING "Flags used by the compiler during release with debug info builds" FORCE ) - -# NAG Fortran -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" ) - if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=(stop|nonstd)" ) - set( FPE_EXIT TRUE ) - endif() + # Intel Fortran + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + set(FPE_EXIT_FLAG "[-/]fpe(-all=|)0") - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=full") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ieee=full") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]dcfuns") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -dcfuns") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]thread_safe") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -thread_safe") - endif() - - # Disable warnings - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=obs") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=obs") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=x77") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=x77") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=ques") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=ques") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=unused") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=unused") - endif() - - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-recursive") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -recursive" - CACHE STRING "Recursive flag must be set" FORCE) - endif() + add_compile_options("$<$:-recursive>") + if(UNIX) + add_compile_options("$<$:-fp-model strict>") + endif() - # Suppress compiler banner and summary - include(CheckFortranCompilerFlag) - check_fortran_compiler_flag("-quiet" _quiet) - if( _quiet AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]quiet") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -quiet") - endif() + # SunPro F95 + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "SunPro") + set(FPE_EXIT_FLAG "-ftrap=") + set(FPE_DISABLE_FLAG "-ftrap=(%|)none") -# NVIDIA HPC SDK -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC" ) - if( ("${CMAKE_Fortran_FLAGS}" MATCHES "-Ktrap=") AND - NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Ktrap=none") ) - set( FPE_EXIT TRUE ) - endif() + message(STATUS "Disabling FPE trap handlers with -ftrap=%none") + add_compile_options("$<$:-ftrap=%none>") - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]Kieee") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Kieee") - endif() + if(UNIX) + # Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler. + # This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin + string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES + "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") + endif() - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Mrecursive") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mrecursive" - CACHE STRING "Recursive flag must be set" FORCE) - endif() + # IBM XL Fortran + elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6 + (CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8 + set(FPE_EXIT_FLAG "-qflttrap=[a-zA-Z:]:enable") -# Flang Fortran -elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "Flang" ) - if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "-Mrecursive") ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mrecursive" - CACHE STRING "Recursive flag must be set" FORCE) - endif() + add_compile_options("$<$:-qrecur>") + if(UNIX) + add_compile_options("$<$:-qnosave>") + add_compile_options("$<$:-qstrict>") + endif() -# Compaq Fortran -elseif(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.") + # HP Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "HP") + set(FPE_EXIT_FLAG "\\+fp_exception") + + message(STATUS "Enabling strict float conversion with +fltconst_strict") + add_compile_options("$<$:+fltconst_strict>") + + # Most versions of cmake don't have good default options for the HP compiler + add_compile_options("$<$,$>:-g>") + add_compile_options("$<$,$>:+Osize>") + add_compile_options("$<$,$>:+O2>") + add_compile_options("$<$,$>:+O2 -g>") + + # NAG Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG") + set(FPE_EXIT_FLAG "[-/]ieee=(stop|nonstd)") + + add_compile_options("$<$:-ieee=full>") + add_compile_options("$<$:-dcfuns>") + add_compile_options("$<$:-thread_safe>") + add_link_options("$<$:-thread_safe>") + add_compile_options("$<$:-recursive>") + + # Disable warnings + add_compile_options("$<$:-w=obs>") + add_compile_options("$<$:-w=x77>") + add_compile_options("$<$:-w=ques>") + add_compile_options("$<$:-w=unused>") + + # Suppress compiler banner and summary + include(CheckFortranCompilerFlag) + check_fortran_compiler_flag("-quiet" _quiet) + add_compile_options("$<$,$>:-quiet>") + add_link_options("$<$,$>:-quiet>") + + # NVIDIA HPC SDK + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "NVHPC") + set(FPE_EXIT_FLAG "-Ktrap=") + set(FPE_DISABLE_FLAG "-Ktrap=none") + + add_compile_options("$<$:-Kieee>") + add_compile_options("$<$:-Mrecursive>") + + # Flang Fortran + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Flang") + add_compile_options("$<$:-Mrecursive>") + + # Compaq Fortran + elseif(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() - 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() -else() - message(WARNING "Fortran local arrays should be allocated on the stack." - " Please use a compiler which guarantees that feature." - " See https://github.com/Reference-LAPACK/lapack/pull/188 and references therein.") -endif() + else() + message(WARNING "Fortran local arrays should be allocated on the stack." + " Please use a compiler which guarantees that feature." + " See https://github.com/Reference-LAPACK/lapack/pull/188 and references therein.") + endif() -if( "${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]" ) - message( STATUS "Reducing RELEASE optimization level to O2" ) - string( REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE - "${CMAKE_Fortran_FLAGS_RELEASE}" ) - set( CMAKE_Fortran_FLAGS_RELEASE "${CMAKE_Fortran_FLAGS_RELEASE}" - CACHE STRING "Flags used by the compiler during release builds" FORCE ) -endif() + if("${CMAKE_Fortran_FLAGS_RELEASE}" MATCHES "O[3-9]") + message(STATUS "Reducing RELEASE optimization level to O2") + string(REGEX REPLACE "O[3-9]" "O2" CMAKE_Fortran_FLAGS_RELEASE + "${CMAKE_Fortran_FLAGS_RELEASE}") + endif() + # Get all flags added via `add_compile_options(...)` + get_directory_property(COMP_OPTIONS COMPILE_OPTIONS) -if( FPE_EXIT ) - message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are currently explicitly enabled in the compiler flags. LAPACK is designed to check for and handle these cases internally and enabling these traps will likely cause LAPACK to crash. Please re-configure with floating point exception trapping disabled." ) -endif() + if(("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_EXIT_FLAG}") AND NOT + ("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "${FPE_DISABLE_FLAG}")) + message( FATAL_ERROR "Floating Point Exception (FPE) trap handlers are" + " currently explicitly enabled in the compiler flags. LAPACK is designed" + " to check for and handle these cases internally and enabling these traps" + " will likely cause LAPACK to crash. Please re-configure with floating" + " point exception trapping disabled.") + endif() endmacro() diff --git a/CMakeLists.txt b/CMakeLists.txt index 5baf8f446b..387e612fe9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -265,15 +265,7 @@ if(NOT BLAS_FOUND) add_subdirectory(BLAS) set(BLAS_LIBRARIES ${BLASLIB}) else() - set(CMAKE_EXE_LINKER_FLAGS - "${CMAKE_EXE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for executables" FORCE) - set(CMAKE_MODULE_LINKER_FLAGS - "${CMAKE_MODULE_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for modules" FORCE) - set(CMAKE_SHARED_LINKER_FLAGS - "${CMAKE_SHARED_LINKER_FLAGS} ${BLAS_LINKER_FLAGS}" - CACHE STRING "Linker flags for shared libs" FORCE) + add_link_options(${BLAS_LINKER_FLAGS}) endif() @@ -355,15 +347,7 @@ if(NOT LATESTLAPACK_FOUND) add_subdirectory(SRC) else() - set(CMAKE_EXE_LINKER_FLAGS - "${CMAKE_EXE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for executables" FORCE) - set(CMAKE_MODULE_LINKER_FLAGS - "${CMAKE_MODULE_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for modules" FORCE) - set(CMAKE_SHARED_LINKER_FLAGS - "${CMAKE_SHARED_LINKER_FLAGS} ${LAPACK_LINKER_FLAGS}" - CACHE STRING "Linker flags for shared libs" FORCE) + add_link_options(${LAPACK_LINKER_FLAGS}) endif() if(BUILD_TESTING) diff --git a/INSTALL/CMakeLists.txt b/INSTALL/CMakeLists.txt index 51fe01f1e2..92524ebc5a 100644 --- a/INSTALL/CMakeLists.txt +++ b/INSTALL/CMakeLists.txt @@ -1,5 +1,13 @@ cmake_minimum_required(VERSION 3.6) project(TIMING Fortran) + +# Add the CMake directory for custom CMake modules +set(CMAKE_MODULE_PATH "${TIMING_SOURCE_DIR}/../CMAKE" ${CMAKE_MODULE_PATH}) + +# Check for any necessary platform specific compiler flags +include(CheckLAPACKCompilerFlags) +CheckLAPACKCompilerFlags() + add_executable(secondtst_NONE second_NONE.f secondtst.f) add_executable(secondtst_EXT_ETIME second_EXT_ETIME.f secondtst.f) add_executable(secondtst_EXT_ETIME_ second_EXT_ETIME_.f secondtst.f) From 0af92d8230f9904735360ed9af6f54d9bd25e4ad Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 5 Jun 2024 13:13:38 +0200 Subject: [PATCH 092/206] Bump minimum CMake version to 3.13 --- CMakeLists.txt | 2 +- INSTALL/CMakeLists.txt | 2 +- LAPACKE/mangling/CMakeLists.txt | 2 +- lapack_build.cmake | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 387e612fe9..7f6e2d804b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.9) +cmake_minimum_required(VERSION 3.13) project(LAPACK) diff --git a/INSTALL/CMakeLists.txt b/INSTALL/CMakeLists.txt index 92524ebc5a..5d34584ff1 100644 --- a/INSTALL/CMakeLists.txt +++ b/INSTALL/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.6) +cmake_minimum_required(VERSION 3.13) project(TIMING Fortran) # Add the CMake directory for custom CMake modules diff --git a/LAPACKE/mangling/CMakeLists.txt b/LAPACKE/mangling/CMakeLists.txt index 1b6b308e07..a3e20ab79a 100644 --- a/LAPACKE/mangling/CMakeLists.txt +++ b/LAPACKE/mangling/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.6) +cmake_minimum_required(VERSION 3.13) project(MANGLING C Fortran) add_executable(xintface Fintface.f Cintface.c) diff --git a/lapack_build.cmake b/lapack_build.cmake index 83f812460e..1460acaa28 100644 --- a/lapack_build.cmake +++ b/lapack_build.cmake @@ -4,7 +4,7 @@ ## HINTS: ctest -Ddashboard_model=Nightly -S $(pwd)/lapack/lapack_build.cmake ## -cmake_minimum_required(VERSION 3.6) +cmake_minimum_required(VERSION 3.13) ################################################################### # The values in this section must always be provided ################################################################### From fe5c2529fe92c28b6dcbabe360d36f99e23b81f7 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 5 Jun 2024 14:06:32 +0200 Subject: [PATCH 093/206] Set minimum CMake version for `INDEX64_EXT_API` to 3.18 due to the need of the `Fortran_PREPROCESS` target property --- CMakeLists.txt | 2 +- SRC/CMakeLists.txt | 1 + TESTING/MATGEN/CMakeLists.txt | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 7f6e2d804b..2dde033025 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -109,7 +109,7 @@ else() endif() # By default build extended _64 API for supported compilers only set(INDEX64_EXT_API_COMPILERS "Intel|GNU") -option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix" ON) +option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix (needs CMake >= 3.18)" ON) message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDEX64_EXT_API}") include(GNUInstallDirs) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index a2f396bae2..869b1c8a28 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -541,6 +541,7 @@ if(BUILD_INDEX64_EXT_API) set(BUILD_INDEX64_EXT_API OFF) set(BUILD_INDEX64_EXT_API OFF PARENT_SCOPE) else() + cmake_minimum_required(VERSION 3.18) set(SOURCES_64) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${LAPACKLIB}_64_obj) diff --git a/TESTING/MATGEN/CMakeLists.txt b/TESTING/MATGEN/CMakeLists.txt index 6d3a75ceb0..3866acc29c 100644 --- a/TESTING/MATGEN/CMakeLists.txt +++ b/TESTING/MATGEN/CMakeLists.txt @@ -61,6 +61,7 @@ if(BUILD_INDEX64_EXT_API) set(BUILD_INDEX64_EXT_API OFF) set(BUILD_INDEX64_EXT_API OFF PARENT_SCOPE) else() + cmake_minimum_required(VERSION 3.18) set(SOURCES_64) file(MAKE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) file(COPY ${SOURCES} DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) From d638ddba42b5ed076b0f9f6fcfe5fd4ed3244032 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 5 Jun 2024 14:13:25 +0200 Subject: [PATCH 094/206] Disable `BUILD_INDEX64_EXT_API` by default if the CMake version is less than 3.18.0 --- CMakeLists.txt | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2dde033025..f5ed2ba325 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -107,9 +107,18 @@ else() set(LAPACKELIB "lapacke") set(TMGLIB "tmglib") endif() -# By default build extended _64 API for supported compilers only + +# By default build extended _64 API for supported compilers only. This needs +# CMake >= 3.18! Let's disable it by default for CMake < 3.18. +if(CMAKE_VERSION VERSION_LESS "3.18") + set(INDEX64_EXT_API_DEFAULT OFF) +else() + set(INDEX64_EXT_API_DEFAULT ON) +endif() set(INDEX64_EXT_API_COMPILERS "Intel|GNU") -option(BUILD_INDEX64_EXT_API "Build Index-64 API as extended API with _64 suffix (needs CMake >= 3.18)" ON) +option(BUILD_INDEX64_EXT_API + "Build Index-64 API as extended API with _64 suffix (needs CMake >= 3.18)" + ${INDEX64_EXT_API_DEFAULT}) message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDEX64_EXT_API}") include(GNUInstallDirs) From 1d4010e26ad84a71cbf855fab297ecf509bf3567 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Thu, 6 Jun 2024 15:01:52 +0700 Subject: [PATCH 095/206] fix lastv possible range in slarf1f and slarf1l, #1011 --- SRC/slarf1f.f | 8 ++++---- SRC/slarf1l.f | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/SRC/slarf1f.f b/SRC/slarf1f.f index 493e57bb21..daf43423f5 100644 --- a/SRC/slarf1f.f +++ b/SRC/slarf1f.f @@ -157,11 +157,11 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + LASTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end -! of V. +! of V up to V(1). IF( APPLYLEFT ) THEN LASTV = M ELSE @@ -173,7 +173,7 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) I = 1 END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -185,7 +185,7 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILASLR(M, LASTV, C, LDC) END IF END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + IF( LASTC.EQ.0 ) THEN RETURN END IF IF( APPLYLEFT ) THEN diff --git a/SRC/slarf1l.f b/SRC/slarf1l.f index 901b01dce2..d7b0eb759b 100644 --- a/SRC/slarf1l.f +++ b/SRC/slarf1l.f @@ -159,11 +159,11 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + LASTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end -! of V. +! of V up to V(1). IF( APPLYLEFT ) THEN LASTV = M ELSE @@ -175,7 +175,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) I = 1 END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -187,7 +187,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILASLR(M, LASTV, C, LDC) END IF END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + IF( LASTC.EQ.0 ) THEN RETURN END IF IF( APPLYLEFT ) THEN From ea943fc1c70093ffe6927dafa9e74d3d01809d0d Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Thu, 6 Jun 2024 16:35:50 +0700 Subject: [PATCH 096/206] fix lastv possible range in clarf1f, #1011 --- SRC/clarf1f.f | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/SRC/clarf1f.f b/SRC/clarf1f.f index b1cc9e9792..255f074e4f 100644 --- a/SRC/clarf1f.f +++ b/SRC/clarf1f.f @@ -164,11 +164,11 @@ SUBROUTINE CLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + LASTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end -! of V. +! of V up to V(1). IF( APPLYLEFT ) THEN LASTV = M ELSE @@ -180,7 +180,7 @@ SUBROUTINE CLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) I = 1 END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -192,7 +192,7 @@ SUBROUTINE CLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILACLR(M, LASTV, C, LDC) END IF END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + IF( LASTC.EQ.0 ) THEN RETURN END IF IF( APPLYLEFT ) THEN From b8b97714c342f92872f2f3025d3322ced964d1bc Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Thu, 6 Jun 2024 16:36:51 +0700 Subject: [PATCH 097/206] implement clarf1l, #1011 --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 2 +- SRC/clarf1l.f | 267 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 269 insertions(+), 2 deletions(-) create mode 100644 SRC/clarf1l.f diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index fe7670e146..d9662db944 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -218,7 +218,7 @@ set(CLASRC claqhb.f claqhe.f claqhp.f claqp2.f claqps.f claqp2rk.f claqp3rk.f claqsb.f claqr0.f claqr1.f claqr2.f claqr3.f claqr4.f claqr5.f claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f - clarf.f clarf1f.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f + clarf.f clarf1f.f clarf1l.f clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f90 clartv.f clarz.f clarzb.f clarzt.f clascl.f claset.f clasr.f classq.f90 claswp.f clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f diff --git a/SRC/Makefile b/SRC/Makefile index 6fbebc544d..7fb2a5670d 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -249,7 +249,7 @@ CLASRC = \ claqhb.o claqhe.o claqhp.o claqp2.o claqps.o claqp2rk.o claqp3rk.o claqsb.o \ claqr0.o claqr1.o claqr2.o claqr3.o claqr4.o claqr5.o \ claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \ - clarf.o clarf1f.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \ + clarf.o clarf1f.o clarf1l.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \ clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \ clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o \ claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \ diff --git a/SRC/clarf1l.f b/SRC/clarf1l.f new file mode 100644 index 0000000000..40dda403a7 --- /dev/null +++ b/SRC/clarf1l.f @@ -0,0 +1,267 @@ +*> \brief \b CLARF1L applies an elementary reflector to a general rectangular +* matrix assuming v(lastv) = 1, where lastv is the last non-zero +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CLARF1L + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* COMPLEX TAU +* .. +* .. Array Arguments .. +* COMPLEX C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CLARF1L applies a complex elementary reflector H to a complex m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**H +*> +*> where tau is a real scalar and v is a real vector assuming v(lastv) = 1, +*> where lastv is the last non-zero element. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> +*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead +*> tau. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV <> 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf1f +* +* ===================================================================== + SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + COMPLEX TAU +* .. +* .. Array Arguments .. + COMPLEX C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX ONE, ZERO + PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), + $ ZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, LASTV, LASTC +* .. +* .. External Subroutines .. + EXTERNAL CGEMV, CGERC, CSCAL +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILACLR, ILACLC + EXTERNAL LSAME, ILACLR, ILACLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + LASTV = 1 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V up to V(1). + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + IF( INCV.GT.0 ) THEN + I = 1 + (LASTV-1) * INCV + ELSE + I = 1 + END IF +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) + LASTV = LASTV - 1 + I = I - INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILACLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILACLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.EQ.1 ) THEN +* +* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* + CALL CSCAL( LASTC, ONE - TAU, C, LDC ) + ELSE +* +* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) +* + CALL CGEMV( 'Conjugate transpose', LASTV - 1, LASTC, + $ ONE, C, LDC, V, INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) += C(lastv,1:lastc)**H * v(lastv,1) +* + DO I = 1, LASTC + WORK( I ) = WORK( I ) + CONJG( C( LASTV, I ) ) + END DO +* +* C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**H +* + DO I = 1, LASTC + C( LASTV, I ) = C( LASTV, I ) + $ - TAU * CONJG( WORK( I ) ) + END DO +* +* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**H +* + CALL CGERC( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C, + $ LDC) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.EQ.1 ) THEN +* +* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* + CALL CSCAL( LASTC, ONE - TAU, C, 1 ) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) +* + CALL CGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, + $ LDC, V, INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) +* + CALL CAXPY( LASTC, ONE, C( 1, LASTV ), 1, WORK, 1 ) +* +* C(1:lastc,lastv) += - tau * v(lastv,1) * w(1:lastc,1) +* + CALL CAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 ) +* +* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**H +* + CALL CGERC( LASTC, LASTV - 1, -TAU, WORK, 1, V, + $ INCV, C, LDC ) + END IF + END IF + RETURN +* +* End of CLARF1L +* + END From 7708f1e9c885bffa48917e167852a2a90062b9f5 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Thu, 6 Jun 2024 07:57:41 -0400 Subject: [PATCH 098/206] update dlarf1f.f and zlarf1f.f to not reference v(1) --- SRC/dlarf1f.f | 122 +++++++++++++++++++++++++++++++------------------- SRC/dorg2l.f | 1 - SRC/zlarf1f.f | 47 +++++++++++++++---- 3 files changed, 116 insertions(+), 54 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index 8a27526dd8..8f0830f7ff 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -74,7 +74,7 @@ *> (1 + (M-1)*abs(INCV)) if SIDE = 'L' *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' *> The vector v in the representation of H. V is not used if -*> TAU = 0. +*> TAU = 0. V(1) is not referenced or modified. *> \endverbatim *> *> \param[in] INCV @@ -110,6 +110,40 @@ *> or (M) if SIDE = 'R' *> \endverbatim * +* To take advantage of the fact that v(1) = 1, we do the following +* v = [ 1 v_2 ]**T +* If SIDE='L' +* |-----| +* | C_1 | +* C =| C_2 | +* |-----| +* C_1\in\mathbb{R}^{1\times n}, C_2\in\mathbb{R}^{m-1\times n} +* So we compute: +* C = HC = (I - \tau vv**T)C +* = C - \tau vv**T C +* w = C**T v = [ C_1**T C_2**T ] [ 1 v_2 ]**T +* = C_1**T + C_2**T v ( DGEMM then DAXPY ) +* C = C - \tau vv**T C +* = C - \tau vw**T +* Giving us C_1 = C_1 - \tau w**T ( DAXPY ) +* and +* C_2 = C_2 - \tau v_2w**T ( DGER ) +* If SIDE='R' +* +* C = [ C_1 C_2 ] +* C_1\in\mathbb{R}^{m\times 1}, C_2\in\mathbb{R}^{m\times n-1} +* So we compute: +* C = CH = C(I - \tau vv**T) +* = C - \tau Cvv**T +* +* w = Cv = [ C_1 C_2 ] [ 1 v_2 ]**T +* = C_1 + C_2v_2 ( DGEMM then DAXPY ) +* C = C - \tau Cvv**T +* = C - \tau wv**T +* Giving us C_1 = C_1 - \tau w ( DAXPY ) +* and +* C_2 = C_2 - \tau wv_2**T ( DGER ) +* * Authors: * ======== * @@ -175,7 +209,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) I = 1 END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) +! Since we are assuming that V(1) = 1, and it is not stored, so we +! shouldn't access it. + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -186,67 +222,63 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILADLR(M, LASTV, C, LDC) END IF - END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + ELSE +! TAU is 0, so H = I. Meaning HC = C = CH. RETURN END IF IF( APPLYLEFT ) THEN * * Form H * C * - IF( LASTV.GT.0 ) THEN - ! Check if m = 1. This means v = 1, So we just need to compute - ! C := HC = (1-\tau)C. - IF( M.EQ.1 .OR. LASTV.EQ.1) THEN - CALL DSCAL(LASTC, ONE - TAU, C, LDC) - ELSE + ! Check if lastv = 1. This means v = 1, So we just need to compute + ! C := HC = (1-\tau)C. + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, LDC) + ELSE * -* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) +* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) * - ! w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) - CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), - $ LDC, V(1+INCV), INCV, ZERO, WORK, 1) - ! w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) = C(1,1:lastc)**T - CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) + ! w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) + CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1+1,1), + $ LDC, V(1+INCV), INCV, ZERO, WORK, 1) + ! w(1:lastc,1) += C(1,1:lastc)**T * v(1,1) = C(1,1:lastc)**T + CALL DAXPY(LASTC, ONE, C, LDC, WORK, 1) * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T * ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**T ! = C(...) - tau * w(1:lastc,1)**T - CALL DAXPY(LASTC, -TAU, WORK, 1, C, LDC) - ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T - CALL DGER(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, 1, - $ C(1+1,1), LDC) - END IF + CALL DAXPY(LASTC, -TAU, WORK, 1, C, LDC) + ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**T + CALL DGER(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, 1, + $ C(1+1,1), LDC) END IF ELSE * * Form C * H * - IF( LASTV.GT.0 ) THEN - ! Check if n = 1. This means v = 1, so we just need to compute - ! C := CH = C(1-\tau). - IF( N.EQ.1 .OR. LASTV.EQ.1) THEN - CALL DSCAL(LASTC, ONE - TAU, C, 1) - ELSE -* -* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) -* - ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) - CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, - $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) - ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) - CALL DAXPY(LASTC, ONE, C, 1, WORK, 1) -* -* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T -* - ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T - ! = C(...) - tau * w(1:lastc,1) - CALL DAXPY(LASTC, -TAU, WORK, 1, C, 1) - ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T - CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), - $ INCV, C(1,1+1), LDC ) - END IF + ! Check if n = 1. This means v = 1, so we just need to compute + ! C := CH = C(1-\tau). + IF( LASTV.EQ.1 ) THEN + CALL DSCAL(LASTC, ONE - TAU, C, 1) + ELSE +* +* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) +* + ! w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) + CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, + $ C(1,1+1), LDC, V(1+INCV), INCV, ZERO, WORK, 1 ) + ! w(1:lastc,1) += C(1:lastc,1) v(1,1) = C(1:lastc,1) + CALL DAXPY(LASTC, ONE, C, 1, WORK, 1) +* +* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T +* + ! C(1:lastc,1) := C(...) - tau * w(1:lastc,1) * v(1,1)**T + ! = C(...) - tau * w(1:lastc,1) + CALL DAXPY(LASTC, -TAU, WORK, 1, C, 1) + ! C(1:lastc,2:lastv) := C(...) - tau * w(1:lastc,1) * v(2:lastv)**T + CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), + $ INCV, C(1,1+1), LDC ) END IF END IF RETURN diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index d5106b53d0..5345142924 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -176,7 +176,6 @@ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * - A( M-N+II, II ) = ONE CALL DLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), $ A, $ LDA, WORK ) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index da3dd305ec..2e859e1390 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -75,7 +75,7 @@ *> (1 + (M-1)*abs(INCV)) if SIDE = 'L' *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' *> The vector v in the representation of H. V is not used if -*> TAU = 0. +*> TAU = 0. V(1) is not referenced or modified. *> \endverbatim *> *> \param[in] INCV @@ -110,6 +110,39 @@ *> (N) if SIDE = 'L' *> or (M) if SIDE = 'R' *> \endverbatim +* To take advantage of the fact that v(1) = 1, we do the following +* v = [ 1 v_2 ]**T +* If SIDE='L' +* |-----| +* | C_1 | +* C =| C_2 | +* |-----| +* C_1\in\mathbb{C}^{1\times n}, C_2\in\mathbb{C}^{m-1\times n} +* So we compute: +* C = HC = (I - \tau vv**T)C +* = C - \tau vv**T C +* w = C**T v = [ C_1**T C_2**T ] [ 1 v_2 ]**T +* = C_1**T + C_2**T v ( ZGEMM then ZAXPYC-like ) +* C = C - \tau vv**T C +* = C - \tau vw**T +* Giving us C_1 = C_1 - \tau w**T ( ZAXPYC-like ) +* and +* C_2 = C_2 - \tau v_2w**T ( ZGERC ) +* If SIDE='R' +* +* C = [ C_1 C_2 ] +* C_1\in\mathbb{C}^{m\times 1}, C_2\in\mathbb{C}^{m\times n-1} +* So we compute: +* C = CH = C(I - \tau vv**T) +* = C - \tau Cvv**T +* +* w = Cv = [ C_1 C_2 ] [ 1 v_2 ]**T +* = C_1 + C_2v_2 ( ZGEMM then ZAXPYC-like ) +* C = C - \tau Cvv**T +* = C - \tau wv**T +* Giving us C_1 = C_1 - \tau w ( ZAXPYC-like ) +* and +* C_2 = C_2 - \tau wv_2**T ( ZGERC ) * * Authors: * ======== @@ -177,7 +210,9 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) I = 1 END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) +! Since we are assuming that V(1) = 1, and it is not stored, so we +! shouldn't access it. + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -196,10 +231,9 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.GT.0 ) THEN ! Check if m = 1. This means v = 1, So we just need to compute ! C := HC = (1-\tau)C. - IF( M.EQ.1 .OR. LASTV.EQ.1) THEN + IF( LASTV.EQ.1 ) THEN CALL ZSCAL(LASTC, ONE - TAU, C, LDC) ELSE * @@ -230,15 +264,13 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, $ 1, C(1+1,1), LDC) END IF - END IF ELSE * * Form C * H * - IF( LASTV.GT.0 ) THEN ! Check if n = 1. This means v = 1, so we just need to compute ! C := CH = C(1-\tau). - IF( N.EQ.1 .OR. LASTV.EQ.1) THEN + IF( LASTV.EQ.1 ) THEN CALL ZSCAL(LASTC, ONE - TAU, C, 1) ELSE * @@ -259,7 +291,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) CALL ZGERC( LASTC, LASTV-1, -TAU, WORK, 1, V(1+INCV), $ INCV, C(1,1+1), LDC ) END IF - END IF END IF RETURN * From 2bee29348798a22384fc391612b39b1573b7ef1a Mon Sep 17 00:00:00 2001 From: Bogdan Date: Thu, 6 Jun 2024 19:26:27 +0300 Subject: [PATCH 099/206] solving the issue --- SRC/cgetc2.f | 4 ++-- SRC/dgetc2.f | 4 ++-- SRC/sgetc2.f | 4 ++-- SRC/zgetc2.f | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/SRC/cgetc2.f b/SRC/cgetc2.f index c452aa0670..ae72121612 100644 --- a/SRC/cgetc2.f +++ b/SRC/cgetc2.f @@ -176,8 +176,8 @@ SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO ) * Find max element in matrix A * XMAX = ZERO - DO 20 IP = I, N - DO 10 JP = I, N + DO 20 JP = I, N + DO 10 IP = I, N IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN XMAX = ABS( A( IP, JP ) ) IPV = IP diff --git a/SRC/dgetc2.f b/SRC/dgetc2.f index 8ee83328c4..c03c5de55d 100644 --- a/SRC/dgetc2.f +++ b/SRC/dgetc2.f @@ -176,8 +176,8 @@ SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO ) * Find max element in matrix A * XMAX = ZERO - DO 20 IP = I, N - DO 10 JP = I, N + DO 20 JP = I, N + DO 10 IP = I, N IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN XMAX = ABS( A( IP, JP ) ) IPV = IP diff --git a/SRC/sgetc2.f b/SRC/sgetc2.f index 498bc79d03..5cc8609d58 100644 --- a/SRC/sgetc2.f +++ b/SRC/sgetc2.f @@ -176,8 +176,8 @@ SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) * Find max element in matrix A * XMAX = ZERO - DO 20 IP = I, N - DO 10 JP = I, N + DO 20 JP = I, N + DO 10 IP = I, N IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN XMAX = ABS( A( IP, JP ) ) IPV = IP diff --git a/SRC/zgetc2.f b/SRC/zgetc2.f index 649820bc56..8a51da0dd9 100644 --- a/SRC/zgetc2.f +++ b/SRC/zgetc2.f @@ -176,8 +176,8 @@ SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) * Find max element in matrix A * XMAX = ZERO - DO 20 IP = I, N - DO 10 JP = I, N + DO 20 JP = I, N + DO 10 IP = I, N IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN XMAX = ABS( A( IP, JP ) ) IPV = IP From 8ed1ab507fc0aa466dc363e47a3520380e52a545 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Fri, 7 Jun 2024 14:30:34 +0700 Subject: [PATCH 100/206] update single complex routines to use clarf1f and clarf1l, #1011 --- SRC/cgebd2.f | 30 +++++------- SRC/cgehd2.f | 20 +++----- SRC/cgelq2.f | 18 ++----- SRC/cgeql2.f | 17 ++----- SRC/cgeqp3rk.f | 4 +- SRC/cgeqr2.f | 14 ++---- SRC/cgeqr2p.f | 14 ++---- SRC/cgerq2.f | 16 ++----- SRC/claqp2.f | 16 ++----- SRC/claqp2rk.f | 19 +++----- SRC/claqr2.f | 20 ++++---- SRC/claqr3.f | 20 ++++---- SRC/cunbdb.f | 127 +++++++++++++++++++++++-------------------------- SRC/cunbdb1.f | 27 +++++------ SRC/cunbdb2.f | 35 +++++++------- SRC/cunbdb3.f | 32 +++++-------- SRC/cunbdb4.f | 57 ++++++++++------------ SRC/cung2l.f | 8 ++-- SRC/cung2r.f | 7 ++- SRC/cungl2.f | 8 ++-- SRC/cungr2.f | 6 +-- SRC/cunm2l.f | 14 ++---- SRC/cunm2r.f | 5 -- SRC/cunml2.f | 15 ++---- SRC/cunmr2.f | 15 ++---- SRC/cupmtr.f | 22 +++------ 26 files changed, 228 insertions(+), 358 deletions(-) diff --git a/SRC/cgebd2.f b/SRC/cgebd2.f index 5175d9e845..b4e3e6dd0c 100644 --- a/SRC/cgebd2.f +++ b/SRC/cgebd2.f @@ -203,16 +203,15 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * ===================================================================== * * .. Parameters .. - COMPLEX ZERO, ONE - PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ), - $ ONE = ( 1.0E+0, 0.0E+0 ) ) + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) * .. * .. Local Scalars .. INTEGER I COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, CLARFG, XERBLA + EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, MIN @@ -246,13 +245,13 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1, $ TAUQ( I ) ) D( I ) = REAL( ALPHA ) - A( I, I ) = ONE * * Apply H(i)**H to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK ) + $ CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, + $ WORK ) A( I, I ) = D( I ) * IF( I.LT.N ) THEN @@ -265,12 +264,11 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), $ LDA, TAUP( I ) ) E( I ) = REAL( ALPHA ) - A( I, I+1 ) = ONE * * Apply G(i) to A(i+1:m,i+1:n) from the right * - CALL CLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA, - $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) + CALL CLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA, + $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) A( I, I+1 ) = E( I ) ELSE @@ -290,13 +288,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA, $ TAUP( I ) ) D( I ) = REAL( ALPHA ) - A( I, I ) = ONE * * Apply G(i) to A(i+1:m,i:n) from the right * IF( I.LT.M ) - $ CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAUP( I ), A( I+1, I ), LDA, WORK ) + $ CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAUP( I ), A( I+1, I ), LDA, WORK ) CALL CLACGV( N-I+1, A( I, I ), LDA ) A( I, I ) = D( I ) * @@ -309,13 +306,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1, $ TAUQ( I ) ) E( I ) = REAL( ALPHA ) - A( I+1, I ) = ONE * * Apply H(i)**H to A(i+1:m,i+1:n) from the left * - CALL CLARF( 'Left', M-I, N-I, A( I+1, I ), 1, - $ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA, - $ WORK ) + CALL CLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1, + $ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA, + $ WORK ) A( I+1, I ) = E( I ) ELSE TAUQ( I ) = ZERO diff --git a/SRC/cgehd2.f b/SRC/cgehd2.f index 2502d38b9a..808aa236bd 100644 --- a/SRC/cgehd2.f +++ b/SRC/cgehd2.f @@ -160,16 +160,11 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFG, XERBLA + EXTERNAL CLARF1F, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, MIN @@ -197,22 +192,19 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) * - ALPHA = A( I+1, I ) - CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, + CALL CLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right * - CALL CLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), - $ A( 1, I+1 ), LDA, WORK ) + CALL CLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), + $ A( 1, I+1 ), LDA, WORK ) * * Apply H(i)**H to A(i+1:ihi,i+1:n) from the left * - CALL CLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, - $ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK ) + CALL CLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, + $ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK ) * - A( I+1, I ) = ALPHA 10 CONTINUE * RETURN diff --git a/SRC/cgelq2.f b/SRC/cgelq2.f index bf7d669a13..80f056e9be 100644 --- a/SRC/cgelq2.f +++ b/SRC/cgelq2.f @@ -140,16 +140,11 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I, K - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, CLARFG, XERBLA + EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -178,19 +173,16 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Generate elementary reflector H(i) to annihilate A(i,i+1:n) * CALL CLACGV( N-I+1, A( I, I ), LDA ) - ALPHA = A( I, I ) - CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA, + CALL CLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, $ TAU( I ) ) IF( I.LT.M ) THEN * * Apply H(i) to A(i+1:m,i:n) from the right * - A( I, I ) = ONE - CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), - $ A( I+1, I ), LDA, WORK ) + CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), + $ A( I+1, I ), LDA, WORK ) END IF - A( I, I ) = ALPHA CALL CLACGV( N-I+1, A( I, I ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/cgeql2.f b/SRC/cgeql2.f index c55c6d76ad..0161adb2e9 100644 --- a/SRC/cgeql2.f +++ b/SRC/cgeql2.f @@ -134,16 +134,11 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I, K - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFG, XERBLA + EXTERNAL CLARF1L, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, MIN @@ -172,15 +167,13 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * Generate elementary reflector H(i) to annihilate * A(1:m-k+i-1,n-k+i) * - ALPHA = A( M-K+I, N-K+I ) - CALL CLARFG( M-K+I, ALPHA, A( 1, N-K+I ), 1, TAU( I ) ) + CALL CLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1, + $ TAU( I ) ) * * Apply H(i)**H to A(1:m-k+i,1:n-k+i-1) from the left * - A( M-K+I, N-K+I ) = ONE - CALL CLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, - $ CONJG( TAU( I ) ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = ALPHA + CALL CLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + $ CONJG( TAU( I ) ), A, LDA, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/cgeqp3rk.f b/SRC/cgeqp3rk.f index 656c01ef89..b0173f6529 100644 --- a/SRC/cgeqp3rk.f +++ b/SRC/cgeqp3rk.f @@ -678,7 +678,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Minimal workspace size in case of using only unblocked * BLAS 2 code in CLAQP2RK. * 1) CLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in CLARF subroutine inside CLAQP2RK to apply an +* in CLARF1F subroutine inside CLAQP2RK to apply an * elementary reflector from the left. * TOTAL_WORK_SIZE = 3*N + NRHS - 1 * @@ -694,7 +694,7 @@ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) CGEQP3RK, CLAQP2RK, CLAQP3RK: 2*N to store full and * partial column 2-norms. * 2) CLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in CLARF subroutine to apply an elementary reflector +* in CLARF1F subroutine to apply an elementary reflector * from the left. * 3) CLAQP3RK: NB*(N+NRHS) to use in the work array F that * is used to apply a block reflector from diff --git a/SRC/cgeqr2.f b/SRC/cgeqr2.f index 29dddb2085..4b6a4289ea 100644 --- a/SRC/cgeqr2.f +++ b/SRC/cgeqr2.f @@ -141,16 +141,11 @@ SUBROUTINE CGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I, K - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFG, XERBLA + EXTERNAL CLARF1F, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, MIN @@ -184,11 +179,8 @@ SUBROUTINE CGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i)**H to A(i:m,i+1:n) from the left * - ALPHA = A( I, I ) - A( I, I ) = ONE - CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) - A( I, I ) = ALPHA + CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/cgeqr2p.f b/SRC/cgeqr2p.f index fb5012b49a..26c73f9b0b 100644 --- a/SRC/cgeqr2p.f +++ b/SRC/cgeqr2p.f @@ -145,16 +145,11 @@ SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I, K - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, XERBLA + EXTERNAL CLARF1F, CLARFGP, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX, MIN @@ -188,11 +183,8 @@ SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i)**H to A(i:m,i+1:n) from the left * - ALPHA = A( I, I ) - A( I, I ) = ONE - CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) - A( I, I ) = ALPHA + CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/cgerq2.f b/SRC/cgerq2.f index ac1217118d..a7fa0609e6 100644 --- a/SRC/cgerq2.f +++ b/SRC/cgerq2.f @@ -134,16 +134,11 @@ SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. INTEGER I, K - COMPLEX ALPHA * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, CLARFG, XERBLA + EXTERNAL CLACGV, CLARF1L, CLARFG, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -173,16 +168,13 @@ SUBROUTINE CGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * A(m-k+i,1:n-k+i-1) * CALL CLACGV( N-K+I, A( M-K+I, 1 ), LDA ) - ALPHA = A( M-K+I, N-K+I ) - CALL CLARFG( N-K+I, ALPHA, A( M-K+I, 1 ), LDA, + CALL CLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA, $ TAU( I ) ) * * Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right * - A( M-K+I, N-K+I ) = ONE - CALL CLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, - $ TAU( I ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = ALPHA + CALL CLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, + $ TAU( I ), A, LDA, WORK ) CALL CLACGV( N-K+I-1, A( M-K+I, 1 ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/claqp2.f b/SRC/claqp2.f index 544ddabc97..eb166af7ba 100644 --- a/SRC/claqp2.f +++ b/SRC/claqp2.f @@ -164,17 +164,14 @@ SUBROUTINE CLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * * .. Parameters .. REAL ZERO, ONE - COMPLEX CONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, - $ CONE = ( 1.0E+0, 0.0E+0 ) ) + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. INTEGER I, ITEMP, J, MN, OFFPI, PVT REAL TEMP, TEMP2, TOL3Z - COMPLEX AII * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFG, CSWAP + EXTERNAL CLARF1F, CLARFG, CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, MAX, MIN, SQRT @@ -222,12 +219,9 @@ SUBROUTINE CLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * * Apply H(i)**H to A(offset+i:m,i+1:n) from the left. * - AII = A( OFFPI, I ) - A( OFFPI, I ) = CONE - CALL CLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, - $ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA, - $ WORK( 1 ) ) - A( OFFPI, I ) = AII + CALL CLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, + $ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA, + $ WORK( 1 ) ) END IF * * Update partial column norms. diff --git a/SRC/claqp2rk.f b/SRC/claqp2rk.f index 0501c50bb4..af19333dd4 100644 --- a/SRC/claqp2rk.f +++ b/SRC/claqp2rk.f @@ -254,7 +254,7 @@ *> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (N-1) -*> Used in CLARF subroutine to apply an elementary +*> Used in CLARF1F subroutine to apply an elementary *> reflector from the left. *> \endverbatim *> @@ -364,18 +364,16 @@ SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * .. 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 ) ) + COMPLEX CZERO + PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) ) * .. * .. Local Scalars .. INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT, $ MINMNUPDT REAL HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z - COMPLEX AIKK * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFG, CSWAP + EXTERNAL CLARF1F, CLARFG, CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, CONJG, AIMAG, MAX, MIN, SQRT @@ -633,12 +631,9 @@ SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * condition is satisfied, not only KK < N+NRHS ) * IF( KK.LT.MINMNUPDT ) THEN - AIKK = A( I, KK ) - A( I, KK ) = CONE - CALL CLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, - $ CONJG( TAU( KK ) ), A( I, KK+1 ), LDA, - $ WORK( 1 ) ) - A( I, KK ) = AIKK + CALL CLARF1F( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, + $ CONJG( TAU( KK ) ), A( I, KK+1 ), LDA, + $ WORK( 1 ) ) END IF * IF( KK.LT.MINMNFACT ) THEN diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 6abdb615e5..526236eeed 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -292,7 +292,7 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( RZERO = 0.0e0, RONE = 1.0e0 ) * .. * .. Local Scalars .. - COMPLEX BETA, CDUM, S, TAU + COMPLEX CDUM, S, TAU REAL FOO, SAFMAX, SAFMIN, SMLNUM, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, $ KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT @@ -303,7 +303,7 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, - $ CLARF, + $ CLARF1F, $ CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. @@ -475,19 +475,17 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, DO 50 I = 1, NS WORK( I ) = CONJG( WORK( I ) ) 50 CONTINUE - BETA = WORK( 1 ) - CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL CLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, - $ WORK( JW+1 ) ) - CALL CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL CLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, + $ WORK( JW+1 ) ) + CALL CLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL CLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL CGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/claqr3.f b/SRC/claqr3.f index f516e5cfde..4d433b8cda 100644 --- a/SRC/claqr3.f +++ b/SRC/claqr3.f @@ -289,7 +289,7 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( RZERO = 0.0e0, RONE = 1.0e0 ) * .. * .. Local Scalars .. - COMPLEX BETA, CDUM, S, TAU + COMPLEX CDUM, S, TAU REAL FOO, SAFMAX, SAFMIN, SMLNUM, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, $ KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3, @@ -303,7 +303,7 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, $ CLAQR4, - $ CLARF, CLARFG, CLASET, CTREXC, CUNMHR + $ CLARF1F, CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL @@ -489,19 +489,17 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, DO 50 I = 1, NS WORK( I ) = CONJG( WORK( I ) ) 50 CONTINUE - BETA = WORK( 1 ) - CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL CLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, - $ WORK( JW+1 ) ) - CALL CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL CLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, + $ WORK( JW+1 ) ) + CALL CLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL CLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL CGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index 7abfb07d71..3401cb6983 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -307,8 +307,6 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * .. Parameters .. REAL REALONE PARAMETER ( REALONE = 1.0E0 ) - COMPLEX ONE - PARAMETER ( ONE = (1.0E0,0.0E0) ) * .. * .. Local Scalars .. LOGICAL COLMAJOR, LQUERY @@ -316,7 +314,7 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, REAL Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL CAXPY, CLARF, CLARFGP, CSCAL, + EXTERNAL CAXPY, CLARF1F, CLARFGP, CSCAL, $ XERBLA EXTERNAL CLACGV * @@ -425,7 +423,6 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, ELSE IF ( P .EQ. I ) THEN CALL CLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF - X11(I,I) = ONE IF ( M-P .GT. I ) THEN CALL CLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) @@ -433,19 +430,20 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, - $ CONJG(TAUP1(I)), X11(I,I+1), LDX11, WORK ) - CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, WORK ) + CALL CLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, + $ CONJG(TAUP1(I)), X11(I,I+1), LDX11, + $ WORK ) + CALL CLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL CLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, - $ CONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) - CALL CLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ CONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) + CALL CLARF1F( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ CONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) + CALL CLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ CONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -473,7 +471,6 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, $ TAUQ1(I) ) END IF - X11(I,I+1) = ONE END IF IF ( M-Q+1 .GT. I ) THEN CALL CLACGV( M-Q-I+1, X12(I,I), LDX12 ) @@ -485,24 +482,23 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ TAUQ2(I) ) END IF END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL CLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) - CALL CLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL CLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK ) + CALL CLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL CLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN - CALL CLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) + CALL CLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) END IF * IF( I .LT. Q ) @@ -525,16 +521,15 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL CLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL CLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL CLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) + $ CALL CLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) * CALL CLACGV( M-Q-I+1, X12(I,I), LDX12 ) * @@ -549,9 +544,8 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) CALL CLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1), $ LDX22, TAUQ2(P+I) ) - X22(Q+I,P+I) = ONE - CALL CLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, - $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) + CALL CLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, + $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) * CALL CLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) * @@ -590,7 +584,6 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * CALL CLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, $ TAUP1(I) ) - X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL CLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, $ TAUP2(I) ) @@ -598,17 +591,16 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, $ TAUP2(I) ) END IF - X21(I,I) = ONE -* - CALL CLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), - $ X11(I+1,I), LDX11, WORK ) - CALL CLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), - $ X12(I,I), LDX12, WORK ) - CALL CLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), - $ X21(I+1,I), LDX21, WORK ) - CALL CLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), X22(I,I), LDX22, WORK ) +* + CALL CLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), + $ X11(I+1,I), LDX11, WORK ) + CALL CLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), + $ X12(I,I), LDX12, WORK ) + CALL CLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), X21(I+1,I), LDX21, WORK ) + CALL CLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), X22(I,I), LDX22, WORK ) * CALL CLACGV( P-I+1, X11(I,I), LDX11 ) CALL CLACGV( M-P-I+1, X21(I,I), LDX21 ) @@ -632,25 +624,26 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, IF( I .LT. Q ) THEN CALL CLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, $ TAUQ1(I) ) - X11(I+1,I) = ONE END IF CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL CLARF( 'L', Q-I, P-I, X11(I+1,I), 1, - $ CONJG(TAUQ1(I)), X11(I+1,I+1), LDX11, WORK ) - CALL CLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, - $ CONJG(TAUQ1(I)), X21(I+1,I+1), LDX21, WORK ) + CALL CLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, + $ CONJG(TAUQ1(I)), X11(I+1,I+1), LDX11, + $ WORK ) + CALL CLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, + $ CONJG(TAUQ1(I)), X21(I+1,I+1), LDX21, + $ WORK ) END IF - CALL CLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ CONJG(TAUQ2(I)), - $ X12(I,I+1), LDX12, WORK ) + CALL CLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), + $ X12(I,I+1), LDX12, WORK ) IF ( M-P .GT. I ) THEN - CALL CLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ CONJG(TAUQ2(I)), X22(I,I+1), LDX22, WORK ) + CALL CLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X22(I,I+1), LDX22, + $ WORK ) END IF END DO * @@ -662,15 +655,16 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ 1 ) CALL CLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL CLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ CONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) + CALL CLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X12(I,I+1), LDX12, + $ WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL CLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, - $ CONJG(TAUQ2(I)), X22(I,Q+1), LDX22, WORK ) + $ CALL CLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X22(I,Q+1), LDX22, + $ WORK ) * END DO * @@ -682,11 +676,10 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ X22(P+I,Q+I), 1 ) CALL CLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1, $ TAUQ2(P+I) ) - X22(P+I,Q+I) = ONE IF ( M-P-Q .NE. I ) THEN - CALL CLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, - $ CONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), LDX22, - $ WORK ) + CALL CLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), + $ 1, CONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), + $ LDX22, WORK ) END IF END DO * diff --git a/SRC/cunbdb1.f b/SRC/cunbdb1.f index 1c096a4bd2..8acc019fb2 100644 --- a/SRC/cunbdb1.f +++ b/SRC/cunbdb1.f @@ -216,10 +216,6 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, * * ==================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = (1.0E0,0.0E0) ) -* .. * .. Local Scalars .. REAL C, S INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5, @@ -227,7 +223,7 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, + EXTERNAL CLARF1F, CLARFGP, CUNBDB5, CSROT, $ XERBLA EXTERNAL CLACGV * .. @@ -287,12 +283,11 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( REAL( X21(I,I) ), REAL( X11(I,I) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I) = ONE - X21(I,I) = ONE - CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) - CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) + CALL CLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) * IF( I .LT. Q ) THEN CALL CSROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, @@ -301,11 +296,11 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL CLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, $ TAUQ1(I) ) S = REAL( X21(I,I+1) ) - X21(I,I+1) = ONE - CALL CLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) - CALL CLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL CLARF1F( '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 )**2 $ + SCNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f index 737d0e773b..e9416679ec 100644 --- a/SRC/cunbdb2.f +++ b/SRC/cunbdb2.f @@ -217,9 +217,8 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * ==================================================================== * * .. Parameters .. - COMPLEX NEGONE, ONE - PARAMETER ( NEGONE = (-1.0E0,0.0E0), - $ ONE = (1.0E0,0.0E0) ) + COMPLEX NEGONE + PARAMETER ( NEGONE = (-1.0E0,0.0E0) ) * .. * .. Local Scalars .. REAL C, S @@ -228,7 +227,7 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, + EXTERNAL CLARF1F, CLARFGP, CUNBDB5, CSROT, CSCAL, $ CLACGV, $ XERBLA * .. @@ -290,11 +289,10 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL CLACGV( Q-I+1, X11(I,I), LDX11 ) CALL CLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = REAL( X11(I,I) ) - X11(I,I) = ONE - CALL CLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL CLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL CLARF1F( '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 )**2 $ + SCNRM2( M-P-I+1, X21(I,I), 1 )**2 ) @@ -310,14 +308,13 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( REAL( X11(I+1,I) ), REAL( X21(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X11(I+1,I) = ONE - CALL CLARF( 'L', P-I, Q-I, X11(I+1,I), 1, - $ CONJG(TAUP1(I)), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL CLARF1F( 'L', P-I, Q-I, X11(I+1,I), 1, + $ CONJG(TAUP1(I)), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF - X21(I,I) = ONE - CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) * END DO * @@ -325,9 +322,9 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = P + 1, Q CALL CLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) - X21(I,I) = ONE - CALL CLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, CONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) END DO * RETURN diff --git a/SRC/cunbdb3.f b/SRC/cunbdb3.f index 91ae5f8954..2425a565eb 100644 --- a/SRC/cunbdb3.f +++ b/SRC/cunbdb3.f @@ -216,10 +216,6 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * * ==================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = (1.0E0,0.0E0) ) -* .. * .. Local Scalars .. REAL C, S INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5, @@ -227,7 +223,7 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CLACGV, + EXTERNAL CLARF1F, CLARFGP, CUNBDB5, CSROT, CLACGV, $ XERBLA * .. * .. External Functions .. @@ -289,11 +285,10 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) CALL CLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) S = REAL( X21(I,I) ) - X21(I,I) = ONE - CALL CLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X11(I,I), LDX11, WORK(ILARF) ) - CALL CLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X21(I+1,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I,I), LDX11, WORK(ILARF) ) + CALL CLARF1F( '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 )**2 $ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 ) @@ -309,14 +304,12 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( REAL( X21(I+1,I) ), REAL( X11(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X21(I+1,I) = ONE - CALL CLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, - $ CONJG(TAUP2(I)), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', M-P-I, Q-I, X21(I+1,I), 1, + $ CONJG(TAUP2(I)), + $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF - X11(I,I) = ONE - CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) + CALL CLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) * END DO * @@ -324,9 +317,8 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = M-P + 1, Q CALL CLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) - X11(I,I) = ONE - CALL CLARF( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) + CALL CLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f index 71d35a7118..65f2717c5d 100644 --- a/SRC/cunbdb4.f +++ b/SRC/cunbdb4.f @@ -228,8 +228,8 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, * ==================================================================== * * .. Parameters .. - COMPLEX NEGONE, ONE, ZERO - PARAMETER ( NEGONE = (-1.0E0,0.0E0), ONE = (1.0E0,0.0E0), + COMPLEX NEGONE, ZERO + PARAMETER ( NEGONE = (-1.0E0,0.0E0), $ ZERO = (0.0E0,0.0E0) ) * .. * .. Local Scalars .. @@ -239,7 +239,7 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL CLARF, CLARFGP, CUNBDB5, CSROT, CSCAL, + EXTERNAL CLARF1F, CLARFGP, CUNBDB5, CSROT, CSCAL, $ CLACGV, $ XERBLA * .. @@ -309,14 +309,12 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( REAL( PHANTOM(1) ), REAL( PHANTOM(P+1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - PHANTOM(1) = ONE - PHANTOM(P+1) = ONE - CALL CLARF( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), - $ X11, - $ LDX11, WORK(ILARF) ) - CALL CLARF( 'L', M-P, Q, PHANTOM(P+1), 1, - $ CONJG(TAUP2(1)), - $ X21, LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), + $ X11, + $ LDX11, WORK(ILARF) ) + CALL CLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, + $ CONJG(TAUP2(1)), + $ X21, LDX21, WORK(ILARF) ) ELSE CALL CUNBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -329,23 +327,22 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( REAL( X11(I,I-1) ), REAL( X21(I,I-1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I-1) = ONE - X21(I,I-1) = ONE - CALL CLARF( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, - $ CONJG(TAUP1(I)), X11(I,I), LDX11, WORK(ILARF) ) - CALL CLARF( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, - $ CONJG(TAUP2(I)), X21(I,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, + $ CONJG(TAUP1(I)), X11(I,I), LDX11, + $ WORK(ILARF) ) + CALL CLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, + $ CONJG(TAUP2(I)), X21(I,I), LDX21, + $ WORK(ILARF) ) END IF * CALL CSROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) CALL CLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) C = REAL( X21(I,I) ) - X21(I,I) = ONE - CALL CLARF( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL CLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X21(I+1,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL CLARF1F( '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 ) IF( I .LT. M-Q ) THEN S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2 @@ -360,11 +357,10 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DO I = M - Q + 1, P CALL CLACGV( Q-I+1, X11(I,I), LDX11 ) CALL CLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) - X11(I,I) = ONE - CALL CLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL CLARF( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL CLARF1F( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X11(I,I), LDX11 ) END DO * @@ -375,10 +371,9 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL CLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), $ LDX21, $ TAUQ1(I) ) - X21(M-Q+I-P,I) = ONE - CALL CLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, - $ TAUQ1(I), - $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) + CALL CLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), + $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) END DO * diff --git a/SRC/cung2l.f b/SRC/cung2l.f index 602f1c8ef9..10536022c8 100644 --- a/SRC/cung2l.f +++ b/SRC/cung2l.f @@ -134,7 +134,7 @@ SUBROUTINE CUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL CLARF, CSCAL, XERBLA + EXTERNAL CLARF1L, CSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -178,9 +178,9 @@ SUBROUTINE CUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL CLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), - $ A, - $ LDA, WORK ) + CALL CLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, + $ LDA, WORK ) CALL CSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) * diff --git a/SRC/cung2r.f b/SRC/cung2r.f index d854ed437f..2d529f672e 100644 --- a/SRC/cung2r.f +++ b/SRC/cung2r.f @@ -134,7 +134,7 @@ SUBROUTINE CUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL CLARF, CSCAL, XERBLA + EXTERNAL CLARF1F, CSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -177,9 +177,8 @@ SUBROUTINE CUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i:m,i:n) from the left * IF( I.LT.N ) THEN - A( I, I ) = ONE - CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK ) + CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + $ A( I, I+1 ), LDA, WORK ) END IF IF( I.LT.M ) $ CALL CSCAL( M-I, -TAU( I ), A( I+1, I ), 1 ) diff --git a/SRC/cungl2.f b/SRC/cungl2.f index 4e5042b636..c4b4a272e0 100644 --- a/SRC/cungl2.f +++ b/SRC/cungl2.f @@ -133,7 +133,7 @@ SUBROUTINE CUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, CSCAL, XERBLA + EXTERNAL CLACGV, CLARF1F, CSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -182,9 +182,9 @@ SUBROUTINE CUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) IF( I.LT.N ) THEN CALL CLACGV( N-I, A( I, I+1 ), LDA ) IF( I.LT.M ) THEN - A( I, I ) = ONE - CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ CONJG( TAU( I ) ), A( I+1, I ), LDA, WORK ) + CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ CONJG( TAU( I ) ), A( I+1, I ), LDA, + $ WORK ) END IF CALL CSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA ) CALL CLACGV( N-I, A( I, I+1 ), LDA ) diff --git a/SRC/cungr2.f b/SRC/cungr2.f index 1e99911121..fbae716a24 100644 --- a/SRC/cungr2.f +++ b/SRC/cungr2.f @@ -134,7 +134,7 @@ SUBROUTINE CUNGR2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, CSCAL, XERBLA + EXTERNAL CLACGV, CLARF1L, CSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -183,8 +183,8 @@ SUBROUTINE CUNGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * CALL CLACGV( N-M+II-1, A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - CALL CLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, - $ CONJG( TAU( I ) ), A, LDA, WORK ) + CALL CLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + $ CONJG( TAU( I ) ), A, LDA, WORK ) CALL CSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) CALL CLACGV( N-M+II-1, A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - CONJG( TAU( I ) ) diff --git a/SRC/cunm2l.f b/SRC/cunm2l.f index 238b73525e..cb08b03c99 100644 --- a/SRC/cunm2l.f +++ b/SRC/cunm2l.f @@ -171,21 +171,17 @@ SUBROUTINE CUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - COMPLEX AII, TAUI + COMPLEX TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CLARF, XERBLA + EXTERNAL CLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -266,10 +262,8 @@ SUBROUTINE CUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, ELSE TAUI = CONJG( TAU( I ) ) END IF - AII = A( NQ-K+I, I ) - A( NQ-K+I, I ) = ONE - CALL CLARF( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, WORK ) - A( NQ-K+I, I ) = AII + CALL CLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, + $ WORK ) 10 CONTINUE RETURN * diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index 094a15bf7c..07238cd416 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -171,10 +171,6 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ @@ -270,7 +266,6 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, ELSE TAUI = CONJG( TAU( I ) ) END IF - A( I, I ) = ONE CALL CLARF1F( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), $ LDC, $ WORK ) diff --git a/SRC/cunml2.f b/SRC/cunml2.f index a00ce5ff0c..f2a9d542fc 100644 --- a/SRC/cunml2.f +++ b/SRC/cunml2.f @@ -171,21 +171,17 @@ SUBROUTINE CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - COMPLEX AII, TAUI + COMPLEX TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, XERBLA + EXTERNAL CLACGV, CLARF1F, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -272,11 +268,8 @@ SUBROUTINE CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF IF( I.LT.NQ ) $ CALL CLACGV( NQ-I, A( I, I+1 ), LDA ) - AII = A( I, I ) - A( I, I ) = ONE - CALL CLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ), - $ LDC, WORK ) - A( I, I ) = AII + CALL CLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, + $ JC ), LDC, WORK ) IF( I.LT.NQ ) $ CALL CLACGV( NQ-I, A( I, I+1 ), LDA ) 10 CONTINUE diff --git a/SRC/cunmr2.f b/SRC/cunmr2.f index 69988e84ab..1cfa860a83 100644 --- a/SRC/cunmr2.f +++ b/SRC/cunmr2.f @@ -171,21 +171,17 @@ SUBROUTINE CUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - COMPLEX AII, TAUI + COMPLEX TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CLACGV, CLARF, XERBLA + EXTERNAL CLACGV, CLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -267,11 +263,8 @@ SUBROUTINE CUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, TAUI = TAU( I ) END IF CALL CLACGV( NQ-K+I-1, A( I, 1 ), LDA ) - AII = A( I, NQ-K+I ) - A( I, NQ-K+I ) = ONE - CALL CLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, - $ WORK ) - A( I, NQ-K+I ) = AII + CALL CLARF1L( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, + $ WORK ) CALL CLACGV( NQ-K+I-1, A( I, 1 ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/cupmtr.f b/SRC/cupmtr.f index 6f82851911..6faab0105a 100644 --- a/SRC/cupmtr.f +++ b/SRC/cupmtr.f @@ -163,21 +163,17 @@ SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - COMPLEX ONE - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) -* .. * .. Local Scalars .. LOGICAL FORWRD, LEFT, NOTRAN, UPPER INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ - COMPLEX AII, TAUI + COMPLEX TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL CLARF, XERBLA + EXTERNAL CLARF1F, CLARF1L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX @@ -266,11 +262,8 @@ SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, ELSE TAUI = CONJG( TAU( I ) ) END IF - AII = AP( II ) - AP( II ) = ONE - CALL CLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, LDC, - $ WORK ) - AP( II ) = AII + CALL CLARF1L( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, + $ LDC, WORK ) * IF( FORWRD ) THEN II = II + I + 2 @@ -306,8 +299,6 @@ SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, END IF * DO 20 I = I1, I2, I3 - AII = AP( II ) - AP( II ) = ONE IF( LEFT ) THEN * * H(i) or H(i)**H is applied to C(i+1:m,1:n) @@ -329,9 +320,8 @@ SUBROUTINE CUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, ELSE TAUI = CONJG( TAU( I ) ) END IF - CALL CLARF( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, JC ), - $ LDC, WORK ) - AP( II ) = AII + CALL CLARF1F( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, + $ JC ), LDC, WORK ) * IF( FORWRD ) THEN II = II + NQ - I + 1 From b5797590362402f50f56ab7b4127baa4a7ba7498 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Fri, 7 Jun 2024 15:41:39 +0700 Subject: [PATCH 101/206] small fix in larf1f and larf1l, #1011 --- SRC/clarf1l.f | 2 +- SRC/slarf1f.f | 13 +++++++------ SRC/slarf1l.f | 8 ++++---- 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/SRC/clarf1l.f b/SRC/clarf1l.f index 40dda403a7..3627f21c5e 100644 --- a/SRC/clarf1l.f +++ b/SRC/clarf1l.f @@ -244,7 +244,7 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) * CALL CGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, - $ LDC, V, INCV, ZERO, WORK, 1 ) + $ LDC, V, INCV, ZERO, WORK, 1 ) * * w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) * diff --git a/SRC/slarf1f.f b/SRC/slarf1f.f index daf43423f5..efbec9061b 100644 --- a/SRC/slarf1f.f +++ b/SRC/slarf1f.f @@ -202,7 +202,7 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * w(1:lastc,1) := C(2:lastv,1:lastc)**T * v(2:lastv,1) * CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C( 2, 1 ), - $ LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) + $ LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) * * w(1:lastc,1) += v(1,1) * C(1,1:lastc)**T * @@ -214,8 +214,8 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**T * - CALL SGER( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, WORK, - $ 1, C( 2, 1 ), LDC ) + CALL SGER( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), INCV, + $ WORK, 1, C( 2, 1 ), LDC ) END IF ELSE * @@ -230,8 +230,9 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * w(1:lastc,1) := C(1:lastc,2:lastv) * v(2:lastv,1) * - CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, - $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, WORK, 1 ) + CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, + $ C( 1, 2 ), LDC, V( 1 + INCV ), INCV, ZERO, + $ WORK, 1 ) * * w(1:lastc,1) += v(1,1) * C(1:lastc,1) * @@ -244,7 +245,7 @@ SUBROUTINE SLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * C(1:lastc,2:lastv) += - tau * w(1:lastc,1) * v(2:lastv)**T * CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, - $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) + $ V( 1 + INCV ), INCV, C( 1, 2 ), LDC ) END IF END IF RETURN diff --git a/SRC/slarf1l.f b/SRC/slarf1l.f index d7b0eb759b..60b7fe863d 100644 --- a/SRC/slarf1l.f +++ b/SRC/slarf1l.f @@ -204,7 +204,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) * CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C, LDC, - $ V, INCV, ZERO, WORK, 1 ) + $ V, INCV, ZERO, WORK, 1 ) * * w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) * @@ -217,7 +217,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**T * CALL SGER( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C, - $ LDC) + $ LDC) END IF ELSE * @@ -233,7 +233,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) * CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, - $ LDC, V, INCV, ZERO, WORK, 1 ) + $ LDC, V, INCV, ZERO, WORK, 1 ) * * w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) * @@ -246,7 +246,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**T * CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, V, - $ INCV, C, LDC ) + $ INCV, C, LDC ) END IF END IF RETURN From cbd638d9d02888c59d9c3218913c408ca55dd8d8 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Fri, 7 Jun 2024 16:29:15 +0700 Subject: [PATCH 102/206] define larf1f and larf1l in lapack_64.h, #1011 --- SRC/lapack_64.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 8576805b2e..24e4fd148a 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -325,6 +325,8 @@ #define CLAR2V CLAR2V_64 #define CLARCM CLARCM_64 #define CLARF CLARF_64 +#define CLARF1F CLARF1F_64 +#define CLARF1L CLARF1L_64 #define CLARFB CLARFB_64 #define CLARFB_GETT CLARFB_GETT_64 #define CLARFG CLARFG_64 @@ -1384,6 +1386,8 @@ #define SLAR1V SLAR1V_64 #define SLAR2V SLAR2V_64 #define SLARF SLARF_64 +#define SLARF1F SLARF1F_64 +#define SLARF1L SLARF1L_64 #define SLARFB SLARFB_64 #define SLARFB_GETT SLARFB_GETT_64 #define SLARFG SLARFG_64 From ba27bf02d77f2fd53ad859fe1d3fee187c7cea4e Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Fri, 7 Jun 2024 16:45:55 +0700 Subject: [PATCH 103/206] small fix in routines to use larf1f and larf1l, #1011 --- SRC/cunbdb.f | 5 +++-- SRC/sorbdb.f | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index 3401cb6983..f78397ef6f 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -544,8 +544,9 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) CALL CLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1), $ LDX22, TAUQ2(P+I) ) - CALL CLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, - $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) + CALL CLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + $ LDX22, TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, + $ WORK ) * CALL CLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) * diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index a401342e1c..7da1a44d77 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -639,8 +639,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, IF( I .LT. Q ) THEN CALL SLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL SLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL SLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, + $ TAUQ1(I), X21(I+1,I+1), LDX21, WORK ) END IF CALL SLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) From 741907cae0facf748afe0894ac390500428fa21c Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Mon, 10 Jun 2024 00:49:40 -0400 Subject: [PATCH 104/206] updating dlarf1f and dlarf1l to fix a bug found within dorg2l --- SRC/dlarf1f.f | 4 ++-- SRC/dlarf1l.f | 11 ++--------- SRC/dorg2l.f | 1 + 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index 8f0830f7ff..bb30807932 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -211,7 +211,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Look for the last non-zero row in V. ! Since we are assuming that V(1) = 1, and it is not stored, so we ! shouldn't access it. - DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) + DO WHILE( LASTV.GE.2 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -232,7 +232,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * ! Check if lastv = 1. This means v = 1, So we just need to compute ! C := HC = (1-\tau)C. - IF( LASTV.EQ.1 ) THEN + IF( LASTV.LE.1 ) THEN CALL DSCAL(LASTC, ONE - TAU, C, LDC) ELSE * diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index 9b5483da6c..4983ae2d3d 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -170,16 +170,7 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ELSE LASTV = N END IF - IF( INCV.GT.0 ) THEN - I = 1 + (LASTV-1) * INCV - ELSE - I = 1 - END IF ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) - LASTV = LASTV - 1 - I = I - INCV - END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). LASTC = ILADLC(LASTV, N, C, LDC) @@ -187,6 +178,8 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILADLR(M, LASTV, C, LDC) END IF + ELSE + RETURN END IF ! Note that lastc.eq.0 renders the BLAS operations null; no special ! case is needed at this level. diff --git a/SRC/dorg2l.f b/SRC/dorg2l.f index 5345142924..b954302396 100644 --- a/SRC/dorg2l.f +++ b/SRC/dorg2l.f @@ -176,6 +176,7 @@ SUBROUTINE DORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * + !A(M-N+II, II) = ONE CALL DLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), $ A, $ LDA, WORK ) From 690067c21809121432e7aa46852a7869404c21cf Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Tue, 11 Jun 2024 17:17:45 +0700 Subject: [PATCH 105/206] add firstv param in larf1l, #1011 --- SRC/clarf1l.f | 66 +++++++++++++++++++++++++-------------------------- SRC/slarf1l.f | 56 +++++++++++++++++++++---------------------- 2 files changed, 59 insertions(+), 63 deletions(-) diff --git a/SRC/clarf1l.f b/SRC/clarf1l.f index 3627f21c5e..fae094bb67 100644 --- a/SRC/clarf1l.f +++ b/SRC/clarf1l.f @@ -84,7 +84,7 @@ *> \param[in] INCV *> \verbatim *> INCV is INTEGER -*> The increment between elements of v. INCV <> 0. +*> The increment between elements of v. INCV > 0. *> \endverbatim *> *> \param[in] TAU @@ -149,7 +149,7 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC + INTEGER I, J, LASTV, LASTC, FIRSTV * .. * .. External Subroutines .. EXTERNAL CGEMV, CGERC, CSCAL @@ -165,7 +165,7 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 1 + FIRSTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end @@ -175,15 +175,11 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ELSE LASTV = N END IF - IF( INCV.GT.0 ) THEN - I = 1 + (LASTV-1) * INCV - ELSE - I = 1 - END IF + I = 1 ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) - LASTV = LASTV - 1 - I = I - INCV + DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO ) + FIRSTV = FIRSTV + 1 + I = I + INCV END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). @@ -200,51 +196,53 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.EQ.1 ) THEN + IF( LASTV.EQ.FIRSTV ) THEN * -* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc) * - CALL CSCAL( LASTC, ONE - TAU, C, LDC ) + CALL CSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC ) ELSE * -* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) +* w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1) * - CALL CGEMV( 'Conjugate transpose', LASTV - 1, LASTC, - $ ONE, C, LDC, V, INCV, ZERO, WORK, 1 ) + CALL CGEMV( 'Conjugate transpose', LASTV - FIRSTV, LASTC, + $ ONE, C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) * * w(1:lastc,1) += C(lastv,1:lastc)**H * v(lastv,1) * - DO I = 1, LASTC - WORK( I ) = WORK( I ) + CONJG( C( LASTV, I ) ) + DO J = 1, LASTC + WORK( J ) = WORK( J ) + CONJG( C( LASTV, J ) ) END DO * * C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**H * - DO I = 1, LASTC - C( LASTV, I ) = C( LASTV, I ) - $ - TAU * CONJG( WORK( I ) ) + DO J = 1, LASTC + C( LASTV, J ) = C( LASTV, J ) + $ - TAU * CONJG( WORK( J ) ) END DO * -* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**H +* C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**H * - CALL CGERC( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C, - $ LDC) + CALL CGERC( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV, + $ WORK, 1, C( FIRSTV, 1 ), LDC) END IF ELSE * * Form C * H * - IF( LASTV.EQ.1 ) THEN + IF( LASTV.EQ.FIRSTV ) THEN * -* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv) * - CALL CSCAL( LASTC, ONE - TAU, C, 1 ) + CALL CSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 ) ELSE * -* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) +* w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1) * - CALL CGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, - $ LDC, V, INCV, ZERO, WORK, 1 ) + CALL CGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE, + $ C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) * * w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) * @@ -254,10 +252,10 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * CALL CAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 ) * -* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**H +* C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**H * - CALL CGERC( LASTC, LASTV - 1, -TAU, WORK, 1, V, - $ INCV, C, LDC ) + CALL CGERC( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ), + $ INCV, C( 1, FIRSTV ), LDC ) END IF END IF RETURN diff --git a/SRC/slarf1l.f b/SRC/slarf1l.f index 60b7fe863d..f4a3596006 100644 --- a/SRC/slarf1l.f +++ b/SRC/slarf1l.f @@ -82,7 +82,7 @@ *> \param[in] INCV *> \verbatim *> INCV is INTEGER -*> The increment between elements of v. INCV <> 0. +*> The increment between elements of v. INCV > 0. *> \endverbatim *> *> \param[in] TAU @@ -146,7 +146,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC + INTEGER I, LASTV, LASTC, FIRSTV * .. * .. External Subroutines .. EXTERNAL SGEMV, SGER, SAXPY, SSCAL @@ -159,7 +159,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 1 + FIRSTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end @@ -169,15 +169,11 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ELSE LASTV = N END IF - IF( INCV.GT.0 ) THEN - I = 1 + (LASTV-1) * INCV - ELSE - I = 1 - END IF + I = 1 ! Look for the last non-zero row in V. - DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) - LASTV = LASTV - 1 - I = I - INCV + DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO ) + FIRSTV = FIRSTV + 1 + I = I + INCV END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). @@ -194,17 +190,18 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * * Form H * C * - IF( LASTV.EQ.1 ) THEN + IF( LASTV.EQ.FIRSTV ) THEN * -* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc) * - CALL SSCAL( LASTC, ONE - TAU, C, LDC ) + CALL SSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC ) ELSE * -* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) +* w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1) * - CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C, LDC, - $ V, INCV, ZERO, WORK, 1 ) + CALL SGEMV( 'Transpose', LASTV - FIRSTV, LASTC, ONE, + $ C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) * * w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) * @@ -214,26 +211,27 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * CALL SAXPY( LASTC, -TAU, WORK, 1, C( LASTV, 1 ), LDC ) * -* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**T +* C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**T * - CALL SGER( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C, - $ LDC) + CALL SGER( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV, + $ WORK, 1, C( FIRSTV, 1 ), LDC) END IF ELSE * * Form C * H * - IF( LASTV.EQ.1 ) THEN + IF( LASTV.EQ.FIRSTV ) THEN * -* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv) * - CALL SSCAL( LASTC, ONE - TAU, C, 1 ) + CALL SSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 ) ELSE * -* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) +* w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1) * - CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C, - $ LDC, V, INCV, ZERO, WORK, 1 ) + CALL SGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE, + $ C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) * * w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) * @@ -243,10 +241,10 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * CALL SAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 ) * -* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**T +* C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**T * - CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, V, - $ INCV, C, LDC ) + CALL SGER( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ), + $ INCV, C( 1, FIRSTV ), LDC ) END IF END IF RETURN From 7159cfb377c9855bbc2eab0c7027c907b2e9d310 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 11 Jun 2024 15:56:46 +0100 Subject: [PATCH 106/206] Fix Intel compiler flags which contain a space --- CMAKE/CheckLAPACKCompilerFlags.cmake | 4 ++-- TESTING/MATGEN/CMakeLists.txt | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index 2cf62c18fa..d727caff3f 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -18,7 +18,7 @@ macro(CheckLAPACKCompilerFlags) if(WIN32) set(FOPT_ILP64 /integer-size:64) else() - set(FOPT_ILP64 "-integer-size 64") + set(FOPT_ILP64 "SHELL:-integer-size 64") endif() elseif((CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge") OR # CMake 2.6 (CMAKE_Fortran_COMPILER_ID STREQUAL "XL")) # CMake 2.8 @@ -61,7 +61,7 @@ macro(CheckLAPACKCompilerFlags) add_compile_options("$<$:-recursive>") if(UNIX) - add_compile_options("$<$:-fp-model strict>") + add_compile_options("$<$:SHELL:-fp-model strict>") endif() # SunPro F95 diff --git a/TESTING/MATGEN/CMakeLists.txt b/TESTING/MATGEN/CMakeLists.txt index 3866acc29c..02e05a86d4 100644 --- a/TESTING/MATGEN/CMakeLists.txt +++ b/TESTING/MATGEN/CMakeLists.txt @@ -74,7 +74,7 @@ if(BUILD_INDEX64_EXT_API) endforeach() file(COPY matgen_64.h DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/${TMGLIB}_64_obj) add_library(${TMGLIB}_64_obj OBJECT ${SOURCES_64}) - target_compile_options(${TMGLIB}_64_obj PRIVATE ${FOPT_ILP64} -DMATGEN_64) + target_compile_options(${TMGLIB}_64_obj PRIVATE "${FOPT_ILP64}" -DMATGEN_64) set_target_properties( ${TMGLIB}_64_obj PROPERTIES POSITION_INDEPENDENT_CODE ON From c744ebe3c4958cfceb065e3bcbc630bae3b06200 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 12 Jun 2024 07:23:31 -0400 Subject: [PATCH 107/206] updating dlarf1l to use firstv scanner properly --- SRC/dlarf1l.f | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index 4983ae2d3d..2995bc79dd 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -147,7 +147,7 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC, J + INTEGER I, LASTV, LASTC, J, FIRSTV * .. * .. External Subroutines .. EXTERNAL DGEMV, DGER @@ -160,7 +160,7 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + FIRSTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end @@ -170,7 +170,12 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ELSE LASTV = N END IF + I = 1 ! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO ) + FIRSTV = FIRSTV + 1 + I = I + INCV + END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). LASTC = ILADLC(LASTV, N, C, LDC) @@ -190,15 +195,16 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) IF( LASTV.GT.0 ) THEN ! Check if m = 1. This means v = 1, So we just need to compute ! C := HC = (1-\tau)C. - IF( LASTV.EQ.1 ) THEN - CALL DSCAL(LASTC, ONE - TAU, C, LDC) + IF( LASTV.EQ.FIRSTV ) THEN + CALL DSCAL(LASTC, ONE - TAU, C( FIRSTV, 1), LDC) ELSE * * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1) * ! w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1) - CALL DGEMV( 'Transpose', LASTV-1, LASTC, ONE, C(1,1), - $ LDC, V(1), INCV, ZERO, WORK, 1) + CALL DGEMV( 'Transpose', LASTV-FIRSTV, LASTC, ONE, + $ C(FIRSTV,1), LDC, V(I), INCV, ZERO, + $ WORK, 1) ! w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) = C(lastv,1:lastc)**T CALL DAXPY(LASTC, ONE, C(LASTV,1), LDC, WORK, 1) * @@ -208,8 +214,8 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! = C(...) - tau * w(1:lastc,1)**T CALL DAXPY(LASTC, -TAU, WORK, 1, C(LASTV,1), LDC) ! C(1:lastv-1,1:lastc) := C(...) - tau * v(1:lastv-1,1)*w(1:lastc,1)**T - CALL DGER(LASTV-1, LASTC, -TAU, V(1), INCV, WORK, 1, - $ C(1,1), LDC) + CALL DGER(LASTV-FIRSTV, LASTC, -TAU, V(I), INCV, + $ WORK, 1, C(FIRSTV,1), LDC) END IF END IF ELSE @@ -219,15 +225,15 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) IF( LASTV.GT.0 ) THEN ! Check if n = 1. This means v = 1, so we just need to compute ! C := CH = C(1-\tau). - IF( LASTV.EQ.1 ) THEN + IF( LASTV.EQ.FIRSTV ) THEN CALL DSCAL(LASTC, ONE - TAU, C, 1) ELSE * * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) * ! w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1) - CALL DGEMV( 'No transpose', LASTC, LASTV-1, ONE, - $ C(1,1), LDC, V(1), INCV, ZERO, WORK, 1 ) + CALL DGEMV( 'No transpose', LASTC, LASTV-FIRSTV, + $ ONE, C(1,FIRSTV), LDC, V(I), INCV, ZERO, WORK, 1 ) ! w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) = C(1:lastc,lastv) CALL DAXPY(LASTC, ONE, C(1,LASTV), 1, WORK, 1) * @@ -237,8 +243,8 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! = C(...) - tau * w(1:lastc,1) CALL DAXPY(LASTC, -TAU, WORK, 1, C(1,LASTV), 1) ! C(1:lastc,1:lastv-1) := C(...) - tau * w(1:lastc,1) * v(1:lastv-1)**T - CALL DGER( LASTC, LASTV-1, -TAU, WORK, 1, V(1), - $ INCV, C(1,1), LDC ) + CALL DGER( LASTC, LASTV-FIRSTV, -TAU, WORK, 1, V(I), + $ INCV, C(1,FIRSTV), LDC ) END IF END IF END IF From b69186b1bdc4a122a99739e33110bfc3c4f97840 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 12 Jun 2024 08:02:00 -0400 Subject: [PATCH 108/206] updating dlarf1l.f --- SRC/dlarf1l.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index 2995bc79dd..8c6670727f 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -147,7 +147,7 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC, J, FIRSTV + INTEGER I, J, FIRSTV, LASTV, LASTC * .. * .. External Subroutines .. EXTERNAL DGEMV, DGER From 7f30ba884ddad0afd0ad8cd64806852d699c8a0c Mon Sep 17 00:00:00 2001 From: Caroline Newcombe Date: Wed, 12 Jun 2024 15:54:20 -0500 Subject: [PATCH 109/206] Fix infinite loop when an error occurs in tests ddrvst and sdrvst --- TESTING/EIG/ddrvst.f | 8 +++++--- TESTING/EIG/dlahd2.f | 4 ++-- TESTING/EIG/sdrvst.f | 8 +++++--- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/TESTING/EIG/ddrvst.f b/TESTING/EIG/ddrvst.f index 805fd8271c..311684238d 100644 --- a/TESTING/EIG/ddrvst.f +++ b/TESTING/EIG/ddrvst.f @@ -2772,7 +2772,7 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, RESULT( NTEST ) = ULPINV RESULT( NTEST+1 ) = ULPINV RESULT( NTEST+2 ) = ULPINV - GO TO 700 + GO TO 1750 END IF END IF * @@ -2797,13 +2797,13 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, RETURN ELSE RESULT( NTEST ) = ULPINV - GO TO 700 + GO TO 1750 END IF END IF * IF( M3.EQ.0 .AND. N.GT.0 ) THEN RESULT( NTEST ) = ULPINV - GO TO 700 + GO TO 1750 END IF * * Do test 78 (or +54) @@ -2819,6 +2819,8 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ MAX( UNFL, TEMP3*ULP ) * CALL DLACPY( ' ', N, N, V, LDU, A, LDA ) +* + 1750 CONTINUE * 1720 CONTINUE * diff --git a/TESTING/EIG/dlahd2.f b/TESTING/EIG/dlahd2.f index a6c65635f0..cccbd2537c 100644 --- a/TESTING/EIG/dlahd2.f +++ b/TESTING/EIG/dlahd2.f @@ -534,8 +534,8 @@ SUBROUTINE DLAHD2( IOUNIT, PATH ) $ / ' 2: norm( I - Q'' Q ) / ( m ulp )', $ / ' 3: norm( I - PT PT'' ) / ( n ulp )', $ / ' 4: norm( Y - Q'' C ) / ( norm(Y) max(m,nrhs) ulp )' ) - 9968 FORMAT( / ' Tests performed: See sdrvst.f' ) - 9967 FORMAT( / ' Tests performed: See cdrvst.f' ) + 9968 FORMAT( / ' Tests performed: See ddrvst.f' ) + 9967 FORMAT( / ' Tests performed: See zdrvst.f' ) * * End of DLAHD2 * diff --git a/TESTING/EIG/sdrvst.f b/TESTING/EIG/sdrvst.f index be6d33cee4..2d02f54edf 100644 --- a/TESTING/EIG/sdrvst.f +++ b/TESTING/EIG/sdrvst.f @@ -2772,7 +2772,7 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, RESULT( NTEST ) = ULPINV RESULT( NTEST+1 ) = ULPINV RESULT( NTEST+2 ) = ULPINV - GO TO 700 + GO TO 1750 END IF END IF * @@ -2797,13 +2797,13 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, RETURN ELSE RESULT( NTEST ) = ULPINV - GO TO 700 + GO TO 1750 END IF END IF * IF( M3.EQ.0 .AND. N.GT.0 ) THEN RESULT( NTEST ) = ULPINV - GO TO 700 + GO TO 1750 END IF * * Do test 78 (or +54) @@ -2819,6 +2819,8 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ MAX( UNFL, TEMP3*ULP ) * CALL SLACPY( ' ', N, N, V, LDU, A, LDA ) +* + 1750 CONTINUE * 1720 CONTINUE * From c8b1a514cd0e749ce5a0ad9836b65f23519b2f88 Mon Sep 17 00:00:00 2001 From: Eduard Fedorenkov Date: Thu, 13 Jun 2024 15:31:25 +0700 Subject: [PATCH 110/206] code style small fixes, #1011 --- SRC/cgelq2.f | 3 +-- SRC/clarf1f.f | 6 +++--- SRC/clarf1l.f | 6 +++--- SRC/cunbdb.f | 18 ++++++------------ SRC/cunbdb2.f | 4 ++-- SRC/cunbdb3.f | 4 ++-- SRC/cunbdb4.f | 10 ++++------ SRC/cung2l.f | 3 +-- SRC/cunm2r.f | 3 +-- SRC/sgebd2.f | 6 ++---- SRC/sgehd2.f | 4 ---- SRC/sgelq2.f | 7 +------ SRC/sgeql2.f | 7 +------ SRC/sgeqr2.f | 4 ---- SRC/sgeqr2p.f | 4 ---- SRC/sgerq2.f | 4 ---- SRC/slarf1f.f | 6 +++--- SRC/slarf1l.f | 6 +++--- SRC/sopmtr.f | 7 +------ SRC/sorbdb.f | 42 ++++++++++++++---------------------------- SRC/sorbdb1.f | 13 ++++--------- SRC/sorbdb2.f | 7 +++---- SRC/sorbdb3.f | 10 ++-------- SRC/sorbdb4.f | 17 +++++++---------- SRC/sorg2l.f | 3 +-- SRC/sorgr2.f | 3 +-- SRC/sorm2l.f | 4 ---- SRC/sorm2r.f | 4 ---- SRC/sorml2.f | 4 ---- SRC/sormr2.f | 7 +------ 30 files changed, 67 insertions(+), 159 deletions(-) diff --git a/SRC/cgelq2.f b/SRC/cgelq2.f index 80f056e9be..6f702f3c13 100644 --- a/SRC/cgelq2.f +++ b/SRC/cgelq2.f @@ -180,8 +180,7 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i+1:m,i:n) from the right * CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), - $ A( I+1, I ), LDA, WORK ) + $ TAU( I ), A( I+1, I ), LDA, WORK ) END IF CALL CLACGV( N-I+1, A( I, I ), LDA ) 10 CONTINUE diff --git a/SRC/clarf1f.f b/SRC/clarf1f.f index 255f074e4f..c973dc0747 100644 --- a/SRC/clarf1f.f +++ b/SRC/clarf1f.f @@ -8,11 +8,11 @@ * *> \htmlonly *> Download CLARF1F + dependencies -*> +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * diff --git a/SRC/clarf1l.f b/SRC/clarf1l.f index fae094bb67..a911bf1138 100644 --- a/SRC/clarf1l.f +++ b/SRC/clarf1l.f @@ -8,11 +8,11 @@ * *> \htmlonly *> Download CLARF1L + dependencies -*> +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * diff --git a/SRC/cunbdb.f b/SRC/cunbdb.f index f78397ef6f..d366f516aa 100644 --- a/SRC/cunbdb.f +++ b/SRC/cunbdb.f @@ -485,16 +485,13 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF( I .LT. Q ) THEN CALL CLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) + $ TAUQ1(I), X11(I+1,I+1), LDX11, WORK ) CALL CLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + $ TAUQ1(I), X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN CALL CLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + $ TAUQ2(I), X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN CALL CLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, @@ -524,8 +521,7 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF ( P .GT. I ) THEN CALL CLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + $ TAUQ2(I), X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) $ CALL CLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, @@ -596,8 +592,7 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL CLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), $ X11(I+1,I), LDX11, WORK ) CALL CLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), - $ X12(I,I), LDX12, WORK ) + $ TAUP1(I), X12(I,I), LDX12, WORK ) CALL CLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, $ TAUP2(I), X21(I+1,I), LDX21, WORK ) CALL CLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, @@ -638,8 +633,7 @@ SUBROUTINE CUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ WORK ) END IF CALL CLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ CONJG(TAUQ2(I)), - $ X12(I,I+1), LDX12, WORK ) + $ CONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) IF ( M-P .GT. I ) THEN CALL CLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, diff --git a/SRC/cunbdb2.f b/SRC/cunbdb2.f index e9416679ec..b4ef0e83dc 100644 --- a/SRC/cunbdb2.f +++ b/SRC/cunbdb2.f @@ -309,8 +309,8 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( PHI(I) ) S = SIN( PHI(I) ) CALL CLARF1F( 'L', P-I, Q-I, X11(I+1,I), 1, - $ CONJG(TAUP1(I)), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + $ CONJG(TAUP1(I)), X11(I+1,I+1), LDX11, + $ WORK(ILARF) ) END IF CALL CLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, diff --git a/SRC/cunbdb3.f b/SRC/cunbdb3.f index 2425a565eb..579a4fc7b0 100644 --- a/SRC/cunbdb3.f +++ b/SRC/cunbdb3.f @@ -305,8 +305,8 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( PHI(I) ) S = SIN( PHI(I) ) CALL CLARF1F( 'L', M-P-I, Q-I, X21(I+1,I), 1, - $ CONJG(TAUP2(I)), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + $ CONJG(TAUP2(I)), X21(I+1,I+1), LDX21, + $ WORK(ILARF) ) END IF CALL CLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), $ X11(I,I+1), LDX11, WORK(ILARF) ) diff --git a/SRC/cunbdb4.f b/SRC/cunbdb4.f index 65f2717c5d..74c658c668 100644 --- a/SRC/cunbdb4.f +++ b/SRC/cunbdb4.f @@ -310,11 +310,9 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( THETA(I) ) S = SIN( THETA(I) ) CALL CLARF1F( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), - $ X11, - $ LDX11, WORK(ILARF) ) + $ X11, LDX11, WORK(ILARF) ) CALL CLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, - $ CONJG(TAUP2(1)), - $ X21, LDX21, WORK(ILARF) ) + $ CONJG(TAUP2(1)), X21, LDX21, WORK(ILARF) ) ELSE CALL CUNBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -372,8 +370,8 @@ SUBROUTINE CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, $ LDX21, $ TAUQ1(I) ) CALL CLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, - $ TAUQ1(I), - $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) + $ TAUQ1(I), X21(M-Q+I-P+1,I), LDX21, + $ WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) END DO * diff --git a/SRC/cung2l.f b/SRC/cung2l.f index 10536022c8..c7351591b6 100644 --- a/SRC/cung2l.f +++ b/SRC/cung2l.f @@ -179,8 +179,7 @@ SUBROUTINE CUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * A( M-N+II, II ) = ONE CALL CLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), - $ A, - $ LDA, WORK ) + $ A, LDA, WORK ) CALL CSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) * diff --git a/SRC/cunm2r.f b/SRC/cunm2r.f index 07238cd416..67cdc4369c 100644 --- a/SRC/cunm2r.f +++ b/SRC/cunm2r.f @@ -267,8 +267,7 @@ SUBROUTINE CUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, TAUI = CONJG( TAU( I ) ) END IF CALL CLARF1F( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), - $ LDC, - $ WORK ) + $ LDC, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/sgebd2.f b/SRC/sgebd2.f index c0ff242297..e6bf4a5a15 100644 --- a/SRC/sgebd2.f +++ b/SRC/sgebd2.f @@ -247,8 +247,7 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * IF( I.LT.N ) $ CALL SLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, - $ TAUQ( I ), - $ A( I, I+1 ), LDA, WORK ) + $ TAUQ( I ), A( I, I+1 ), LDA, WORK ) * IF( I.LT.N ) THEN * @@ -299,8 +298,7 @@ SUBROUTINE SGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * Apply H(i) to A(i+1:m,i+1:n) from the left * CALL SLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1, - $ TAUQ( I ), - $ A( I+1, I+1 ), LDA, WORK ) + $ TAUQ( I ), A( I+1, I+1 ), LDA, WORK ) ELSE TAUQ( I ) = ZERO END IF diff --git a/SRC/sgehd2.f b/SRC/sgehd2.f index e513502130..7392dfdadf 100644 --- a/SRC/sgehd2.f +++ b/SRC/sgehd2.f @@ -160,10 +160,6 @@ SUBROUTINE SGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I * .. diff --git a/SRC/sgelq2.f b/SRC/sgelq2.f index 3e431c3927..03995ce283 100644 --- a/SRC/sgelq2.f +++ b/SRC/sgelq2.f @@ -140,10 +140,6 @@ SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I, K * .. @@ -183,8 +179,7 @@ SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i+1:m,i:n) from the right * CALL SLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), - $ A( I+1, I ), LDA, WORK ) + $ TAU( I ), A( I+1, I ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/sgeql2.f b/SRC/sgeql2.f index ec58dc2269..0a66465607 100644 --- a/SRC/sgeql2.f +++ b/SRC/sgeql2.f @@ -134,10 +134,6 @@ SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I, K * .. @@ -177,8 +173,7 @@ SUBROUTINE SGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left * CALL SLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, - $ TAU( I ), - $ A, LDA, WORK ) + $ TAU( I ), A, LDA, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/sgeqr2.f b/SRC/sgeqr2.f index 1868b204c6..8a593dd65b 100644 --- a/SRC/sgeqr2.f +++ b/SRC/sgeqr2.f @@ -141,10 +141,6 @@ SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I, K * .. diff --git a/SRC/sgeqr2p.f b/SRC/sgeqr2p.f index 02fe30826d..e24ad01a1e 100644 --- a/SRC/sgeqr2p.f +++ b/SRC/sgeqr2p.f @@ -145,10 +145,6 @@ SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I, K * .. diff --git a/SRC/sgerq2.f b/SRC/sgerq2.f index 036f979cb5..b997d1824e 100644 --- a/SRC/sgerq2.f +++ b/SRC/sgerq2.f @@ -134,10 +134,6 @@ SUBROUTINE SGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. INTEGER I, K * .. diff --git a/SRC/slarf1f.f b/SRC/slarf1f.f index efbec9061b..c55a408047 100644 --- a/SRC/slarf1f.f +++ b/SRC/slarf1f.f @@ -8,11 +8,11 @@ * *> \htmlonly *> Download SLARF1F + dependencies -*> +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * diff --git a/SRC/slarf1l.f b/SRC/slarf1l.f index f4a3596006..2398963a91 100644 --- a/SRC/slarf1l.f +++ b/SRC/slarf1l.f @@ -9,11 +9,11 @@ * *> \htmlonly *> Download SLARF1L + dependencies -*> +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * diff --git a/SRC/sopmtr.f b/SRC/sopmtr.f index 14749c29d7..90c8ea0d0e 100644 --- a/SRC/sopmtr.f +++ b/SRC/sopmtr.f @@ -163,10 +163,6 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. LOGICAL FORWRD, LEFT, NOTRAN, UPPER INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ @@ -261,8 +257,7 @@ SUBROUTINE SOPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * Apply H(i) * CALL SLARF1L( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), C, - $ LDC, - $ WORK ) + $ LDC, WORK ) * IF( FORWRD ) THEN II = II + I + 2 diff --git a/SRC/sorbdb.f b/SRC/sorbdb.f index 7da1a44d77..b2f2eec4ca 100644 --- a/SRC/sorbdb.f +++ b/SRC/sorbdb.f @@ -307,8 +307,6 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * .. Parameters .. REAL REALONE PARAMETER ( REALONE = 1.0E0 ) - REAL ONE - PARAMETER ( ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL COLMAJOR, LQUERY @@ -436,18 +434,15 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, END IF IF ( M-Q+1 .GT. I ) THEN CALL SLARF1F( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, - $ TAUP1(I), - $ X12(I,I), LDX12, WORK ) + $ TAUP1(I), X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ TAUP2(I), - $ X21(I,I+1), LDX21, WORK ) + $ TAUP2(I), X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN CALL SLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ TAUP2(I), - $ X22(I,I), LDX22, WORK ) + $ TAUP2(I), X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -488,16 +483,13 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF( I .LT. Q ) THEN CALL SLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) + $ TAUQ1(I), X11(I+1,I+1), LDX11, WORK ) CALL SLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + $ TAUQ1(I), X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN CALL SLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + $ TAUQ2(I), X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN CALL SLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, @@ -521,8 +513,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF ( P .GT. I ) THEN CALL SLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + $ TAUQ2(I), X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) $ CALL SLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, @@ -589,8 +580,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF ( Q .GT. I ) THEN CALL SLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), - $ X11(I+1,I), LDX11, WORK ) + $ TAUP1(I), X11(I+1,I), LDX11, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN CALL SLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, @@ -598,8 +588,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, END IF IF ( Q .GT. I ) THEN CALL SLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), - $ X21(I+1,I), LDX21, WORK ) + $ TAUP2(I), X21(I+1,I), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN CALL SLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, @@ -646,8 +635,7 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN CALL SLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,I+1), LDX22, WORK ) + $ TAUQ2(I), X22(I,I+1), LDX22, WORK ) END IF * END DO @@ -662,13 +650,11 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * IF ( P .GT. I ) THEN CALL SLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ TAUQ2(I), - $ X12(I,I+1), LDX12, WORK ) + $ TAUQ2(I), X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) $ CALL SLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,Q+1), LDX22, WORK ) + $ TAUQ2(I), X22(I,Q+1), LDX22, WORK ) * END DO * @@ -686,8 +672,8 @@ SUBROUTINE SORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ 1, $ TAUQ2(P+I) ) CALL SLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), - $ 1, TAUQ2(P+I), X22(P+I,Q+I+1), - $ LDX22, WORK ) + $ 1, TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, + $ WORK ) END IF * * diff --git a/SRC/sorbdb1.f b/SRC/sorbdb1.f index 1ce1bc8a6d..1304efe104 100644 --- a/SRC/sorbdb1.f +++ b/SRC/sorbdb1.f @@ -217,10 +217,6 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, * * ==================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) -* .. * .. Local Scalars .. REAL C, S INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5, @@ -288,10 +284,9 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( THETA(I) ) S = SIN( THETA(I) ) CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) + $ I+1), LDX11, WORK(ILARF) ) CALL SLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + $ X21(I,I+1), LDX21, WORK(ILARF) ) * IF( I .LT. Q ) THEN CALL SROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, @@ -302,8 +297,8 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL SLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) CALL SLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + $ TAUQ1(I), X21(I+1,I+1), LDX21, + $ WORK(ILARF) ) 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 ) diff --git a/SRC/sorbdb2.f b/SRC/sorbdb2.f index c785305c8c..b35a83b60e 100644 --- a/SRC/sorbdb2.f +++ b/SRC/sorbdb2.f @@ -216,8 +216,8 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * ==================================================================== * * .. Parameters .. - REAL NEGONE, ONE - PARAMETER ( NEGONE = -1.0E0, ONE = 1.0E0 ) + REAL NEGONE + PARAMETER ( NEGONE = -1.0E0 ) * .. * .. Local Scalars .. REAL C, S @@ -289,8 +289,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL SLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X11(I+1,I), LDX11, WORK(ILARF) ) CALL SLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, - $ TAUQ1(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + $ TAUQ1(I), X21(I,I), LDX21, WORK(ILARF) ) 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 ) diff --git a/SRC/sorbdb3.f b/SRC/sorbdb3.f index d064723e6a..4fa7231d1d 100644 --- a/SRC/sorbdb3.f +++ b/SRC/sorbdb3.f @@ -216,10 +216,6 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, * * ==================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E0 ) -* .. * .. Local Scalars .. REAL C, S INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5, @@ -310,8 +306,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) + $ I+1), LDX11, WORK(ILARF) ) * END DO * @@ -320,8 +315,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DO I = M-P + 1, Q CALL SLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) CALL SLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), X11(I, - $ I+1), - $ LDX11, WORK(ILARF) ) + $ I+1), LDX11, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/sorbdb4.f b/SRC/sorbdb4.f index 0eb9edd658..a429d9d812 100644 --- a/SRC/sorbdb4.f +++ b/SRC/sorbdb4.f @@ -229,8 +229,8 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, * ==================================================================== * * .. Parameters .. - REAL NEGONE, ONE, ZERO - PARAMETER ( NEGONE = -1.0E0, ONE = 1.0E0, ZERO = 0.0E0 ) + REAL NEGONE, ZERO + PARAMETER ( NEGONE = -1.0E0, ZERO = 0.0E0 ) * .. * .. Local Scalars .. REAL C, S @@ -309,11 +309,9 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( THETA(I) ) S = SIN( THETA(I) ) CALL SLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, - $ LDX11, - $ WORK(ILARF) ) + $ LDX11, WORK(ILARF) ) CALL SLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), - $ X21, - $ LDX21, WORK(ILARF) ) + $ X21, LDX21, WORK(ILARF) ) ELSE CALL SORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -329,8 +327,7 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL SLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), $ X11(I,I), LDX11, WORK(ILARF) ) CALL SLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, - $ TAUP2(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + $ TAUP2(I), X21(I,I), LDX21, WORK(ILARF) ) END IF * CALL SROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) @@ -365,8 +362,8 @@ SUBROUTINE SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, $ LDX21, $ TAUQ1(I) ) CALL SLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, - $ TAUQ1(I), - $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) + $ TAUQ1(I), X21(M-Q+I-P+1,I), LDX21, + $ WORK(ILARF) ) END DO * RETURN diff --git a/SRC/sorg2l.f b/SRC/sorg2l.f index 32bbbaabb9..7ac4a204bd 100644 --- a/SRC/sorg2l.f +++ b/SRC/sorg2l.f @@ -178,8 +178,7 @@ SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * A( M-N+II, II ) = ONE CALL SLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), - $ A, - $ LDA, WORK ) + $ A, LDA, WORK ) CALL SSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) * diff --git a/SRC/sorgr2.f b/SRC/sorgr2.f index 3435d3586f..5ba985aca0 100644 --- a/SRC/sorgr2.f +++ b/SRC/sorgr2.f @@ -182,8 +182,7 @@ SUBROUTINE SORGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * A( II, N-M+II ) = ONE CALL SLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA, - $ TAU( I ), - $ A, LDA, WORK ) + $ TAU( I ), A, LDA, WORK ) CALL SSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - TAU( I ) * diff --git a/SRC/sorm2l.f b/SRC/sorm2l.f index ff2e0b1c87..b4792d8a9f 100644 --- a/SRC/sorm2l.f +++ b/SRC/sorm2l.f @@ -171,10 +171,6 @@ SUBROUTINE SORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ diff --git a/SRC/sorm2r.f b/SRC/sorm2r.f index 360770a5bf..bdadcd8055 100644 --- a/SRC/sorm2r.f +++ b/SRC/sorm2r.f @@ -171,10 +171,6 @@ SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ diff --git a/SRC/sorml2.f b/SRC/sorml2.f index 7ebd0caf8a..c1e0c4a080 100644 --- a/SRC/sorml2.f +++ b/SRC/sorml2.f @@ -171,10 +171,6 @@ SUBROUTINE SORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ diff --git a/SRC/sormr2.f b/SRC/sormr2.f index e0e4f73311..256c8fd2fc 100644 --- a/SRC/sormr2.f +++ b/SRC/sormr2.f @@ -171,10 +171,6 @@ SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * * ===================================================================== * -* .. Parameters .. - REAL ONE - PARAMETER ( ONE = 1.0E+0 ) -* .. * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ @@ -262,8 +258,7 @@ SUBROUTINE SORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Apply H(i) * CALL SLARF1L( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, - $ LDC, - $ WORK ) + $ LDC, WORK ) 10 CONTINUE RETURN * From 35b375866235495d1c95d43e0d48d7afa1edc418 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Fri, 14 Jun 2024 08:42:10 -0400 Subject: [PATCH 111/206] implement zlarf1l and use it in relevant routines. TODO: update comments and cleanup --- SRC/CMakeLists.txt | 2 +- SRC/Makefile | 2 +- SRC/zgebd2.f | 20 ++-- SRC/zgehd2.f | 15 +-- SRC/zgelq2.f | 13 +-- SRC/zgeql2.f | 10 +- SRC/zgeqr2.f | 9 +- SRC/zgeqr2p.f | 9 +- SRC/zgerq2.f | 12 +- SRC/zlaqp2.f | 11 +- SRC/zlaqp2rk.f | 13 +-- SRC/zlaqr2.f | 20 ++-- SRC/zlaqr3.f | 18 ++- SRC/zlarf1f.f | 20 ++-- SRC/zlarf1l.f | 268 +++++++++++++++++++++++++++++++++++++++++++++ SRC/zunbdb.f | 127 +++++++++++---------- SRC/zunbdb1.f | 28 ++--- SRC/zunbdb2.f | 32 +++--- SRC/zunbdb3.f | 30 ++--- SRC/zunbdb4.f | 53 ++++----- SRC/zung2l.f | 8 +- SRC/zung2r.f | 7 +- SRC/zungl2.f | 8 +- SRC/zungr2.f | 7 +- SRC/zunm2l.f | 10 +- SRC/zunm2r.f | 7 +- SRC/zunml2.f | 11 +- SRC/zunmr2.f | 9 +- SRC/zupmtr.f | 18 +-- err | 18 +++ 30 files changed, 516 insertions(+), 299 deletions(-) create mode 100644 SRC/zlarf1l.f create mode 100644 err diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index c3a1889a0b..c6b393b44d 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -418,7 +418,7 @@ set(ZLASRC zlaqhb.f zlaqhe.f zlaqhp.f zlaqp2.f zlaqps.f zlaqp2rk.f zlaqp3rk.f zlaqsb.f zlaqr0.f zlaqr1.f zlaqr2.f zlaqr3.f zlaqr4.f zlaqr5.f zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f - zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.f + zlarcm.f zlarf.f zlarfb.f zlarfb_gett.f zlarf1f.f zlarf1l.f zlarfg.f zlarfgp.f zlarft.f zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f90 zlartv.f zlarz.f zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f diff --git a/SRC/Makefile b/SRC/Makefile index ddf26f46f3..50faed428a 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -453,7 +453,7 @@ ZLASRC = \ zlaqhb.o zlaqhe.o zlaqhp.o zlaqp2.o zlaqps.o zlaqp2rk.o zlaqp3rk.o zlaqsb.o \ zlaqr0.o zlaqr1.o zlaqr2.o zlaqr3.o zlaqr4.o zlaqr5.o \ zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \ - zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.o\ + zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o zlarf1f.o zlarf1l.o \ zlarfg.o zlarft.o zlarfgp.o \ zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \ zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \ diff --git a/SRC/zgebd2.f b/SRC/zgebd2.f index ec1142954b..510ab849be 100644 --- a/SRC/zgebd2.f +++ b/SRC/zgebd2.f @@ -202,16 +202,14 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * ===================================================================== * * .. Parameters .. - COMPLEX*16 ZERO, ONE - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), - $ ONE = ( 1.0D+0, 0.0D+0 ) ) -* .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) * .. Local Scalars .. INTEGER I COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, MIN @@ -245,12 +243,11 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1, $ TAUQ( I ) ) D( I ) = DBLE( ALPHA ) - A( I, I ) = ONE * * Apply H(i)**H to A(i:m,i+1:n) from the left * IF( I.LT.N ) - $ CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, $ DCONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK ) A( I, I ) = D( I ) * @@ -264,11 +261,10 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA, $ TAUP( I ) ) E( I ) = DBLE( ALPHA ) - A( I, I+1 ) = ONE * * Apply G(i) to A(i+1:m,i+1:n) from the right * - CALL ZLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA, + CALL ZLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA, $ TAUP( I ), A( I+1, I+1 ), LDA, WORK ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) A( I, I+1 ) = E( I ) @@ -289,12 +285,11 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA, $ TAUP( I ) ) D( I ) = DBLE( ALPHA ) - A( I, I ) = ONE * * Apply G(i) to A(i+1:m,i:n) from the right * IF( I.LT.M ) - $ CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, $ TAUP( I ), A( I+1, I ), LDA, WORK ) CALL ZLACGV( N-I+1, A( I, I ), LDA ) A( I, I ) = D( I ) @@ -308,11 +303,10 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1, $ TAUQ( I ) ) E( I ) = DBLE( ALPHA ) - A( I+1, I ) = ONE * * Apply H(i)**H to A(i+1:m,i+1:n) from the left * - CALL ZLARF( 'Left', M-I, N-I, A( I+1, I ), 1, + CALL ZLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1, $ DCONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA, $ WORK ) A( I+1, I ) = E( I ) diff --git a/SRC/zgehd2.f b/SRC/zgehd2.f index 63c9fce1c8..98e6a6945d 100644 --- a/SRC/zgehd2.f +++ b/SRC/zgehd2.f @@ -169,7 +169,7 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLARF1F, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, MIN @@ -197,22 +197,19 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) * - ALPHA = A( I+1, I ) - CALL ZLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, + CALL ZLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, $ TAU( I ) ) - A( I+1, I ) = ONE * * Apply H(i) to A(1:ihi,i+1:ihi) from the right * - CALL ZLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), - $ A( 1, I+1 ), LDA, WORK ) + CALL ZLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), + $ A( 1, I+1 ), LDA, WORK ) * * Apply H(i)**H to A(i+1:ihi,i+1:n) from the left * - CALL ZLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, - $ DCONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK ) + CALL ZLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, + $ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK ) * - A( I+1, I ) = ALPHA 10 CONTINUE * RETURN diff --git a/SRC/zgelq2.f b/SRC/zgelq2.f index bd3521caa3..402378ea7b 100644 --- a/SRC/zgelq2.f +++ b/SRC/zgelq2.f @@ -149,7 +149,7 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -178,19 +178,16 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * Generate elementary reflector H(i) to annihilate A(i,i+1:n) * CALL ZLACGV( N-I+1, A( I, I ), LDA ) - ALPHA = A( I, I ) - CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA, + CALL ZLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA, $ TAU( I ) ) IF( I.LT.M ) THEN * * Apply H(i) to A(i+1:m,i:n) from the right * - A( I, I ) = ONE - CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ TAU( I ), - $ A( I+1, I ), LDA, WORK ) + CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ TAU( I ), + $ A( I+1, I ), LDA, WORK ) END IF - A( I, I ) = ALPHA CALL ZLACGV( N-I+1, A( I, I ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/zgeql2.f b/SRC/zgeql2.f index cdac186e98..e1933c1a6e 100644 --- a/SRC/zgeql2.f +++ b/SRC/zgeql2.f @@ -172,15 +172,13 @@ SUBROUTINE ZGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * Generate elementary reflector H(i) to annihilate * A(1:m-k+i-1,n-k+i) * - ALPHA = A( M-K+I, N-K+I ) - CALL ZLARFG( M-K+I, ALPHA, A( 1, N-K+I ), 1, TAU( I ) ) + CALL ZLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1, + $ TAU( I ) ) * * Apply H(i)**H to A(1:m-k+i,1:n-k+i-1) from the left * - A( M-K+I, N-K+I ) = ONE - CALL ZLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, - $ DCONJG( TAU( I ) ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = ALPHA + CALL ZLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, + $ CONJG( TAU( I ) ), A, LDA, WORK ) 10 CONTINUE RETURN * diff --git a/SRC/zgeqr2.f b/SRC/zgeqr2.f index 457404ad91..8e648eaabf 100644 --- a/SRC/zgeqr2.f +++ b/SRC/zgeqr2.f @@ -150,7 +150,7 @@ SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLARF1F, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, MIN @@ -184,11 +184,8 @@ SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i)**H to A(i:m,i+1:n) from the left * - ALPHA = A( I, I ) - A( I, I ) = ONE - CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) - A( I, I ) = ALPHA + CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/zgeqr2p.f b/SRC/zgeqr2p.f index 93451faec8..fcfd008337 100644 --- a/SRC/zgeqr2p.f +++ b/SRC/zgeqr2p.f @@ -154,7 +154,7 @@ SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZLARFGP + EXTERNAL XERBLA, ZLARF1F, ZLARFGP * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, MIN @@ -188,11 +188,8 @@ SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * * Apply H(i)**H to A(i:m,i+1:n) from the left * - ALPHA = A( I, I ) - A( I, I ) = ONE - CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, - $ DCONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) - A( I, I ) = ALPHA + CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, + $ CONJG( TAU( I ) ), A( I, I+1 ), LDA, WORK ) END IF 10 CONTINUE RETURN diff --git a/SRC/zgerq2.f b/SRC/zgerq2.f index f7bac6d570..4d84c87990 100644 --- a/SRC/zgerq2.f +++ b/SRC/zgerq2.f @@ -143,7 +143,7 @@ SUBROUTINE ZGERQ2( M, N, A, LDA, TAU, WORK, INFO ) COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLACGV, ZLARF1L, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -173,15 +173,13 @@ SUBROUTINE ZGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * A(m-k+i,1:n-k+i-1) * CALL ZLACGV( N-K+I, A( M-K+I, 1 ), LDA ) - ALPHA = A( M-K+I, N-K+I ) - CALL ZLARFG( N-K+I, ALPHA, A( M-K+I, 1 ), LDA, TAU( I ) ) + CALL ZLARFG( N-K+I, A( M-K+I, N-K+I ), A( M-K+I, 1 ), LDA, + $ TAU( I ) ) * * Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right * - A( M-K+I, N-K+I ) = ONE - CALL ZLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, - $ TAU( I ), A, LDA, WORK ) - A( M-K+I, N-K+I ) = ALPHA + CALL ZLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA, + $ TAU( I ), A, LDA, WORK ) CALL ZLACGV( N-K+I-1, A( M-K+I, 1 ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/zlaqp2.f b/SRC/zlaqp2.f index ee47f5119b..dd6b56739f 100644 --- a/SRC/zlaqp2.f +++ b/SRC/zlaqp2.f @@ -174,7 +174,7 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, COMPLEX*16 AII * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFG, ZSWAP + EXTERNAL ZLARF1F, ZLARFG, ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCONJG, MAX, MIN, SQRT @@ -222,12 +222,9 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * * Apply H(i)**H to A(offset+i:m,i+1:n) from the left. * - AII = A( OFFPI, I ) - A( OFFPI, I ) = CONE - CALL ZLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, - $ DCONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA, - $ WORK( 1 ) ) - A( OFFPI, I ) = AII + CALL ZLARF1F( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, + $ CONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA, + $ WORK( 1 ) ) END IF * * Update partial column norms. diff --git a/SRC/zlaqp2rk.f b/SRC/zlaqp2rk.f index f6bf555c26..ffe29ebe8a 100644 --- a/SRC/zlaqp2rk.f +++ b/SRC/zlaqp2rk.f @@ -254,7 +254,7 @@ *> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (N-1) -*> Used in ZLARF subroutine to apply an elementary +*> Used in ZLARF1F subroutine to apply an elementary *> reflector from the left. *> \endverbatim *> @@ -375,7 +375,7 @@ SUBROUTINE ZLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, COMPLEX*16 AIKK * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFG, ZSWAP + EXTERNAL ZLARF1F, ZLARFG, ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT @@ -633,12 +633,9 @@ SUBROUTINE ZLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, * condition is satisfied, not only KK < N+NRHS ) * IF( KK.LT.MINMNUPDT ) THEN - AIKK = A( I, KK ) - A( I, KK ) = CONE - CALL ZLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, - $ DCONJG( TAU( KK ) ), A( I, KK+1 ), LDA, - $ WORK( 1 ) ) - A( I, KK ) = AIKK + CALL ZLARF1F( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1, + $ CONJG( TAU( KK ) ), A( I, KK+1 ), LDA, + $ WORK( 1 ) ) END IF * IF( KK.LT.MINMNFACT ) THEN diff --git a/SRC/zlaqr2.f b/SRC/zlaqr2.f index e29c3875a8..a107e2a411 100644 --- a/SRC/zlaqr2.f +++ b/SRC/zlaqr2.f @@ -293,7 +293,7 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( RZERO = 0.0d0, RONE = 1.0d0 ) * .. * .. Local Scalars .. - COMPLEX*16 BETA, CDUM, S, TAU + COMPLEX*16 CDUM, S, TAU DOUBLE PRECISION FOO, SAFMAX, SAFMIN, SMLNUM, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, $ KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT @@ -305,7 +305,7 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, $ ZLAHQR, - $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR + $ ZLARF1F, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN @@ -476,19 +476,17 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, DO 50 I = 1, NS WORK( I ) = DCONJG( WORK( I ) ) 50 CONTINUE - BETA = WORK( 1 ) - CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL ZLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT, - $ WORK( JW+1 ) ) - CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL ZLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, + $ WORK( JW+1 ) ) + CALL ZLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL ZLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index a6f962611c..18f7df87a5 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -304,7 +304,7 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, * .. External Subroutines .. EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, $ ZLAQR4, - $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR + $ ZLARF1F, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN @@ -490,19 +490,17 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, DO 50 I = 1, NS WORK( I ) = DCONJG( WORK( I ) ) 50 CONTINUE - BETA = WORK( 1 ) - CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU ) - WORK( 1 ) = ONE + CALL ZLARFG( NS, WORK( 1 ), WORK( 2 ), 1, TAU ) * CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), $ LDT ) * - CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT, - $ WORK( JW+1 ) ) - CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, - $ WORK( JW+1 ) ) - CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, - $ WORK( JW+1 ) ) + CALL ZLARF1F( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT, + $ WORK( JW+1 ) ) + CALL ZLARF1F( 'R', NS, NS, WORK, 1, TAU, T, LDT, + $ WORK( JW+1 ) ) + CALL ZLARF1F( 'R', JW, NS, WORK, 1, TAU, V, LDV, + $ WORK( JW+1 ) ) * CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ), $ LWORK-JW, INFO ) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index 2e859e1390..caf64593d5 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -184,17 +184,17 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) INTEGER I, LASTV, LASTC, J * .. * .. External Subroutines .. - EXTERNAL ZGEMV, ZGERC + EXTERNAL ZGEMV, ZGERC, ZSCAL * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILADLR, ILADLC - EXTERNAL LSAME, ILADLR, ILADLC + INTEGER ILAZLR, ILAZLC + EXTERNAL LSAME, ILAZLR, ILAZLC * .. * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + LASTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end @@ -218,13 +218,13 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END DO IF( APPLYLEFT ) THEN ! Scan for the last non-zero column in C(1:lastv,:). - LASTC = ILADLC(LASTV, N, C, LDC) + LASTC = ILAZLC(LASTV, N, C, LDC) ELSE ! Scan for the last non-zero row in C(:,1:lastv). - LASTC = ILADLR(M, LASTV, C, LDC) + LASTC = ILAZLR(M, LASTV, C, LDC) END IF - END IF - IF( LASTC.EQ.0 .OR. LASTV.EQ.0 ) THEN + ELSE +! TAU is 0, so H = I. Meaning HC = C = CH. RETURN END IF IF( APPLYLEFT ) THEN @@ -249,7 +249,7 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! w += C_1**H ! This is essentially a zaxpyc DO I = 1, LASTC - WORK(I) = WORK(I) + DCONJG(C(1,I)) + WORK(I) = WORK(I) + CONJG(C(1,I)) END DO * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H @@ -258,7 +258,7 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! = C(...) - tau * Conj(w(1:lastc,1)) ! This is essentially a zaxpyc DO I = 1, LASTC - C(1,I) = C(1,I) - TAU * DCONJG(WORK(I)) + C(1,I) = C(1,I) - TAU * CONJG(WORK(I)) END DO ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, diff --git a/SRC/zlarf1l.f b/SRC/zlarf1l.f new file mode 100644 index 0000000000..4ddafcb025 --- /dev/null +++ b/SRC/zlarf1l.f @@ -0,0 +1,268 @@ +*> \brief \b ZLARF1L applies an elementary reflector to a general rectangular +* matrix assuming v(lastv) = 1, where lastv is the last non-zero +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLARF1L + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* .. Scalar Arguments .. +* CHARACTER SIDE +* INTEGER INCV, LDC, M, N +* COMPLEX*16 TAU +* .. +* .. Array Arguments .. +* COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLARF1L applies a complex elementary reflector H to a complex m by n matrix +*> C, from either the left or the right. H is represented in the form +*> +*> H = I - tau * v * v**H +*> +*> where tau is a real scalar and v is a real vector assuming v(lastv) = 1, +*> where lastv is the last non-zero element. +*> +*> If tau = 0, then H is taken to be the unit matrix. +*> +*> To apply H**H (the conjugate transpose of H), supply conjg(tau) instead +*> tau. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'L': form H * C +*> = 'R': form C * H +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix C. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix C. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX*16 array, dimension +*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' +*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' +*> The vector v in the representation of H. V is not used if +*> TAU = 0. +*> \endverbatim +*> +*> \param[in] INCV +*> \verbatim +*> INCV is INTEGER +*> The increment between elements of v. INCV > 0. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 +*> The value tau in the representation of H. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension (LDC,N) +*> On entry, the m by n matrix C. +*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', +*> or C * H if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> The leading dimension of the array C. LDC >= max(1,M). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension +*> (N) if SIDE = 'L' +*> or (M) if SIDE = 'R' +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larf1f +* +* ===================================================================== + SUBROUTINE ZLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER SIDE + INTEGER INCV, LDC, M, N + COMPLEX*16 TAU +* .. +* .. Array Arguments .. + COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE, ZERO + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), + $ ZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL APPLYLEFT + INTEGER I, J, LASTV, LASTC, FIRSTV +* .. +* .. External Subroutines .. + EXTERNAL ZGEMV, ZGERC, ZSCAL +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAZLR, ILAZLC + EXTERNAL LSAME, ILAZLR, ILAZLC +* .. +* .. Executable Statements .. +* + APPLYLEFT = LSAME( SIDE, 'L' ) + FIRSTV = 1 + LASTC = 0 + IF( TAU.NE.ZERO ) THEN +! Set up variables for scanning V. LASTV begins pointing to the end +! of V up to V(1). + IF( APPLYLEFT ) THEN + LASTV = M + ELSE + LASTV = N + END IF + I = 1 +! Look for the last non-zero row in V. + DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO ) + FIRSTV = FIRSTV + 1 + I = I + INCV + END DO + IF( APPLYLEFT ) THEN +! Scan for the last non-zero column in C(1:lastv,:). + LASTC = ILAZLC(LASTV, N, C, LDC) + ELSE +! Scan for the last non-zero row in C(:,1:lastv). + LASTC = ILAZLR(M, LASTV, C, LDC) + END IF + END IF + IF( LASTC.EQ.0 ) THEN + RETURN + END IF + IF( APPLYLEFT ) THEN +* +* Form H * C +* + IF( LASTV.EQ.FIRSTV ) THEN +* +* C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc) +* + CALL ZSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC ) + ELSE +* +* w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1) +* + CALL ZGEMV( 'Conjugate transpose', LASTV - FIRSTV, LASTC, + $ ONE, C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) +* +* w(1:lastc,1) += C(lastv,1:lastc)**H * v(lastv,1) +* + DO J = 1, LASTC + WORK( J ) = WORK( J ) + CONJG( C( LASTV, J ) ) + END DO +* +* C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**H +* + DO J = 1, LASTC + C( LASTV, J ) = C( LASTV, J ) + $ - TAU * CONJG( WORK( J ) ) + END DO +* +* C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**H +* + CALL ZGERC( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV, + $ WORK, 1, C( FIRSTV, 1 ), LDC) + END IF + ELSE +* +* Form C * H +* + IF( LASTV.EQ.FIRSTV ) THEN +* +* C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv) +* + CALL ZSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 ) + ELSE +* +* w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1) +* + CALL ZGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE, + $ C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO, + $ WORK, 1 ) +* +* w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) +* + CALL ZAXPY( LASTC, ONE, C( 1, LASTV ), 1, WORK, 1 ) +* +* C(1:lastc,lastv) += - tau * v(lastv,1) * w(1:lastc,1) +* + CALL ZAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 ) +* +* C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**H +* + CALL ZGERC( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ), + $ INCV, C( 1, FIRSTV ), LDC ) + END IF + END IF + RETURN +* +* End of ZLARF1L +* + END diff --git a/SRC/zunbdb.f b/SRC/zunbdb.f index f05e46e6d7..250ed59ad0 100644 --- a/SRC/zunbdb.f +++ b/SRC/zunbdb.f @@ -316,7 +316,7 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, DOUBLE PRECISION Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. - EXTERNAL ZAXPY, ZLARF, ZLARFGP, ZSCAL, + EXTERNAL ZAXPY, ZLARF1F, ZLARFGP, ZSCAL, $ XERBLA EXTERNAL ZLACGV * @@ -427,7 +427,6 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, ELSE IF ( P .EQ. I ) THEN CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) END IF - X11(I,I) = ONE IF ( M-P .GT. I ) THEN CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, $ TAUP2(I) ) @@ -435,19 +434,20 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, $ TAUP2(I) ) END IF - X21(I,I) = ONE * IF ( Q .GT. I ) THEN - CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, - $ DCONJG(TAUP1(I)), X11(I,I+1), LDX11, WORK ) - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ DCONJG(TAUP2(I)), X21(I,I+1), LDX21, WORK ) + CALL ZLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, + $ CONJG(TAUP1(I)), X11(I,I+1), LDX11, + $ WORK ) + CALL ZLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK ) END IF IF ( M-Q+1 .GT. I ) THEN - CALL ZLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, - $ DCONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) - CALL ZLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ DCONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) + CALL ZLARF1F( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ CONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) + CALL ZLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ CONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -477,7 +477,6 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL ZLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, $ TAUQ1(I) ) END IF - X11(I,I+1) = ONE END IF IF ( M-Q+1 .GT. I ) THEN CALL ZLACGV( M-Q-I+1, X12(I,I), LDX12 ) @@ -489,24 +488,23 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ TAUQ2(I) ) END IF END IF - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL ZLARF( 'R', P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK ) - CALL ZLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, - $ TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL ZLARF1F( 'R', P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK ) + CALL ZLARF1F( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, + $ TAUQ1(I), + $ X21(I+1,I+1), LDX21, WORK ) END IF IF ( P .GT. I ) THEN - CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL ZLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF ( M-P .GT. I ) THEN - CALL ZLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) + CALL ZLARF1F( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) END IF * IF( I .LT. Q ) @@ -529,16 +527,15 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, $ TAUQ2(I) ) END IF - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + CALL ZLARF1F( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), + $ X12(I+1,I), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL ZLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, - $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) + $ CALL ZLARF1F( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) * CALL ZLACGV( M-Q-I+1, X12(I,I), LDX12 ) * @@ -553,9 +550,9 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL ZLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) CALL ZLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1), $ LDX22, TAUQ2(P+I) ) - X22(Q+I,P+I) = ONE - CALL ZLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22, - $ TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK ) + CALL ZLARF1F( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), + $ LDX22, TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, + $ WORK ) * CALL ZLACGV( M-P-Q-I+1, X22(Q+I,P+I), LDX22 ) * @@ -595,7 +592,6 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, * CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, $ TAUP1(I) ) - X11(I,I) = ONE IF ( I .EQ. M-P ) THEN CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, $ TAUP2(I) ) @@ -603,17 +599,16 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, $ TAUP2(I) ) END IF - X21(I,I) = ONE -* - CALL ZLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), - $ X11(I+1,I), LDX11, WORK ) - CALL ZLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, - $ TAUP1(I), - $ X12(I,I), LDX12, WORK ) - CALL ZLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), - $ X21(I+1,I), LDX21, WORK ) - CALL ZLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), X22(I,I), LDX22, WORK ) +* + CALL ZLARF1F( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), + $ X11(I+1,I), LDX11, WORK ) + CALL ZLARF1F( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), + $ X12(I,I), LDX12, WORK ) + CALL ZLARF1F( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), X21(I+1,I), LDX21, WORK ) + CALL ZLARF1F( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, + $ TAUP2(I), X22(I,I), LDX22, WORK ) * CALL ZLACGV( P-I+1, X11(I,I), LDX11 ) CALL ZLACGV( M-P-I+1, X21(I,I), LDX21 ) @@ -639,23 +634,26 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, IF( I .LT. Q ) THEN CALL ZLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, $ TAUQ1(I) ) - X11(I+1,I) = ONE END IF CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF( I .LT. Q ) THEN - CALL ZLARF( 'L', Q-I, P-I, X11(I+1,I), 1, - $ DCONJG(TAUQ1(I)), X11(I+1,I+1), LDX11, WORK ) - CALL ZLARF( 'L', Q-I, M-P-I, X11(I+1,I), 1, - $ DCONJG(TAUQ1(I)), X21(I+1,I+1), LDX21, WORK ) + CALL ZLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, + $ CONJG(TAUQ1(I)), X11(I+1,I+1), LDX11, + $ WORK ) + CALL ZLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, + $ CONJG(TAUQ1(I)), X21(I+1,I+1), LDX21, + $ WORK ) END IF - CALL ZLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) + CALL ZLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), + $ X12(I,I+1), LDX12, WORK ) + IF ( M-P .GT. I ) THEN - CALL ZLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X22(I,I+1), LDX22, WORK ) + CALL ZLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X22(I,I+1), LDX22, + $ WORK ) END IF * END DO @@ -668,15 +666,16 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ 1 ) CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, $ TAUQ2(I) ) - X12(I,I) = ONE * IF ( P .GT. I ) THEN - CALL ZLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) + CALL ZLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X12(I,I+1), LDX12, + $ WORK ) END IF IF( M-P-Q .GE. 1 ) - $ CALL ZLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X22(I,Q+1), LDX22, WORK ) + $ CALL ZLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, + $ CONJG(TAUQ2(I)), X22(I,Q+1), LDX22, + $ WORK ) * END DO * @@ -688,12 +687,10 @@ SUBROUTINE ZUNBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ X22(P+I,Q+I), 1 ) CALL ZLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1, $ TAUQ2(P+I) ) - X22(P+I,Q+I) = ONE -* IF ( M-P-Q .NE. I ) THEN - CALL ZLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, - $ DCONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), LDX22, - $ WORK ) + CALL ZLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), + $ 1, CONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), + $ LDX22, WORK ) END IF * END DO diff --git a/SRC/zunbdb1.f b/SRC/zunbdb1.f index b96c499938..af0eeaea73 100644 --- a/SRC/zunbdb1.f +++ b/SRC/zunbdb1.f @@ -228,7 +228,7 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, + EXTERNAL ZLARF1F, ZLARFGP, ZUNBDB5, ZDROT, $ XERBLA EXTERNAL ZLACGV * .. @@ -288,13 +288,13 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( DBLE( X21(I,I) ), DBLE( X11(I,I) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I) = ONE - X21(I,I) = ONE - CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ DCONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + C = COS( THETA(I) ) + S = SIN( THETA(I) ) + CALL ZLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) * IF( I .LT. Q ) THEN CALL ZDROT( Q-I, X11(I,I+1), LDX11, X21(I,I+1), LDX21, C, @@ -303,14 +303,14 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL ZLARFGP( Q-I, X21(I,I+1), X21(I,I+2), LDX21, $ TAUQ1(I) ) S = DBLE( X21(I,I+1) ) - X21(I,I+1) = ONE - CALL ZLARF( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) - CALL ZLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL ZLARF1F( '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 )**2 - $ + DZNRM2( M-P-I, X21(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/SRC/zunbdb2.f b/SRC/zunbdb2.f index 245391982f..3d0dc4a59a 100644 --- a/SRC/zunbdb2.f +++ b/SRC/zunbdb2.f @@ -227,7 +227,7 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, + EXTERNAL ZLARF1F, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, $ ZLACGV, $ XERBLA * .. @@ -289,11 +289,10 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL ZLACGV( Q-I+1, X11(I,I), LDX11 ) CALL ZLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) C = DBLE( X11(I,I) ) - X11(I,I) = ONE - CALL ZLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL ZLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL ZLARF1F( '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 )**2 $ + DZNRM2( M-P-I+1, X21(I,I), 1 )**2 ) @@ -309,15 +308,13 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( DBLE( X11(I+1,I) ), DBLE( X21(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X11(I+1,I) = ONE - CALL ZLARF( 'L', P-I, Q-I, X11(I+1,I), 1, - $ DCONJG(TAUP1(I)), - $ X11(I+1,I+1), LDX11, WORK(ILARF) ) + CALL ZLARF1F( 'L', P-I, Q-I, X11(I+1,I), 1, + $ CONJG(TAUP1(I)), + $ X11(I+1,I+1), LDX11, WORK(ILARF) ) END IF - X21(I,I) = ONE - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ DCONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) * END DO * @@ -325,10 +322,9 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, * DO I = P + 1, Q CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) - X21(I,I) = ONE - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ DCONJG(TAUP2(I)), - $ X21(I,I+1), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ CONJG(TAUP2(I)), X21(I,I+1), LDX21, + $ WORK(ILARF) ) END DO * RETURN diff --git a/SRC/zunbdb3.f b/SRC/zunbdb3.f index 67b3eeedcb..d7aa8fadb2 100644 --- a/SRC/zunbdb3.f +++ b/SRC/zunbdb3.f @@ -226,7 +226,7 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZLACGV, + EXTERNAL ZLARF1F, ZLARFGP, ZUNBDB5, ZDROT, ZLACGV, $ XERBLA * .. * .. External Functions .. @@ -285,14 +285,12 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, $ S ) END IF * - CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) CALL ZLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) S = DBLE( X21(I,I) ) - X21(I,I) = ONE - CALL ZLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X11(I,I), LDX11, WORK(ILARF) ) - CALL ZLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X21(I+1,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I,I), LDX11, WORK(ILARF) ) + CALL ZLARF1F( '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 )**2 $ + DZNRM2( M-P-I, X21(I+1,I), 1 )**2 ) @@ -308,24 +306,20 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI(I) = ATAN2( DBLE( X21(I+1,I) ), DBLE( X11(I,I) ) ) C = COS( PHI(I) ) S = SIN( PHI(I) ) - X21(I+1,I) = ONE - CALL ZLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1, - $ DCONJG(TAUP2(I)), X21(I+1,I+1), LDX21, - $ WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P-I, Q-I, X21(I+1,I), 1, + $ CONJG(TAUP2(I)), + $ X21(I+1,I+1), LDX21, WORK(ILARF) ) END IF - X11(I,I) = ONE - CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) -* + CALL ZLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) END DO * * Reduce the bottom-right portion of X11 to the identity matrix * DO I = M-P + 1, Q CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) - X11(I,I) = ONE - CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK(ILARF) ) + CALL ZLARF1F( 'L', P-I+1, Q-I, X11(I,I), 1, CONJG(TAUP1(I)), + $ X11(I,I+1), LDX11, WORK(ILARF) ) END DO * RETURN diff --git a/SRC/zunbdb4.f b/SRC/zunbdb4.f index a242d956dc..90d70168f3 100644 --- a/SRC/zunbdb4.f +++ b/SRC/zunbdb4.f @@ -239,7 +239,7 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, LOGICAL LQUERY * .. * .. External Subroutines .. - EXTERNAL ZLARF, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, + EXTERNAL ZLARF1F, ZLARFGP, ZUNBDB5, ZDROT, ZSCAL, $ ZLACGV, $ XERBLA * .. @@ -309,14 +309,12 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( DBLE( PHANTOM(1) ), DBLE( PHANTOM(P+1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - PHANTOM(1) = ONE - PHANTOM(P+1) = ONE - CALL ZLARF( 'L', P, Q, PHANTOM(1), 1, DCONJG(TAUP1(1)), - $ X11, - $ LDX11, WORK(ILARF) ) - CALL ZLARF( 'L', M-P, Q, PHANTOM(P+1), 1, - $ DCONJG(TAUP2(1)), - $ X21, LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'L', P, Q, PHANTOM(1), 1, CONJG(TAUP1(1)), + $ X11, + $ LDX11, WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, + $ CONJG(TAUP2(1)), + $ X21, LDX21, WORK(ILARF) ) ELSE CALL ZUNBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -329,23 +327,22 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, THETA(I) = ATAN2( DBLE( X11(I,I-1) ), DBLE( X21(I,I-1) ) ) C = COS( THETA(I) ) S = SIN( THETA(I) ) - X11(I,I-1) = ONE - X21(I,I-1) = ONE - CALL ZLARF( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, - $ DCONJG(TAUP1(I)), X11(I,I), LDX11, WORK(ILARF) ) - CALL ZLARF( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, - $ DCONJG(TAUP2(I)), X21(I,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, + $ CONJG(TAUP1(I)), X11(I,I), LDX11, + $ WORK(ILARF) ) + CALL ZLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, + $ CONJG(TAUP2(I)), X21(I,I), LDX21, + $ WORK(ILARF) ) END IF * CALL ZDROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) CALL ZLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) ) C = DBLE( X21(I,I) ) - X21(I,I) = ONE - CALL ZLARF( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL ZLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), - $ X21(I+1,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL ZLARF1F( '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 ) IF( I .LT. M-Q ) THEN S = SQRT( DZNRM2( P-I, X11(I+1,I), 1 )**2 @@ -360,11 +357,10 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DO I = M - Q + 1, P CALL ZLACGV( Q-I+1, X11(I,I), LDX11 ) CALL ZLARFGP( Q-I+1, X11(I,I), X11(I,I+1), LDX11, TAUQ1(I) ) - X11(I,I) = ONE - CALL ZLARF( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL ZLARF( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X11(I+1,I), LDX11, WORK(ILARF) ) + CALL ZLARF1F( 'R', Q-P, Q-I+1, X11(I,I), LDX11, TAUQ1(I), + $ X21(M-Q+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X11(I,I), LDX11 ) END DO * @@ -375,10 +371,9 @@ SUBROUTINE ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, CALL ZLARFGP( Q-I+1, X21(M-Q+I-P,I), X21(M-Q+I-P,I+1), $ LDX21, $ TAUQ1(I) ) - X21(M-Q+I-P,I) = ONE - CALL ZLARF( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, - $ TAUQ1(I), - $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) + CALL ZLARF1F( 'R', Q-I, Q-I+1, X21(M-Q+I-P,I), LDX21, + $ TAUQ1(I), + $ X21(M-Q+I-P+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(M-Q+I-P,I), LDX21 ) END DO * diff --git a/SRC/zung2l.f b/SRC/zung2l.f index 28854861bb..814034e188 100644 --- a/SRC/zung2l.f +++ b/SRC/zung2l.f @@ -134,7 +134,7 @@ SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZSCAL + EXTERNAL XERBLA, ZLARF1L, ZSCAL * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -178,9 +178,9 @@ SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left * A( M-N+II, II ) = ONE - CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), - $ A, - $ LDA, WORK ) + CALL ZLARF1L( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), + $ A, + $ LDA, WORK ) CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) A( M-N+II, II ) = ONE - TAU( I ) * diff --git a/SRC/zung2r.f b/SRC/zung2r.f index b73246b2b3..80237cf312 100644 --- a/SRC/zung2r.f +++ b/SRC/zung2r.f @@ -134,7 +134,7 @@ SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZSCAL + EXTERNAL XERBLA, ZLARF1F, ZSCAL * .. * .. Intrinsic Functions .. INTRINSIC MAX @@ -177,9 +177,8 @@ SUBROUTINE ZUNG2R( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i) to A(i:m,i:n) from the left * IF( I.LT.N ) THEN - A( I, I ) = ONE - CALL ZLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK ) + CALL ZLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), + $ A( I, I+1 ), LDA, WORK ) END IF IF( I.LT.M ) $ CALL ZSCAL( M-I, -TAU( I ), A( I+1, I ), 1 ) diff --git a/SRC/zungl2.f b/SRC/zungl2.f index 83308c59b1..4647c93f2a 100644 --- a/SRC/zungl2.f +++ b/SRC/zungl2.f @@ -133,7 +133,7 @@ SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, J, L * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF, ZSCAL + EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZSCAL * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -182,9 +182,9 @@ SUBROUTINE ZUNGL2( M, N, K, A, LDA, TAU, WORK, INFO ) IF( I.LT.N ) THEN CALL ZLACGV( N-I, A( I, I+1 ), LDA ) IF( I.LT.M ) THEN - A( I, I ) = ONE - CALL ZLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, - $ DCONJG( TAU( I ) ), A( I+1, I ), LDA, WORK ) + CALL ZLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA, + $ CONJG( TAU( I ) ), A( I+1, I ), LDA, + $ WORK ) END IF CALL ZSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA ) CALL ZLACGV( N-I, A( I, I+1 ), LDA ) diff --git a/SRC/zungr2.f b/SRC/zungr2.f index 05c5fc74ec..33f6be35f7 100644 --- a/SRC/zungr2.f +++ b/SRC/zungr2.f @@ -134,7 +134,7 @@ SUBROUTINE ZUNGR2( M, N, K, A, LDA, TAU, WORK, INFO ) INTEGER I, II, J, L * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF, ZSCAL + EXTERNAL XERBLA, ZLACGV, ZLARF1L, ZSCAL * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -182,9 +182,8 @@ SUBROUTINE ZUNGR2( M, N, K, A, LDA, TAU, WORK, INFO ) * Apply H(i)**H to A(1:m-k+i,1:n-k+i) from the right * CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA ) - A( II, N-M+II ) = ONE - CALL ZLARF( 'Right', II-1, N-M+II, A( II, 1 ), LDA, - $ DCONJG( TAU( I ) ), A, LDA, WORK ) + CALL ZLARF1L( 'Right', II-1, N-M+II, A( II, 1 ), LDA, + $ CONJG( TAU( I ) ), A, LDA, WORK ) CALL ZSCAL( N-M+II-1, -TAU( I ), A( II, 1 ), LDA ) CALL ZLACGV( N-M+II-1, A( II, 1 ), LDA ) A( II, N-M+II ) = ONE - DCONJG( TAU( I ) ) diff --git a/SRC/zunm2l.f b/SRC/zunm2l.f index 0e0ed1c067..08dac348c9 100644 --- a/SRC/zunm2l.f +++ b/SRC/zunm2l.f @@ -178,14 +178,14 @@ SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - COMPLEX*16 AII, TAUI + COMPLEX*16 TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF + EXTERNAL XERBLA, ZLARF1L * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -266,10 +266,8 @@ SUBROUTINE ZUNM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, ELSE TAUI = DCONJG( TAU( I ) ) END IF - AII = A( NQ-K+I, I ) - A( NQ-K+I, I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, WORK ) - A( NQ-K+I, I ) = AII + CALL ZLARF1L( SIDE, MI, NI, A( 1, I ), 1, TAUI, C, LDC, + $ WORK ) 10 CONTINUE RETURN * diff --git a/SRC/zunm2r.f b/SRC/zunm2r.f index 6d6c802a6d..1ced5b127d 100644 --- a/SRC/zunm2r.f +++ b/SRC/zunm2r.f @@ -185,7 +185,7 @@ SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF + EXTERNAL XERBLA, ZLARF1F * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -270,12 +270,9 @@ SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, ELSE TAUI = DCONJG( TAU( I ) ) END IF - AII = A( I, I ) - A( I, I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), + CALL ZLARF1F( SIDE, MI, NI, A( I, I ), 1, TAUI, C( IC, JC ), $ LDC, $ WORK ) - A( I, I ) = AII 10 CONTINUE RETURN * diff --git a/SRC/zunml2.f b/SRC/zunml2.f index 00385dc612..dace8cce02 100644 --- a/SRC/zunml2.f +++ b/SRC/zunml2.f @@ -178,14 +178,14 @@ SUBROUTINE ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - COMPLEX*16 AII, TAUI + COMPLEX*16 TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF + EXTERNAL XERBLA, ZLACGV, ZLARF1F * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -272,11 +272,8 @@ SUBROUTINE ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF IF( I.LT.NQ ) $ CALL ZLACGV( NQ-I, A( I, I+1 ), LDA ) - AII = A( I, I ) - A( I, I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ), - $ LDC, WORK ) - A( I, I ) = AII + CALL ZLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, + $ JC ), LDC, WORK ) IF( I.LT.NQ ) $ CALL ZLACGV( NQ-I, A( I, I+1 ), LDA ) 10 CONTINUE diff --git a/SRC/zunmr2.f b/SRC/zunmr2.f index 6547522173..578c71cc1d 100644 --- a/SRC/zunmr2.f +++ b/SRC/zunmr2.f @@ -185,7 +185,7 @@ SUBROUTINE ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACGV, ZLARF + EXTERNAL XERBLA, ZLACGV, ZLARF1L * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -267,11 +267,8 @@ SUBROUTINE ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, TAUI = TAU( I ) END IF CALL ZLACGV( NQ-K+I-1, A( I, 1 ), LDA ) - AII = A( I, NQ-K+I ) - A( I, NQ-K+I ) = ONE - CALL ZLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, - $ WORK ) - A( I, NQ-K+I ) = AII + CALL ZLARF1L( SIDE, MI, NI, A( I, 1 ), LDA, TAUI, C, LDC, + $ WORK ) CALL ZLACGV( NQ-K+I-1, A( I, 1 ), LDA ) 10 CONTINUE RETURN diff --git a/SRC/zupmtr.f b/SRC/zupmtr.f index acf922f6d5..b3b8b8eb19 100644 --- a/SRC/zupmtr.f +++ b/SRC/zupmtr.f @@ -170,14 +170,14 @@ SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, * .. Local Scalars .. LOGICAL FORWRD, LEFT, NOTRAN, UPPER INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ - COMPLEX*16 AII, TAUI + COMPLEX*16 TAUI * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF + EXTERNAL XERBLA, ZLARF1, ZLARF1F * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX @@ -266,11 +266,8 @@ SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, ELSE TAUI = DCONJG( TAU( I ) ) END IF - AII = AP( II ) - AP( II ) = ONE - CALL ZLARF( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, LDC, - $ WORK ) - AP( II ) = AII + CALL ZLARF1L( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, + $ LDC, WORK ) * IF( FORWRD ) THEN II = II + I + 2 @@ -306,8 +303,6 @@ SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, END IF * DO 20 I = I1, I2, I3 - AII = AP( II ) - AP( II ) = ONE IF( LEFT ) THEN * * H(i) or H(i)**H is applied to C(i+1:m,1:n) @@ -329,9 +324,8 @@ SUBROUTINE ZUPMTR( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, ELSE TAUI = DCONJG( TAU( I ) ) END IF - CALL ZLARF( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, JC ), - $ LDC, WORK ) - AP( II ) = AII + CALL ZLARF1F( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, + $ JC ), LDC, WORK ) * IF( FORWRD ) THEN II = II + NQ - I + 1 diff --git a/err b/err new file mode 100644 index 0000000000..18b5e219f4 --- /dev/null +++ b/err @@ -0,0 +1,18 @@ +Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL +Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL +Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL +Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL +zgeql2.f:186:72: + + 186 | 10 CONTINUE + | 1 +Error: End of nonblock DO statement at (1) is within another block +zgeql2.f:191:9: + + 191 | END + | 1 +Error: END IF statement expected at (1) +f951: Error: Unexpected end of file in ‘zgeql2.f’ +make[1]: *** [: zgeql2.o] Error 1 +make[1]: *** Waiting for unfinished jobs.... +make: *** [Makefile:25: lapacklib] Error 2 From d2190178d8c2404626be08952236d4f1550b7ec6 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Fri, 14 Jun 2024 08:42:18 -0400 Subject: [PATCH 112/206] implement zlarf1l and use it in relevant routines. TODO: update comments and cleanup --- err | 18 ------------------ 1 file changed, 18 deletions(-) delete mode 100644 err diff --git a/err b/err deleted file mode 100644 index 18b5e219f4..0000000000 --- a/err +++ /dev/null @@ -1,18 +0,0 @@ -Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL -Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL -Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL -Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_UNDERFLOW_FLAG IEEE_DENORMAL -zgeql2.f:186:72: - - 186 | 10 CONTINUE - | 1 -Error: End of nonblock DO statement at (1) is within another block -zgeql2.f:191:9: - - 191 | END - | 1 -Error: END IF statement expected at (1) -f951: Error: Unexpected end of file in ‘zgeql2.f’ -make[1]: *** [: zgeql2.o] Error 1 -make[1]: *** Waiting for unfinished jobs.... -make: *** [Makefile:25: lapacklib] Error 2 From 35d6a7b0db82fde1af308220aa96bfe2b3282d88 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 15 Jun 2024 10:01:13 -0400 Subject: [PATCH 113/206] updating documentation, using xLARF1y where applicable, and removing some extraneous variables --- SRC/dgebd2.f | 4 +-- SRC/dgeqp3rk.f | 4 +-- SRC/dlaqp2rk.f | 4 +-- SRC/dlarf1f.f | 12 +++---- SRC/dlarf1l.f | 8 ++--- SRC/dormqr.f | 80 +++++++++++++++++++++---------------------- SRC/la_constants.mod | Bin 1563 -> 0 bytes SRC/la_xisnan.mod | Bin 321 -> 0 bytes SRC/zgehd2.f | 1 - SRC/zgelq2.f | 1 - SRC/zgeql2.f | 3 +- SRC/zgeqp3rk.f | 4 +-- SRC/zgeqr2.f | 1 - SRC/zgeqr2p.f | 1 - SRC/zgerq2.f | 1 - SRC/zlaqp2.f | 1 - SRC/zlaqp2rk.f | 1 - SRC/zlaqr3.f | 2 +- SRC/zlarf1f.f | 18 +++++----- SRC/zlarf1l.f | 6 ++-- SRC/zunm2r.f | 2 +- SRC/zunmr2.f | 2 +- 22 files changed, 74 insertions(+), 82 deletions(-) delete mode 100644 SRC/la_constants.mod delete mode 100644 SRC/la_xisnan.mod diff --git a/SRC/dgebd2.f b/SRC/dgebd2.f index 5677ef382b..4994d74808 100644 --- a/SRC/dgebd2.f +++ b/SRC/dgebd2.f @@ -202,8 +202,8 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D+0 ) * .. * .. Local Scalars .. INTEGER I diff --git a/SRC/dgeqp3rk.f b/SRC/dgeqp3rk.f index e14ea95c07..2bd82ca9b0 100644 --- a/SRC/dgeqp3rk.f +++ b/SRC/dgeqp3rk.f @@ -670,7 +670,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) DGEQP3RK and DLAQP2RK: 2*N to store full and partial * column 2-norms. * 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in DLARF subroutine inside DLAQP2RK to apply an +* in DLARF1F subroutine inside DLAQP2RK to apply an * elementary reflector from the left. * TOTAL_WORK_SIZE = 3*N + NRHS - 1 * @@ -686,7 +686,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) DGEQP3RK, DLAQP2RK, DLAQP3RK: 2*N to store full and * partial column 2-norms. * 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in DLARF subroutine to apply an elementary reflector +* in DLARF1F subroutine to apply an elementary reflector * from the left. * 3) DLAQP3RK: NB*(N+NRHS) to use in the work array F that * is used to apply a block reflector from diff --git a/SRC/dlaqp2rk.f b/SRC/dlaqp2rk.f index 8b834aca4e..fd6d7ba63d 100644 --- a/SRC/dlaqp2rk.f +++ b/SRC/dlaqp2rk.f @@ -253,7 +253,7 @@ *> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (N-1) -*> Used in DLARF subroutine to apply an elementary +*> Used in DLARF1F subroutine to apply an elementary *> reflector from the left. *> \endverbatim *> @@ -370,7 +370,7 @@ SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, DOUBLE PRECISION HUGEVAL, TEMP, TEMP2, TOL3Z * .. * .. External Subroutines .. - EXTERNAL DLARF, DLARFG, DSWAP + EXTERNAL DLARF1F, DLARFG, DSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index bb30807932..049057feb2 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -7,12 +7,12 @@ * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DLARF + dependencies -*> +*> Download DLARF1F + dependencies +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * @@ -180,7 +180,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC, J + INTEGER I, LASTV, LASTC * .. * .. External Subroutines .. EXTERNAL DGEMV, DGER @@ -283,6 +283,6 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END IF RETURN * -* End of DLARF +* End of DLARF1F * END diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index 8c6670727f..fc20dd21e3 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -9,11 +9,11 @@ * *> \htmlonly *> Download DLARF + dependencies -*> +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * @@ -250,6 +250,6 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END IF RETURN * -* End of DLARF +* End of DLARF1L * END diff --git a/SRC/dormqr.f b/SRC/dormqr.f index d8fd7d034f..a9f8ba2279 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -272,68 +272,68 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, END IF END IF * -* IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN + IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN * * Use unblocked code * CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, $ WORK, $ IINFO ) -* ELSE + ELSE * * Use blocked code * -! IWT = 1 + NW*NB -! IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. -! $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN -! I1 = 1 -! I2 = K -! I3 = NB -! ELSE -! I1 = ( ( K-1 ) / NB )*NB + 1 -! I2 = 1 -! I3 = -NB -! END IF -* -! IF( LEFT ) THEN -! NI = N -! JC = 1 -! ELSE -! MI = M -! IC = 1 -! END IF -* -! DO 10 I = I1, I2, I3 -! IB = MIN( NB, K-I+1 ) + IWT = 1 + NW*NB + IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. + $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN + I1 = 1 + I2 = K + I3 = NB + ELSE + I1 = ( ( K-1 ) / NB )*NB + 1 + I2 = 1 + I3 = -NB + END IF +* + IF( LEFT ) THEN + NI = N + JC = 1 + ELSE + MI = M + IC = 1 + END IF +* + DO 10 I = I1, I2, I3 + IB = MIN( NB, K-I+1 ) * * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * -! CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, -! $ I ), -! $ LDA, TAU( I ), WORK( IWT ), LDT ) -! IF( LEFT ) THEN + CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), + $ LDA, TAU( I ), WORK( IWT ), LDT ) + IF( LEFT ) THEN * * H or H**T is applied to C(i:m,1:n) * -! MI = M - I + 1 -! IC = I -! ELSE + MI = M - I + 1 + IC = I + ELSE * * H or H**T is applied to C(1:m,i:n) * -! NI = N - I + 1 -! JC = I -! END IF + NI = N - I + 1 + JC = I + END IF * * Apply H or H**T * -! CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, -! $ NI, -! $ IB, A( I, I ), LDA, WORK( IWT ), LDT, -! $ C( IC, JC ), LDC, WORK, LDWORK ) -! 10 CONTINUE -! END IF + CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, + $ NI, + $ IB, A( I, I ), LDA, WORK( IWT ), LDT, + $ C( IC, JC ), LDC, WORK, LDWORK ) + 10 CONTINUE + END IF WORK( 1 ) = LWKOPT RETURN * diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod deleted file mode 100644 index b8006a566979124de13911e5efcec9baedca2f6f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod deleted file mode 100644 index 1b5610476a459fda31282807dce61ffd51c6d396..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< diff --git a/SRC/zgehd2.f b/SRC/zgehd2.f index 98e6a6945d..22c03157bd 100644 --- a/SRC/zgehd2.f +++ b/SRC/zgehd2.f @@ -166,7 +166,6 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I - COMPLEX*16 ALPHA * .. * .. External Subroutines .. EXTERNAL XERBLA, ZLARF1F, ZLARFG diff --git a/SRC/zgelq2.f b/SRC/zgelq2.f index 402378ea7b..f84756167d 100644 --- a/SRC/zgelq2.f +++ b/SRC/zgelq2.f @@ -146,7 +146,6 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - COMPLEX*16 ALPHA * .. * .. External Subroutines .. EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG diff --git a/SRC/zgeql2.f b/SRC/zgeql2.f index e1933c1a6e..d972c4ba16 100644 --- a/SRC/zgeql2.f +++ b/SRC/zgeql2.f @@ -140,10 +140,9 @@ SUBROUTINE ZGEQL2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - COMPLEX*16 ALPHA * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLARF, ZLARFG + EXTERNAL XERBLA, ZLARF1L, ZLARFG * .. * .. Intrinsic Functions .. INTRINSIC DCONJG, MAX, MIN diff --git a/SRC/zgeqp3rk.f b/SRC/zgeqp3rk.f index 654093e31d..322741b210 100644 --- a/SRC/zgeqp3rk.f +++ b/SRC/zgeqp3rk.f @@ -677,7 +677,7 @@ SUBROUTINE ZGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * Minimal workspace size in case of using only unblocked * BLAS 2 code in ZLAQP2RK. * 1) ZLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in ZLARF subroutine inside ZLAQP2RK to apply an +* in ZLARF1F subroutine inside ZLAQP2RK to apply an * elementary reflector from the left. * TOTAL_WORK_SIZE = 3*N + NRHS - 1 * @@ -693,7 +693,7 @@ SUBROUTINE ZGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA, * 1) ZGEQP3RK, ZLAQP2RK, ZLAQP3RK: 2*N to store full and * partial column 2-norms. * 2) ZLAQP2RK: N+NRHS-1 to use in WORK array that is used -* in ZLARF subroutine to apply an elementary reflector +* in ZLARF1F subroutine to apply an elementary reflector * from the left. * 3) ZLAQP3RK: NB*(N+NRHS) to use in the work array F that * is used to apply a block reflector from diff --git a/SRC/zgeqr2.f b/SRC/zgeqr2.f index 8e648eaabf..784d76e617 100644 --- a/SRC/zgeqr2.f +++ b/SRC/zgeqr2.f @@ -147,7 +147,6 @@ SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - COMPLEX*16 ALPHA * .. * .. External Subroutines .. EXTERNAL XERBLA, ZLARF1F, ZLARFG diff --git a/SRC/zgeqr2p.f b/SRC/zgeqr2p.f index fcfd008337..b5827494af 100644 --- a/SRC/zgeqr2p.f +++ b/SRC/zgeqr2p.f @@ -151,7 +151,6 @@ SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - COMPLEX*16 ALPHA * .. * .. External Subroutines .. EXTERNAL XERBLA, ZLARF1F, ZLARFGP diff --git a/SRC/zgerq2.f b/SRC/zgerq2.f index 4d84c87990..0df8cc3208 100644 --- a/SRC/zgerq2.f +++ b/SRC/zgerq2.f @@ -140,7 +140,6 @@ SUBROUTINE ZGERQ2( M, N, A, LDA, TAU, WORK, INFO ) * .. * .. Local Scalars .. INTEGER I, K - COMPLEX*16 ALPHA * .. * .. External Subroutines .. EXTERNAL XERBLA, ZLACGV, ZLARF1L, ZLARFG diff --git a/SRC/zlaqp2.f b/SRC/zlaqp2.f index dd6b56739f..7189307bb5 100644 --- a/SRC/zlaqp2.f +++ b/SRC/zlaqp2.f @@ -171,7 +171,6 @@ SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, * .. Local Scalars .. INTEGER I, ITEMP, J, MN, OFFPI, PVT DOUBLE PRECISION TEMP, TEMP2, TOL3Z - COMPLEX*16 AII * .. * .. External Subroutines .. EXTERNAL ZLARF1F, ZLARFG, ZSWAP diff --git a/SRC/zlaqp2rk.f b/SRC/zlaqp2rk.f index ffe29ebe8a..9fe92fc5a9 100644 --- a/SRC/zlaqp2rk.f +++ b/SRC/zlaqp2rk.f @@ -372,7 +372,6 @@ SUBROUTINE ZLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL, INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT, $ MINMNUPDT DOUBLE PRECISION HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z - COMPLEX*16 AIKK * .. * .. External Subroutines .. EXTERNAL ZLARF1F, ZLARFG, ZSWAP diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index 18f7df87a5..b217cf0a63 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -290,7 +290,7 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, PARAMETER ( RZERO = 0.0d0, RONE = 1.0d0 ) * .. * .. Local Scalars .. - COMPLEX*16 BETA, CDUM, S, TAU + COMPLEX*16 CDUM, S, TAU DOUBLE PRECISION FOO, SAFMAX, SAFMIN, SMLNUM, ULP INTEGER I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN, $ KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3, diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index caf64593d5..8598259b30 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -7,12 +7,12 @@ * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DLARF + dependencies -*> +*> Download ZLARF1F + dependencies +*> *> [TGZ] -*> +*> *> [ZIP] -*> +*> *> [TXT] *> \endhtmlonly * @@ -248,8 +248,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) $ V(1+INCV), INCV, ZERO, WORK, 1) ! w += C_1**H ! This is essentially a zaxpyc - DO I = 1, LASTC - WORK(I) = WORK(I) + CONJG(C(1,I)) + DO J = 1, LASTC + WORK(J) = WORK(J) + DCONJG(C(1,J)) END DO * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H @@ -257,8 +257,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**H ! = C(...) - tau * Conj(w(1:lastc,1)) ! This is essentially a zaxpyc - DO I = 1, LASTC - C(1,I) = C(1,I) - TAU * CONJG(WORK(I)) + DO J = 1, LASTC + C(1,J) = C(1,J) - TAU * DCONJG(WORK(J)) END DO ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, @@ -294,6 +294,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) END IF RETURN * -* End of DLARF +* End of ZLARF1F * END diff --git a/SRC/zlarf1l.f b/SRC/zlarf1l.f index 4ddafcb025..13d0cdba92 100644 --- a/SRC/zlarf1l.f +++ b/SRC/zlarf1l.f @@ -9,13 +9,13 @@ *> \htmlonly *> Download ZLARF1L + dependencies *> +*href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf1l.f"> *> [TGZ] *> +*href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf1l.f"> *> [ZIP] *> +*href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf1l.f"> *> [TXT] *> \endhtmlonly * diff --git a/SRC/zunm2r.f b/SRC/zunm2r.f index 1ced5b127d..ce7d535572 100644 --- a/SRC/zunm2r.f +++ b/SRC/zunm2r.f @@ -178,7 +178,7 @@ SUBROUTINE ZUNM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ - COMPLEX*16 AII, TAUI + COMPLEX*16 TAUI * .. * .. External Functions .. LOGICAL LSAME diff --git a/SRC/zunmr2.f b/SRC/zunmr2.f index 578c71cc1d..15768d23e8 100644 --- a/SRC/zunmr2.f +++ b/SRC/zunmr2.f @@ -178,7 +178,7 @@ SUBROUTINE ZUNMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, MI, NI, NQ - COMPLEX*16 AII, TAUI + COMPLEX*16 TAUI * .. * .. External Functions .. LOGICAL LSAME From 48fbcb11a6cb67e74b02e7d3c1bac0e04cde913d Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 15 Jun 2024 10:19:00 -0400 Subject: [PATCH 114/206] updating documentation, using xLARF1y where applicable, and removing some extraneous variables --- SRC/dlarf1f.f | 15 +++++++++------ SRC/dlarf1l.f | 6 ++---- SRC/la_constants.mod | Bin 0 -> 1563 bytes SRC/la_xisnan.mod | Bin 0 -> 321 bytes 4 files changed, 11 insertions(+), 10 deletions(-) create mode 100644 SRC/la_constants.mod create mode 100644 SRC/la_xisnan.mod diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index 049057feb2..f16cdcf9c5 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -36,7 +36,7 @@ *> *> \verbatim *> -*> DLARF applies a real elementary reflector H to a real m by n matrix +*> DLARF1F applies a real elementary reflector H to a real m by n matrix *> C, from either the left or the right. H is represented in the form *> *> H = I - tau * v * v**T @@ -193,7 +193,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Executable Statements .. * APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 + LASTV = 1 LASTC = 0 IF( TAU.NE.ZERO ) THEN ! Set up variables for scanning V. LASTV begins pointing to the end @@ -222,9 +222,6 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILADLR(M, LASTV, C, LDC) END IF - ELSE -! TAU is 0, so H = I. Meaning HC = C = CH. - RETURN END IF IF( APPLYLEFT ) THEN * @@ -232,7 +229,10 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * ! Check if lastv = 1. This means v = 1, So we just need to compute ! C := HC = (1-\tau)C. - IF( LASTV.LE.1 ) THEN + IF( LASTV.EQ.1 ) THEN +* +* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc) +* CALL DSCAL(LASTC, ONE - TAU, C, LDC) ELSE * @@ -260,6 +260,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Check if n = 1. This means v = 1, so we just need to compute ! C := CH = C(1-\tau). IF( LASTV.EQ.1 ) THEN +* +* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1) +* CALL DSCAL(LASTC, ONE - TAU, C, 1) ELSE * diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index fc20dd21e3..95a8b319b5 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -8,7 +8,7 @@ * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DLARF + dependencies +*> Download DLARF1L + dependencies *> *> [TGZ] *> @@ -147,7 +147,7 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT - INTEGER I, J, FIRSTV, LASTV, LASTC + INTEGER I, FIRSTV, LASTV, LASTC * .. * .. External Subroutines .. EXTERNAL DGEMV, DGER @@ -183,8 +183,6 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILADLR(M, LASTV, C, LDC) END IF - ELSE - RETURN END IF ! Note that lastc.eq.0 renders the BLAS operations null; no special ! case is needed at this level. diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod new file mode 100644 index 0000000000000000000000000000000000000000..b8006a566979124de13911e5efcec9baedca2f6f GIT binary patch literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) literal 0 HcmV?d00001 diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod new file mode 100644 index 0000000000000000000000000000000000000000..1b5610476a459fda31282807dce61ffd51c6d396 GIT binary patch literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< literal 0 HcmV?d00001 From 63461c17538551721c2fd2980abcf1313eff8143 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 15 Jun 2024 10:19:13 -0400 Subject: [PATCH 115/206] updating documentation, using xLARF1y where applicable, and removing some extraneous variables --- SRC/la_constants.mod | Bin 1563 -> 0 bytes SRC/la_xisnan.mod | Bin 321 -> 0 bytes 2 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 SRC/la_constants.mod delete mode 100644 SRC/la_xisnan.mod diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod deleted file mode 100644 index b8006a566979124de13911e5efcec9baedca2f6f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod deleted file mode 100644 index 1b5610476a459fda31282807dce61ffd51c6d396..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< From 12075f5c4a6561341b1ff29a6d9aef4d874552b0 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 15 Jun 2024 10:21:35 -0400 Subject: [PATCH 116/206] updating documentation, using xLARF1y where applicable, and removing some extraneous variables --- SRC/zlarf1f.f | 2 ++ SRC/zlarf1l.f | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index 8598259b30..936275b5f6 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -185,6 +185,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. * .. External Subroutines .. EXTERNAL ZGEMV, ZGERC, ZSCAL +* .. Intrinsic Functions .. + INTRINSIC DCONJG * .. * .. External Functions .. LOGICAL LSAME diff --git a/SRC/zlarf1l.f b/SRC/zlarf1l.f index 13d0cdba92..5bb6eac156 100644 --- a/SRC/zlarf1l.f +++ b/SRC/zlarf1l.f @@ -158,7 +158,7 @@ SUBROUTINE ZLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) EXTERNAL ZGEMV, ZGERC, ZSCAL * .. * .. Intrinsic Functions .. - INTRINSIC CONJG + INTRINSIC DCONJG * .. * .. External Functions .. LOGICAL LSAME From b564666e6cb992f4e26d8f6ec15724033ce27f7d Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 18 Jun 2024 10:43:28 -0400 Subject: [PATCH 117/206] adding macro to lapack_64.h --- SRC/la_constants.mod | Bin 0 -> 1563 bytes SRC/la_xisnan.mod | Bin 0 -> 321 bytes SRC/lapack_64.h | 4 ++++ 3 files changed, 4 insertions(+) create mode 100644 SRC/la_constants.mod create mode 100644 SRC/la_xisnan.mod diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod new file mode 100644 index 0000000000000000000000000000000000000000..b8006a566979124de13911e5efcec9baedca2f6f GIT binary patch literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) literal 0 HcmV?d00001 diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod new file mode 100644 index 0000000000000000000000000000000000000000..1b5610476a459fda31282807dce61ffd51c6d396 GIT binary patch literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< literal 0 HcmV?d00001 diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 8576805b2e..f46aa925f1 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -794,6 +794,8 @@ #define DLAR1V DLAR1V_64 #define DLAR2V DLAR2V_64 #define DLARF DLARF_64 +#define DLARF1F DLARF1F_64 +#define DLARF1L DLARF1L_64 #define DLARFB DLARFB_64 #define DLARFB_GETT DLARFB_GETT_64 #define DLARFG DLARFG_64 @@ -2025,6 +2027,8 @@ #define ZLAR2V ZLAR2V_64 #define ZLARCM ZLARCM_64 #define ZLARF ZLARF_64 +#define ZLARF1F ZLARF1F_64 +#define ZLARF1L ZLARF1L_64 #define ZLARFB ZLARFB_64 #define ZLARFB_GETT ZLARFB_GETT_64 #define ZLARFG ZLARFG_64 From 4a5139ee3fc5778db002e95b2f34cdb2287ed4ae Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Tue, 18 Jun 2024 10:43:44 -0400 Subject: [PATCH 118/206] adding macro to lapack_64.h --- SRC/la_constants.mod | Bin 1563 -> 0 bytes SRC/la_xisnan.mod | Bin 321 -> 0 bytes 2 files changed, 0 insertions(+), 0 deletions(-) delete mode 100644 SRC/la_constants.mod delete mode 100644 SRC/la_xisnan.mod diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod deleted file mode 100644 index b8006a566979124de13911e5efcec9baedca2f6f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod deleted file mode 100644 index 1b5610476a459fda31282807dce61ffd51c6d396..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< From 6cd9d27cd56ddabd967505a0a6740ffec8aa8b9f Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 15:31:45 +0200 Subject: [PATCH 119/206] Made the type of hidden Fortran strlen arguments configurable for the NAG Fortran compiler and old GFortran --- CBLAS/include/cblas_f77.h | 186 +-- CBLAS/src/xerbla.c | 2 +- CMAKE/CheckLAPACKCompilerFlags.cmake | 18 + LAPACKE/include/lapack.h | 2066 +++++++++++++------------- 4 files changed, 1149 insertions(+), 1123 deletions(-) diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index b9a1172e29..6b29e4de3f 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -17,6 +17,10 @@ * or make the str argument into a struct. */ #define BLAS_FORTRAN_STRLEN_END +#ifndef FORTRAN_STRLEN + #define FORTRAN_STRLEN size_t +#endif + #ifdef CRAY #include #define F77_CHAR _fcd @@ -569,7 +573,7 @@ __attribute__((weak)) #endif F77_xerbla_base(FCHAR, void * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); @@ -652,78 +656,78 @@ void F77_dcabs1_sub_base(const void *, double *); void F77_sgemv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_sgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_ssymv_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_ssbmv_base(FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_sspmv_base(FCHAR, FINT, const float *, const float *, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_strmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_stbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_strsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_stbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_stpmv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_stpsv_base(FCHAR, FCHAR, FCHAR, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_sger_base(FINT, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT); void F77_ssyr_base(FCHAR, FINT, const float *, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_sspr_base(FCHAR, FINT, const float *, const float *, FINT, float * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_sspr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_ssyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); @@ -731,78 +735,78 @@ void F77_ssyr2_base(FCHAR, FINT, const float *, const float *, FINT, const float void F77_dgemv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dsymv_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dsbmv_base(FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dspmv_base(FCHAR, FINT, const double *, const double *, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dtrmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtrsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtpmv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtpsv_base(FCHAR, FCHAR, FCHAR, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dger_base(FINT, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT); void F77_dsyr_base(FCHAR, FINT, const double *, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dspr_base(FCHAR, FINT, const double *, const double *, FINT, double * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dspr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_dsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); @@ -810,79 +814,79 @@ void F77_dsyr2_base(FCHAR, FINT, const double *, const double *, FINT, const dou void F77_cgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_cgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_chemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_chbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_chpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_ctrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_cgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); void F77_cgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); void F77_cher_base(FCHAR, FINT, const float *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_cher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_chpr_base(FCHAR, FINT, const float *, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_chpr2_base(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); @@ -890,79 +894,79 @@ void F77_chpr2_base(FCHAR, FINT, const float *, const void *, FINT, const void * void F77_zgemv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zgbmv_base(FCHAR, FINT, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zhemv_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zhbmv_base(FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zhpmv_base(FCHAR, FINT, const void *, const void *, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_ztrmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztbmv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztpmv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztrsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztbsv_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztpsv_base(FCHAR, FCHAR, FCHAR, FINT, const void *, void *,FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zgerc_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); void F77_zgeru_base(FINT, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT); void F77_zher_base(FCHAR, FINT, const double *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zher2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zhpr_base(FCHAR, FINT, const double *, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); void F77_zhpr2_base(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); @@ -974,32 +978,32 @@ void F77_zhpr2_base(FCHAR, FINT, const double *, const void *, FINT, const void void F77_sgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ssymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ssyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ssyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_strmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_strsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); @@ -1007,32 +1011,32 @@ void F77_strsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const void F77_dgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_dtrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); @@ -1040,47 +1044,47 @@ void F77_dtrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, cons void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); @@ -1088,47 +1092,47 @@ void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); diff --git a/CBLAS/src/xerbla.c b/CBLAS/src/xerbla.c index 06ac7cfa12..a7ca7869a7 100644 --- a/CBLAS/src/xerbla.c +++ b/CBLAS/src/xerbla.c @@ -17,7 +17,7 @@ F77_xerbla_base (char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END -, size_t len +, FORTRAN_STRLEN len #endif ) { diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index d727caff3f..2502c5a6d0 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -55,6 +55,10 @@ macro(CheckLAPACKCompilerFlags) add_compile_options("$<$:-frecursive>") + if(CMAKE_Fortran_COMPILER_VERSION VERSION_LESS "8") + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") + endif() + # Intel Fortran elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") set(FPE_EXIT_FLAG "[-/]fpe(-all=|)0") @@ -113,6 +117,20 @@ macro(CheckLAPACKCompilerFlags) add_link_options("$<$:-thread_safe>") add_compile_options("$<$:-recursive>") + # By default NAG Fortran uses 32bit integers as hidden STRLEN arguments + if(UNIX) + if(APPLE) + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") + else() + # Get all flags added via `add_compile_options(...)` + get_directory_property(COMP_OPTIONS COMPILE_OPTIONS) + + if(NOT("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "-abi=64c")) + add_compile_options("$<$:FORTRAN_STRLEN=int>") + endif() + endif() + endif() + # Disable warnings add_compile_options("$<$:-w=obs>") add_compile_options("$<$:-w=x77>") diff --git a/LAPACKE/include/lapack.h b/LAPACKE/include/lapack.h index 03e23d9e27..52eda84a7a 100644 --- a/LAPACKE/include/lapack.h +++ b/LAPACKE/include/lapack.h @@ -19,6 +19,10 @@ * or make the str argument into a struct. */ #define LAPACK_FORTRAN_STRLEN_END +#ifndef FORTRAN_STRLEN + #define FORTRAN_STRLEN size_t +#endif + /* Complex types are structures equivalent to the * Fortran complex types COMPLEX(4) and COMPLEX(8). * @@ -134,7 +138,7 @@ typedef lapack_logical (*LAPACK_Z_SELECT2) lapack_logical LAPACK_lsame_base( const char* ca, const char* cb, lapack_int lca, lapack_int lcb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -182,7 +186,7 @@ void LAPACK_cbbcsd_base( float* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -212,7 +216,7 @@ void LAPACK_dbbcsd_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -242,7 +246,7 @@ void LAPACK_sbbcsd_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -272,7 +276,7 @@ void LAPACK_zbbcsd_base( double* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -294,7 +298,7 @@ void LAPACK_dbdsdc_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -316,7 +320,7 @@ void LAPACK_sbdsdc_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -337,7 +341,7 @@ void LAPACK_cbdsqr_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -358,7 +362,7 @@ void LAPACK_dbdsqr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -379,7 +383,7 @@ void LAPACK_sbdsqr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -400,7 +404,7 @@ void LAPACK_zbdsqr_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -423,7 +427,7 @@ void LAPACK_dbdsvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -446,7 +450,7 @@ void LAPACK_sbdsvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -463,7 +467,7 @@ void LAPACK_ddisna_base( double* SEP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -480,7 +484,7 @@ void LAPACK_sdisna_base( float* SEP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -503,7 +507,7 @@ void LAPACK_cgbbrd_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -525,7 +529,7 @@ void LAPACK_dgbbrd_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -547,7 +551,7 @@ void LAPACK_sgbbrd_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -570,7 +574,7 @@ void LAPACK_zgbbrd_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -590,7 +594,7 @@ void LAPACK_cgbcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -610,7 +614,7 @@ void LAPACK_dgbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -630,7 +634,7 @@ void LAPACK_sgbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -650,7 +654,7 @@ void LAPACK_zgbcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -761,7 +765,7 @@ void LAPACK_cgbrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -784,7 +788,7 @@ void LAPACK_dgbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -807,7 +811,7 @@ void LAPACK_sgbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -830,7 +834,7 @@ void LAPACK_zgbrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -858,7 +862,7 @@ void LAPACK_cgbrfsx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -886,7 +890,7 @@ void LAPACK_dgbrfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -914,7 +918,7 @@ void LAPACK_sgbrfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -942,7 +946,7 @@ void LAPACK_zgbrfsx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -997,7 +1001,7 @@ void LAPACK_cgbsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1024,7 +1028,7 @@ void LAPACK_dgbsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1051,7 +1055,7 @@ void LAPACK_sgbsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1078,7 +1082,7 @@ void LAPACK_zgbsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1108,7 +1112,7 @@ void LAPACK_cgbsvxx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1138,7 +1142,7 @@ void LAPACK_dgbsvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1168,7 +1172,7 @@ void LAPACK_sgbsvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1198,7 +1202,7 @@ void LAPACK_zgbsvxx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1239,7 +1243,7 @@ void LAPACK_cgbtrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1256,7 +1260,7 @@ void LAPACK_dgbtrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1273,7 +1277,7 @@ void LAPACK_sgbtrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1290,7 +1294,7 @@ void LAPACK_zgbtrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1307,7 +1311,7 @@ void LAPACK_cgebak_base( lapack_complex_float* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1324,7 +1328,7 @@ void LAPACK_dgebak_base( double* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1341,7 +1345,7 @@ void LAPACK_sgebak_base( float* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1358,7 +1362,7 @@ void LAPACK_zgebak_base( lapack_complex_double* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1375,7 +1379,7 @@ void LAPACK_cgebal_base( float* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1392,7 +1396,7 @@ void LAPACK_dgebal_base( double* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1409,7 +1413,7 @@ void LAPACK_sgebal_base( float* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1426,7 +1430,7 @@ void LAPACK_zgebal_base( double* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1490,7 +1494,7 @@ void LAPACK_cgecon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1510,7 +1514,7 @@ void LAPACK_dgecon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1530,7 +1534,7 @@ void LAPACK_sgecon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1550,7 +1554,7 @@ void LAPACK_zgecon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1658,7 +1662,7 @@ void LAPACK_cgees_base( float* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1678,7 +1682,7 @@ void LAPACK_dgees_base( double* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1698,7 +1702,7 @@ void LAPACK_sgees_base( float* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1718,7 +1722,7 @@ void LAPACK_zgees_base( double* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1740,7 +1744,7 @@ void LAPACK_cgeesx_base( float* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1763,7 +1767,7 @@ void LAPACK_dgeesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1786,7 +1790,7 @@ void LAPACK_sgeesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1808,7 +1812,7 @@ void LAPACK_zgeesx_base( double* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1829,7 +1833,7 @@ void LAPACK_cgeev_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1850,7 +1854,7 @@ void LAPACK_dgeev_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1871,7 +1875,7 @@ void LAPACK_sgeev_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1892,7 +1896,7 @@ void LAPACK_zgeev_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1917,7 +1921,7 @@ void LAPACK_cgeevx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1943,7 +1947,7 @@ void LAPACK_dgeevx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1969,7 +1973,7 @@ void LAPACK_sgeevx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -1994,7 +1998,7 @@ void LAPACK_zgeevx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2048,7 +2052,7 @@ void LAPACK_cgejsv_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2069,7 +2073,7 @@ void LAPACK_dgejsv_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2090,7 +2094,7 @@ void LAPACK_sgejsv_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2112,7 +2116,7 @@ void LAPACK_zgejsv_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2226,7 +2230,7 @@ void LAPACK_cgels_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2244,7 +2248,7 @@ void LAPACK_dgels_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2262,7 +2266,7 @@ void LAPACK_sgels_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2280,7 +2284,7 @@ void LAPACK_zgels_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2425,7 +2429,7 @@ void LAPACK_cgemlq_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2444,7 +2448,7 @@ void LAPACK_dgemlq_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2463,7 +2467,7 @@ void LAPACK_sgemlq_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2482,7 +2486,7 @@ void LAPACK_zgemlq_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2501,7 +2505,7 @@ void LAPACK_cgemqr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2520,7 +2524,7 @@ void LAPACK_dgemqr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2539,7 +2543,7 @@ void LAPACK_sgemqr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2558,7 +2562,7 @@ void LAPACK_zgemqr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2577,7 +2581,7 @@ void LAPACK_cgemqrt_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2596,7 +2600,7 @@ void LAPACK_dgemqrt_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2615,7 +2619,7 @@ void LAPACK_sgemqrt_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2634,7 +2638,7 @@ void LAPACK_zgemqrt_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -2993,7 +2997,7 @@ void LAPACK_cgerfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3016,7 +3020,7 @@ void LAPACK_dgerfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3039,7 +3043,7 @@ void LAPACK_sgerfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3062,7 +3066,7 @@ void LAPACK_zgerfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3090,7 +3094,7 @@ void LAPACK_cgerfsx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3118,7 +3122,7 @@ void LAPACK_dgerfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3146,7 +3150,7 @@ void LAPACK_sgerfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3174,7 +3178,7 @@ void LAPACK_zgerfsx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3260,7 +3264,7 @@ void LAPACK_cgesdd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3281,7 +3285,7 @@ void LAPACK_dgesdd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3302,7 +3306,7 @@ void LAPACK_sgesdd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3324,7 +3328,7 @@ void LAPACK_zgesdd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3349,7 +3353,7 @@ void LAPACK_cgedmd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3374,7 +3378,7 @@ void LAPACK_dgedmd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3398,7 +3402,7 @@ void LAPACK_sgedmd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3423,7 +3427,7 @@ void LAPACK_zgedmd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3451,7 +3455,7 @@ void LAPACK_cgedmdq_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3478,7 +3482,7 @@ void LAPACK_dgedmdq_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3505,7 +3509,7 @@ void LAPACK_sgedmdq_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3534,7 +3538,7 @@ void LAPACK_zgedmdq_base( lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3604,7 +3608,7 @@ void LAPACK_cgesvd_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3624,7 +3628,7 @@ void LAPACK_dgesvd_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3644,7 +3648,7 @@ void LAPACK_sgesvd_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3665,7 +3669,7 @@ void LAPACK_zgesvd_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3687,7 +3691,7 @@ void LAPACK_cgesvdq_base( float* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3709,7 +3713,7 @@ void LAPACK_dgesvdq_base( double* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3731,7 +3735,7 @@ void LAPACK_sgesvdq_base( float* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3753,7 +3757,7 @@ void LAPACK_zgesvdq_base( double* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3777,7 +3781,7 @@ void LAPACK_cgesvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3801,7 +3805,7 @@ void LAPACK_dgesvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3824,7 +3828,7 @@ void LAPACK_sgesvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3848,7 +3852,7 @@ void LAPACK_zgesvdx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3868,7 +3872,7 @@ void LAPACK_cgesvj_base( float* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3887,7 +3891,7 @@ void LAPACK_dgesvj_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3906,7 +3910,7 @@ void LAPACK_sgesvj_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3926,7 +3930,7 @@ void LAPACK_zgesvj_base( double* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3953,7 +3957,7 @@ void LAPACK_cgesvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -3980,7 +3984,7 @@ void LAPACK_dgesvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4007,7 +4011,7 @@ void LAPACK_sgesvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4034,7 +4038,7 @@ void LAPACK_zgesvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4064,7 +4068,7 @@ void LAPACK_cgesvxx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4094,7 +4098,7 @@ void LAPACK_dgesvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4124,7 +4128,7 @@ void LAPACK_sgesvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4154,7 +4158,7 @@ void LAPACK_zgesvxx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4271,7 +4275,7 @@ void LAPACK_cgetrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4288,7 +4292,7 @@ void LAPACK_dgetrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4305,7 +4309,7 @@ void LAPACK_sgetrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4322,7 +4326,7 @@ void LAPACK_zgetrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4340,7 +4344,7 @@ void LAPACK_cgetsls_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4358,7 +4362,7 @@ void LAPACK_dgetsls_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4376,7 +4380,7 @@ void LAPACK_sgetsls_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4394,7 +4398,7 @@ void LAPACK_zgetsls_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4448,7 +4452,7 @@ void LAPACK_cggbak_base( lapack_complex_float* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4466,7 +4470,7 @@ void LAPACK_dggbak_base( double* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4484,7 +4488,7 @@ void LAPACK_sggbak_base( float* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4502,7 +4506,7 @@ void LAPACK_zggbak_base( lapack_complex_double* V, lapack_int const* ldv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4522,7 +4526,7 @@ void LAPACK_cggbal_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4542,7 +4546,7 @@ void LAPACK_dggbal_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4562,7 +4566,7 @@ void LAPACK_sggbal_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4582,7 +4586,7 @@ void LAPACK_zggbal_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4605,7 +4609,7 @@ void LAPACK_cgges_base( float* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4628,7 +4632,7 @@ void LAPACK_dgges_base( double* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4651,7 +4655,7 @@ void LAPACK_sgges_base( float* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4674,7 +4678,7 @@ void LAPACK_zgges_base( double* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4697,7 +4701,7 @@ void LAPACK_cgges3_base( float* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4720,7 +4724,7 @@ void LAPACK_dgges3_base( double* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4743,7 +4747,7 @@ void LAPACK_sgges3_base( float* work, lapack_int const* lwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4766,7 +4770,7 @@ void LAPACK_zgges3_base( double* rwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4792,7 +4796,7 @@ void LAPACK_cggesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4818,7 +4822,7 @@ void LAPACK_dggesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4844,7 +4848,7 @@ void LAPACK_sggesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4870,7 +4874,7 @@ void LAPACK_zggesx_base( lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4893,7 +4897,7 @@ void LAPACK_cggev_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4916,7 +4920,7 @@ void LAPACK_dggev_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4939,7 +4943,7 @@ void LAPACK_sggev_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4962,7 +4966,7 @@ void LAPACK_zggev_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -4985,7 +4989,7 @@ void LAPACK_cggev3_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5008,7 +5012,7 @@ void LAPACK_dggev3_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5031,7 +5035,7 @@ void LAPACK_sggev3_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5054,7 +5058,7 @@ void LAPACK_zggev3_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5084,7 +5088,7 @@ void LAPACK_cggevx_base( lapack_int* iwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5114,7 +5118,7 @@ void LAPACK_dggevx_base( lapack_int* iwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5144,7 +5148,7 @@ void LAPACK_sggevx_base( lapack_int* iwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5174,7 +5178,7 @@ void LAPACK_zggevx_base( lapack_int* iwork, lapack_logical* BWORK, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5238,7 +5242,7 @@ void LAPACK_cgghd3_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5258,7 +5262,7 @@ void LAPACK_dgghd3_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5278,7 +5282,7 @@ void LAPACK_sgghd3_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5298,7 +5302,7 @@ void LAPACK_zgghd3_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5317,7 +5321,7 @@ void LAPACK_cgghrd_base( lapack_complex_float* Z, lapack_int const* ldz, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5336,7 +5340,7 @@ void LAPACK_dgghrd_base( double* Z, lapack_int const* ldz, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5355,7 +5359,7 @@ void LAPACK_sgghrd_base( float* Z, lapack_int const* ldz, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5374,7 +5378,7 @@ void LAPACK_zgghrd_base( lapack_complex_double* Z, lapack_int const* ldz, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5521,7 +5525,7 @@ lapack_int LAPACK_cggsvd_base( lapack_complex_float* work, float* rwork, lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5543,7 +5547,7 @@ lapack_int LAPACK_sggsvd_base( float* q, lapack_int const* ldq, float* work, lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5565,7 +5569,7 @@ lapack_int LAPACK_dggsvd_base( double* q, lapack_int const* ldq, double* work, lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5588,7 +5592,7 @@ lapack_int LAPACK_zggsvd_base( lapack_complex_double* work, double* rwork, lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5613,7 +5617,7 @@ void LAPACK_cggsvd3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5637,7 +5641,7 @@ void LAPACK_dggsvd3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5661,7 +5665,7 @@ void LAPACK_sggsvd3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5686,7 +5690,7 @@ void LAPACK_zggsvd3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5709,7 +5713,7 @@ lapack_int LAPACK_sggsvp_base( lapack_int* iwork, float* tau, float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5732,7 +5736,7 @@ lapack_int LAPACK_dggsvp_base( lapack_int* iwork, double* tau, double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5754,7 +5758,7 @@ lapack_int LAPACK_cggsvp_base( lapack_int* iwork, float* rwork, lapack_complex_float* tau, lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5776,7 +5780,7 @@ lapack_int LAPACK_zggsvp_base( lapack_int* iwork, double* rwork, lapack_complex_double* tau, lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5802,7 +5806,7 @@ void LAPACK_cggsvp3_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5827,7 +5831,7 @@ void LAPACK_dggsvp3_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5852,7 +5856,7 @@ void LAPACK_sggsvp3_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5878,7 +5882,7 @@ void LAPACK_zggsvp3_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5900,7 +5904,7 @@ void LAPACK_cgtcon_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5923,7 +5927,7 @@ void LAPACK_dgtcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5946,7 +5950,7 @@ void LAPACK_sgtcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5968,7 +5972,7 @@ void LAPACK_zgtcon_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -5996,7 +6000,7 @@ void LAPACK_cgtrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6024,7 +6028,7 @@ void LAPACK_dgtrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6052,7 +6056,7 @@ void LAPACK_sgtrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6080,7 +6084,7 @@ void LAPACK_zgtrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6145,7 +6149,7 @@ void LAPACK_cgtsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6174,7 +6178,7 @@ void LAPACK_dgtsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6203,7 +6207,7 @@ void LAPACK_sgtsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6232,7 +6236,7 @@ void LAPACK_zgtsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6288,7 +6292,7 @@ void LAPACK_cgttrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6308,7 +6312,7 @@ void LAPACK_dgttrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6328,7 +6332,7 @@ void LAPACK_sgttrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6348,7 +6352,7 @@ void LAPACK_zgttrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6368,7 +6372,7 @@ void LAPACK_chbev_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6388,7 +6392,7 @@ void LAPACK_zhbev_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6408,7 +6412,7 @@ void LAPACK_chbev_2stage_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6428,7 +6432,7 @@ void LAPACK_zhbev_2stage_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6449,7 +6453,7 @@ void LAPACK_chbevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6470,7 +6474,7 @@ void LAPACK_zhbevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6491,7 +6495,7 @@ void LAPACK_chbevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6512,7 +6516,7 @@ void LAPACK_zhbevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6537,7 +6541,7 @@ void LAPACK_chbevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6562,7 +6566,7 @@ void LAPACK_zhbevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6587,7 +6591,7 @@ void LAPACK_chbevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6612,7 +6616,7 @@ void LAPACK_zhbevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6632,7 +6636,7 @@ void LAPACK_chbgst_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6652,7 +6656,7 @@ void LAPACK_zhbgst_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6673,7 +6677,7 @@ void LAPACK_chbgv_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6694,7 +6698,7 @@ void LAPACK_zhbgv_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6716,7 +6720,7 @@ void LAPACK_chbgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6738,7 +6742,7 @@ void LAPACK_zhbgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6764,7 +6768,7 @@ void LAPACK_chbgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6790,7 +6794,7 @@ void LAPACK_zhbgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6810,7 +6814,7 @@ void LAPACK_chbtrd_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6830,7 +6834,7 @@ void LAPACK_zhbtrd_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6849,7 +6853,7 @@ void LAPACK_checon_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6868,7 +6872,7 @@ void LAPACK_zhecon_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6888,7 +6892,7 @@ void LAPACK_checon_3_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6908,7 +6912,7 @@ void LAPACK_zhecon_3_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6928,7 +6932,7 @@ void LAPACK_cheequb_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6948,7 +6952,7 @@ void LAPACK_zheequb_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6967,7 +6971,7 @@ void LAPACK_cheev_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -6986,7 +6990,7 @@ void LAPACK_zheev_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7005,7 +7009,7 @@ void LAPACK_cheev_2stage_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7024,7 +7028,7 @@ void LAPACK_zheev_2stage_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7044,7 +7048,7 @@ void LAPACK_cheevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7064,7 +7068,7 @@ void LAPACK_zheevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7084,7 +7088,7 @@ void LAPACK_cheevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7104,7 +7108,7 @@ void LAPACK_zheevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7128,7 +7132,7 @@ void LAPACK_cheevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7152,7 +7156,7 @@ void LAPACK_zheevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7176,7 +7180,7 @@ void LAPACK_cheevr_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7200,7 +7204,7 @@ void LAPACK_zheevr_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7224,7 +7228,7 @@ void LAPACK_cheevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7248,7 +7252,7 @@ void LAPACK_zheevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7272,7 +7276,7 @@ void LAPACK_cheevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7296,7 +7300,7 @@ void LAPACK_zheevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7313,7 +7317,7 @@ void LAPACK_chegst_base( const lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7330,7 +7334,7 @@ void LAPACK_zhegst_base( const lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7350,7 +7354,7 @@ void LAPACK_chegv_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7370,7 +7374,7 @@ void LAPACK_zhegv_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7390,7 +7394,7 @@ void LAPACK_chegv_2stage_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7410,7 +7414,7 @@ void LAPACK_zhegv_2stage_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7431,7 +7435,7 @@ void LAPACK_chegvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7452,7 +7456,7 @@ void LAPACK_zhegvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7477,7 +7481,7 @@ void LAPACK_chegvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7502,7 +7506,7 @@ void LAPACK_zhegvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7525,7 +7529,7 @@ void LAPACK_cherfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7548,7 +7552,7 @@ void LAPACK_zherfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7575,7 +7579,7 @@ void LAPACK_cherfsx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7602,7 +7606,7 @@ void LAPACK_zherfsx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7620,7 +7624,7 @@ void LAPACK_chesv_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7638,7 +7642,7 @@ void LAPACK_zhesv_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7656,7 +7660,7 @@ void LAPACK_chesv_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7674,7 +7678,7 @@ void LAPACK_zhesv_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7693,7 +7697,7 @@ void LAPACK_chesv_aa_2stage_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7712,7 +7716,7 @@ void LAPACK_zhesv_aa_2stage_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7731,7 +7735,7 @@ void LAPACK_chesv_rk_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7750,7 +7754,7 @@ void LAPACK_zhesv_rk_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7768,7 +7772,7 @@ void LAPACK_chesv_rook_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7786,7 +7790,7 @@ void LAPACK_zhesv_rook_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7810,7 +7814,7 @@ void LAPACK_chesvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7834,7 +7838,7 @@ void LAPACK_zhesvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7863,7 +7867,7 @@ void LAPACK_chesvxx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7892,7 +7896,7 @@ void LAPACK_zhesvxx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7907,7 +7911,7 @@ void LAPACK_cheswapr_base( lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7922,7 +7926,7 @@ void LAPACK_zheswapr_base( lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7942,7 +7946,7 @@ void LAPACK_chetrd_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7962,7 +7966,7 @@ void LAPACK_zhetrd_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -7983,7 +7987,7 @@ void LAPACK_chetrd_2stage_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8004,7 +8008,7 @@ void LAPACK_zhetrd_2stage_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8021,7 +8025,7 @@ void LAPACK_chetrf_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8038,7 +8042,7 @@ void LAPACK_zhetrf_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8055,7 +8059,7 @@ void LAPACK_chetrf_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8072,7 +8076,7 @@ void LAPACK_zhetrf_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8090,7 +8094,7 @@ void LAPACK_chetrf_aa_2stage_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8108,7 +8112,7 @@ void LAPACK_zhetrf_aa_2stage_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8126,7 +8130,7 @@ void LAPACK_chetrf_rk_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8144,7 +8148,7 @@ void LAPACK_zhetrf_rk_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8161,7 +8165,7 @@ void LAPACK_chetrf_rook_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8178,7 +8182,7 @@ void LAPACK_zhetrf_rook_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8195,7 +8199,7 @@ void LAPACK_chetri_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8212,7 +8216,7 @@ void LAPACK_zhetri_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8229,7 +8233,7 @@ void LAPACK_chetri2_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8246,7 +8250,7 @@ void LAPACK_zhetri2_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8263,7 +8267,7 @@ void LAPACK_chetri2x_base( lapack_complex_float* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8280,7 +8284,7 @@ void LAPACK_zhetri2x_base( lapack_complex_double* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8298,7 +8302,7 @@ void LAPACK_chetri_3_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8316,7 +8320,7 @@ void LAPACK_zhetri_3_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8333,7 +8337,7 @@ void LAPACK_chetrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8350,7 +8354,7 @@ void LAPACK_zhetrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8368,7 +8372,7 @@ void LAPACK_chetrs2_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8386,7 +8390,7 @@ void LAPACK_zhetrs2_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8404,7 +8408,7 @@ void LAPACK_chetrs_3_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8422,7 +8426,7 @@ void LAPACK_zhetrs_3_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8440,7 +8444,7 @@ void LAPACK_chetrs_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8458,7 +8462,7 @@ void LAPACK_zhetrs_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8476,7 +8480,7 @@ void LAPACK_chetrs_aa_2stage_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8494,7 +8498,7 @@ void LAPACK_zhetrs_aa_2stage_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8511,7 +8515,7 @@ void LAPACK_chetrs_rook_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8528,7 +8532,7 @@ void LAPACK_zhetrs_rook_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8546,7 +8550,7 @@ void LAPACK_chfrk_base( float const* beta, lapack_complex_float* C #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8564,7 +8568,7 @@ void LAPACK_zhfrk_base( double const* beta, lapack_complex_double* C #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8587,7 +8591,7 @@ void LAPACK_chgeqz_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8610,7 +8614,7 @@ void LAPACK_dhgeqz_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8633,7 +8637,7 @@ void LAPACK_shgeqz_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8656,7 +8660,7 @@ void LAPACK_zhgeqz_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8675,7 +8679,7 @@ void LAPACK_chpcon_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8694,7 +8698,7 @@ void LAPACK_zhpcon_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8714,7 +8718,7 @@ void LAPACK_chpev_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8734,7 +8738,7 @@ void LAPACK_zhpev_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8755,7 +8759,7 @@ void LAPACK_chpevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8776,7 +8780,7 @@ void LAPACK_zhpevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8800,7 +8804,7 @@ void LAPACK_chpevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8824,7 +8828,7 @@ void LAPACK_zhpevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8841,7 +8845,7 @@ void LAPACK_chpgst_base( lapack_complex_float const* BP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8858,7 +8862,7 @@ void LAPACK_zhpgst_base( lapack_complex_double const* BP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8879,7 +8883,7 @@ void LAPACK_chpgv_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8900,7 +8904,7 @@ void LAPACK_zhpgv_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8922,7 +8926,7 @@ void LAPACK_chpgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8944,7 +8948,7 @@ void LAPACK_zhpgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8969,7 +8973,7 @@ void LAPACK_chpgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -8994,7 +8998,7 @@ void LAPACK_zhpgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9017,7 +9021,7 @@ void LAPACK_chprfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9040,7 +9044,7 @@ void LAPACK_zhprfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9057,7 +9061,7 @@ void LAPACK_chpsv_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9074,7 +9078,7 @@ void LAPACK_zhpsv_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9098,7 +9102,7 @@ void LAPACK_chpsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9122,7 +9126,7 @@ void LAPACK_zhpsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9141,7 +9145,7 @@ void LAPACK_chptrd_base( lapack_complex_float* tau, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9160,7 +9164,7 @@ void LAPACK_zhptrd_base( lapack_complex_double* tau, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9176,7 +9180,7 @@ void LAPACK_chptrf_base( lapack_complex_float* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9192,7 +9196,7 @@ void LAPACK_zhptrf_base( lapack_complex_double* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9209,7 +9213,7 @@ void LAPACK_chptri_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9226,7 +9230,7 @@ void LAPACK_zhptri_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9243,7 +9247,7 @@ void LAPACK_chptrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9260,7 +9264,7 @@ void LAPACK_zhptrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9282,7 +9286,7 @@ void LAPACK_chsein_base( float* rwork, lapack_int* IFAILL, lapack_int* IFAILR, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9304,7 +9308,7 @@ void LAPACK_dhsein_base( double* work, lapack_int* IFAILL, lapack_int* IFAILR, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9326,7 +9330,7 @@ void LAPACK_shsein_base( float* work, lapack_int* IFAILL, lapack_int* IFAILR, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9348,7 +9352,7 @@ void LAPACK_zhsein_base( double* rwork, lapack_int* IFAILL, lapack_int* IFAILR, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9367,7 +9371,7 @@ void LAPACK_chseqr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9387,7 +9391,7 @@ void LAPACK_dhseqr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9407,7 +9411,7 @@ void LAPACK_shseqr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9426,7 +9430,7 @@ void LAPACK_zhseqr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9480,7 +9484,7 @@ void LAPACK_clacp2_base( float const* A, lapack_int const* lda, lapack_complex_float* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9496,7 +9500,7 @@ void LAPACK_zlacp2_base( double const* A, lapack_int const* lda, lapack_complex_double* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9512,7 +9516,7 @@ void LAPACK_clacpy_base( lapack_complex_float const* A, lapack_int const* lda, lapack_complex_float* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9528,7 +9532,7 @@ void LAPACK_dlacpy_base( double const* A, lapack_int const* lda, double* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9544,7 +9548,7 @@ void LAPACK_slacpy_base( float const* A, lapack_int const* lda, float* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9560,7 +9564,7 @@ void LAPACK_zlacpy_base( lapack_complex_double const* A, lapack_int const* lda, lapack_complex_double* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9697,7 +9701,7 @@ void LAPACK_zlagsy( double LAPACK_dlamch_base( char const* cmach #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9710,7 +9714,7 @@ double LAPACK_dlamch_base( lapack_float_return LAPACK_slamch_base( char const* cmach #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9726,7 +9730,7 @@ lapack_float_return LAPACK_clangb_base( lapack_complex_float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9742,7 +9746,7 @@ double LAPACK_dlangb_base( double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9758,7 +9762,7 @@ lapack_float_return LAPACK_slangb_base( float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9774,7 +9778,7 @@ double LAPACK_zlangb_base( lapack_complex_double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9790,7 +9794,7 @@ lapack_float_return LAPACK_clange_base( lapack_complex_float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9806,7 +9810,7 @@ double LAPACK_dlange_base( double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9822,7 +9826,7 @@ lapack_float_return LAPACK_slange_base( float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9838,7 +9842,7 @@ double LAPACK_zlange_base( lapack_complex_double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9855,7 +9859,7 @@ lapack_float_return LAPACK_clangt_base( lapack_complex_float const* D, lapack_complex_float const* DU #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9872,7 +9876,7 @@ double LAPACK_dlangt_base( double const* D, double const* DU #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9889,7 +9893,7 @@ lapack_float_return LAPACK_slangt_base( float const* D, float const* DU #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9906,7 +9910,7 @@ double LAPACK_zlangt_base( lapack_complex_double const* D, lapack_complex_double const* DU #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9922,7 +9926,7 @@ lapack_float_return LAPACK_clanhb_base( lapack_complex_float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9938,7 +9942,7 @@ double LAPACK_zlanhb_base( lapack_complex_double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9954,7 +9958,7 @@ lapack_float_return LAPACK_clanhe_base( lapack_complex_float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9970,7 +9974,7 @@ double LAPACK_zlanhe_base( lapack_complex_double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -9986,7 +9990,7 @@ lapack_float_return LAPACK_clanhp_base( lapack_complex_float const* AP, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10002,7 +10006,7 @@ double LAPACK_zlanhp_base( lapack_complex_double const* AP, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10018,7 +10022,7 @@ lapack_float_return LAPACK_clanhs_base( lapack_complex_float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10034,7 +10038,7 @@ double LAPACK_dlanhs_base( double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10050,7 +10054,7 @@ lapack_float_return LAPACK_slanhs_base( float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10066,7 +10070,7 @@ double LAPACK_zlanhs_base( lapack_complex_double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10082,7 +10086,7 @@ lapack_float_return LAPACK_clanht_base( float const* D, lapack_complex_float const* E #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10098,7 +10102,7 @@ double LAPACK_zlanht_base( double const* D, lapack_complex_double const* E #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10114,7 +10118,7 @@ lapack_float_return LAPACK_clansb_base( lapack_complex_float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10130,7 +10134,7 @@ double LAPACK_dlansb_base( double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10146,7 +10150,7 @@ lapack_float_return LAPACK_slansb_base( float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10162,7 +10166,7 @@ double LAPACK_zlansb_base( lapack_complex_double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10178,7 +10182,7 @@ lapack_float_return LAPACK_clansp_base( lapack_complex_float const* AP, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10194,7 +10198,7 @@ double LAPACK_dlansp_base( double const* AP, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10210,7 +10214,7 @@ lapack_float_return LAPACK_slansp_base( float const* AP, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10226,7 +10230,7 @@ double LAPACK_zlansp_base( lapack_complex_double const* AP, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10242,7 +10246,7 @@ double LAPACK_dlanst_base( double const* D, double const* E #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10258,7 +10262,7 @@ lapack_float_return LAPACK_slanst_base( float const* D, float const* E #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10274,7 +10278,7 @@ lapack_float_return LAPACK_clansy_base( lapack_complex_float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10290,7 +10294,7 @@ double LAPACK_dlansy_base( double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10306,7 +10310,7 @@ lapack_float_return LAPACK_slansy_base( float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10322,7 +10326,7 @@ double LAPACK_zlansy_base( lapack_complex_double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10338,7 +10342,7 @@ lapack_float_return LAPACK_clantb_base( lapack_complex_float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10354,7 +10358,7 @@ double LAPACK_dlantb_base( double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10370,7 +10374,7 @@ lapack_float_return LAPACK_slantb_base( float const* AB, lapack_int const* ldab, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10386,7 +10390,7 @@ double LAPACK_zlantb_base( lapack_complex_double const* AB, lapack_int const* ldab, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10402,7 +10406,7 @@ lapack_float_return LAPACK_clantp_base( lapack_complex_float const* AP, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10418,7 +10422,7 @@ double LAPACK_dlantp_base( double const* AP, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10434,7 +10438,7 @@ lapack_float_return LAPACK_slantp_base( float const* AP, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10450,7 +10454,7 @@ double LAPACK_zlantp_base( lapack_complex_double const* AP, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10466,7 +10470,7 @@ lapack_float_return LAPACK_clantr_base( lapack_complex_float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10482,7 +10486,7 @@ double LAPACK_dlantr_base( double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10498,7 +10502,7 @@ lapack_float_return LAPACK_slantr_base( float const* A, lapack_int const* lda, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10514,7 +10518,7 @@ double LAPACK_zlantr_base( lapack_complex_double const* A, lapack_int const* lda, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10610,7 +10614,7 @@ void LAPACK_clarf_base( lapack_complex_float* C, lapack_int const* ldc, lapack_complex_float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10628,7 +10632,7 @@ void LAPACK_dlarf_base( double* C, lapack_int const* ldc, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10646,7 +10650,7 @@ void LAPACK_slarf_base( float* C, lapack_int const* ldc, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10664,7 +10668,7 @@ void LAPACK_zlarf_base( lapack_complex_double* C, lapack_int const* ldc, lapack_complex_double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10682,7 +10686,7 @@ void LAPACK_clarfb_base( lapack_complex_float* C, lapack_int const* ldc, lapack_complex_float* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10700,7 +10704,7 @@ void LAPACK_dlarfb_base( double* C, lapack_int const* ldc, double* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10718,7 +10722,7 @@ void LAPACK_slarfb_base( float* C, lapack_int const* ldc, float* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10736,7 +10740,7 @@ void LAPACK_zlarfb_base( lapack_complex_double* C, lapack_int const* ldc, lapack_complex_double* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10781,7 +10785,7 @@ void LAPACK_clarft_base( lapack_complex_float const* tau, lapack_complex_float* T, lapack_int const* ldt #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10798,7 +10802,7 @@ void LAPACK_dlarft_base( double const* tau, double* T, lapack_int const* ldt #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10815,7 +10819,7 @@ void LAPACK_slarft_base( float const* tau, float* T, lapack_int const* ldt #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10832,7 +10836,7 @@ void LAPACK_zlarft_base( lapack_complex_double const* tau, lapack_complex_double* T, lapack_int const* ldt #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10850,7 +10854,7 @@ void LAPACK_clarfx_base( lapack_complex_float* C, lapack_int const* ldc, lapack_complex_float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10868,7 +10872,7 @@ void LAPACK_dlarfx_base( double* C, lapack_int const* ldc, double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10886,7 +10890,7 @@ void LAPACK_slarfx_base( float* C, lapack_int const* ldc, float* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10904,7 +10908,7 @@ void LAPACK_zlarfx_base( lapack_complex_double* C, lapack_int const* ldc, lapack_complex_double* work #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10974,7 +10978,7 @@ void LAPACK_clascl_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -10992,7 +10996,7 @@ void LAPACK_dlascl_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11010,7 +11014,7 @@ void LAPACK_slascl_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11028,7 +11032,7 @@ void LAPACK_zlascl_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11045,7 +11049,7 @@ void LAPACK_claset_base( lapack_complex_float const* beta, lapack_complex_float* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11062,7 +11066,7 @@ void LAPACK_dlaset_base( double const* beta, double* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11079,7 +11083,7 @@ void LAPACK_slaset_base( float const* beta, float* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11096,7 +11100,7 @@ void LAPACK_zlaset_base( lapack_complex_double const* beta, lapack_complex_double* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11112,7 +11116,7 @@ void LAPACK_dlasrt_base( double* D, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11128,7 +11132,7 @@ void LAPACK_slasrt_base( float* D, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11198,7 +11202,7 @@ void LAPACK_clatms_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11220,7 +11224,7 @@ void LAPACK_dlatms_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11242,7 +11246,7 @@ void LAPACK_slatms_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11264,7 +11268,7 @@ void LAPACK_zlatms_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11280,7 +11284,7 @@ void LAPACK_clauum_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11296,7 +11300,7 @@ void LAPACK_dlauum_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11312,7 +11316,7 @@ void LAPACK_slauum_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11328,7 +11332,7 @@ void LAPACK_zlauum_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11351,7 +11355,7 @@ void LAPACK_dopgtr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11370,7 +11374,7 @@ void LAPACK_sopgtr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11389,7 +11393,7 @@ void LAPACK_dopmtr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11408,7 +11412,7 @@ void LAPACK_sopmtr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11434,7 +11438,7 @@ void LAPACK_dorbdb_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11460,7 +11464,7 @@ void LAPACK_sorbdb_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11486,7 +11490,7 @@ void LAPACK_dorcsd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11512,7 +11516,7 @@ void LAPACK_sorcsd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11535,7 +11539,7 @@ void LAPACK_dorcsd2by1_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11558,7 +11562,7 @@ void LAPACK_sorcsd2by1_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11576,7 +11580,7 @@ void LAPACK_dorgbr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11594,7 +11598,7 @@ void LAPACK_sorgbr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11692,7 +11696,7 @@ void LAPACK_dorgtr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11710,7 +11714,7 @@ void LAPACK_sorgtr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11763,7 +11767,7 @@ void LAPACK_dormbr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11782,7 +11786,7 @@ void LAPACK_sormbr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11801,7 +11805,7 @@ void LAPACK_dormhr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11820,7 +11824,7 @@ void LAPACK_sormhr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11839,7 +11843,7 @@ void LAPACK_dormlq_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11858,7 +11862,7 @@ void LAPACK_sormlq_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11877,7 +11881,7 @@ void LAPACK_dormql_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11896,7 +11900,7 @@ void LAPACK_sormql_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11915,7 +11919,7 @@ void LAPACK_dormqr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11934,7 +11938,7 @@ void LAPACK_sormqr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11953,7 +11957,7 @@ void LAPACK_dormrq_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11972,7 +11976,7 @@ void LAPACK_sormrq_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -11991,7 +11995,7 @@ void LAPACK_dormrz_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12010,7 +12014,7 @@ void LAPACK_sormrz_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12029,7 +12033,7 @@ void LAPACK_dormtr_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12048,7 +12052,7 @@ void LAPACK_sormtr_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12068,7 +12072,7 @@ void LAPACK_cpbcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12088,7 +12092,7 @@ void LAPACK_dpbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12108,7 +12112,7 @@ void LAPACK_spbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12128,7 +12132,7 @@ void LAPACK_zpbcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12147,7 +12151,7 @@ void LAPACK_cpbequ_base( float* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12166,7 +12170,7 @@ void LAPACK_dpbequ_base( double* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12185,7 +12189,7 @@ void LAPACK_spbequ_base( float* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12204,7 +12208,7 @@ void LAPACK_zpbequ_base( double* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12227,7 +12231,7 @@ void LAPACK_cpbrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12250,7 +12254,7 @@ void LAPACK_dpbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12273,7 +12277,7 @@ void LAPACK_spbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12296,7 +12300,7 @@ void LAPACK_zpbrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12312,7 +12316,7 @@ void LAPACK_cpbstf_base( lapack_complex_float* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12328,7 +12332,7 @@ void LAPACK_dpbstf_base( double* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12344,7 +12348,7 @@ void LAPACK_spbstf_base( float* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12360,7 +12364,7 @@ void LAPACK_zpbstf_base( lapack_complex_double* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12377,7 +12381,7 @@ void LAPACK_cpbsv_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12394,7 +12398,7 @@ void LAPACK_dpbsv_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12411,7 +12415,7 @@ void LAPACK_spbsv_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12428,7 +12432,7 @@ void LAPACK_zpbsv_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12454,7 +12458,7 @@ void LAPACK_cpbsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12480,7 +12484,7 @@ void LAPACK_dpbsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12506,7 +12510,7 @@ void LAPACK_spbsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12532,7 +12536,7 @@ void LAPACK_zpbsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12548,7 +12552,7 @@ void LAPACK_cpbtrf_base( lapack_complex_float* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12564,7 +12568,7 @@ void LAPACK_dpbtrf_base( double* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12580,7 +12584,7 @@ void LAPACK_spbtrf_base( float* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12596,7 +12600,7 @@ void LAPACK_zpbtrf_base( lapack_complex_double* AB, lapack_int const* ldab, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12613,7 +12617,7 @@ void LAPACK_cpbtrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12630,7 +12634,7 @@ void LAPACK_dpbtrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12647,7 +12651,7 @@ void LAPACK_spbtrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12664,7 +12668,7 @@ void LAPACK_zpbtrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12680,7 +12684,7 @@ void LAPACK_cpftrf_base( lapack_complex_float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12696,7 +12700,7 @@ void LAPACK_dpftrf_base( double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12712,7 +12716,7 @@ void LAPACK_spftrf_base( float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12728,7 +12732,7 @@ void LAPACK_zpftrf_base( lapack_complex_double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12744,7 +12748,7 @@ void LAPACK_cpftri_base( lapack_complex_float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12760,7 +12764,7 @@ void LAPACK_dpftri_base( double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12776,7 +12780,7 @@ void LAPACK_spftri_base( float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12792,7 +12796,7 @@ void LAPACK_zpftri_base( lapack_complex_double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12809,7 +12813,7 @@ void LAPACK_cpftrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12826,7 +12830,7 @@ void LAPACK_dpftrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12843,7 +12847,7 @@ void LAPACK_spftrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12860,7 +12864,7 @@ void LAPACK_zpftrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12880,7 +12884,7 @@ void LAPACK_cpocon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12900,7 +12904,7 @@ void LAPACK_dpocon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12920,7 +12924,7 @@ void LAPACK_spocon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -12940,7 +12944,7 @@ void LAPACK_zpocon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13035,7 +13039,7 @@ void LAPACK_cporfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13058,7 +13062,7 @@ void LAPACK_dporfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13081,7 +13085,7 @@ void LAPACK_sporfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13104,7 +13108,7 @@ void LAPACK_zporfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13131,7 +13135,7 @@ void LAPACK_cporfsx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13158,7 +13162,7 @@ void LAPACK_dporfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13185,7 +13189,7 @@ void LAPACK_sporfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13212,7 +13216,7 @@ void LAPACK_zporfsx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13229,7 +13233,7 @@ void LAPACK_cposv_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13246,7 +13250,7 @@ void LAPACK_dposv_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13263,7 +13267,7 @@ void LAPACK_sposv_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13280,7 +13284,7 @@ void LAPACK_zposv_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13300,7 +13304,7 @@ void LAPACK_dsposv_base( float* swork, lapack_int* iter, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13321,7 +13325,7 @@ void LAPACK_zcposv_base( double* rwork, lapack_int* iter, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13347,7 +13351,7 @@ void LAPACK_cposvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13373,7 +13377,7 @@ void LAPACK_dposvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13399,7 +13403,7 @@ void LAPACK_sposvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13425,7 +13429,7 @@ void LAPACK_zposvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13454,7 +13458,7 @@ void LAPACK_cposvxx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13483,7 +13487,7 @@ void LAPACK_dposvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13512,7 +13516,7 @@ void LAPACK_sposvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13541,7 +13545,7 @@ void LAPACK_zposvxx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13557,7 +13561,7 @@ void LAPACK_cpotf2_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13573,7 +13577,7 @@ void LAPACK_dpotf2_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13589,7 +13593,7 @@ void LAPACK_spotf2_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13605,7 +13609,7 @@ void LAPACK_zpotf2_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13621,7 +13625,7 @@ void LAPACK_cpotrf_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13637,7 +13641,7 @@ void LAPACK_dpotrf_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13653,7 +13657,7 @@ void LAPACK_spotrf_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13669,7 +13673,7 @@ void LAPACK_zpotrf_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13685,7 +13689,7 @@ void LAPACK_cpotrf2_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13701,7 +13705,7 @@ void LAPACK_dpotrf2_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13717,7 +13721,7 @@ void LAPACK_spotrf2_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13733,7 +13737,7 @@ void LAPACK_zpotrf2_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13749,7 +13753,7 @@ void LAPACK_cpotri_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13765,7 +13769,7 @@ void LAPACK_dpotri_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13781,7 +13785,7 @@ void LAPACK_spotri_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13797,7 +13801,7 @@ void LAPACK_zpotri_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13814,7 +13818,7 @@ void LAPACK_cpotrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13831,7 +13835,7 @@ void LAPACK_dpotrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13848,7 +13852,7 @@ void LAPACK_spotrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13865,7 +13869,7 @@ void LAPACK_zpotrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13885,7 +13889,7 @@ void LAPACK_cppcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13905,7 +13909,7 @@ void LAPACK_dppcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13925,7 +13929,7 @@ void LAPACK_sppcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13945,7 +13949,7 @@ void LAPACK_zppcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13964,7 +13968,7 @@ void LAPACK_cppequ_base( float* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -13983,7 +13987,7 @@ void LAPACK_dppequ_base( double* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14002,7 +14006,7 @@ void LAPACK_sppequ_base( float* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14021,7 +14025,7 @@ void LAPACK_zppequ_base( double* amax, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14044,7 +14048,7 @@ void LAPACK_cpprfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14067,7 +14071,7 @@ void LAPACK_dpprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14090,7 +14094,7 @@ void LAPACK_spprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14113,7 +14117,7 @@ void LAPACK_zpprfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14130,7 +14134,7 @@ void LAPACK_cppsv_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14147,7 +14151,7 @@ void LAPACK_dppsv_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14164,7 +14168,7 @@ void LAPACK_sppsv_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14181,7 +14185,7 @@ void LAPACK_zppsv_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14207,7 +14211,7 @@ void LAPACK_cppsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14233,7 +14237,7 @@ void LAPACK_dppsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14259,7 +14263,7 @@ void LAPACK_sppsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14285,7 +14289,7 @@ void LAPACK_zppsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14301,7 +14305,7 @@ void LAPACK_cpptrf_base( lapack_complex_float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14317,7 +14321,7 @@ void LAPACK_dpptrf_base( double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14333,7 +14337,7 @@ void LAPACK_spptrf_base( float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14349,7 +14353,7 @@ void LAPACK_zpptrf_base( lapack_complex_double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14365,7 +14369,7 @@ void LAPACK_cpptri_base( lapack_complex_float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14381,7 +14385,7 @@ void LAPACK_dpptri_base( double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14397,7 +14401,7 @@ void LAPACK_spptri_base( float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14413,7 +14417,7 @@ void LAPACK_zpptri_base( lapack_complex_double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14430,7 +14434,7 @@ void LAPACK_cpptrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14447,7 +14451,7 @@ void LAPACK_dpptrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14464,7 +14468,7 @@ void LAPACK_spptrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14481,7 +14485,7 @@ void LAPACK_zpptrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14499,7 +14503,7 @@ void LAPACK_cpstrf_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14517,7 +14521,7 @@ void LAPACK_dpstrf_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14535,7 +14539,7 @@ void LAPACK_spstrf_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14553,7 +14557,7 @@ void LAPACK_zpstrf_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14612,7 +14616,7 @@ void LAPACK_cpteqr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14631,7 +14635,7 @@ void LAPACK_dpteqr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14650,7 +14654,7 @@ void LAPACK_spteqr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14669,7 +14673,7 @@ void LAPACK_zpteqr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14694,7 +14698,7 @@ void LAPACK_cptrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14747,7 +14751,7 @@ void LAPACK_zptrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14805,7 +14809,7 @@ void LAPACK_cptsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14830,7 +14834,7 @@ void LAPACK_dptsvx_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14855,7 +14859,7 @@ void LAPACK_sptsvx_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14881,7 +14885,7 @@ void LAPACK_zptsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14927,7 +14931,7 @@ void LAPACK_cpttrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14961,7 +14965,7 @@ void LAPACK_zpttrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14980,7 +14984,7 @@ void LAPACK_dsbev_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -14999,7 +15003,7 @@ void LAPACK_ssbev_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15018,7 +15022,7 @@ void LAPACK_dsbev_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15037,7 +15041,7 @@ void LAPACK_ssbev_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15057,7 +15061,7 @@ void LAPACK_dsbevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15077,7 +15081,7 @@ void LAPACK_ssbevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15097,7 +15101,7 @@ void LAPACK_dsbevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15117,7 +15121,7 @@ void LAPACK_ssbevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15141,7 +15145,7 @@ void LAPACK_dsbevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15165,7 +15169,7 @@ void LAPACK_ssbevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15189,7 +15193,7 @@ void LAPACK_dsbevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15213,7 +15217,7 @@ void LAPACK_ssbevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15232,7 +15236,7 @@ void LAPACK_dsbgst_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15251,7 +15255,7 @@ void LAPACK_ssbgst_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15271,7 +15275,7 @@ void LAPACK_dsbgv_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15291,7 +15295,7 @@ void LAPACK_ssbgv_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15312,7 +15316,7 @@ void LAPACK_dsbgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15333,7 +15337,7 @@ void LAPACK_ssbgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15358,7 +15362,7 @@ void LAPACK_dsbgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15383,7 +15387,7 @@ void LAPACK_ssbgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15403,7 +15407,7 @@ void LAPACK_dsbtrd_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15423,7 +15427,7 @@ void LAPACK_ssbtrd_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15441,7 +15445,7 @@ void LAPACK_dsfrk_base( double const* beta, double* C #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15459,7 +15463,7 @@ void LAPACK_ssfrk_base( float const* beta, float* C #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15478,7 +15482,7 @@ void LAPACK_cspcon_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15498,7 +15502,7 @@ void LAPACK_dspcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15518,7 +15522,7 @@ void LAPACK_sspcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15537,7 +15541,7 @@ void LAPACK_zspcon_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15556,7 +15560,7 @@ void LAPACK_dspev_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15575,7 +15579,7 @@ void LAPACK_sspev_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15595,7 +15599,7 @@ void LAPACK_dspevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15615,7 +15619,7 @@ void LAPACK_sspevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15638,7 +15642,7 @@ void LAPACK_dspevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15661,7 +15665,7 @@ void LAPACK_sspevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15678,7 +15682,7 @@ void LAPACK_dspgst_base( double const* BP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15695,7 +15699,7 @@ void LAPACK_sspgst_base( float const* BP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15715,7 +15719,7 @@ void LAPACK_dspgv_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15735,7 +15739,7 @@ void LAPACK_sspgv_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15756,7 +15760,7 @@ void LAPACK_dspgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15777,7 +15781,7 @@ void LAPACK_sspgvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15801,7 +15805,7 @@ void LAPACK_dspgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15825,7 +15829,7 @@ void LAPACK_sspgvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15848,7 +15852,7 @@ void LAPACK_csprfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15871,7 +15875,7 @@ void LAPACK_dsprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15894,7 +15898,7 @@ void LAPACK_ssprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15917,7 +15921,7 @@ void LAPACK_zsprfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15934,7 +15938,7 @@ void LAPACK_cspsv_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15951,7 +15955,7 @@ void LAPACK_dspsv_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15968,7 +15972,7 @@ void LAPACK_sspsv_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -15985,7 +15989,7 @@ void LAPACK_zspsv_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16009,7 +16013,7 @@ void LAPACK_cspsvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16033,7 +16037,7 @@ void LAPACK_dspsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16057,7 +16061,7 @@ void LAPACK_sspsvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16081,7 +16085,7 @@ void LAPACK_zspsvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16100,7 +16104,7 @@ void LAPACK_dsptrd_base( double* tau, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16119,7 +16123,7 @@ void LAPACK_ssptrd_base( float* tau, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16135,7 +16139,7 @@ void LAPACK_csptrf_base( lapack_complex_float* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16151,7 +16155,7 @@ void LAPACK_dsptrf_base( double* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16167,7 +16171,7 @@ void LAPACK_ssptrf_base( float* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16183,7 +16187,7 @@ void LAPACK_zsptrf_base( lapack_complex_double* AP, lapack_int* ipiv, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16200,7 +16204,7 @@ void LAPACK_csptri_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16217,7 +16221,7 @@ void LAPACK_dsptri_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16234,7 +16238,7 @@ void LAPACK_ssptri_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16251,7 +16255,7 @@ void LAPACK_zsptri_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16268,7 +16272,7 @@ void LAPACK_csptrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16285,7 +16289,7 @@ void LAPACK_dsptrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16302,7 +16306,7 @@ void LAPACK_ssptrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16319,7 +16323,7 @@ void LAPACK_zsptrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16342,7 +16346,7 @@ void LAPACK_dstebz_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16365,7 +16369,7 @@ void LAPACK_sstebz_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16386,7 +16390,7 @@ void LAPACK_cstedc_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16406,7 +16410,7 @@ void LAPACK_dstedc_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16426,7 +16430,7 @@ void LAPACK_sstedc_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16447,7 +16451,7 @@ void LAPACK_zstedc_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16471,7 +16475,7 @@ void LAPACK_cstegr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16495,7 +16499,7 @@ void LAPACK_dstegr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16519,7 +16523,7 @@ void LAPACK_sstegr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16543,7 +16547,7 @@ void LAPACK_zstegr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16610,7 +16614,7 @@ void LAPACK_cstemr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16633,7 +16637,7 @@ void LAPACK_dstemr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16656,7 +16660,7 @@ void LAPACK_sstemr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16679,7 +16683,7 @@ void LAPACK_zstemr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16698,7 +16702,7 @@ void LAPACK_csteqr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16717,7 +16721,7 @@ void LAPACK_dsteqr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16736,7 +16740,7 @@ void LAPACK_ssteqr_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16755,7 +16759,7 @@ void LAPACK_zsteqr_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16788,7 +16792,7 @@ void LAPACK_dstev_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16807,7 +16811,7 @@ void LAPACK_sstev_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16827,7 +16831,7 @@ void LAPACK_dstevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16847,7 +16851,7 @@ void LAPACK_sstevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16871,7 +16875,7 @@ void LAPACK_dstevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16895,7 +16899,7 @@ void LAPACK_sstevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16919,7 +16923,7 @@ void LAPACK_dstevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16943,7 +16947,7 @@ void LAPACK_sstevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16962,7 +16966,7 @@ void LAPACK_csycon_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -16982,7 +16986,7 @@ void LAPACK_dsycon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17002,7 +17006,7 @@ void LAPACK_ssycon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17021,7 +17025,7 @@ void LAPACK_zsycon_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17041,7 +17045,7 @@ void LAPACK_csycon_3_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17062,7 +17066,7 @@ void LAPACK_dsycon_3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17083,7 +17087,7 @@ void LAPACK_ssycon_3_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17103,7 +17107,7 @@ void LAPACK_zsycon_3_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17120,7 +17124,7 @@ void LAPACK_csyconv_base( lapack_complex_float* E, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17137,7 +17141,7 @@ void LAPACK_dsyconv_base( double* E, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17154,7 +17158,7 @@ void LAPACK_ssyconv_base( float* E, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17171,7 +17175,7 @@ void LAPACK_zsyconv_base( lapack_complex_double* E, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17191,7 +17195,7 @@ void LAPACK_csyequb_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17211,7 +17215,7 @@ void LAPACK_dsyequb_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17231,7 +17235,7 @@ void LAPACK_ssyequb_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17251,7 +17255,7 @@ void LAPACK_zsyequb_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17269,7 +17273,7 @@ void LAPACK_dsyev_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17287,7 +17291,7 @@ void LAPACK_ssyev_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17305,7 +17309,7 @@ void LAPACK_dsyev_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17323,7 +17327,7 @@ void LAPACK_ssyev_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17342,7 +17346,7 @@ void LAPACK_dsyevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17361,7 +17365,7 @@ void LAPACK_ssyevd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17380,7 +17384,7 @@ void LAPACK_dsyevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17399,7 +17403,7 @@ void LAPACK_ssyevd_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17422,7 +17426,7 @@ void LAPACK_dsyevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17445,7 +17449,7 @@ void LAPACK_ssyevr_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17468,7 +17472,7 @@ void LAPACK_dsyevr_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17491,7 +17495,7 @@ void LAPACK_ssyevr_2stage_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17514,7 +17518,7 @@ void LAPACK_dsyevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17537,7 +17541,7 @@ void LAPACK_ssyevx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17560,7 +17564,7 @@ void LAPACK_dsyevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17583,7 +17587,7 @@ void LAPACK_ssyevx_2stage_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17600,7 +17604,7 @@ void LAPACK_dsygst_base( double const* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17617,7 +17621,7 @@ void LAPACK_ssygst_base( float const* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17636,7 +17640,7 @@ void LAPACK_dsygv_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17655,7 +17659,7 @@ void LAPACK_ssygv_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17674,7 +17678,7 @@ void LAPACK_dsygv_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17693,7 +17697,7 @@ void LAPACK_ssygv_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17713,7 +17717,7 @@ void LAPACK_dsygvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17733,7 +17737,7 @@ void LAPACK_ssygvd_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17757,7 +17761,7 @@ void LAPACK_dsygvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17781,7 +17785,7 @@ void LAPACK_ssygvx_base( lapack_int* iwork, lapack_int* IFAIL, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17798,7 +17802,7 @@ void LAPACK_csyr_base( lapack_complex_float const* X, lapack_int const* incx, lapack_complex_float* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17815,7 +17819,7 @@ void LAPACK_zsyr_base( lapack_complex_double const* X, lapack_int const* incx, lapack_complex_double* A, lapack_int const* lda #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17838,7 +17842,7 @@ void LAPACK_csyrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17861,7 +17865,7 @@ void LAPACK_dsyrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17884,7 +17888,7 @@ void LAPACK_ssyrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17907,7 +17911,7 @@ void LAPACK_zsyrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17934,7 +17938,7 @@ void LAPACK_csyrfsx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17961,7 +17965,7 @@ void LAPACK_dsyrfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -17988,7 +17992,7 @@ void LAPACK_ssyrfsx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18015,7 +18019,7 @@ void LAPACK_zsyrfsx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18033,7 +18037,7 @@ void LAPACK_csysv_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18051,7 +18055,7 @@ void LAPACK_dsysv_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18069,7 +18073,7 @@ void LAPACK_ssysv_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18087,7 +18091,7 @@ void LAPACK_zsysv_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18105,7 +18109,7 @@ void LAPACK_csysv_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18123,7 +18127,7 @@ void LAPACK_dsysv_aa_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18141,7 +18145,7 @@ void LAPACK_ssysv_aa_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18159,7 +18163,7 @@ void LAPACK_zsysv_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18178,7 +18182,7 @@ void LAPACK_csysv_aa_2stage_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18197,7 +18201,7 @@ void LAPACK_dsysv_aa_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18216,7 +18220,7 @@ void LAPACK_ssysv_aa_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18235,7 +18239,7 @@ void LAPACK_zsysv_aa_2stage_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18254,7 +18258,7 @@ void LAPACK_csysv_rk_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18273,7 +18277,7 @@ void LAPACK_dsysv_rk_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18292,7 +18296,7 @@ void LAPACK_ssysv_rk_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18311,7 +18315,7 @@ void LAPACK_zsysv_rk_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18329,7 +18333,7 @@ void LAPACK_csysv_rook_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18347,7 +18351,7 @@ void LAPACK_dsysv_rook_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18365,7 +18369,7 @@ void LAPACK_ssysv_rook_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18383,7 +18387,7 @@ void LAPACK_zsysv_rook_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18407,7 +18411,7 @@ void LAPACK_csysvx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18431,7 +18435,7 @@ void LAPACK_dsysvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18455,7 +18459,7 @@ void LAPACK_ssysvx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18479,7 +18483,7 @@ void LAPACK_zsysvx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18508,7 +18512,7 @@ void LAPACK_csysvxx_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18537,7 +18541,7 @@ void LAPACK_dsysvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18566,7 +18570,7 @@ void LAPACK_ssysvxx_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18595,7 +18599,7 @@ void LAPACK_zsysvxx_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18610,7 +18614,7 @@ void LAPACK_csyswapr_base( lapack_int const* n, lapack_complex_float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18625,7 +18629,7 @@ void LAPACK_dsyswapr_base( lapack_int const* n, double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18640,7 +18644,7 @@ void LAPACK_ssyswapr_base( lapack_int const* n, float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18655,7 +18659,7 @@ void LAPACK_zsyswapr_base( lapack_int const* n, lapack_complex_double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18675,7 +18679,7 @@ void LAPACK_dsytrd_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18695,7 +18699,7 @@ void LAPACK_ssytrd_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18716,7 +18720,7 @@ void LAPACK_dsytrd_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18737,7 +18741,7 @@ void LAPACK_ssytrd_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18754,7 +18758,7 @@ void LAPACK_csytrf_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18771,7 +18775,7 @@ void LAPACK_dsytrf_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18788,7 +18792,7 @@ void LAPACK_ssytrf_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18805,7 +18809,7 @@ void LAPACK_zsytrf_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18822,7 +18826,7 @@ void LAPACK_csytrf_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18839,7 +18843,7 @@ void LAPACK_dsytrf_aa_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18856,7 +18860,7 @@ void LAPACK_ssytrf_aa_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18873,7 +18877,7 @@ void LAPACK_zsytrf_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18891,7 +18895,7 @@ void LAPACK_csytrf_aa_2stage_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18909,7 +18913,7 @@ void LAPACK_dsytrf_aa_2stage_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18927,7 +18931,7 @@ void LAPACK_ssytrf_aa_2stage_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18945,7 +18949,7 @@ void LAPACK_zsytrf_aa_2stage_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18963,7 +18967,7 @@ void LAPACK_csytrf_rk_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18981,7 +18985,7 @@ void LAPACK_dsytrf_rk_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -18999,7 +19003,7 @@ void LAPACK_ssytrf_rk_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19017,7 +19021,7 @@ void LAPACK_zsytrf_rk_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19034,7 +19038,7 @@ void LAPACK_csytrf_rook_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19051,7 +19055,7 @@ void LAPACK_dsytrf_rook_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19068,7 +19072,7 @@ void LAPACK_ssytrf_rook_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19085,7 +19089,7 @@ void LAPACK_zsytrf_rook_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19102,7 +19106,7 @@ void LAPACK_csytri_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19119,7 +19123,7 @@ void LAPACK_dsytri_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19136,7 +19140,7 @@ void LAPACK_ssytri_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19153,7 +19157,7 @@ void LAPACK_zsytri_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19170,7 +19174,7 @@ void LAPACK_csytri2_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19187,7 +19191,7 @@ void LAPACK_dsytri2_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19204,7 +19208,7 @@ void LAPACK_ssytri2_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19221,7 +19225,7 @@ void LAPACK_zsytri2_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19238,7 +19242,7 @@ void LAPACK_csytri2x_base( lapack_complex_float* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19255,7 +19259,7 @@ void LAPACK_dsytri2x_base( double* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19272,7 +19276,7 @@ void LAPACK_ssytri2x_base( float* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19289,7 +19293,7 @@ void LAPACK_zsytri2x_base( lapack_complex_double* work, lapack_int const* nb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19307,7 +19311,7 @@ void LAPACK_csytri_3_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19325,7 +19329,7 @@ void LAPACK_dsytri_3_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19343,7 +19347,7 @@ void LAPACK_ssytri_3_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19361,7 +19365,7 @@ void LAPACK_zsytri_3_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19378,7 +19382,7 @@ void LAPACK_csytrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19395,7 +19399,7 @@ void LAPACK_dsytrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19412,7 +19416,7 @@ void LAPACK_ssytrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19429,7 +19433,7 @@ void LAPACK_zsytrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19447,7 +19451,7 @@ void LAPACK_csytrs2_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19465,7 +19469,7 @@ void LAPACK_dsytrs2_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19483,7 +19487,7 @@ void LAPACK_ssytrs2_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19501,7 +19505,7 @@ void LAPACK_zsytrs2_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19519,7 +19523,7 @@ void LAPACK_csytrs_3_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19537,7 +19541,7 @@ void LAPACK_dsytrs_3_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19555,7 +19559,7 @@ void LAPACK_ssytrs_3_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19573,7 +19577,7 @@ void LAPACK_zsytrs_3_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19591,7 +19595,7 @@ void LAPACK_csytrs_aa_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19609,7 +19613,7 @@ void LAPACK_dsytrs_aa_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19627,7 +19631,7 @@ void LAPACK_ssytrs_aa_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19645,7 +19649,7 @@ void LAPACK_zsytrs_aa_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19663,7 +19667,7 @@ void LAPACK_csytrs_aa_2stage_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19681,7 +19685,7 @@ void LAPACK_dsytrs_aa_2stage_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19699,7 +19703,7 @@ void LAPACK_ssytrs_aa_2stage_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19717,7 +19721,7 @@ void LAPACK_zsytrs_aa_2stage_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19734,7 +19738,7 @@ void LAPACK_csytrs_rook_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19751,7 +19755,7 @@ void LAPACK_dsytrs_rook_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19768,7 +19772,7 @@ void LAPACK_ssytrs_rook_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19785,7 +19789,7 @@ void LAPACK_zsytrs_rook_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19804,7 +19808,7 @@ void LAPACK_ctbcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19823,7 +19827,7 @@ void LAPACK_dtbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19842,7 +19846,7 @@ void LAPACK_stbcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19861,7 +19865,7 @@ void LAPACK_ztbcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19883,7 +19887,7 @@ void LAPACK_ctbrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19905,7 +19909,7 @@ void LAPACK_dtbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19927,7 +19931,7 @@ void LAPACK_stbrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19949,7 +19953,7 @@ void LAPACK_ztbrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19966,7 +19970,7 @@ void LAPACK_ctbtrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -19983,7 +19987,7 @@ void LAPACK_dtbtrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20000,7 +20004,7 @@ void LAPACK_stbtrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20017,7 +20021,7 @@ void LAPACK_ztbtrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20034,7 +20038,7 @@ void LAPACK_ctfsm_base( lapack_complex_float const* A, lapack_complex_float* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20051,7 +20055,7 @@ void LAPACK_dtfsm_base( double const* A, double* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20068,7 +20072,7 @@ void LAPACK_stfsm_base( float const* A, float* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20085,7 +20089,7 @@ void LAPACK_ztfsm_base( lapack_complex_double const* A, lapack_complex_double* B, lapack_int const* ldb #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20101,7 +20105,7 @@ void LAPACK_ctftri_base( lapack_complex_float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20117,7 +20121,7 @@ void LAPACK_dtftri_base( double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20133,7 +20137,7 @@ void LAPACK_stftri_base( float* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20149,7 +20153,7 @@ void LAPACK_ztftri_base( lapack_complex_double* A, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20166,7 +20170,7 @@ void LAPACK_ctfttp_base( lapack_complex_float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20183,7 +20187,7 @@ void LAPACK_dtfttp_base( double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20200,7 +20204,7 @@ void LAPACK_stfttp_base( float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20217,7 +20221,7 @@ void LAPACK_ztfttp_base( lapack_complex_double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20234,7 +20238,7 @@ void LAPACK_ctfttr_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20251,7 +20255,7 @@ void LAPACK_dtfttr_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20268,7 +20272,7 @@ void LAPACK_stfttr_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20285,7 +20289,7 @@ void LAPACK_ztfttr_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20307,7 +20311,7 @@ void LAPACK_ctgevc_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20328,7 +20332,7 @@ void LAPACK_dtgevc_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20349,7 +20353,7 @@ void LAPACK_stgevc_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20371,7 +20375,7 @@ void LAPACK_ztgevc_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20500,7 +20504,7 @@ void LAPACK_ctgsja_base( lapack_complex_float* work, lapack_int* ncycle, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20525,7 +20529,7 @@ void LAPACK_dtgsja_base( double* work, lapack_int* ncycle, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20550,7 +20554,7 @@ void LAPACK_stgsja_base( float* work, lapack_int* ncycle, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20575,7 +20579,7 @@ void LAPACK_ztgsja_base( lapack_complex_double* work, lapack_int* ncycle, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20599,7 +20603,7 @@ void LAPACK_ctgsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20623,7 +20627,7 @@ void LAPACK_dtgsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20647,7 +20651,7 @@ void LAPACK_stgsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20671,7 +20675,7 @@ void LAPACK_ztgsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20696,7 +20700,7 @@ void LAPACK_ctgsyl_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20721,7 +20725,7 @@ void LAPACK_dtgsyl_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20746,7 +20750,7 @@ void LAPACK_stgsyl_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20771,7 +20775,7 @@ void LAPACK_ztgsyl_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20790,7 +20794,7 @@ void LAPACK_ctpcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20809,7 +20813,7 @@ void LAPACK_dtpcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20828,7 +20832,7 @@ void LAPACK_stpcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20847,7 +20851,7 @@ void LAPACK_ztpcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20935,7 +20939,7 @@ void LAPACK_ctpmlqt_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20955,7 +20959,7 @@ void LAPACK_dtpmlqt_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20975,7 +20979,7 @@ void LAPACK_stpmlqt_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -20995,7 +20999,7 @@ void LAPACK_ztpmlqt_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21015,7 +21019,7 @@ void LAPACK_ctpmqrt_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21035,7 +21039,7 @@ void LAPACK_dtpmqrt_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21055,7 +21059,7 @@ void LAPACK_stpmqrt_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21075,7 +21079,7 @@ void LAPACK_ztpmqrt_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21162,7 +21166,7 @@ void LAPACK_ctprfb_base( lapack_complex_float* B, lapack_int const* ldb, lapack_complex_float* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21181,7 +21185,7 @@ void LAPACK_dtprfb_base( double* B, lapack_int const* ldb, double* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21200,7 +21204,7 @@ void LAPACK_stprfb_base( float* B, lapack_int const* ldb, float* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21219,7 +21223,7 @@ void LAPACK_ztprfb_base( lapack_complex_double* B, lapack_int const* ldb, lapack_complex_double* work, lapack_int const* ldwork #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21241,7 +21245,7 @@ void LAPACK_ctprfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21263,7 +21267,7 @@ void LAPACK_dtprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21285,7 +21289,7 @@ void LAPACK_stprfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21307,7 +21311,7 @@ void LAPACK_ztprfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21323,7 +21327,7 @@ void LAPACK_ctptri_base( lapack_complex_float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21339,7 +21343,7 @@ void LAPACK_dtptri_base( double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21355,7 +21359,7 @@ void LAPACK_stptri_base( float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21371,7 +21375,7 @@ void LAPACK_ztptri_base( lapack_complex_double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21388,7 +21392,7 @@ void LAPACK_ctptrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21405,7 +21409,7 @@ void LAPACK_dtptrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21422,7 +21426,7 @@ void LAPACK_stptrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21439,7 +21443,7 @@ void LAPACK_ztptrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21456,7 +21460,7 @@ void LAPACK_ctpttf_base( lapack_complex_float* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21473,7 +21477,7 @@ void LAPACK_dtpttf_base( double* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21490,7 +21494,7 @@ void LAPACK_stpttf_base( float* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21507,7 +21511,7 @@ void LAPACK_ztpttf_base( lapack_complex_double* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21524,7 +21528,7 @@ void LAPACK_ctpttr_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21541,7 +21545,7 @@ void LAPACK_dtpttr_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21558,7 +21562,7 @@ void LAPACK_stpttr_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21575,7 +21579,7 @@ void LAPACK_ztpttr_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21594,7 +21598,7 @@ void LAPACK_ctrcon_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21613,7 +21617,7 @@ void LAPACK_dtrcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21632,7 +21636,7 @@ void LAPACK_strcon_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21651,7 +21655,7 @@ void LAPACK_ztrcon_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21672,7 +21676,7 @@ void LAPACK_ctrevc_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21692,7 +21696,7 @@ void LAPACK_dtrevc_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21712,7 +21716,7 @@ void LAPACK_strevc_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21733,7 +21737,7 @@ void LAPACK_ztrevc_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21754,7 +21758,7 @@ void LAPACK_ctrevc3_base( float* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21774,7 +21778,7 @@ void LAPACK_dtrevc3_base( double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21794,7 +21798,7 @@ void LAPACK_strevc3_base( float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21815,7 +21819,7 @@ void LAPACK_ztrevc3_base( double* rwork, lapack_int const* lrwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21832,7 +21836,7 @@ void LAPACK_ctrexc_base( lapack_complex_float* Q, lapack_int const* ldq, lapack_int const* ifst, lapack_int const* ilst, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21850,7 +21854,7 @@ void LAPACK_dtrexc_base( double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21868,7 +21872,7 @@ void LAPACK_strexc_base( float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21885,7 +21889,7 @@ void LAPACK_ztrexc_base( lapack_complex_double* Q, lapack_int const* ldq, lapack_int const* ifst, lapack_int const* ilst, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21907,7 +21911,7 @@ void LAPACK_ctrrfs_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21929,7 +21933,7 @@ void LAPACK_dtrrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21951,7 +21955,7 @@ void LAPACK_strrfs_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21973,7 +21977,7 @@ void LAPACK_ztrrfs_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -21995,7 +21999,7 @@ void LAPACK_ctrsen_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22019,7 +22023,7 @@ void LAPACK_dtrsen_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22043,7 +22047,7 @@ void LAPACK_strsen_base( lapack_int* iwork, lapack_int const* liwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22065,7 +22069,7 @@ void LAPACK_ztrsen_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22088,7 +22092,7 @@ void LAPACK_ctrsna_base( float* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22111,7 +22115,7 @@ void LAPACK_dtrsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22134,7 +22138,7 @@ void LAPACK_strsna_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22157,7 +22161,7 @@ void LAPACK_ztrsna_base( double* rwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22176,7 +22180,7 @@ void LAPACK_ctrsyl_base( float* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22195,7 +22199,7 @@ void LAPACK_dtrsyl_base( double* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22214,7 +22218,7 @@ void LAPACK_strsyl_base( float* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22233,7 +22237,7 @@ void LAPACK_ztrsyl_base( double* scale, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22252,7 +22256,7 @@ void LAPACK_ctrsyl3_base( float* swork, lapack_int const *ldswork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22272,7 +22276,7 @@ void LAPACK_dtrsyl3_base( double* swork, lapack_int const *ldswork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22292,7 +22296,7 @@ void LAPACK_strsyl3_base( float* swork, lapack_int const *ldswork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22311,7 +22315,7 @@ void LAPACK_ztrsyl3_base( double* swork, lapack_int const *ldswork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22327,7 +22331,7 @@ void LAPACK_ctrtri_base( lapack_complex_float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22343,7 +22347,7 @@ void LAPACK_dtrtri_base( double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22359,7 +22363,7 @@ void LAPACK_strtri_base( float* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22375,7 +22379,7 @@ void LAPACK_ztrtri_base( lapack_complex_double* A, lapack_int const* lda, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22392,7 +22396,7 @@ void LAPACK_ctrtrs_base( lapack_complex_float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22409,7 +22413,7 @@ void LAPACK_dtrtrs_base( double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22426,7 +22430,7 @@ void LAPACK_strtrs_base( float* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22443,7 +22447,7 @@ void LAPACK_ztrtrs_base( lapack_complex_double* B, lapack_int const* ldb, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22460,7 +22464,7 @@ void LAPACK_ctrttf_base( lapack_complex_float* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22477,7 +22481,7 @@ void LAPACK_dtrttf_base( double* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22494,7 +22498,7 @@ void LAPACK_strttf_base( float* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22511,7 +22515,7 @@ void LAPACK_ztrttf_base( lapack_complex_double* ARF, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22528,7 +22532,7 @@ void LAPACK_ctrttp_base( lapack_complex_float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22545,7 +22549,7 @@ void LAPACK_dtrttp_base( double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22562,7 +22566,7 @@ void LAPACK_strttp_base( float* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22579,7 +22583,7 @@ void LAPACK_ztrttp_base( lapack_complex_double* AP, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22637,7 +22641,7 @@ void LAPACK_cunbdb_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22663,7 +22667,7 @@ void LAPACK_zunbdb_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22690,7 +22694,7 @@ void LAPACK_cuncsd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22717,7 +22721,7 @@ void LAPACK_zuncsd_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t, size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22741,7 +22745,7 @@ void LAPACK_cuncsd2by1_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22765,7 +22769,7 @@ void LAPACK_zuncsd2by1_base( lapack_int* iwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22783,7 +22787,7 @@ void LAPACK_cungbr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22801,7 +22805,7 @@ void LAPACK_zungbr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22899,7 +22903,7 @@ void LAPACK_cungtr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22917,7 +22921,7 @@ void LAPACK_zungtr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22970,7 +22974,7 @@ void LAPACK_cunmbr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -22989,7 +22993,7 @@ void LAPACK_zunmbr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23008,7 +23012,7 @@ void LAPACK_cunmhr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23027,7 +23031,7 @@ void LAPACK_zunmhr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23046,7 +23050,7 @@ void LAPACK_cunmlq_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23065,7 +23069,7 @@ void LAPACK_zunmlq_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23084,7 +23088,7 @@ void LAPACK_cunmql_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23103,7 +23107,7 @@ void LAPACK_zunmql_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23122,7 +23126,7 @@ void LAPACK_cunmqr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23141,7 +23145,7 @@ void LAPACK_zunmqr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23160,7 +23164,7 @@ void LAPACK_cunmrq_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23179,7 +23183,7 @@ void LAPACK_zunmrq_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23198,7 +23202,7 @@ void LAPACK_cunmrz_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23217,7 +23221,7 @@ void LAPACK_zunmrz_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23236,7 +23240,7 @@ void LAPACK_cunmtr_base( lapack_complex_float* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23255,7 +23259,7 @@ void LAPACK_zunmtr_base( lapack_complex_double* work, lapack_int const* lwork, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23274,7 +23278,7 @@ void LAPACK_cupgtr_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23293,7 +23297,7 @@ void LAPACK_zupgtr_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t + , FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23312,7 +23316,7 @@ void LAPACK_cupmtr_base( lapack_complex_float* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END @@ -23331,7 +23335,7 @@ void LAPACK_zupmtr_base( lapack_complex_double* work, lapack_int* info #ifdef LAPACK_FORTRAN_STRLEN_END - , size_t, size_t, size_t + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); #ifdef LAPACK_FORTRAN_STRLEN_END From 50a943dad9c8e09bd8f8c3547e96e1e7c119c209 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 18:54:32 +0100 Subject: [PATCH 120/206] Fixed external 64bit api CBLAS example. CBLAS_API64 needs to be defined before including cblas_64.h --- CBLAS/examples/cblas_example2_64.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/CBLAS/examples/cblas_example2_64.c b/CBLAS/examples/cblas_example2_64.c index f3d59a81f0..1682e6d208 100644 --- a/CBLAS/examples/cblas_example2_64.c +++ b/CBLAS/examples/cblas_example2_64.c @@ -1,10 +1,11 @@ /* cblas_example2.c */ +#define CBLAS_API64 +#define F77_INT int64_t + #include #include #include "cblas_64.h" -#define CBLAS_API64 -#define F77_INT int64_t #include "cblas_f77.h" #define INVALID -1 From a926c938eb15f720c6470a6d412638465ad2d07d Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 18:56:09 +0100 Subject: [PATCH 121/206] Fixed wrong F77 C declarations for complex BLAS routines. Some complex arrays were declared as float* or double* instead of void*. --- CBLAS/include/cblas_f77.h | 40 +++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 6b29e4de3f..c25bc621b5 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -884,7 +884,7 @@ void F77_chpr_base(FCHAR, FINT, const float *, const void *, FINT, void * , FORTRAN_STRLEN #endif ); -void F77_chpr2_base(FCHAR, FINT, const float *, const void *, FINT, const void *, FINT, void * +void F77_chpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif @@ -964,7 +964,7 @@ void F77_zhpr_base(FCHAR, FINT, const double *, const void *, FINT, void * , FORTRAN_STRLEN #endif ); -void F77_zhpr2_base(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void * +void F77_zhpr2_base(FCHAR, FINT, const void *, const void *, FINT, const void *, FINT, void * #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif @@ -1042,47 +1042,47 @@ void F77_dtrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, cons /* Single Complex Precision */ -void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_chemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT +void F77_csyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, float *, FINT +void F77_cherk_base(FCHAR, FCHAR, FINT, FINT, const float *, const void *, FINT, const float *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_csyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_cher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const float *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT +void F77_ctrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, float *, FINT +void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif @@ -1090,47 +1090,47 @@ void F77_ctrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const /* Double Complex Precision */ -void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_zhemm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT +void F77_zsyrk_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, double *, FINT +void F77_zherk_base(FCHAR, FCHAR, FINT, FINT, const double *, const void *, FINT, const double *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_zsyr2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_zher2k_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const double *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT +void F77_ztrmm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, double *, FINT +void F77_ztrsm_base(FCHAR, FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif From f47a8708b99356d1b0cb91deee7499364e27f1e3 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 18:58:50 +0100 Subject: [PATCH 122/206] Added missing FORTRAN_STRLEN arguments in CBLAS testting framework --- CBLAS/include/cblas_test.h | 9 ++++ CBLAS/testing/c_c2chke.c | 12 ++++- CBLAS/testing/c_c3chke.c | 12 ++++- CBLAS/testing/c_cblas2.c | 90 +++++++++++++++++++++++++++++++------- CBLAS/testing/c_cblas3.c | 58 +++++++++++++++++++----- CBLAS/testing/c_d2chke.c | 12 ++++- CBLAS/testing/c_d3chke.c | 12 ++++- CBLAS/testing/c_dblas2.c | 90 +++++++++++++++++++++++++++++++------- CBLAS/testing/c_dblas3.c | 36 ++++++++++++--- CBLAS/testing/c_s2chke.c | 12 ++++- CBLAS/testing/c_s3chke.c | 12 ++++- CBLAS/testing/c_sblas2.c | 90 +++++++++++++++++++++++++++++++------- CBLAS/testing/c_sblas3.c | 36 ++++++++++++--- CBLAS/testing/c_xerbla.c | 6 ++- CBLAS/testing/c_z2chke.c | 12 ++++- CBLAS/testing/c_z3chke.c | 12 ++++- CBLAS/testing/c_zblas2.c | 90 +++++++++++++++++++++++++++++++------- CBLAS/testing/c_zblas3.c | 54 +++++++++++++++++++---- 18 files changed, 546 insertions(+), 109 deletions(-) diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index f8174ba43c..663176f9b5 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -7,6 +7,15 @@ #include "cblas.h" #include "cblas_mangling.h" +/* It seems all current Fortran compilers put strlen at end. +* Some historical compilers put strlen after the str argument +* or make the str argument into a struct. */ +#define BLAS_FORTRAN_STRLEN_END + +#ifndef FORTRAN_STRLEN + #define FORTRAN_STRLEN size_t +#endif + #define TRUE 1 #define PASSED 1 #define TEST_ROW_MJR 1 diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index e46bcd1493..6c69c9ef1d 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_c2chke(char *rout) { +void F77_c2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index b5bbc753cd..1f0cab8e2c 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_c3chke(char * rout) { +void F77_c3chke(char * rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; float A[4] = {0.0,0.0,0.0,0.0}, B[4] = {0.0,0.0,0.0,0.0}, diff --git a/CBLAS/testing/c_cblas2.c b/CBLAS/testing/c_cblas2.c index b4c8734c0d..1c87136743 100644 --- a/CBLAS/testing/c_cblas2.c +++ b/CBLAS/testing/c_cblas2.c @@ -11,7 +11,11 @@ void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, const void *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, - const void *beta, void *y, CBLAS_INT *incy) { + const void *beta, void *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; @@ -41,7 +45,11 @@ void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy) { + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,irow,jcol,LDA; @@ -144,7 +152,11 @@ void F77_cgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, - CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){ + CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; @@ -175,7 +187,11 @@ void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){ + CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_COMPLEX *A; CBLAS_INT i,irow,j,jcol,LDA; @@ -238,7 +254,11 @@ CBLAS_INT i,irow,j,jcol,LDA; void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy){ + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_COMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; @@ -294,7 +314,11 @@ void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -357,7 +381,11 @@ void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT irow, jcol, i, j, LDA; @@ -420,7 +448,11 @@ void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -475,7 +507,11 @@ void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -531,7 +567,11 @@ void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -560,7 +600,11 @@ void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -589,7 +633,11 @@ void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, - CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap) { + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -665,7 +713,11 @@ void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, - CBLAS_TEST_COMPLEX *ap) { + CBLAS_TEST_COMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -741,7 +793,11 @@ void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX } void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, - CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) { + CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -774,7 +830,11 @@ void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, - CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda) { + CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A; CBLAS_INT i,j,LDA; diff --git a/CBLAS/testing/c_cblas3.c b/CBLAS/testing/c_cblas3.c index f758dc9ebc..c8e4705cc1 100644 --- a/CBLAS/testing/c_cblas3.c +++ b/CBLAS/testing/c_cblas3.c @@ -14,7 +14,11 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -89,8 +93,12 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB } void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, - CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -153,8 +161,12 @@ void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I } void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, - CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -208,7 +220,11 @@ void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, float *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, - float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_COMPLEX *A, *C; @@ -264,7 +280,11 @@ void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, - CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_COMPLEX *A, *C; @@ -320,7 +340,11 @@ void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, float *beta, - CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_UPLO uplo; @@ -384,7 +408,11 @@ void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, - CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_COMPLEX *A, *B, *C; CBLAS_UPLO uplo; @@ -447,7 +475,11 @@ void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA } void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, - CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) { + CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_COMPLEX *A, *B; CBLAS_SIDE side; @@ -506,7 +538,11 @@ void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d void F77_ctrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, - CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb) { + CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_COMPLEX *A, *B; CBLAS_SIDE side; diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index 90d9c3ca70..9548c100f8 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_d2chke(char *rout) { +void F77_d2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index c9056c85ce..d89b404c97 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_d3chke(char *rout) { +void F77_d3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, B[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_dblas2.c b/CBLAS/testing/c_dblas2.c index 7a3e278e10..8902e2787f 100644 --- a/CBLAS/testing/c_dblas2.c +++ b/CBLAS/testing/c_dblas2.c @@ -10,7 +10,11 @@ void F77_dgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, - double *y, CBLAS_INT *incy ) { + double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; @@ -61,7 +65,11 @@ void F77_dger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, double *alpha, doub } void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) { + CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -89,7 +97,11 @@ void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx ) { + CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -114,7 +126,11 @@ void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, - CBLAS_INT *incy) { + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -137,7 +153,11 @@ void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub } void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, - CBLAS_INT *incx, double *a, CBLAS_INT *lda) { + CBLAS_INT *incx, double *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -161,7 +181,11 @@ void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl } void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, - CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda) { + CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -186,7 +210,11 @@ void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, - double *beta, double *y, CBLAS_INT *incy ) { + double *beta, double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,irow,j,jcol,LDA; @@ -223,7 +251,11 @@ void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA } void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -269,7 +301,11 @@ void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -316,7 +352,11 @@ void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, - double *y, CBLAS_INT *incy) { + double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A; CBLAS_INT i,j,irow,jcol,LDA; CBLAS_UPLO uplo; @@ -360,7 +400,11 @@ void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, doubl } void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *ap, - double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy) { + double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { double *A,*AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -398,7 +442,11 @@ void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub } void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx) { + CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -438,7 +486,11 @@ void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx) { + CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -479,7 +531,11 @@ void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, - CBLAS_INT *incx, double *ap ){ + CBLAS_INT *incx, double *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ double *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -531,7 +587,11 @@ void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl } void F77_dspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, - CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap ){ + CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ double *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; diff --git a/CBLAS/testing/c_dblas3.c b/CBLAS/testing/c_dblas3.c index 49c5a698fd..f0bc74af1b 100644 --- a/CBLAS/testing/c_dblas3.c +++ b/CBLAS/testing/c_dblas3.c @@ -13,7 +13,11 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, - double *beta, double *c, CBLAS_INT *ldc ) { + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -75,7 +79,11 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB } void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, - double *beta, double *c, CBLAS_INT *ldc ) { + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { double *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -129,7 +137,11 @@ void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, - double *beta, double *c, CBLAS_INT *ldc ) { + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; double *A, *C; @@ -177,7 +189,11 @@ void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, - double *beta, double *c, CBLAS_INT *ldc ) { + double *beta, double *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; double *A, *B, *C; CBLAS_UPLO uplo; @@ -232,7 +248,11 @@ void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA } void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, - CBLAS_INT *ldb) { + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; double *A, *B; CBLAS_SIDE side; @@ -283,7 +303,11 @@ void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d void F77_dtrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, - CBLAS_INT *ldb) { + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; double *A, *B; CBLAS_SIDE side; diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index adb09a6049..6f7f7bd40e 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_s2chke(char *rout) { +void F77_s2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index f95277e9c8..2c79c62337 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_s3chke(char *rout) { +void F77_s3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; float A[2] = {0.0,0.0}, B[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_sblas2.c b/CBLAS/testing/c_sblas2.c index 00bb4ca13e..a56893b4dd 100644 --- a/CBLAS/testing/c_sblas2.c +++ b/CBLAS/testing/c_sblas2.c @@ -10,7 +10,11 @@ void F77_sgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, - float *y, CBLAS_INT *incy ) { + float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; @@ -61,7 +65,11 @@ void F77_sger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float } void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) { + CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -89,7 +97,11 @@ void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx ) { + CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -114,7 +126,11 @@ void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, - CBLAS_INT *incy) { + CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -137,7 +153,11 @@ void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float } void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, - CBLAS_INT *incx, float *a, CBLAS_INT *lda) { + CBLAS_INT *incx, float *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -161,7 +181,11 @@ void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float } void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, - CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda) { + CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -186,7 +210,11 @@ void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, - float *beta, float *y, CBLAS_INT *incy ) { + float *beta, float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,irow,j,jcol,LDA; @@ -223,7 +251,11 @@ void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA } void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -269,7 +301,11 @@ void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -316,7 +352,11 @@ void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, - float *y, CBLAS_INT *incy) { + float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A; CBLAS_INT i,j,irow,jcol,LDA; CBLAS_UPLO uplo; @@ -360,7 +400,11 @@ void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float } void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *ap, - float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy) { + float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { float *A,*AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -397,7 +441,11 @@ void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float } void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx) { + CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -436,7 +484,11 @@ void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx) { + CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -476,7 +528,11 @@ void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, - CBLAS_INT *incx, float *ap ){ + CBLAS_INT *incx, float *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ float *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -527,7 +583,11 @@ void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float } void F77_sspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, - CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *ap ){ + CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ float *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; diff --git a/CBLAS/testing/c_sblas3.c b/CBLAS/testing/c_sblas3.c index 0621b293d5..513c1e2697 100644 --- a/CBLAS/testing/c_sblas3.c +++ b/CBLAS/testing/c_sblas3.c @@ -11,7 +11,11 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, - float *beta, float *c, CBLAS_INT *ldc ) { + float *beta, float *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -72,7 +76,11 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB } void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, - float *beta, float *c, CBLAS_INT *ldc ) { + float *beta, float *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { float *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -126,7 +134,11 @@ void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, - float *beta, float *c, CBLAS_INT *ldc ) { + float *beta, float *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; float *A, *C; @@ -174,7 +186,11 @@ void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, - float *beta, float *c, CBLAS_INT *ldc ) { + float *beta, float *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; float *A, *B, *C; CBLAS_UPLO uplo; @@ -229,7 +245,11 @@ void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA } void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, - CBLAS_INT *ldb) { + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; float *A, *B; CBLAS_SIDE side; @@ -280,7 +300,11 @@ void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d void F77_strsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, - CBLAS_INT *ldb) { + CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; float *A, *B; CBLAS_SIDE side; diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 57d61ee1fd..9aca9809cf 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -87,7 +87,11 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...) #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo) #else -void F77_xerbla(char *srname, void *vinfo) +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END +, FORTRAN_STRLEN +#endif +) #endif { #ifdef F77_Char diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 23f6896761..23dec5331e 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_z2chke(char *rout) { +void F77_z2chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; double A[2] = {0.0,0.0}, X[2] = {0.0,0.0}, diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index d114e8f995..3175500f81 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -10,7 +10,11 @@ char *cblas_rout; #ifdef F77_Char void F77_xerbla(F77_Char F77_srname, void *vinfo); #else -void F77_xerbla(char *srname, void *vinfo); +void F77_xerbla(char *srname, void *vinfo +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +); #endif void chkxer(void) { @@ -24,7 +28,11 @@ void chkxer(void) { cblas_lerr = 1 ; } -void F77_z3chke(char * rout) { +void F77_z3chke(char *rout +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { char *sf = ( rout ) ; double A[4] = {0.0,0.0,0.0,0.0}, B[4] = {0.0,0.0,0.0,0.0}, diff --git a/CBLAS/testing/c_zblas2.c b/CBLAS/testing/c_zblas2.c index b70f9ce5e0..e305711f51 100644 --- a/CBLAS/testing/c_zblas2.c +++ b/CBLAS/testing/c_zblas2.c @@ -11,7 +11,11 @@ void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, const void *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, - const void *beta, void *y, CBLAS_INT *incy) { + const void *beta, void *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; @@ -41,7 +45,11 @@ void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, void F77_zgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *kl, CBLAS_INT *ku, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy) { + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,irow,jcol,LDA; @@ -144,7 +152,11 @@ void F77_zgerc(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, - CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){ + CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; @@ -175,7 +187,11 @@ void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX void F77_zhbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){ + CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,irow,j,jcol,LDA; @@ -238,7 +254,11 @@ CBLAS_INT i,irow,j,jcol,LDA; void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy){ + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +){ CBLAS_TEST_ZOMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; @@ -294,7 +314,11 @@ void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT irow, jcol, i, j, LDA; CBLAS_TRANSPOSE trans; @@ -357,7 +381,11 @@ void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT irow, jcol, i, j, LDA; @@ -420,7 +448,11 @@ void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -475,7 +507,11 @@ void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, - CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx) { + CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; CBLAS_INT i, j, k, LDA; CBLAS_TRANSPOSE trans; @@ -531,7 +567,11 @@ void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -560,7 +600,11 @@ void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, - CBLAS_INT *incx) { + CBLAS_INT *incx +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_TRANSPOSE trans; @@ -589,7 +633,11 @@ void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, } void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, - CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap) { + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -665,7 +713,11 @@ void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, - CBLAS_TEST_ZOMPLEX *ap) { + CBLAS_TEST_ZOMPLEX *ap +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *AP; CBLAS_INT i,j,k,LDA; CBLAS_UPLO uplo; @@ -741,7 +793,11 @@ void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX } void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, - CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda) { + CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; CBLAS_UPLO uplo; @@ -774,7 +830,11 @@ void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, void F77_zher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, - CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda) { + CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A; CBLAS_INT i,j,LDA; diff --git a/CBLAS/testing/c_zblas3.c b/CBLAS/testing/c_zblas3.c index 891c70a83d..f8223c572e 100644 --- a/CBLAS/testing/c_zblas3.c +++ b/CBLAS/testing/c_zblas3.c @@ -14,7 +14,11 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -90,7 +94,11 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -154,7 +162,11 @@ void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_INT i,j,LDA, LDB, LDC; @@ -208,7 +220,11 @@ void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, double *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, - double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_ZOMPLEX *A, *C; @@ -264,7 +280,11 @@ void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, - CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDC; CBLAS_TEST_ZOMPLEX *A, *C; @@ -320,7 +340,11 @@ void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, double *beta, - CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_UPLO uplo; @@ -384,7 +408,11 @@ void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, - CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB,LDC; CBLAS_TEST_ZOMPLEX *A, *B, *C; CBLAS_UPLO uplo; @@ -447,7 +475,11 @@ void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA } void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, - CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb) { + CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_ZOMPLEX *A, *B; CBLAS_SIDE side; @@ -506,7 +538,11 @@ void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d void F77_ztrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *diagn, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, - CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb) { + CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +) { CBLAS_INT i,j,LDA,LDB; CBLAS_TEST_ZOMPLEX *A, *B; CBLAS_SIDE side; From 4f504e0236f5e42767c26bf8a4d94c1c1e9e206e Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 19:29:01 +0100 Subject: [PATCH 123/206] Fixed use of F77_xerbla in CBLAS testing framework --- CBLAS/testing/c_c2chke.c | 6 +++--- CBLAS/testing/c_c3chke.c | 6 +++--- CBLAS/testing/c_d2chke.c | 6 +++--- CBLAS/testing/c_d3chke.c | 6 +++--- CBLAS/testing/c_s2chke.c | 4 ++-- CBLAS/testing/c_s3chke.c | 6 +++--- CBLAS/testing/c_xerbla.c | 4 ++-- CBLAS/testing/c_z2chke.c | 6 +++--- CBLAS/testing/c_z3chke.c | 6 +++--- 9 files changed, 25 insertions(+), 25 deletions(-) diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index 6c69c9ef1d..8d346bd239 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -48,7 +48,7 @@ void F77_c2chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 1f0cab8e2c..7f28f09106 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -51,7 +51,7 @@ void F77_c3chke(char * rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index 9548c100f8..6ff1160a98 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -46,7 +46,7 @@ void F77_d2chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index d89b404c97..40e522361d 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -46,7 +46,7 @@ void F77_d3chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 6f7f7bd40e..25cca1bbd6 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 2c79c62337..eb09911a53 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -46,7 +46,7 @@ void F77_s3chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 9aca9809cf..f1505dfc3a 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -85,14 +85,14 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...) } #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo) +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ) -#endif { #ifdef F77_Char char *srname; diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 23dec5331e..7d51372ae6 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -48,7 +48,7 @@ void F77_z2chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index 3175500f81..37a6ff5037 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -8,14 +8,14 @@ CBLAS_INT link_xerbla=TRUE; char *cblas_rout; #ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo); +void F77_xerbla(F77_Char F77_srname, void *vinfo #else void F77_xerbla(char *srname, void *vinfo +#endif #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif ); -#endif void chkxer(void) { extern CBLAS_INT cblas_ok, cblas_lerr, cblas_info; @@ -51,7 +51,7 @@ void F77_z3chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif From 51219d2328f4f25f59626452427312a77d8a9952 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 19 Jun 2024 19:31:04 +0100 Subject: [PATCH 124/206] Fixed use of F77_xerbla in CBLAS testing framework --- CBLAS/testing/c_s2chke.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 25cca1bbd6..2d7237f0ed 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -46,7 +46,7 @@ void F77_s2chke(char *rout if (link_xerbla) /* call these first to link */ { cblas_xerbla(cblas_info,cblas_rout,""); - F77_xerbla(cblas_rout,&cblas_info); + F77_xerbla(cblas_rout,&cblas_info, 1); } #endif From 57b267c90204cf6f84fb28a538c894369cde375e Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 19 Jun 2024 22:09:04 -0400 Subject: [PATCH 125/206] fixing compilation errors due to not checking for lastc=0 --- SRC/dlarf1f.f | 9 +++++---- SRC/dlarf1l.f | 7 +++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/SRC/dlarf1f.f b/SRC/dlarf1f.f index f16cdcf9c5..104122999b 100644 --- a/SRC/dlarf1f.f +++ b/SRC/dlarf1f.f @@ -175,15 +175,13 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER IONE - PARAMETER ( IONE = 1 ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT INTEGER I, LASTV, LASTC * .. * .. External Subroutines .. - EXTERNAL DGEMV, DGER + EXTERNAL DGEMV, DGER, DAXPY, DSCAL * .. * .. External Functions .. LOGICAL LSAME @@ -211,7 +209,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Look for the last non-zero row in V. ! Since we are assuming that V(1) = 1, and it is not stored, so we ! shouldn't access it. - DO WHILE( LASTV.GE.2 .AND. V( I ).EQ.ZERO ) + DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO @@ -223,6 +221,9 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILADLR(M, LASTV, C, LDC) END IF END IF + IF( LASTC.EQ.0 ) THEN + RETURN + END IF IF( APPLYLEFT ) THEN * * Form H * C diff --git a/SRC/dlarf1l.f b/SRC/dlarf1l.f index 95a8b319b5..80a486f79c 100644 --- a/SRC/dlarf1l.f +++ b/SRC/dlarf1l.f @@ -142,8 +142,6 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) - INTEGER IONE - PARAMETER ( IONE = 1 ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT @@ -184,8 +182,9 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) LASTC = ILADLR(M, LASTV, C, LDC) END IF END IF -! Note that lastc.eq.0 renders the BLAS operations null; no special -! case is needed at this level. + IF( LASTC.EQ.0 ) THEN + RETURN + END IF IF( APPLYLEFT ) THEN * * Form H * C From 9a51a35c8b3b7bd99cfa3919c4238df37e0013b5 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 19 Jun 2024 23:36:02 -0400 Subject: [PATCH 126/206] fixing compilation errors in test suite --- SRC/dorbdb.f | 28 +++++++++++++--------------- SRC/dorbdb1.f | 5 +++-- SRC/dorbdb2.f | 4 ++-- SRC/dorbdb4.f | 13 ++++++------- SRC/zlarf1f.f | 32 +++++++++++++++++--------------- 5 files changed, 41 insertions(+), 41 deletions(-) diff --git a/SRC/dorbdb.f b/SRC/dorbdb.f index 2def0a5147..c796db13fd 100644 --- a/SRC/dorbdb.f +++ b/SRC/dorbdb.f @@ -440,13 +440,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ X12(I,I), LDX12, WORK ) END IF IF ( Q .GT. I ) THEN - CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK ) + CALL DLARF1F( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ TAUP2(I), X21(I,I+1), LDX21, WORK ) END IF IF ( M-Q+1 .GT. I ) THEN CALL DLARF1F( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ TAUP2(I), - $ X22(I,I), LDX22, WORK ) + $ TAUP2(I), X22(I,I), LDX22, WORK ) END IF * IF( I .LT. Q ) THEN @@ -638,15 +637,14 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, IF( I .LT. Q ) THEN CALL DLARF1F( 'L', Q-I, P-I, X11(I+1,I), 1, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK ) - CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK ) + CALL DLARF1F( 'L', Q-I, M-P-I, X11(I+1,I), 1, + $ TAUQ1(I), X21(I+1,I+1), LDX21, WORK ) END IF CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), - $ X12(I,I+1), LDX12, WORK ) + $ X12(I,I+1), LDX12, WORK ) IF ( M-P-I .GT. 0 ) THEN CALL DLARF1F( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,I+1), LDX22, WORK ) + $ TAUQ2(I), X22(I,I+1), LDX22, WORK ) END IF * END DO @@ -660,13 +658,12 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, $ TAUQ2(I) ) * IF ( P .GT. I ) THEN - CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), - $ X12(I,I+1), LDX12, WORK ) + CALL DLARF1F( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ TAUQ2(I), X12(I,I+1), LDX12, WORK ) END IF IF( M-P-Q .GE. 1 ) $ CALL DLARF1F( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, - $ TAUQ2(I), - $ X22(I,Q+1), LDX22, WORK ) + $ TAUQ2(I), X22(I,Q+1), LDX22, WORK ) * END DO * @@ -683,8 +680,9 @@ SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), $ 1, $ TAUQ2(P+I) ) - CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, - $ TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK ) + CALL DLARF1F( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), + $ 1, TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, + $ WORK ) END IF * END DO diff --git a/SRC/dorbdb1.f b/SRC/dorbdb1.f index a4095e9096..1972ef4bc4 100644 --- a/SRC/dorbdb1.f +++ b/SRC/dorbdb1.f @@ -301,8 +301,9 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, S = X21(I,I+1) CALL DLARF1F( 'R', P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X11(I+1,I+1), LDX11, WORK(ILARF) ) - CALL DLARF1F( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), - $ X21(I+1,I+1), LDX21, WORK(ILARF) ) + CALL DLARF1F( '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 )**2 $ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) diff --git a/SRC/dorbdb2.f b/SRC/dorbdb2.f index 56204a0b6c..e66a40d6b2 100644 --- a/SRC/dorbdb2.f +++ b/SRC/dorbdb2.f @@ -289,8 +289,8 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = X11(I,I) CALL DLARF1F( 'R', P-I, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X11(I+1,I), LDX11, WORK(ILARF) ) - CALL DLARF1F( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + CALL DLARF1F( '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 )**2 $ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) diff --git a/SRC/dorbdb4.f b/SRC/dorbdb4.f index 14dca198ea..446ccc6862 100644 --- a/SRC/dorbdb4.f +++ b/SRC/dorbdb4.f @@ -308,10 +308,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( THETA(I) ) S = SIN( THETA(I) ) CALL DLARF1F( 'L', P, Q, PHANTOM(1), 1, TAUP1(1), X11, - $ LDX11, - $ WORK(ILARF) ) - CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), X21, - $ LDX21, WORK(ILARF) ) + $ LDX11, WORK(ILARF) ) + CALL DLARF1F( 'L', M-P, Q, PHANTOM(P+1), 1, TAUP2(1), + $ X21, LDX21, WORK(ILARF) ) ELSE CALL DORBDB5( P-I+1, M-P-I+1, Q-I+1, X11(I,I-1), 1, $ X21(I,I-1), 1, X11(I,I), LDX11, X21(I,I), @@ -325,9 +324,9 @@ SUBROUTINE DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, C = COS( THETA(I) ) S = SIN( THETA(I) ) CALL DLARF1F( 'L', P-I+1, Q-I+1, X11(I,I-1), 1, TAUP1(I), - $ X11(I,I), LDX11, WORK(ILARF) ) - CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, TAUP2(I), - $ X21(I,I), LDX21, WORK(ILARF) ) + $ X11(I,I), LDX11, WORK(ILARF) ) + CALL DLARF1F( 'L', M-P-I+1, Q-I+1, X21(I,I-1), 1, + $ TAUP2(I), X21(I,I), LDX21, WORK(ILARF) ) END IF * CALL DROT( Q-I+1, X11(I,I), LDX11, X21(I,I), LDX21, S, -C ) diff --git a/SRC/zlarf1f.f b/SRC/zlarf1f.f index 936275b5f6..8203d4f6c0 100644 --- a/SRC/zlarf1f.f +++ b/SRC/zlarf1f.f @@ -176,8 +176,6 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) COMPLEX*16 ONE, ZERO PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), $ ZERO = ( 0.0D+0, 0.0D+0 ) ) - INTEGER IONE - PARAMETER ( IONE = 1 ) * .. * .. Local Scalars .. LOGICAL APPLYLEFT @@ -225,8 +223,8 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILAZLR(M, LASTV, C, LDC) END IF - ELSE -! TAU is 0, so H = I. Meaning HC = C = CH. + END IF + IF( LASTC.EQ.0 ) THEN RETURN END IF IF( APPLYLEFT ) THEN @@ -246,12 +244,14 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! C = [ C_1 C_2 ]**T, v = [1 v_2]**T ! w = C_1**H + C_2**Hv_2 ! w = C_2**Hv_2 - CALL ZGEMV( 'Conj', LASTV-1, LASTC, ONE, C(1+1,1), LDC, - $ V(1+INCV), INCV, ZERO, WORK, 1) - ! w += C_1**H - ! This is essentially a zaxpyc - DO J = 1, LASTC - WORK(J) = WORK(J) + DCONJG(C(1,J)) + CALL ZGEMV( 'Conjugate transpose', LASTV - 1, + $ LASTC, ONE, C( 1+1, 1 ), LDC, V( 1 + INCV ), + $ INCV, ZERO, WORK, 1 ) +* +* w(1:lastc,1) += v(1,1) * C(1,1:lastc)**H +* + DO I = 1, LASTC + WORK( I ) = WORK( I ) + DCONJG( C( 1, I ) ) END DO * * C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**H @@ -259,12 +259,14 @@ SUBROUTINE ZLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) ! C(1, 1:lastc) := C(...) - tau * v(1,1) * w(1:lastc,1)**H ! = C(...) - tau * Conj(w(1:lastc,1)) ! This is essentially a zaxpyc - DO J = 1, LASTC - C(1,J) = C(1,J) - TAU * DCONJG(WORK(J)) + DO I = 1, LASTC + C( 1, I ) = C( 1, I ) - TAU * DCONJG( WORK( I ) ) END DO - ! C(2:lastv,1:lastc) := C(...) - tau * v(2:lastv,1)*w(1:lastc,1)**H - CALL ZGERC(LASTV-1, LASTC, -TAU, V(1+INCV), INCV, WORK, - $ 1, C(1+1,1), LDC) +* +* C(2:lastv,1:lastc) += - tau * v(2:lastv,1) * w(1:lastc,1)**H +* + CALL ZGERC( LASTV - 1, LASTC, -TAU, V( 1 + INCV ), + $ INCV, WORK, 1, C( 1+1, 1 ), LDC ) END IF ELSE * From ed17a255afefc6736929a692fa433721a9a7a1f5 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 20 Jun 2024 16:04:55 +0100 Subject: [PATCH 127/206] Removed spurious char lenght arguments in LSAME declaration --- LAPACKE/include/lapack.h | 3 +-- LAPACKE/utils/lapacke_lsame.c | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/LAPACKE/include/lapack.h b/LAPACKE/include/lapack.h index 52eda84a7a..f9a254512c 100644 --- a/LAPACKE/include/lapack.h +++ b/LAPACKE/include/lapack.h @@ -135,8 +135,7 @@ typedef lapack_logical (*LAPACK_Z_SELECT2) ( const lapack_complex_double*, const lapack_complex_double* ); #define LAPACK_lsame_base LAPACK_GLOBAL(lsame,LSAME) -lapack_logical LAPACK_lsame_base( const char* ca, const char* cb, - lapack_int lca, lapack_int lcb +lapack_logical LAPACK_lsame_base( const char* ca, const char* cb #ifdef LAPACK_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN #endif diff --git a/LAPACKE/utils/lapacke_lsame.c b/LAPACKE/utils/lapacke_lsame.c index 6b805e3231..f86845e2a0 100644 --- a/LAPACKE/utils/lapacke_lsame.c +++ b/LAPACKE/utils/lapacke_lsame.c @@ -34,7 +34,7 @@ lapack_logical API_SUFFIX(LAPACKE_lsame)( char ca, char cb ) { - return (lapack_logical) LAPACK_lsame( &ca, &cb, 1, 1 ); + return (lapack_logical) LAPACK_lsame( &ca, &cb ); } From b8ee7a533e9091a92b56c2cc8d71c955676eb5e9 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 20 Jun 2024 16:11:08 +0100 Subject: [PATCH 128/206] Fixed wrong NAG Fortran compiler flag / definition for strlen type on Linux --- CMAKE/CheckLAPACKCompilerFlags.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMAKE/CheckLAPACKCompilerFlags.cmake b/CMAKE/CheckLAPACKCompilerFlags.cmake index 2502c5a6d0..7747564e29 100644 --- a/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -126,7 +126,7 @@ macro(CheckLAPACKCompilerFlags) get_directory_property(COMP_OPTIONS COMPILE_OPTIONS) if(NOT("${CMAKE_Fortran_FLAGS};${COMP_OPTIONS}" MATCHES "-abi=64c")) - add_compile_options("$<$:FORTRAN_STRLEN=int>") + add_compile_definitions("$<$:FORTRAN_STRLEN=int>") endif() endif() endif() From 73208915175f0b6e460496d67af748e28e268554 Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Fri, 21 Jun 2024 15:11:33 +0700 Subject: [PATCH 129/206] align documentation of bdsqr workspace with code --- SRC/cbdsqr.f | 4 +++- SRC/dbdsqr.f | 4 +++- SRC/sbdsqr.f | 4 +++- SRC/zbdsqr.f | 4 +++- 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/SRC/cbdsqr.f b/SRC/cbdsqr.f index e3b11a5cb4..66f8065c4a 100644 --- a/SRC/cbdsqr.f +++ b/SRC/cbdsqr.f @@ -166,7 +166,9 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is REAL array, dimension (4*(N-1)) +*> RWORK is REAL array, dimension (LRWORK) +*> LRWORK = 4*N, if NCVT = NRU = NCC = 0, and +*> LRWORK = 4*(N-1), otherwise *> \endverbatim *> *> \param[out] INFO diff --git a/SRC/dbdsqr.f b/SRC/dbdsqr.f index 4b6fe20417..a9673cadc6 100644 --- a/SRC/dbdsqr.f +++ b/SRC/dbdsqr.f @@ -166,7 +166,9 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (4*(N-1)) +*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> LWORK = 4*N, if NCVT = NRU = NCC = 0, and +*> LWORK = 4*(N-1), otherwise *> \endverbatim *> *> \param[out] INFO diff --git a/SRC/sbdsqr.f b/SRC/sbdsqr.f index 27b434363e..1270e78f8e 100644 --- a/SRC/sbdsqr.f +++ b/SRC/sbdsqr.f @@ -166,7 +166,9 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (4*(N-1)) +*> WORK is REAL array, dimension (LWORK) +*> LWORK = 4*N, if NCVT = NRU = NCC = 0, and +*> LWORK = 4*(N-1), otherwise *> \endverbatim *> *> \param[out] INFO diff --git a/SRC/zbdsqr.f b/SRC/zbdsqr.f index c8ba35fa68..890180be28 100644 --- a/SRC/zbdsqr.f +++ b/SRC/zbdsqr.f @@ -166,7 +166,9 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (4*(N-1)) +*> RWORK is DOUBLE PRECISION array, dimension (LRWORK) +*> LRWORK = 4*N, if NCVT = NRU = NCC = 0, and +*> LRWORK = 4*(N-1), otherwise *> \endverbatim *> *> \param[out] INFO From 7113caa0eca3af6d3e7cb9902e585e5e16a16aaa Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 21 Jun 2024 11:05:16 +0200 Subject: [PATCH 130/206] Fixed commented out result initialization --- TESTING/LIN/dchkqp3rk.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/TESTING/LIN/dchkqp3rk.f b/TESTING/LIN/dchkqp3rk.f index 1834e63282..319d332dd2 100755 --- a/TESTING/LIN/dchkqp3rk.f +++ b/TESTING/LIN/dchkqp3rk.f @@ -605,9 +605,9 @@ SUBROUTINE DCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, CALL DLACPY( 'All', M, NRHS, COPYB, LDA, $ B, LDA ) CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 ) - ! DO I = 1, NTESTS - ! RESULT( I ) = ZERO - ! END DO + DO I = 1, NTESTS + RESULT( I ) = ZERO + END DO * ABSTOL = -1.0 RELTOL = -1.0 From 69992ad76de4b52c36044fa79036cd64cdd11855 Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Fri, 21 Jun 2024 18:29:42 +0700 Subject: [PATCH 131/206] fix few typos and sytrd boundary workspace --- SRC/cgehrd.f | 2 +- SRC/chetrd.f | 2 +- SRC/sgelqt.f | 2 +- SRC/sgemlq.f | 2 +- SRC/sgemlqt.f | 2 +- SRC/ssytrd.f | 2 +- SRC/zhetrd.f | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f index f2a7d042ae..35bd2e668c 100644 --- a/SRC/cgehrd.f +++ b/SRC/cgehrd.f @@ -232,7 +232,7 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, IF( NH.LE.1 ) THEN LWKOPT = 1 ELSE - NB = MIN( NBMAX, ILAENV( 1, 'DGEHRD', ' ', N, ILO, IHI, + NB = MIN( NBMAX, ILAENV( 1, 'CGEHRD', ' ', N, ILO, IHI, $ -1 ) ) LWKOPT = N*NB + TSIZE END IF diff --git a/SRC/chetrd.f b/SRC/chetrd.f index 15ea04b9fc..34c74959dc 100644 --- a/SRC/chetrd.f +++ b/SRC/chetrd.f @@ -251,7 +251,7 @@ SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, * Determine the block size. * NB = ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF * diff --git a/SRC/sgelqt.f b/SRC/sgelqt.f index f941388ece..343da9f49a 100644 --- a/SRC/sgelqt.f +++ b/SRC/sgelqt.f @@ -18,7 +18,7 @@ *> *> \verbatim *> -*> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A +*> SGELQT computes a blocked LQ factorization of a real M-by-N matrix A *> using the compact WY representation of Q. *> \endverbatim * diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index 7e4d9bf656..5793e6ea71 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -74,7 +74,7 @@ *> A is REAL array, dimension *> (LDA,M) if SIDE = 'L', *> (LDA,N) if SIDE = 'R' -*> Part of the data structure to represent Q as returned by DGELQ. +*> Part of the data structure to represent Q as returned by SGELQ. *> \endverbatim *> *> \param[in] LDA diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f index 7917f6b9c1..1cb882cb4e 100644 --- a/SRC/sgemlqt.f +++ b/SRC/sgemlqt.f @@ -20,7 +20,7 @@ *> *> \verbatim *> -*> DGEMLQT overwrites the general real M-by-N matrix C with +*> SGEMLQT overwrites the general real M-by-N matrix C with *> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q C C Q diff --git a/SRC/ssytrd.f b/SRC/ssytrd.f index 44201a9540..fda10d3720 100644 --- a/SRC/ssytrd.f +++ b/SRC/ssytrd.f @@ -249,7 +249,7 @@ SUBROUTINE SSYTRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, * Determine the block size. * NB = ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = SROUNDUP_LWORK(LWKOPT) END IF * diff --git a/SRC/zhetrd.f b/SRC/zhetrd.f index 273e87f38e..7a64e228fc 100644 --- a/SRC/zhetrd.f +++ b/SRC/zhetrd.f @@ -250,7 +250,7 @@ SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, * Determine the block size. * NB = ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * From 19b00163aafb70d80434c2028ece21610067f5e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Wed, 19 Jul 2023 12:53:54 +0200 Subject: [PATCH 132/206] Add xGEMMT and their test cases The xGEMMT subroutines are added in the Fortran API. The tests are updated as well. --- BLAS/SRC/CMakeLists.txt | 8 +- BLAS/SRC/Makefile | 8 +- BLAS/SRC/cgemmt.f | 570 ++++++++++++++++++++++++++++++++ BLAS/SRC/dgemmt.f | 432 ++++++++++++++++++++++++ BLAS/SRC/sgemmt.f | 432 ++++++++++++++++++++++++ BLAS/SRC/zgemmt.f | 570 ++++++++++++++++++++++++++++++++ BLAS/TESTING/cblat3.f | 706 ++++++++++++++++++++++++++++++++++++++- BLAS/TESTING/cblat3.in | 1 + BLAS/TESTING/dblat3.f | 518 ++++++++++++++++++++++++++++- BLAS/TESTING/dblat3.in | 1 + BLAS/TESTING/sblat3.f | 518 ++++++++++++++++++++++++++++- BLAS/TESTING/sblat3.in | 1 + BLAS/TESTING/zblat3.f | 714 +++++++++++++++++++++++++++++++++++++++- BLAS/TESTING/zblat3.in | 1 + 14 files changed, 4418 insertions(+), 62 deletions(-) create mode 100644 BLAS/SRC/cgemmt.f create mode 100644 BLAS/SRC/dgemmt.f create mode 100644 BLAS/SRC/sgemmt.f create mode 100644 BLAS/SRC/zgemmt.f diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt index ebf5fce26f..7af9f451c8 100644 --- a/BLAS/SRC/CMakeLists.txt +++ b/BLAS/SRC/CMakeLists.txt @@ -82,15 +82,15 @@ set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f #--------------------------------------------------------- # Level 3 BLAS #--------------------------------------------------------- -set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f) +set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f sgemmt.f) set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f - chemm.f cherk.f cher2k.f) + chemm.f cherk.f cher2k.f cgemmt.f) -set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f) +set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f dgemmt.f) set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f - zhemm.f zherk.f zher2k.f) + zhemm.f zherk.f zher2k.f zgemmt.f) set(SOURCES) diff --git a/BLAS/SRC/Makefile b/BLAS/SRC/Makefile index 70534c8358..145f40ff42 100644 --- a/BLAS/SRC/Makefile +++ b/BLAS/SRC/Makefile @@ -127,18 +127,18 @@ $(ZBLAS2): $(FRC) # Comment out the next 4 definitions if you already have # the Level 3 BLAS. #--------------------------------------------------------- -SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o +SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o sgemmt.o $(SBLAS3): $(FRC) CBLAS3 = cgemm.o csymm.o csyrk.o csyr2k.o ctrmm.o ctrsm.o \ - chemm.o cherk.o cher2k.o + chemm.o cherk.o cher2k.o cgemmt.o $(CBLAS3): $(FRC) -DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o +DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o dgemmt.o $(DBLAS3): $(FRC) ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \ - zhemm.o zherk.o zher2k.o + zhemm.o zherk.o zher2k.o zgemmt.o $(ZBLAS3): $(FRC) ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \ diff --git a/BLAS/SRC/cgemmt.f b/BLAS/SRC/cgemmt.f new file mode 100644 index 0000000000..e6071a345b --- /dev/null +++ b/BLAS/SRC/cgemmt.f @@ -0,0 +1,570 @@ +*> \brief \b CGEMMT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* COMPLEX ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CGEMMT performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used, +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**H. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**H. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is COMPLEX. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is COMPLEX array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is COMPLEX. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower trinangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + COMPLEX A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG,MAX +* .. +* .. Local Scalars .. + COMPLEX TEMP + INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP + LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER +* .. +* .. Parameters .. + COMPLEX ONE + PARAMETER (ONE= (1.0E+0,0.0E+0)) + COMPLEX ZERO + PARAMETER (ZERO= (0.0E+0,0.0E+0)) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* conjugated or transposed, set CONJA and CONJB as true if A and +* B respectively are to be transposed but not conjugated and set +* NROWA and NROWB as the number of rows of A and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + CONJA = LSAME(TRANSA,'C') + CONJB = LSAME(TRANSB,'C') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') + +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('CGEMMT',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. + + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE IF (CONJA) THEN +* +* Form C := alpha*A**H*B + beta*C. +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 150 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 140 I = ISTART, ISTOP + TEMP = ZERO + DO 130 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 130 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 140 CONTINUE + 150 CONTINUE + END IF + ELSE IF (NOTA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A*B**H + beta*C. +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 160 I = ISTART,ISTOP + C(I,J) = ZERO + 160 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 170 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 170 CONTINUE + END IF + DO 190 L = 1,K + TEMP = ALPHA*CONJG(B(J,L)) + DO 180 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 180 CONTINUE + 190 CONTINUE + 200 CONTINUE + ELSE +* +* Form C := alpha*A*B**T + beta*C +* + DO 250 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 210 I = ISTART, ISTOP + C(I,J) = ZERO + 210 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 220 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 220 CONTINUE + END IF + DO 240 L = 1,K + TEMP = ALPHA*B(J,L) + DO 230 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 230 CONTINUE + 240 CONTINUE + 250 CONTINUE + END IF + ELSE IF (CONJA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A**H*B**H + beta*C. +* + DO 280 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 270 I = ISTART, ISTOP + TEMP = ZERO + DO 260 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L)) + 260 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 270 CONTINUE + 280 CONTINUE + ELSE +* +* Form C := alpha*A**H*B**T + beta*C +* + DO 310 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 300 I = ISTART, ISTOP + TEMP = ZERO + DO 290 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(J,L) + 290 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 300 CONTINUE + 310 CONTINUE + END IF + ELSE + IF (CONJB) THEN +* +* Form C := alpha*A**T*B**H + beta*C +* + DO 340 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 330 I = ISTART, ISTOP + TEMP = ZERO + DO 320 L = 1,K + TEMP = TEMP + A(L,I)*CONJG(B(J,L)) + 320 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 330 CONTINUE + 340 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 370 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 360 I = ISTART, ISTOP + TEMP = ZERO + DO 350 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 350 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 360 CONTINUE + 370 CONTINUE + END IF + END IF +* + RETURN +* +* End of CGEMMT +* + END diff --git a/BLAS/SRC/dgemmt.f b/BLAS/SRC/dgemmt.f new file mode 100644 index 0000000000..718fafb17f --- /dev/null +++ b/BLAS/SRC/dgemmt.f @@ -0,0 +1,432 @@ +*> \brief \b DGEMMT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DGEMMT performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used, +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**T. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**T. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is DOUBLE PRECISION. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is DOUBLE PRECISION array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is DOUBLE PRECISION. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is DOUBLE PRECISION array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower trinangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + DOUBLE PRECISION TEMP + INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP + LOGICAL NOTA,NOTB, UPPER +* .. +* .. Parameters .. + DOUBLE PRECISION ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('DGEMMT',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. + + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And if alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + END IF + ELSE + IF (NOTA) THEN +* +* Form C := alpha*A*B**T + beta*C +* + DO 170 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 130 I = ISTART,ISTOP + C(I,J) = ZERO + 130 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 140 I = ISTART,ISTOP + C(I,J) = BETA*C(I,J) + 140 CONTINUE + END IF + DO 160 L = 1,K + TEMP = ALPHA*B(J,L) + DO 150 I = ISTART,ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 190 I = ISTART, ISTOP + TEMP = ZERO + DO 180 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 180 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 190 CONTINUE + 200 CONTINUE + END IF + END IF +* + RETURN +* +* End of SGEMM +* + END diff --git a/BLAS/SRC/sgemmt.f b/BLAS/SRC/sgemmt.f new file mode 100644 index 0000000000..3875e63664 --- /dev/null +++ b/BLAS/SRC/sgemmt.f @@ -0,0 +1,432 @@ +*> \brief \b SGEMMT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* REAL ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SGEMMT performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used, +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**T. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**T. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is REAL. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is REAL array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is REAL array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is REAL. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is REAL array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower trinangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + REAL A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Local Scalars .. + REAL TEMP + INTEGER I,INFO,J,L,NROWA,NROWB, ISTART, ISTOP + LOGICAL NOTA,NOTB, UPPER +* .. +* .. Parameters .. + REAL ONE,ZERO + PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* transposed and set NROWA and NROWB as the number of rows of A +* and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.LSAME(TRANSA,'C')) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.LSAME(TRANSB,'C')) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('SGEMMT',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. + + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And if alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + END IF + ELSE + IF (NOTA) THEN +* +* Form C := alpha*A*B**T + beta*C +* + DO 170 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 130 I = ISTART,ISTOP + C(I,J) = ZERO + 130 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 140 I = ISTART,ISTOP + C(I,J) = BETA*C(I,J) + 140 CONTINUE + END IF + DO 160 L = 1,K + TEMP = ALPHA*B(J,L) + DO 150 I = ISTART,ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 150 CONTINUE + 160 CONTINUE + 170 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 190 I = ISTART, ISTOP + TEMP = ZERO + DO 180 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 180 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 190 CONTINUE + 200 CONTINUE + END IF + END IF +* + RETURN +* +* End of SGEMMT +* + END diff --git a/BLAS/SRC/zgemmt.f b/BLAS/SRC/zgemmt.f new file mode 100644 index 0000000000..37828abaad --- /dev/null +++ b/BLAS/SRC/zgemmt.f @@ -0,0 +1,570 @@ +*> \brief \b ZGEMMT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* C,LDC) +* +* .. Scalar Arguments .. +* COMPLEX*16 ALPHA,BETA +* INTEGER K,LDA,LDB,LDC,N +* CHARACTER TRANSA,TRANSB, UPLO +* .. +* .. Array Arguments .. +* COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZGEMMT performs one of the matrix-matrix operations +*> +*> C := alpha*op( A )*op( B ) + beta*C, +*> +*> where op( X ) is one of +*> +*> op( X ) = X or op( X ) = X**T, +*> +*> alpha and beta are scalars, and A, B and C are matrices, with op( A ) +*> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. +*> Thereby, the routine only accesses and updates the upper or lower +*> triangular part of the result matrix C. This behaviour can be used, +*> the resulting matrix C is known to be symmetric. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] UPLO +*> \verbatim +*> UPLO is CHARACTER*1 +*> On entry, UPLO specifies whether the lower or the upper +*> triangular part of C is access and updated. +*> +*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> +*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> \endverbatim +* +*> \param[in] TRANSA +*> \verbatim +*> TRANSA is CHARACTER*1 +*> On entry, TRANSA specifies the form of op( A ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSA = 'N' or 'n', op( A ) = A. +*> +*> TRANSA = 'T' or 't', op( A ) = A**T. +*> +*> TRANSA = 'C' or 'c', op( A ) = A**H. +*> \endverbatim +*> +*> \param[in] TRANSB +*> \verbatim +*> TRANSB is CHARACTER*1 +*> On entry, TRANSB specifies the form of op( B ) to be used in +*> the matrix multiplication as follows: +*> +*> TRANSB = 'N' or 'n', op( B ) = B. +*> +*> TRANSB = 'T' or 't', op( B ) = B**T. +*> +*> TRANSB = 'C' or 'c', op( B ) = B**H. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> On entry, N specifies the number of rows and columns of +*> the matrix C, the number of columns of op(B) and the number +*> of rows of op(A). N must be at least zero. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> On entry, K specifies the number of columns of the matrix +*> op( A ) and the number of rows of the matrix op( B ). K must +*> be at least zero. +*> \endverbatim +*> +*> \param[in] ALPHA +*> \verbatim +*> ALPHA is COMPLEX*16. +*> On entry, ALPHA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] A +*> \verbatim +*> A is COMPLEX*16 array, dimension ( LDA, ka ), where ka is +*> k when TRANSA = 'N' or 'n', and is n otherwise. +*> Before entry with TRANSA = 'N' or 'n', the leading n by k +*> part of the array A must contain the matrix A, otherwise +*> the leading k by m part of the array A must contain the +*> matrix A. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> On entry, LDA specifies the first dimension of A as declared +*> in the calling (sub) program. When TRANSA = 'N' or 'n' then +*> LDA must be at least max( 1, n ), otherwise LDA must be at +*> least max( 1, k ). +*> \endverbatim +*> +*> \param[in] B +*> \verbatim +*> B is COMPLEX*16 array, dimension ( LDB, kb ), where kb is +*> n when TRANSB = 'N' or 'n', and is k otherwise. +*> Before entry with TRANSB = 'N' or 'n', the leading k by n +*> part of the array B must contain the matrix B, otherwise +*> the leading n by k part of the array B must contain the +*> matrix B. +*> \endverbatim +*> +*> \param[in] LDB +*> \verbatim +*> LDB is INTEGER +*> On entry, LDB specifies the first dimension of B as declared +*> in the calling (sub) program. When TRANSB = 'N' or 'n' then +*> LDB must be at least max( 1, k ), otherwise LDB must be at +*> least max( 1, n ). +*> \endverbatim +*> +*> \param[in] BETA +*> \verbatim +*> BETA is COMPLEX*16. +*> On entry, BETA specifies the scalar beta. When BETA is +*> supplied as zero then C need not be set on input. +*> \endverbatim +*> +*> \param[in,out] C +*> \verbatim +*> C is COMPLEX*16 array, dimension ( LDC, N ) +*> Before entry, the leading n by n part of the array C must +*> contain the matrix C, except when beta is zero, in which +*> case C need not be set on entry. +*> On exit, the upper or lower trinangular part of the matrix +*> C is overwritten by the n by n matrix +*> ( alpha*op( A )*op( B ) + beta*C ). +*> \endverbatim +*> +*> \param[in] LDC +*> \verbatim +*> LDC is INTEGER +*> On entry, LDC specifies the first dimension of C as declared +*> in the calling (sub) program. LDC must be at least +*> max( 1, n ). +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Martin Koehler +* +*> \ingroup gemm +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> Level 3 Blas routine. +*> +*> -- Written on 19-July-2023. +*> Martin Koehler, MPI Magdeburg +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + + BETA,C,LDC) + IMPLICIT NONE +* +* -- Reference BLAS level3 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX*16 ALPHA,BETA + INTEGER K,LDA,LDB,LDC,N + CHARACTER TRANSA,TRANSB,UPLO +* .. +* .. Array Arguments .. + COMPLEX*16 A(LDA,*),B(LDB,*),C(LDC,*) +* .. +* +* ===================================================================== +* +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC CONJG,MAX +* .. +* .. Local Scalars .. + COMPLEX*16 TEMP + INTEGER I,INFO,J,L,NROWA,NROWB,ISTART, ISTOP + LOGICAL CONJA,CONJB,NOTA,NOTB,UPPER +* .. +* .. Parameters .. + COMPLEX*16 ONE + PARAMETER (ONE= (1.0E+0,0.0E+0)) + COMPLEX*16 ZERO + PARAMETER (ZERO= (0.0E+0,0.0E+0)) +* .. +* +* Set NOTA and NOTB as true if A and B respectively are not +* conjugated or transposed, set CONJA and CONJB as true if A and +* B respectively are to be transposed but not conjugated and set +* NROWA and NROWB as the number of rows of A and B respectively. +* + NOTA = LSAME(TRANSA,'N') + NOTB = LSAME(TRANSB,'N') + CONJA = LSAME(TRANSA,'C') + CONJB = LSAME(TRANSB,'C') + IF (NOTA) THEN + NROWA = N + ELSE + NROWA = K + END IF + IF (NOTB) THEN + NROWB = K + ELSE + NROWB = N + END IF + UPPER = LSAME(UPLO, 'U') + +* +* Test the input parameters. +* + INFO = 0 + IF ((.NOT. UPPER) .AND. (.NOT. LSAME(UPLO, 'L'))) THEN + INFO = 1 + ELSE IF ((.NOT.NOTA) .AND. (.NOT.CONJA) .AND. + + (.NOT.LSAME(TRANSA,'T'))) THEN + INFO = 2 + ELSE IF ((.NOT.NOTB) .AND. (.NOT.CONJB) .AND. + + (.NOT.LSAME(TRANSB,'T'))) THEN + INFO = 3 + ELSE IF (N.LT.0) THEN + INFO = 4 + ELSE IF (K.LT.0) THEN + INFO = 5 + ELSE IF (LDA.LT.MAX(1,NROWA)) THEN + INFO = 8 + ELSE IF (LDB.LT.MAX(1,NROWB)) THEN + INFO = 10 + ELSE IF (LDC.LT.MAX(1,N)) THEN + INFO = 13 + END IF + IF (INFO.NE.0) THEN + CALL XERBLA('ZGEMMT',INFO) + RETURN + END IF +* +* Quick return if possible. +* + IF ((N.EQ.0) .OR. + + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN +* +* And when alpha.eq.zero. +* + IF (ALPHA.EQ.ZERO) THEN + IF (BETA.EQ.ZERO) THEN + DO 20 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + C(I,J) = ZERO + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 30 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 30 CONTINUE + 40 CONTINUE + END IF + RETURN + END IF +* +* Start the operations. +* + IF (NOTB) THEN + IF (NOTA) THEN +* +* Form C := alpha*A*B + beta*C. +* + DO 90 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + IF (BETA.EQ.ZERO) THEN + DO 50 I = ISTART, ISTOP + C(I,J) = ZERO + 50 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 60 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 60 CONTINUE + END IF + DO 80 L = 1,K + TEMP = ALPHA*B(L,J) + DO 70 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 70 CONTINUE + 80 CONTINUE + 90 CONTINUE + ELSE IF (CONJA) THEN +* +* Form C := alpha*A**H*B + beta*C. +* + DO 120 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 110 I = ISTART, ISTOP + TEMP = ZERO + DO 100 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(L,J) + 100 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 110 CONTINUE + 120 CONTINUE + ELSE +* +* Form C := alpha*A**T*B + beta*C +* + DO 150 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 140 I = ISTART, ISTOP + TEMP = ZERO + DO 130 L = 1,K + TEMP = TEMP + A(L,I)*B(L,J) + 130 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 140 CONTINUE + 150 CONTINUE + END IF + ELSE IF (NOTA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A*B**H + beta*C. +* + DO 200 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 160 I = ISTART,ISTOP + C(I,J) = ZERO + 160 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 170 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 170 CONTINUE + END IF + DO 190 L = 1,K + TEMP = ALPHA*CONJG(B(J,L)) + DO 180 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 180 CONTINUE + 190 CONTINUE + 200 CONTINUE + ELSE +* +* Form C := alpha*A*B**T + beta*C +* + DO 250 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + IF (BETA.EQ.ZERO) THEN + DO 210 I = ISTART, ISTOP + C(I,J) = ZERO + 210 CONTINUE + ELSE IF (BETA.NE.ONE) THEN + DO 220 I = ISTART, ISTOP + C(I,J) = BETA*C(I,J) + 220 CONTINUE + END IF + DO 240 L = 1,K + TEMP = ALPHA*B(J,L) + DO 230 I = ISTART, ISTOP + C(I,J) = C(I,J) + TEMP*A(I,L) + 230 CONTINUE + 240 CONTINUE + 250 CONTINUE + END IF + ELSE IF (CONJA) THEN + IF (CONJB) THEN +* +* Form C := alpha*A**H*B**H + beta*C. +* + DO 280 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 270 I = ISTART, ISTOP + TEMP = ZERO + DO 260 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*CONJG(B(J,L)) + 260 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 270 CONTINUE + 280 CONTINUE + ELSE +* +* Form C := alpha*A**H*B**T + beta*C +* + DO 310 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 300 I = ISTART, ISTOP + TEMP = ZERO + DO 290 L = 1,K + TEMP = TEMP + CONJG(A(L,I))*B(J,L) + 290 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 300 CONTINUE + 310 CONTINUE + END IF + ELSE + IF (CONJB) THEN +* +* Form C := alpha*A**T*B**H + beta*C +* + DO 340 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 330 I = ISTART, ISTOP + TEMP = ZERO + DO 320 L = 1,K + TEMP = TEMP + A(L,I)*CONJG(B(J,L)) + 320 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 330 CONTINUE + 340 CONTINUE + ELSE +* +* Form C := alpha*A**T*B**T + beta*C +* + DO 370 J = 1,N + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 360 I = ISTART, ISTOP + TEMP = ZERO + DO 350 L = 1,K + TEMP = TEMP + A(L,I)*B(J,L) + 350 CONTINUE + IF (BETA.EQ.ZERO) THEN + C(I,J) = ALPHA*TEMP + ELSE + C(I,J) = ALPHA*TEMP + BETA*C(I,J) + END IF + 360 CONTINUE + 370 CONTINUE + END IF + END IF +* + RETURN +* +* End of ZGEMMT +* + END diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 18adeba6d5..a8cd24c123 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -19,7 +19,7 @@ *> Test program for the COMPLEX Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 9 records +*> of the file are read using list-directed input, the last 10 records *> are read using the format ( A6, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 23 lines: @@ -46,6 +46,7 @@ *> CSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> CHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> CGEMMT T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -93,7 +94,7 @@ PROGRAM CBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX ZERO, ONE PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) REAL RZERO @@ -127,6 +128,7 @@ PROGRAM CBLAT3 EXTERNAL SDIFF, LCE * .. External Subroutines .. EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHKE, CMMCH + EXTERNAL CCHK6 * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. @@ -139,7 +141,7 @@ PROGRAM CBLAT3 * .. Data statements .. DATA SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ', $ 'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K', - $ 'CSYR2K'/ + $ 'CSYR2K', 'CGEMMT'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -317,7 +319,7 @@ PROGRAM CBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test CGEMM, 01. 140 CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -346,6 +348,11 @@ PROGRAM CBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 + 185 CALL CCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -2031,7 +2038,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) RBETA = TWO * GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, - $ 90 )ISNUM + $ 90, 100 )ISNUM 10 INFOT = 1 CALL CGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2212,7 +2219,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL CGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 20 INFOT = 1 CALL CHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2279,7 +2286,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 30 INFOT = 1 CALL CSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2346,7 +2353,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 40 INFOT = 1 CALL CTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2503,7 +2510,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL CTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 50 INFOT = 1 CALL CTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2660,7 +2667,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL CTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 60 INFOT = 1 CALL CHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2715,7 +2722,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL CHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 70 INFOT = 1 CALL CSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2770,7 +2777,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL CSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 80 INFOT = 1 CALL CHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2837,7 +2844,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 90 INFOT = 1 CALL CSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2904,8 +2911,186 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL CSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + 100 INFOT = 1 + CALL CGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL CGEMMT( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 2 + CALL CGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMT( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMT( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMT( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGEMMT( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 3 + CALL CGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CGEMMT( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 8 + CALL CGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CGEMMT( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 10 + CALL CGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL CGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL CGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL CGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + * - 100 IF( OK )THEN + 110 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT @@ -3486,3 +3671,496 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * End of XERBLA * END + + SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests CGEMMT. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*6 SNAME +* .. Array Arguments .. + COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + REAL G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX ALPHA, ALS, BETA, BLS + REAL ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LCE, LCERES + EXTERNAL LCE, LCERES +* .. External Subroutines .. + EXTERNAL CGEMM, CMAKE, CMMCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ + +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL CMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL CMAKE( 'GE', UPLO, ' ', M, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO + $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, + $ BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL CGEMMT( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, AA, LDA, BB, LDB, BETA, + $ CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLOS.EQ.UPLO + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LCE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LCE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LCE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LCERES( 'GE', ' ', M, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL CMMTCH( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, A, NMAX, B, NMAX, + $ BETA, C, NMAX, CT, G, CC, LDC, + $ EPS, ERR, FATAL, NOUT, .TRUE.) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + RETURN +* + 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of CCHK6 +* + END + + SUBROUTINE CMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX ALPHA, BETA + REAL EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + REAL G( * ) +* .. Local Scalars .. + COMPLEX CL + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + REAL ABS1 +* .. Statement Function definitions .. + ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = 1 + + DO 220 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS1( ALPHA )*G( I ) + + $ ABS1( BETA )*ABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of CMMTCH +* + END + diff --git a/BLAS/TESTING/cblat3.in b/BLAS/TESTING/cblat3.in index f1480557a1..686fe64084 100644 --- a/BLAS/TESTING/cblat3.in +++ b/BLAS/TESTING/cblat3.in @@ -21,3 +21,4 @@ CHERK T PUT F FOR NO TEST. SAME COLUMNS. CSYRK T PUT F FOR NO TEST. SAME COLUMNS. CHER2K T PUT F FOR NO TEST. SAME COLUMNS. CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +CGEMMT T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index 89087d539c..ddfbbfbd6a 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -19,10 +19,10 @@ *> Test program for the DOUBLE PRECISION Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 6 records +*> of the file are read using list-directed input, the last 7 records *> are read using the format ( A6, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the -*> following 20 lines: +*> following 21 lines: *> 'dblat3.out' NAME OF SUMMARY OUTPUT FILE *> 6 UNIT NUMBER OF SUMMARY FILE *> 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -43,6 +43,7 @@ *> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. *> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> DGEMMT T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -90,7 +91,7 @@ PROGRAM DBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 7 ) DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) INTEGER NMAX @@ -132,7 +133,7 @@ PROGRAM DBLAT3 COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'DGEMM ', 'DSYMM ', 'DTRMM ', 'DTRSM ', - $ 'DSYRK ', 'DSYR2K'/ + $ 'DSYRK ', 'DSYR2K', 'DGEMMT'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -309,7 +310,7 @@ PROGRAM DBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM * Test DGEMM, 01. 140 CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -338,6 +339,12 @@ PROGRAM DBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test DGEMMT, 07. + 185 CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -1882,7 +1889,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) ALPHA = ONE BETA = TWO * - GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM + GO TO ( 10, 20, 30, 40, 50, 60, 70 )ISNUM 10 INFOT = 1 CALL DGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -1967,7 +1974,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL DGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 20 INFOT = 1 CALL DSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2034,7 +2041,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL DSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 30 INFOT = 1 CALL DTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2143,7 +2150,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 40 INFOT = 1 CALL DTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2252,7 +2259,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL DTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 50 INFOT = 1 CALL DSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2307,7 +2314,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL DSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 60 INFOT = 1 CALL DSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2374,8 +2381,78 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL DSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 80 + 70 INFOT = 1 + CALL DGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL DGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL DGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 70 IF( OK )THEN + 80 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT @@ -2867,3 +2944,420 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * End of XERBLA * END + + SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests DGEMMT. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*6 SNAME +* .. Array Arguments .. + DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LDE, LDERES + EXTERNAL LDE, LDERES +* .. External Subroutines .. + EXTERNAL DGEMMT, DMAKE, DMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL DMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, + $ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL DGEMMT( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LDE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LDE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LDE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LDERES( 'GE', ' ', M, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL DMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + RETURN +* + 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', + $ 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of DCHK6 +* + END + + SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (DGEMMT) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH +* + END + diff --git a/BLAS/TESTING/dblat3.in b/BLAS/TESTING/dblat3.in index 0098f3e521..82e571ee84 100644 --- a/BLAS/TESTING/dblat3.in +++ b/BLAS/TESTING/dblat3.in @@ -18,3 +18,4 @@ DTRMM T PUT F FOR NO TEST. SAME COLUMNS. DTRSM T PUT F FOR NO TEST. SAME COLUMNS. DSYRK T PUT F FOR NO TEST. SAME COLUMNS. DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +DGEMMT T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index c4c1fccee8..a0522d96e8 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -19,7 +19,7 @@ *> Test program for the REAL Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 6 records +*> of the file are read using list-directed input, the last 7 records *> are read using the format ( A6, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 20 lines: @@ -43,6 +43,7 @@ *> STRSM T PUT F FOR NO TEST. SAME COLUMNS. *> SSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> SGEMMT T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -90,7 +91,7 @@ PROGRAM SBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 7 ) REAL ZERO, ONE PARAMETER ( ZERO = 0.0, ONE = 1.0 ) INTEGER NMAX @@ -132,7 +133,7 @@ PROGRAM SBLAT3 COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ', - $ 'SSYRK ', 'SSYR2K'/ + $ 'SSYRK ', 'SSYR2K', 'SGEMMT'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -309,7 +310,7 @@ PROGRAM SBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM * Test SGEMM, 01. 140 CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -338,6 +339,12 @@ PROGRAM SBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test SGEMMT, 07. + 185 CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + GO TO 190 * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -1866,7 +1873,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) REAL A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL CHKXER, SGEMM, SSYMM, SSYR2K, SSYRK, STRMM, - $ STRSM + $ STRSM, SGEMMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Executable Statements .. @@ -1882,7 +1889,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) ALPHA = ONE BETA = TWO * - GO TO ( 10, 20, 30, 40, 50, 60 )ISNUM + GO TO ( 10, 20, 30, 40, 50, 60, 70 )ISNUM 10 INFOT = 1 CALL SGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -1967,7 +1974,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL SGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 20 INFOT = 1 CALL SSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2034,7 +2041,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL SSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 30 INFOT = 1 CALL STRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2143,7 +2150,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL STRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 40 INFOT = 1 CALL STRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2252,7 +2259,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL STRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 50 INFOT = 1 CALL SSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2307,7 +2314,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL SSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 70 + GO TO 80 60 INFOT = 1 CALL SSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2374,8 +2381,78 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL SSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 80 + 70 INFOT = 1 + CALL SGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL SGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL SGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * - 70 IF( OK )THEN + 80 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT @@ -2865,5 +2942,422 @@ SUBROUTINE XERBLA( SRNAME, INFO ) $ ' *******' ) * * End of XERBLA +* + END + + + SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests SGEMMT. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*6 SNAME +* .. Array Arguments .. + REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LSE, LSERES + EXTERNAL LSE, LSERES +* .. External Subroutines .. + EXTERNAL SGEMMT, DMAKE, DMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL SMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, + $ UPLO, TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL SGEMMT( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LSE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LSE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LSE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LSERES( 'GE', ' ', M, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL SMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + RETURN +* + 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', + $ 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of DCHK6 +* + END + + SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (SGEMMT) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + REAL ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + REAL A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH * END diff --git a/BLAS/TESTING/sblat3.in b/BLAS/TESTING/sblat3.in index 5c4e3b83e1..9741a5dd61 100644 --- a/BLAS/TESTING/sblat3.in +++ b/BLAS/TESTING/sblat3.in @@ -18,3 +18,4 @@ STRMM T PUT F FOR NO TEST. SAME COLUMNS. STRSM T PUT F FOR NO TEST. SAME COLUMNS. SSYRK T PUT F FOR NO TEST. SAME COLUMNS. SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +SGEMMT T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index fb4d8019e9..9b54f6be8f 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -19,7 +19,7 @@ *> Test program for the COMPLEX*16 Level 3 Blas. *> *> The program must be driven by a short data file. The first 14 records -*> of the file are read using list-directed input, the last 9 records +*> of the file are read using list-directed input, the last 10 records *> are read using the format ( A6, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 23 lines: @@ -46,6 +46,7 @@ *> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> ZGEMMT T PUT F FOR NO TEST. SAME COLUMNS. *> *> *> Further Details @@ -94,7 +95,7 @@ PROGRAM ZBLAT3 INTEGER NIN PARAMETER ( NIN = 5 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX*16 ZERO, ONE PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), $ ONE = ( 1.0D0, 0.0D0 ) ) @@ -128,7 +129,8 @@ PROGRAM ZBLAT3 LOGICAL LZE EXTERNAL DDIFF, LZE * .. External Subroutines .. - EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHKE, ZMMCH + EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6 + EXTERNAL ZCHKE, ZMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. @@ -141,7 +143,7 @@ PROGRAM ZBLAT3 * .. Data statements .. DATA SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ', $ 'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K', - $ 'ZSYR2K'/ + $ 'ZSYR2K', 'ZGEMMT'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -319,7 +321,7 @@ PROGRAM ZBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test ZGEMM, 01. 140 CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -348,6 +350,13 @@ PROGRAM ZBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 +* Test ZGEMMT, 01. + 185 CALL ZCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G ) + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -2008,7 +2017,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INTEGER INFOT, NOUTC LOGICAL LERR, OK * .. Parameters .. - REAL ONE, TWO + DOUBLE PRECISION ONE, TWO PARAMETER ( ONE = 1.0D0, TWO = 2.0D0 ) * .. Local Scalars .. COMPLEX*16 ALPHA, BETA @@ -2038,7 +2047,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) RBETA = TWO * GO TO ( 10, 20, 30, 40, 50, 60, 70, 80, - $ 90 )ISNUM + $ 90, 100 )ISNUM 10 INFOT = 1 CALL ZGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2219,7 +2228,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 13 CALL ZGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 20 INFOT = 1 CALL ZHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2286,7 +2295,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 30 INFOT = 1 CALL ZSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2353,7 +2362,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 40 INFOT = 1 CALL ZTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2510,7 +2519,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL ZTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 50 INFOT = 1 CALL ZTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2667,7 +2676,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 11 CALL ZTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 60 INFOT = 1 CALL ZHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2722,7 +2731,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL ZHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 70 INFOT = 1 CALL ZSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2777,7 +2786,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 10 CALL ZSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 80 INFOT = 1 CALL ZHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2844,7 +2853,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) - GO TO 100 + GO TO 110 90 INFOT = 1 CALL ZSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) @@ -2911,8 +2920,186 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) INFOT = 12 CALL ZSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + 100 INFOT = 1 + CALL ZGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 1 + CALL ZGEMMT( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 2 + CALL ZGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMT( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMT( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMT( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGEMMT( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 3 + CALL ZGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZGEMMT( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 8 + CALL ZGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZGEMMT( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + + INFOT = 10 + CALL ZGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL ZGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL ZGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + INFOT = 13 + CALL ZGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) + GO TO 110 + * - 100 IF( OK )THEN + 110 IF( OK )THEN WRITE( NOUT, FMT = 9999 )SRNAMT ELSE WRITE( NOUT, FMT = 9998 )SRNAMT @@ -3496,3 +3683,498 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * End of XERBLA * END + + + + SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) +* +* Tests ZGEMMT. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO + PARAMETER ( RZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA + LOGICAL FATAL, REWI, TRACE + CHARACTER*6 SNAME +* .. Array Arguments .. + COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + DOUBLE PRECISION G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX*16 ALPHA, ALS, BETA, BLS + DOUBLE PRECISION ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LZE, LZERES + EXTERNAL LZE, LZERES +* .. External Subroutines .. + EXTERNAL CGEMM, ZMAKE, CMMCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ + +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL ZMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL ZMAKE( 'GE', UPLO, ' ', M, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO + $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, + $ BETA, LDC + IF( REWI ) + $ REWIND NTRA + CALL ZGEMMT( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, AA, LDA, BB, LDB, BETA, + $ CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLOS.EQ.UPLO + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LZE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LZE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LZE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LZERES( 'GE', ' ', M, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL ZMMTCH( UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, A, NMAX, B, NMAX, + $ BETA, C, NMAX, CT, G, CC, LDC, + $ EPS, ERR, FATAL, NOUT, .TRUE.) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + WRITE( NOUT, FMT = 9999 )SNAME, NC + ELSE + WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K, + $ ALPHA, LDA, LDB, BETA, LDC +* + 130 CONTINUE + RETURN +* + 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + $ 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of ZCHK6 +* + END + + SUBROUTINE ZMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO, RONE + PARAMETER ( RZERO = 0.0D0, RONE = 1.0D0 ) +* .. Scalar Arguments .. + COMPLEX*16 ALPHA, BETA + DOUBLE PRECISION EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + DOUBLE PRECISION G( * ) +* .. Local Scalars .. + COMPLEX*16 CL + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + DOUBLE PRECISION ABS1 +* .. Statement Function definitions .. + ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = 1 + + DO 220 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS1( ALPHA )*G( I ) + + $ ABS1( BETA )*ABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of ZMMTCH +* + END + diff --git a/BLAS/TESTING/zblat3.in b/BLAS/TESTING/zblat3.in index a3618b0f6d..ed6e9dd601 100644 --- a/BLAS/TESTING/zblat3.in +++ b/BLAS/TESTING/zblat3.in @@ -21,3 +21,4 @@ ZHERK T PUT F FOR NO TEST. SAME COLUMNS. ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +ZGEMMT T PUT F FOR NO TEST. SAME COLUMNS. From 5daea4888bce21288077b34ab97eea4bfd4005ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Thu, 20 Jul 2023 15:31:30 +0200 Subject: [PATCH 133/206] CBLAS routines for xGEMMT added --- CBLAS/include/cblas.h | 21 +++++++ CBLAS/include/cblas_64.h | 22 +++++++ CBLAS/include/cblas_f77.h | 38 ++++++++++++ CBLAS/include/cblas_test.h | 4 ++ CBLAS/src/CMakeLists.txt | 8 +-- CBLAS/src/Makefile | 8 +-- CBLAS/src/cblas_cgemm.c | 2 +- CBLAS/src/cblas_cgemmt.c | 122 ++++++++++++++++++++++++++++++++++++ CBLAS/src/cblas_dgemm.c | 2 +- CBLAS/src/cblas_dgemmt.c | 121 ++++++++++++++++++++++++++++++++++++ CBLAS/src/cblas_sgemm.c | 2 +- CBLAS/src/cblas_sgemmt.c | 123 +++++++++++++++++++++++++++++++++++++ CBLAS/src/cblas_zgemm.c | 2 +- CBLAS/src/cblas_zgemmt.c | 121 ++++++++++++++++++++++++++++++++++++ 14 files changed, 584 insertions(+), 12 deletions(-) create mode 100644 CBLAS/src/cblas_cgemmt.c create mode 100644 CBLAS/src/cblas_dgemmt.c create mode 100644 CBLAS/src/cblas_sgemmt.c create mode 100644 CBLAS/src/cblas_zgemmt.c diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index 171ff1d609..dfab386bb6 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -472,6 +472,12 @@ void cblas_sgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const float alpha, const float *A, const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, const float beta, float *C, const CBLAS_INT ldc); +void cblas_sgemmt(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc); + void cblas_ssymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, const float alpha, const float *A, const CBLAS_INT lda, @@ -502,6 +508,11 @@ void cblas_dgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const double alpha, const double *A, const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, const double beta, double *C, const CBLAS_INT ldc); +void cblas_dgemmt(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc); void cblas_dsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, const double alpha, const double *A, const CBLAS_INT lda, @@ -532,6 +543,11 @@ void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); +void cblas_cgemmt(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_csymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, @@ -562,6 +578,11 @@ void cblas_zgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); +void cblas_zgemmt(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc); void cblas_zsymm(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, diff --git a/CBLAS/include/cblas_64.h b/CBLAS/include/cblas_64.h index 3901ecf446..aa4125b9bf 100644 --- a/CBLAS/include/cblas_64.h +++ b/CBLAS/include/cblas_64.h @@ -423,6 +423,12 @@ void cblas_sgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const float alpha, const float *A, const int64_t lda, const float *B, const int64_t ldb, const float beta, float *C, const int64_t ldc); +void cblas_sgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const float alpha, const float *A, + const int64_t lda, const float *B, const int64_t ldb, + const float beta, float *C, const int64_t ldc); + void cblas_ssymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const int64_t M, const int64_t N, const float alpha, const float *A, const int64_t lda, @@ -453,6 +459,11 @@ void cblas_dgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const double alpha, const double *A, const int64_t lda, const double *B, const int64_t ldb, const double beta, double *C, const int64_t ldc); +void cblas_dgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const double alpha, const double *A, + const int64_t lda, const double *B, const int64_t ldb, + const double beta, double *C, const int64_t ldc); void cblas_dsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const int64_t M, const int64_t N, const double alpha, const double *A, const int64_t lda, @@ -483,6 +494,12 @@ void cblas_cgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, const void *beta, void *C, const int64_t ldc); +void cblas_cgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); + void cblas_csymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const int64_t M, const int64_t N, const void *alpha, const void *A, const int64_t lda, @@ -513,6 +530,11 @@ void cblas_zgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, const void *beta, void *C, const int64_t ldc); +void cblas_zgemmt_64(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, + CBLAS_TRANSPOSE TransB, const int64_t N, + const int64_t K, const void *alpha, const void *A, + const int64_t lda, const void *B, const int64_t ldb, + const void *beta, void *C, const int64_t ldc); void cblas_zsymm_64(CBLAS_LAYOUT layout, CBLAS_SIDE Side, CBLAS_UPLO Uplo, const int64_t M, const int64_t N, const void *alpha, const void *A, const int64_t lda, diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index c25bc621b5..35bd315336 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -197,24 +197,28 @@ #define F77_zherk_base F77_GLOBAL_SUFFIX(zherk,ZHERK) #define F77_zher2k_base F77_GLOBAL_SUFFIX(zher2k,ZHER2K) #define F77_sgemm_base F77_GLOBAL_SUFFIX(sgemm,SGEMM) +#define F77_sgemmt_base F77_GLOBAL_SUFFIX(sgemmt,SGEMMT) #define F77_ssymm_base F77_GLOBAL_SUFFIX(ssymm,SSYMM) #define F77_ssyrk_base F77_GLOBAL_SUFFIX(ssyrk,SSYRK) #define F77_ssyr2k_base F77_GLOBAL_SUFFIX(ssyr2k,SSYR2K) #define F77_strmm_base F77_GLOBAL_SUFFIX(strmm,STRMM) #define F77_strsm_base F77_GLOBAL_SUFFIX(strsm,STRSM) #define F77_dgemm_base F77_GLOBAL_SUFFIX(dgemm,DGEMM) +#define F77_dgemmt_base F77_GLOBAL_SUFFIX(dgemmt,DGEMMT) #define F77_dsymm_base F77_GLOBAL_SUFFIX(dsymm,DSYMM) #define F77_dsyrk_base F77_GLOBAL_SUFFIX(dsyrk,DSYRK) #define F77_dsyr2k_base F77_GLOBAL_SUFFIX(dsyr2k,DSYR2K) #define F77_dtrmm_base F77_GLOBAL_SUFFIX(dtrmm,DTRMM) #define F77_dtrsm_base F77_GLOBAL_SUFFIX(dtrsm,DTRSM) #define F77_cgemm_base F77_GLOBAL_SUFFIX(cgemm,CGEMM) +#define F77_cgemmt_base F77_GLOBAL_SUFFIX(cgemmt,CGEMMT) #define F77_csymm_base F77_GLOBAL_SUFFIX(csymm,CSYMM) #define F77_csyrk_base F77_GLOBAL_SUFFIX(csyrk,CSYRK) #define F77_csyr2k_base F77_GLOBAL_SUFFIX(csyr2k,CSYR2K) #define F77_ctrmm_base F77_GLOBAL_SUFFIX(ctrmm,CTRMM) #define F77_ctrsm_base F77_GLOBAL_SUFFIX(ctrsm,CTRSM) #define F77_zgemm_base F77_GLOBAL_SUFFIX(zgemm,ZGEMM) +#define F77_zgemmt_base F77_GLOBAL_SUFFIX(zgemmt,ZGEMMT) #define F77_zsymm_base F77_GLOBAL_SUFFIX(zsymm,ZSYMM) #define F77_zsyrk_base F77_GLOBAL_SUFFIX(zsyrk,ZSYRK) #define F77_zsyr2k_base F77_GLOBAL_SUFFIX(zsyr2k,ZSYR2K) @@ -389,6 +393,7 @@ /* Single Precision */ #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__, 1, 1) + #define F77_sgemmt(...) F77_sgemmt_base(__VA_ARGS__, 1, 1, 1) #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__, 1, 1) #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__, 1, 1) #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__, 1, 1) @@ -398,6 +403,7 @@ /* Double Precision */ #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__, 1, 1) + #define F77_dgemmt(...) F77_dgemmt_base(__VA_ARGS__, 1, 1, 1) #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__, 1, 1) #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__, 1, 1) #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__, 1, 1) @@ -407,6 +413,7 @@ /* Single Complex Precision */ #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__, 1, 1) + #define F77_cgemmt(...) F77_cgemmt_base(__VA_ARGS__, 1, 1, 1) #define F77_csymm(...) F77_csymm_base(__VA_ARGS__, 1, 1) #define F77_chemm(...) F77_chemm_base(__VA_ARGS__, 1, 1) #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__, 1, 1) @@ -419,6 +426,7 @@ /* Double Complex Precision */ #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__, 1, 1) + #define F77_zgemmt(...) F77_zgemmt_base(__VA_ARGS__, 1, 1, 1) #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__, 1, 1) #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__, 1, 1) #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__, 1, 1) @@ -513,6 +521,7 @@ /* Single Precision */ #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__) + #define F77_sgemmt(...) F77_sgemmt_base(__VA_ARGS__) #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__) #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__) #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__) @@ -522,6 +531,7 @@ /* Double Precision */ #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__) + #define F77_dgemmt(...) F77_dgemmt_base(__VA_ARGS__) #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__) #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__) #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__) @@ -531,6 +541,7 @@ /* Single Complex Precision */ #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__) + #define F77_cgemmt(...) F77_cgemmt_base(__VA_ARGS__) #define F77_csymm(...) F77_csymm_base(__VA_ARGS__) #define F77_chemm(...) F77_chemm_base(__VA_ARGS__) #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__) @@ -543,6 +554,7 @@ /* Double Complex Precision */ #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__) + #define F77_zgemmt(...) F77_zgemmt_base(__VA_ARGS__) #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__) #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__) #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__) @@ -981,6 +993,12 @@ void F77_sgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float * , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); +void F77_sgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , size_t, size_t, size_t +#endif +); + void F77_ssymm_base(FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN @@ -1014,6 +1032,12 @@ void F77_dgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); +void F77_dgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , size_t, size_t, size_t +#endif +); + void F77_dsymm_base(FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN @@ -1047,6 +1071,13 @@ void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); + +void F77_cgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + void F77_csymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN @@ -1095,6 +1126,13 @@ void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); + +void F77_zgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +#ifdef BLAS_FORTRAN_STRLEN_END + , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN +#endif +); + void F77_zsymm_base(FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index 663176f9b5..9da8c28a0e 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -167,24 +167,28 @@ typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX; #define F77_zherk F77_GLOBAL(czherk,CZHERK) #define F77_zher2k F77_GLOBAL(czher2k,CZHER2K) #define F77_sgemm F77_GLOBAL(csgemm,CSGEMM) +#define F77_sgemmt F77_GLOBAL(csgemmt,CSGEMMT) #define F77_ssymm F77_GLOBAL(cssymm,CSSYMM) #define F77_ssyrk F77_GLOBAL(cssyrk,CSSYRK) #define F77_ssyr2k F77_GLOBAL(cssyr2k,CSSYR2K) #define F77_strmm F77_GLOBAL(cstrmm,CSTRMM) #define F77_strsm F77_GLOBAL(cstrsm,CSTRSM) #define F77_dgemm F77_GLOBAL(cdgemm,CDGEMM) +#define F77_dgemmt F77_GLOBAL(cdgemmt,CDGEMMT) #define F77_dsymm F77_GLOBAL(cdsymm,CDSYMM) #define F77_dsyrk F77_GLOBAL(cdsyrk,CDSYRK) #define F77_dsyr2k F77_GLOBAL(cdsyr2k,CDSYR2K) #define F77_dtrmm F77_GLOBAL(cdtrmm,CDTRMM) #define F77_dtrsm F77_GLOBAL(cdtrsm,CDTRSM) #define F77_cgemm F77_GLOBAL(ccgemm,CCGEMM) +#define F77_cgemmt F77_GLOBAL(ccgemmt,CCGEMMT) #define F77_csymm F77_GLOBAL(ccsymm,CCSYMM) #define F77_csyrk F77_GLOBAL(ccsyrk,CCSYRK) #define F77_csyr2k F77_GLOBAL(ccsyr2k,CCSYR2K) #define F77_ctrmm F77_GLOBAL(cctrmm,CCTRMM) #define F77_ctrsm F77_GLOBAL(cctrsm,CCTRSM) #define F77_zgemm F77_GLOBAL(czgemm,CZGEMM) +#define F77_zgemmt F77_GLOBAL(czgemmt,CZGEMMT) #define F77_zsymm F77_GLOBAL(czsymm,CZSYMM) #define F77_zsyrk F77_GLOBAL(czsyrk,CZSYRK) #define F77_zsyr2k F77_GLOBAL(czsyr2k,CZSYR2K) diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 3724852007..67926534e9 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -85,21 +85,21 @@ set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c # Files for level 3 single precision real set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c - cblas_strsm.c) + cblas_strsm.c cblas_sgemmt.c) # Files for level 3 double precision real set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c - cblas_dtrsm.c) + cblas_dtrsm.c cblas_cgemmt.c) # Files for level 3 single precision complex set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c - cblas_csyr2k.c) + cblas_csyr2k.c cblas_cgemmt.c) # Files for level 3 double precision complex set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c - cblas_zsyr2k.c) + cblas_zsyr2k.c cblas_zgemmt.c) set(SOURCES) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index a455cd66be..ba0b63a487 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -137,21 +137,21 @@ zlib2: $(zlev2) $(errhand) # Files for level 3 single precision real slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \ - cblas_strsm.o + cblas_strsm.o cblas_sgemmt.o # Files for level 3 double precision real dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \ - cblas_dtrsm.o + cblas_dtrsm.o cblas_dgemmt.o # Files for level 3 single precision complex clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \ cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \ - cblas_csyr2k.o + cblas_csyr2k.o cblas_cgemmt.o # Files for level 3 double precision complex zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \ cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \ - cblas_zsyr2k.o + cblas_zsyr2k.o cblas_zgemmt.o .PHONY: slib3 dlib3 clib3 zlib3 # Single precision real diff --git a/CBLAS/src/cblas_cgemm.c b/CBLAS/src/cblas_cgemm.c index fe4b599a19..5950ed1f8c 100644 --- a/CBLAS/src/cblas_cgemm.c +++ b/CBLAS/src/cblas_cgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_cgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cgemmt.c b/CBLAS/src/cblas_cgemmt.c new file mode 100644 index 0000000000..4d63dd284d --- /dev/null +++ b/CBLAS/src/cblas_cgemmt.c @@ -0,0 +1,122 @@ +/* + * + * cblas_cgemm.c + * This program is a C interface to cgemm. + * Written by Keita Teranishi + * 4/8/1998 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_cgemm_t)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) +{ + char TA, TB; + char UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else + #define F77_TA &TA + #define F77_TB &TB + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if( layout == CblasColMajor ) + { + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmt", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmt", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_cgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmt", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmt", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + + #endif + + F77_cgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmt", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_dgemm.c b/CBLAS/src/cblas_dgemm.c index bee9aa8a68..c4ae0275c2 100644 --- a/CBLAS/src/cblas_dgemm.c +++ b/CBLAS/src/cblas_dgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_dgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dgemmt.c b/CBLAS/src/cblas_dgemmt.c new file mode 100644 index 0000000000..84242f5c83 --- /dev/null +++ b/CBLAS/src/cblas_dgemmt.c @@ -0,0 +1,121 @@ +/* + * + * cblas_dgemm.c + * This program is a C interface to dgemm. + * Written by Keita Teranishi + * 4/8/1998 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB. F77_UL; +#else + #define F77_TA &TA + #define F77_TB &TB + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + if( layout == CblasColMajor ) + { + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmt","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmt","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_dgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, + &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmt","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmt","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_dgemmt( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, + &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmt", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} diff --git a/CBLAS/src/cblas_sgemm.c b/CBLAS/src/cblas_sgemm.c index a7b21fb58b..26be2a8f0a 100644 --- a/CBLAS/src/cblas_sgemm.c +++ b/CBLAS/src/cblas_sgemm.c @@ -90,7 +90,7 @@ void API_SUFFIX(cblas_sgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_sgemm", + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_sgemmt.c b/CBLAS/src/cblas_sgemmt.c new file mode 100644 index 0000000000..89024c8998 --- /dev/null +++ b/CBLAS/src/cblas_sgemmt.c @@ -0,0 +1,123 @@ +/* + * + * cblas_sgemm.c + * This program is a C interface to sgemm. + * Written by Keita Teranishi + * 4/8/1998 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else + #define F77_TA &TA + #define F77_TB &TB + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + if( layout == CblasColMajor ) + { + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmt", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmt", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_sgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmt", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmt", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_sgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } else + API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmt", + "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; +} diff --git a/CBLAS/src/cblas_zgemm.c b/CBLAS/src/cblas_zgemm.c index 3aaf59abc7..9b3b66e568 100644 --- a/CBLAS/src/cblas_zgemm.c +++ b/CBLAS/src/cblas_zgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_zgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zgemmt.c b/CBLAS/src/cblas_zgemmt.c new file mode 100644 index 0000000000..1bfe59e33c --- /dev/null +++ b/CBLAS/src/cblas_zgemmt.c @@ -0,0 +1,121 @@ +/* + * + * cblas_zgemm.c + * This program is a C interface to zgemm. + * Written by Keita Teranishi + * 4/8/1998 + * + */ + +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) +{ + char TA, TB, UL; +#ifdef F77_CHAR + F77_CHAR F77_TA, F77_TB, F77_UL; +#else + #define F77_TA &TA + #define F77_TB &TB + #define F77_UL &UL +#endif + +#ifdef F77_INT + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; +#else + #define F77_N N + #define F77_K K + #define F77_lda lda + #define F77_ldb ldb + #define F77_ldc ldc +#endif + + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + if( layout == CblasColMajor ) + { + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmt","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmt","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_zgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmt","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmt","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + #ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + #endif + + F77_zgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmt", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; +} From 630fb5b85c88ed5592704497bf315f8cb10c676a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jul 2023 14:00:46 +0200 Subject: [PATCH 134/206] Tests for cblas_cgemmt --- CBLAS/include/cblas.h | 2 +- CBLAS/src/cblas_cgemm.c | 2 +- CBLAS/src/cblas_cgemmt.c | 29 +- CBLAS/testing/c_c3chke.c | 227 +++++++++++++++ CBLAS/testing/c_cblas3.c | 81 ++++++ CBLAS/testing/c_cblat3.f | 580 ++++++++++++++++++++++++++++++++++++++- CBLAS/testing/cin3 | 1 + 7 files changed, 901 insertions(+), 21 deletions(-) diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index dfab386bb6..c323e9e5aa 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -544,7 +544,7 @@ void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); void cblas_cgemmt(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, - CBLAS_TRANSPOSE TransB, const CBLAS_INT M, const CBLAS_INT N, + CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); diff --git a/CBLAS/src/cblas_cgemm.c b/CBLAS/src/cblas_cgemm.c index 5950ed1f8c..fe4b599a19 100644 --- a/CBLAS/src/cblas_cgemm.c +++ b/CBLAS/src/cblas_cgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_cgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cgemmt.c b/CBLAS/src/cblas_cgemmt.c index 4d63dd284d..2d2fae25e7 100644 --- a/CBLAS/src/cblas_cgemmt.c +++ b/CBLAS/src/cblas_cgemmt.c @@ -9,7 +9,7 @@ #include "cblas.h" #include "cblas_f77.h" -void API_SUFFIX(cblas_cgemm_t)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, +void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, @@ -41,17 +41,18 @@ void API_SUFFIX(cblas_cgemm_t)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; CBLAS_CallFromC = 1; - if ( Uplo == CblasUpper ) UL = 'U'; - else if (Uplo == CblasLower) UL= 'L'; - else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } if( layout == CblasColMajor ) { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransA == CblasTrans) TA='T'; else if ( TransA == CblasConjTrans ) TA='C'; else if ( TransA == CblasNoTrans ) TA='N'; @@ -85,6 +86,16 @@ void API_SUFFIX(cblas_cgemm_t)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, } else if (layout == CblasRowMajor) { RowMajorStrg = 1; + + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransA == CblasTrans) TB='T'; else if ( TransA == CblasConjTrans ) TB='C'; else if ( TransA == CblasNoTrans ) TB='N'; diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 7f28f09106..6cbfcdd97d 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -282,6 +282,233 @@ void F77_c3chke(char * rout cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + } else if (strncmp( sf,"cblas_cgemmt" ,12)==0) { + cblas_rout = "cblas_cgemmt" ; + + cblas_info = 1; + cblas_cgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_cgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_cgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_cgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); } else if (strncmp( sf,"cblas_chemm" ,11)==0) { cblas_rout = "cblas_chemm" ; diff --git a/CBLAS/testing/c_cblas3.c b/CBLAS/testing/c_cblas3.c index c8e4705cc1..eb07aaa1c5 100644 --- a/CBLAS/testing/c_cblas3.c +++ b/CBLAS/testing/c_cblas3.c @@ -91,6 +91,87 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } + +void F77_cgemmt(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, + CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { + + CBLAS_TEST_COMPLEX *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + else { + LDA = *n+1; + A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + else { + LDB = *k+1; + B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + + LDC = *n+1; + C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j].real=c[j*(*ldc)+i].real; + C[i*LDC+j].imag=c[j*(*ldc)+i].imag; + } + cblas_cgemmt( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + B, LDB, beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i].real=C[i*LDC+j].real; + c[j*(*ldc)+i].imag=C[i*LDC+j].imag; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + cblas_cgemmt( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); + else + cblas_cgemmt( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); +} + + void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index 94144b8750..eb4e1124ba 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -3,10 +3,10 @@ PROGRAM CBLAT3 * Test program for the COMPLEX Level 3 Blas. * * The program must be driven by a short data file. The first 13 records -* of the file are read using list-directed input, the last 9 records +* of the file are read using list-directed input, the last 10 records * are read using the format ( A12, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the -* following 22 lines: +* following 23 lines: * 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE * -1 UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0) * F LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD. @@ -29,6 +29,7 @@ PROGRAM CBLAT3 * cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. * cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. * cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cgemmt T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -49,7 +50,7 @@ PROGRAM CBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX ZERO, ONE PARAMETER ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) ) REAL RZERO, RHALF, RONE @@ -83,7 +84,7 @@ PROGRAM CBLAT3 LOGICAL LCE EXTERNAL SDIFF, LCE * .. External Subroutines .. - EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CMMCH + EXTERNAL CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHK6, CMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. @@ -97,7 +98,7 @@ PROGRAM CBLAT3 DATA SNAMES/'cblas_cgemm ', 'cblas_chemm ', $ 'cblas_csymm ', 'cblas_ctrmm ', 'cblas_ctrsm ', $ 'cblas_cherk ', 'cblas_csyrk ', 'cblas_cher2k', - $ 'cblas_csyr2k'/ + $ 'cblas_csyr2k', 'cblas_cgemmt' / * .. Executable Statements .. * NOUTC = NOUT @@ -295,7 +296,7 @@ PROGRAM CBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185 )ISNUM * Test CGEMM, 01. 140 IF (CORDER) THEN CALL CCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -329,13 +330,13 @@ PROGRAM CBLAT3 CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test CHERK, 06, CSYRK, 07. @@ -357,15 +358,30 @@ PROGRAM CBLAT3 CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) END IF GO TO 190 +* Test CGEMMT, 10. + 185 IF (CORDER) THEN + CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) + END IF + IF (RORDER) THEN + CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) + END IF + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -2785,3 +2801,547 @@ REAL FUNCTION SDIFF( X, Y ) * End of SDIFF. * END + + SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER ) + IMPLICIT NONE +* +* Tests CGEMMT. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*12 SNAME +* .. Array Arguments .. + COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + REAL G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX ALPHA, ALS, BETA, BLS + REAL ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LCE, LCERES + EXTERNAL LCE, LCERES +* .. External Subroutines .. + EXTERNAL CCGEMM, CMAKE, CMMCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0. +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL CMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL CMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE(IS:IS) +* +* Generate the matrix C. +* + CALL CMAKE( 'ge', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL CPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CCGEMMT(IORDER, UPLO, TRANSA, TRANSB, N, + $ K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO .EQ. UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LCE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LCE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LCE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LCERES( 'ge', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL CMMTCH( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + RETURN +* +10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of CCHK6. +* + END + + SUBROUTINE CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + COMPLEX ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*12 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', + $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) + END + + SUBROUTINE CMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, + $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, + $ NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + REAL RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX ALPHA, BETA + REAL EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + REAL G( * ) +* .. Local Scalars .. + COMPLEX CL + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, AIMAG, CONJG, MAX, REAL, SQRT +* .. Statement Functions .. + REAL ABS1 +* .. Statement Function definitions .. + ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) ) +* .. Executable Statements .. + + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' + + ISTART = 1 + ISTOP = N +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + DO 220 J = 1, N +* + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )* + $ CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS1( ALPHA )*G( I ) + + $ ABS1( BETA )*ABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of CMMCH. +* + END + diff --git a/CBLAS/testing/cin3 b/CBLAS/testing/cin3 index 7b34f267bb..3854aef885 100644 --- a/CBLAS/testing/cin3 +++ b/CBLAS/testing/cin3 @@ -20,3 +20,4 @@ cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_cgemmt T PUT F FOR NO TEST. SAME COLUMNS. From b25cf2c8d4aae92748b0694d179b9b75c101648f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 09:42:06 +0200 Subject: [PATCH 135/206] Update documentation of xGEMMT --- BLAS/SRC/cgemmt.f | 4 ++-- BLAS/SRC/dgemmt.f | 2 +- BLAS/SRC/sgemmt.f | 2 +- BLAS/SRC/zgemmt.f | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/BLAS/SRC/cgemmt.f b/BLAS/SRC/cgemmt.f index e6071a345b..653e9877c1 100644 --- a/BLAS/SRC/cgemmt.f +++ b/BLAS/SRC/cgemmt.f @@ -37,8 +37,8 @@ *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. *> Thereby, the routine only accesses and updates the upper or lower -*> triangular part of the result matrix C. This behaviour can be used, -*> the resulting matrix C is known to be symmetric. +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be Hermitian or symmetric. *> \endverbatim * * Arguments: diff --git a/BLAS/SRC/dgemmt.f b/BLAS/SRC/dgemmt.f index 718fafb17f..5d767ee607 100644 --- a/BLAS/SRC/dgemmt.f +++ b/BLAS/SRC/dgemmt.f @@ -37,7 +37,7 @@ *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. *> Thereby, the routine only accesses and updates the upper or lower -*> triangular part of the result matrix C. This behaviour can be used, +*> triangular part of the result matrix C. This behaviour can be used if *> the resulting matrix C is known to be symmetric. *> \endverbatim * diff --git a/BLAS/SRC/sgemmt.f b/BLAS/SRC/sgemmt.f index 3875e63664..b2ad38e275 100644 --- a/BLAS/SRC/sgemmt.f +++ b/BLAS/SRC/sgemmt.f @@ -37,7 +37,7 @@ *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. *> Thereby, the routine only accesses and updates the upper or lower -*> triangular part of the result matrix C. This behaviour can be used, +*> triangular part of the result matrix C. This behaviour can be used if *> the resulting matrix C is known to be symmetric. *> \endverbatim * diff --git a/BLAS/SRC/zgemmt.f b/BLAS/SRC/zgemmt.f index 37828abaad..5533c780a7 100644 --- a/BLAS/SRC/zgemmt.f +++ b/BLAS/SRC/zgemmt.f @@ -37,8 +37,8 @@ *> alpha and beta are scalars, and A, B and C are matrices, with op( A ) *> an n by k matrix, op( B ) a k by n matrix and C an n by n matrix. *> Thereby, the routine only accesses and updates the upper or lower -*> triangular part of the result matrix C. This behaviour can be used, -*> the resulting matrix C is known to be symmetric. +*> triangular part of the result matrix C. This behaviour can be used if +*> the resulting matrix C is known to be Hermitian or symmetric. *> \endverbatim * * Arguments: From fb5325d58d3252ef5dd8be633ba2b0d2195da155 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 09:48:10 +0200 Subject: [PATCH 136/206] Fix implicit variable --- BLAS/TESTING/sblat3.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index a0522d96e8..fb396775a0 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -3146,7 +3146,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 12 ) = LSE( CS, CC, LCC ) ELSE - ISAME( 12 ) = LSERES( 'GE', ' ', M, N, + ISAME( 12 ) = LSERES( 'GE', ' ', N, N, $ CS, CC, LDC ) END IF ISAME( 13 ) = LDCS.EQ.LDC From 2f80551ce3a3c24237b038e3e5d126ad772e1dc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 09:52:51 +0200 Subject: [PATCH 137/206] Fix further implicit variables --- BLAS/TESTING/cblat3.f | 2 +- BLAS/TESTING/dblat3.f | 2 +- BLAS/TESTING/zblat3.f | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index a8cd24c123..efe798add7 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -3879,7 +3879,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 12 ) = LCE( CS, CC, LCC ) ELSE - ISAME( 12 ) = LCERES( 'GE', ' ', M, N, CS, + ISAME( 12 ) = LCERES( 'GE', ' ', N, N, CS, $ CC, LDC ) END IF ISAME( 13 ) = LDCS.EQ.LDC diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index ddfbbfbd6a..24c5eb7782 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -3145,7 +3145,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 12 ) = LDE( CS, CC, LCC ) ELSE - ISAME( 12 ) = LDERES( 'GE', ' ', M, N, + ISAME( 12 ) = LDERES( 'GE', ' ', N, N, $ CS, CC, LDC ) END IF ISAME( 13 ) = LDCS.EQ.LDC diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 9b54f6be8f..ca974cfb77 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -3893,7 +3893,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, IF( NULL )THEN ISAME( 12 ) = LZE( CS, CC, LCC ) ELSE - ISAME( 12 ) = LZERES( 'GE', ' ', M, N, CS, + ISAME( 12 ) = LZERES( 'GE', ' ', N, N, CS, $ CC, LDC ) END IF ISAME( 13 ) = LDCS.EQ.LDC From 05d01da9f2281ef0e49382b6cd37757dc67eb534 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 09:58:58 +0200 Subject: [PATCH 138/206] Fix missing comma --- BLAS/TESTING/cblat3.f | 2 +- BLAS/TESTING/zblat3.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index efe798add7..1e8c40ae64 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -3846,7 +3846,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Call the subroutine. * IF( TRACE ) - $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO, $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, $ BETA, LDC IF( REWI ) diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index ca974cfb77..3e6e338ce2 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -3860,7 +3860,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * Call the subroutine. * IF( TRACE ) - $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, UPLO, $ TRANSA, TRANSB, N, K, ALPHA, LDA, LDB, $ BETA, LDC IF( REWI ) From 6f66c83ae0c2c0aeb7de5637d661cb5673ca2146 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 10:24:26 +0200 Subject: [PATCH 139/206] Remove useless variable --- BLAS/TESTING/cblat3.f | 4 ++-- BLAS/TESTING/zblat3.f | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 1e8c40ae64..1d11c1554d 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -3708,7 +3708,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, COMPLEX ALPHA, ALS, BETA, BLS REAL ERR, ERRMAX INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, - $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, $ MA, MB, N, NA, NARGS, NB, NC, NS, IS LOGICAL NULL, RESET, SAME, TRANA, TRANB CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS @@ -3815,7 +3815,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the matrix C. * - CALL CMAKE( 'GE', UPLO, ' ', M, N, C, NMAX, + CALL CMAKE( 'GE', UPLO, ' ', N, N, C, NMAX, $ CC, LDC, RESET, ZERO ) * NC = NC + 1 diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 3e6e338ce2..96a6928bfb 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -3722,7 +3722,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, COMPLEX*16 ALPHA, ALS, BETA, BLS DOUBLE PRECISION ERR, ERRMAX INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, - $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, $ MA, MB, N, NA, NARGS, NB, NC, NS, IS LOGICAL NULL, RESET, SAME, TRANA, TRANB CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS @@ -3829,7 +3829,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Generate the matrix C. * - CALL ZMAKE( 'GE', UPLO, ' ', M, N, C, NMAX, + CALL ZMAKE( 'GE', UPLO, ' ', N, N, C, NMAX, $ CC, LDC, RESET, ZERO ) * NC = NC + 1 From 785d734bf5677acaa439dce53c76f45664b55cb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 11:04:51 +0200 Subject: [PATCH 140/206] Fix wrong write --- BLAS/TESTING/cblat3.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 1d11c1554d..7d60c1d1f2 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -3938,7 +3938,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K, + WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE From 6173b6e47447b463806e4f6e0b84afec0c25d0d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Tue, 22 Aug 2023 11:12:35 +0200 Subject: [PATCH 141/206] Fix another variable --- BLAS/TESTING/zblat3.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 96a6928bfb..1b7c98e96a 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -3952,7 +3952,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE WRITE( NOUT, FMT = 9996 )SNAME - WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K, + WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K, $ ALPHA, LDA, LDB, BETA, LDC * 130 CONTINUE From 327869db1b83eb82b19aca657cdc9eee235e0053 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jun 2024 09:27:51 +0200 Subject: [PATCH 142/206] Rename GEMMT to GEMMTR in BLAS/ After the discussion on https://github.com/Reference-LAPACK/lapack/pull/887 the name changed from xGEMMT to xGEMMTR. --- BLAS/SRC/CMakeLists.txt | 8 +- BLAS/SRC/Makefile | 8 +- BLAS/SRC/{cgemmt.f => cgemmtr.f} | 12 +-- BLAS/SRC/{dgemmt.f => dgemmtr.f} | 10 +-- BLAS/SRC/{sgemmt.f => sgemmtr.f} | 12 +-- BLAS/SRC/{zgemmt.f => zgemmtr.f} | 12 +-- BLAS/TESTING/cblat3.f | 122 +++++++++++++++--------------- BLAS/TESTING/cblat3.in | 2 +- BLAS/TESTING/dblat3.f | 60 +++++++-------- BLAS/TESTING/dblat3.in | 2 +- BLAS/TESTING/sblat3.f | 62 ++++++++-------- BLAS/TESTING/sblat3.in | 2 +- BLAS/TESTING/zblat3.f | 124 +++++++++++++++---------------- BLAS/TESTING/zblat3.in | 2 +- 14 files changed, 219 insertions(+), 219 deletions(-) rename BLAS/SRC/{cgemmt.f => cgemmtr.f} (98%) rename BLAS/SRC/{dgemmt.f => dgemmtr.f} (97%) rename BLAS/SRC/{sgemmt.f => sgemmtr.f} (97%) rename BLAS/SRC/{zgemmt.f => zgemmtr.f} (98%) diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt index 7af9f451c8..b9e6f7c4a5 100644 --- a/BLAS/SRC/CMakeLists.txt +++ b/BLAS/SRC/CMakeLists.txt @@ -82,15 +82,15 @@ set(ZBLAS2 zgemv.f zgbmv.f zhemv.f zhbmv.f zhpmv.f #--------------------------------------------------------- # Level 3 BLAS #--------------------------------------------------------- -set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f sgemmt.f) +set(SBLAS3 sgemm.f ssymm.f ssyrk.f ssyr2k.f strmm.f strsm.f sgemmtr.f) set(CBLAS3 cgemm.f csymm.f csyrk.f csyr2k.f ctrmm.f ctrsm.f - chemm.f cherk.f cher2k.f cgemmt.f) + chemm.f cherk.f cher2k.f cgemmtr.f) -set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f dgemmt.f) +set(DBLAS3 dgemm.f dsymm.f dsyrk.f dsyr2k.f dtrmm.f dtrsm.f dgemmtr.f) set(ZBLAS3 zgemm.f zsymm.f zsyrk.f zsyr2k.f ztrmm.f ztrsm.f - zhemm.f zherk.f zher2k.f zgemmt.f) + zhemm.f zherk.f zher2k.f zgemmtr.f) set(SOURCES) diff --git a/BLAS/SRC/Makefile b/BLAS/SRC/Makefile index 145f40ff42..486571fec6 100644 --- a/BLAS/SRC/Makefile +++ b/BLAS/SRC/Makefile @@ -127,18 +127,18 @@ $(ZBLAS2): $(FRC) # Comment out the next 4 definitions if you already have # the Level 3 BLAS. #--------------------------------------------------------- -SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o sgemmt.o +SBLAS3 = sgemm.o ssymm.o ssyrk.o ssyr2k.o strmm.o strsm.o sgemmtr.o $(SBLAS3): $(FRC) CBLAS3 = cgemm.o csymm.o csyrk.o csyr2k.o ctrmm.o ctrsm.o \ - chemm.o cherk.o cher2k.o cgemmt.o + chemm.o cherk.o cher2k.o cgemmtr.o $(CBLAS3): $(FRC) -DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o dgemmt.o +DBLAS3 = dgemm.o dsymm.o dsyrk.o dsyr2k.o dtrmm.o dtrsm.o dgemmtr.o $(DBLAS3): $(FRC) ZBLAS3 = zgemm.o zsymm.o zsyrk.o zsyr2k.o ztrmm.o ztrsm.o \ - zhemm.o zherk.o zher2k.o zgemmt.o + zhemm.o zherk.o zher2k.o zgemmtr.o $(ZBLAS3): $(FRC) ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \ diff --git a/BLAS/SRC/cgemmt.f b/BLAS/SRC/cgemmtr.f similarity index 98% rename from BLAS/SRC/cgemmt.f rename to BLAS/SRC/cgemmtr.f index 653e9877c1..5124a4a195 100644 --- a/BLAS/SRC/cgemmt.f +++ b/BLAS/SRC/cgemmtr.f @@ -1,4 +1,4 @@ -*> \brief \b CGEMMT +*> \brief \b CGEMMTR * * =========== DOCUMENTATION =========== * @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, * C,LDC) * * .. Scalar Arguments .. @@ -26,7 +26,7 @@ *> *> \verbatim *> -*> CGEMMT performs one of the matrix-matrix operations +*> CGEMMTR performs one of the matrix-matrix operations *> *> C := alpha*op( A )*op( B ) + beta*C, *> @@ -186,7 +186,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + BETA,C,LDC) IMPLICIT NONE * @@ -272,7 +272,7 @@ SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, INFO = 13 END IF IF (INFO.NE.0) THEN - CALL XERBLA('CGEMMT',INFO) + CALL XERBLA('CGEMMTR',INFO) RETURN END IF * @@ -565,6 +565,6 @@ SUBROUTINE CGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * RETURN * -* End of CGEMMT +* End of CGEMMTR * END diff --git a/BLAS/SRC/dgemmt.f b/BLAS/SRC/dgemmtr.f similarity index 97% rename from BLAS/SRC/dgemmt.f rename to BLAS/SRC/dgemmtr.f index 5d767ee607..3a54f17b6f 100644 --- a/BLAS/SRC/dgemmt.f +++ b/BLAS/SRC/dgemmtr.f @@ -1,4 +1,4 @@ -*> \brief \b DGEMMT +*> \brief \b DGEMMTR * * =========== DOCUMENTATION =========== * @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE DGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, * C,LDC) * * .. Scalar Arguments .. @@ -26,7 +26,7 @@ *> *> \verbatim *> -*> DGEMMT performs one of the matrix-matrix operations +*> DGEMMTR performs one of the matrix-matrix operations *> *> C := alpha*op( A )*op( B ) + beta*C, *> @@ -186,7 +186,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + BETA,C,LDC) IMPLICIT NONE * @@ -266,7 +266,7 @@ SUBROUTINE DGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, INFO = 13 END IF IF (INFO.NE.0) THEN - CALL XERBLA('DGEMMT',INFO) + CALL XERBLA('DGEMMTR',INFO) RETURN END IF * diff --git a/BLAS/SRC/sgemmt.f b/BLAS/SRC/sgemmtr.f similarity index 97% rename from BLAS/SRC/sgemmt.f rename to BLAS/SRC/sgemmtr.f index b2ad38e275..053075f2ff 100644 --- a/BLAS/SRC/sgemmt.f +++ b/BLAS/SRC/sgemmtr.f @@ -1,4 +1,4 @@ -*> \brief \b SGEMMT +*> \brief \b SGEMMTR * * =========== DOCUMENTATION =========== * @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, * C,LDC) * * .. Scalar Arguments .. @@ -26,7 +26,7 @@ *> *> \verbatim *> -*> SGEMMT performs one of the matrix-matrix operations +*> SGEMMTR performs one of the matrix-matrix operations *> *> C := alpha*op( A )*op( B ) + beta*C, *> @@ -186,7 +186,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + BETA,C,LDC) IMPLICIT NONE * @@ -266,7 +266,7 @@ SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, INFO = 13 END IF IF (INFO.NE.0) THEN - CALL XERBLA('SGEMMT',INFO) + CALL XERBLA('SGEMMTR',INFO) RETURN END IF * @@ -427,6 +427,6 @@ SUBROUTINE SGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * RETURN * -* End of SGEMMT +* End of SGEMMTR * END diff --git a/BLAS/SRC/zgemmt.f b/BLAS/SRC/zgemmtr.f similarity index 98% rename from BLAS/SRC/zgemmt.f rename to BLAS/SRC/zgemmtr.f index 5533c780a7..18adf02dd7 100644 --- a/BLAS/SRC/zgemmt.f +++ b/BLAS/SRC/zgemmtr.f @@ -1,4 +1,4 @@ -*> \brief \b ZGEMMT +*> \brief \b ZGEMMTR * * =========== DOCUMENTATION =========== * @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, +* SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB,BETA, * C,LDC) * * .. Scalar Arguments .. @@ -26,7 +26,7 @@ *> *> \verbatim *> -*> ZGEMMT performs one of the matrix-matrix operations +*> ZGEMMTR performs one of the matrix-matrix operations *> *> C := alpha*op( A )*op( B ) + beta*C, *> @@ -186,7 +186,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, + BETA,C,LDC) IMPLICIT NONE * @@ -272,7 +272,7 @@ SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, INFO = 13 END IF IF (INFO.NE.0) THEN - CALL XERBLA('ZGEMMT',INFO) + CALL XERBLA('ZGEMMTR',INFO) RETURN END IF * @@ -565,6 +565,6 @@ SUBROUTINE ZGEMMT(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * RETURN * -* End of ZGEMMT +* End of ZGEMMTR * END diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 7d60c1d1f2..3d9ed49d52 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -46,7 +46,7 @@ *> CSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> CHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -*> CGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +*> CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -141,7 +141,7 @@ PROGRAM CBLAT3 * .. Data statements .. DATA SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ', $ 'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K', - $ 'CSYR2K', 'CGEMMT'/ + $ 'CSYR2K', 'CGEMMTR'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -2913,179 +2913,179 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 110 100 INFOT = 1 - CALL CGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL CGEMMT( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CGEMMT( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CGEMMT( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL CGEMMT( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL CGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL CGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL CGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 110 @@ -3676,7 +3676,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) * -* Tests CGEMMT. +* Tests CGEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * @@ -3851,7 +3851,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ BETA, LDC IF( REWI ) $ REWIND NTRA - CALL CGEMMT( UPLO, TRANSA, TRANSB, N, K, + CALL CGEMMTR( UPLO, TRANSA, TRANSB, N, K, $ ALPHA, AA, LDA, BB, LDB, BETA, $ CC, LDC ) * diff --git a/BLAS/TESTING/cblat3.in b/BLAS/TESTING/cblat3.in index 686fe64084..a98873cfc7 100644 --- a/BLAS/TESTING/cblat3.in +++ b/BLAS/TESTING/cblat3.in @@ -21,4 +21,4 @@ CHERK T PUT F FOR NO TEST. SAME COLUMNS. CSYRK T PUT F FOR NO TEST. SAME COLUMNS. CHER2K T PUT F FOR NO TEST. SAME COLUMNS. CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -CGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index 24c5eb7782..011cf5f45a 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -43,7 +43,7 @@ *> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. *> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -*> DGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +*> DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -133,7 +133,7 @@ PROGRAM DBLAT3 COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'DGEMM ', 'DSYMM ', 'DTRMM ', 'DTRSM ', - $ 'DSYRK ', 'DSYR2K', 'DGEMMT'/ + $ 'DSYRK ', 'DSYR2K', 'DGEMMTR'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -339,7 +339,7 @@ PROGRAM DBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 -* Test DGEMMT, 07. +* Test DGEMMTR, 07. 185 CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, @@ -2383,73 +2383,73 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 80 70 INFOT = 1 - CALL DGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL DGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL DGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL DGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL DGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL DGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL DGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * 80 IF( OK )THEN @@ -2949,7 +2949,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) * -* Tests DGEMMT. +* Tests DGEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2986,7 +2986,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DGEMMT, DMAKE, DMMTCH + EXTERNAL DGEMMTR, DMAKE, DMMTCH * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -3117,7 +3117,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL DGEMMT( UPLO, TRANSA, TRANSB, N, + CALL DGEMMTR( UPLO, TRANSA, TRANSB, N, $ K, ALPHA, AA, LDA, BB, LDB, $ BETA, CC, LDC ) * @@ -3236,7 +3236,7 @@ SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, * * Checks the results of the computational tests. * -* Auxiliary routine for test program for Level 3 Blas. (DGEMMT) +* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR) * * -- Written on 19-July-2023. * Martin Koehler, MPI Magdeburg diff --git a/BLAS/TESTING/dblat3.in b/BLAS/TESTING/dblat3.in index 82e571ee84..839163fa45 100644 --- a/BLAS/TESTING/dblat3.in +++ b/BLAS/TESTING/dblat3.in @@ -18,4 +18,4 @@ DTRMM T PUT F FOR NO TEST. SAME COLUMNS. DTRSM T PUT F FOR NO TEST. SAME COLUMNS. DSYRK T PUT F FOR NO TEST. SAME COLUMNS. DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -DGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index fb396775a0..94a1961dab 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -43,7 +43,7 @@ *> STRSM T PUT F FOR NO TEST. SAME COLUMNS. *> SSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -*> SGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +*> SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details *> =============== @@ -133,7 +133,7 @@ PROGRAM SBLAT3 COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ', - $ 'SSYRK ', 'SSYR2K', 'SGEMMT'/ + $ 'SSYRK ', 'SSYR2K', 'SGEMMTR'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -339,7 +339,7 @@ PROGRAM SBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 -* Test SGEMMT, 07. +* Test SGEMMTR, 07. 185 CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, @@ -1873,7 +1873,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) REAL A( 2, 1 ), B( 2, 1 ), C( 2, 1 ) * .. External Subroutines .. EXTERNAL CHKXER, SGEMM, SSYMM, SSYR2K, SSYRK, STRMM, - $ STRSM, SGEMMT + $ STRSM, SGEMMTR * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR * .. Executable Statements .. @@ -2383,73 +2383,73 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 80 70 INFOT = 1 - CALL SGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL SGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL SGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL SGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL SGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL SGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL SGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL SGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL SGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL SGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL SGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL SGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL SGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * 80 IF( OK )THEN @@ -2950,7 +2950,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) * -* Tests SGEMMT. +* Tests SGEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2987,7 +2987,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SGEMMT, DMAKE, DMMTCH + EXTERNAL SGEMMTR, DMAKE, DMMTCH * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -3118,7 +3118,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC IF( REWI ) $ REWIND NTRA - CALL SGEMMT( UPLO, TRANSA, TRANSB, N, + CALL SGEMMTR( UPLO, TRANSA, TRANSB, N, $ K, ALPHA, AA, LDA, BB, LDB, $ BETA, CC, LDC ) * @@ -3237,7 +3237,7 @@ SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, * * Checks the results of the computational tests. * -* Auxiliary routine for test program for Level 3 Blas. (SGEMMT) +* Auxiliary routine for test program for Level 3 Blas. (SGEMMTR) * * -- Written on 19-July-2023. * Martin Koehler, MPI Magdeburg diff --git a/BLAS/TESTING/sblat3.in b/BLAS/TESTING/sblat3.in index 9741a5dd61..2013046003 100644 --- a/BLAS/TESTING/sblat3.in +++ b/BLAS/TESTING/sblat3.in @@ -18,4 +18,4 @@ STRMM T PUT F FOR NO TEST. SAME COLUMNS. STRSM T PUT F FOR NO TEST. SAME COLUMNS. SSYRK T PUT F FOR NO TEST. SAME COLUMNS. SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -SGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 1b7c98e96a..a2b85ce961 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -46,7 +46,7 @@ *> ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. *> ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. *> ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -*> ZGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +*> ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> *> Further Details @@ -143,7 +143,7 @@ PROGRAM ZBLAT3 * .. Data statements .. DATA SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ', $ 'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K', - $ 'ZSYR2K', 'ZGEMMT'/ + $ 'ZSYR2K', 'ZGEMMTR'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -350,7 +350,7 @@ PROGRAM ZBLAT3 $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W ) GO TO 190 -* Test ZGEMMT, 01. +* Test ZGEMMTR, 01. 185 CALL ZCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, @@ -2922,179 +2922,179 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 110 100 INFOT = 1 - CALL ZGEMMT( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'N', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'N', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'T', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'T', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'T', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'C', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'C', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 1 - CALL ZGEMMT( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( '/', 'C', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'L', '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'L', '/', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZGEMMT( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'L', '/', 'T', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZGEMMT( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZGEMMT( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZGEMMT( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMT( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMT( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) + CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL ZGEMMT( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL ZGEMMT( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL ZGEMMT( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 10 - CALL ZGEMMT( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'C', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZGEMMT( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) GO TO 110 @@ -3690,7 +3690,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G ) * -* Tests ZGEMMT. +* Tests ZGEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * @@ -3865,7 +3865,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ BETA, LDC IF( REWI ) $ REWIND NTRA - CALL ZGEMMT( UPLO, TRANSA, TRANSB, N, K, + CALL ZGEMMTR( UPLO, TRANSA, TRANSB, N, K, $ ALPHA, AA, LDA, BB, LDB, BETA, $ CC, LDC ) * diff --git a/BLAS/TESTING/zblat3.in b/BLAS/TESTING/zblat3.in index ed6e9dd601..6160d7af99 100644 --- a/BLAS/TESTING/zblat3.in +++ b/BLAS/TESTING/zblat3.in @@ -21,4 +21,4 @@ ZHERK T PUT F FOR NO TEST. SAME COLUMNS. ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -ZGEMMT T PUT F FOR NO TEST. SAME COLUMNS. +ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. From 81b3767a5a782b9986cbb4048d336142f9987de2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jun 2024 09:32:20 +0200 Subject: [PATCH 143/206] Change xGEMMT to xGEMMTR in CBLAS/ --- CBLAS/include/cblas.h | 8 ++--- CBLAS/include/cblas_64.h | 8 ++--- CBLAS/include/cblas_f77.h | 32 +++++++++---------- CBLAS/include/cblas_test.h | 8 ++--- CBLAS/src/CMakeLists.txt | 8 ++--- CBLAS/src/Makefile | 8 ++--- CBLAS/src/{cblas_cgemmt.c => cblas_cgemmtr.c} | 20 ++++++------ CBLAS/src/{cblas_dgemmt.c => cblas_dgemmtr.c} | 18 +++++------ CBLAS/src/{cblas_sgemmt.c => cblas_sgemmtr.c} | 18 +++++------ CBLAS/src/{cblas_zgemmt.c => cblas_zgemmtr.c} | 18 +++++------ CBLAS/testing/c_c3chke.c | 4 +-- CBLAS/testing/c_cblas3.c | 8 ++--- CBLAS/testing/c_cblat3.f | 10 +++--- CBLAS/testing/cin3 | 2 +- 14 files changed, 85 insertions(+), 85 deletions(-) rename CBLAS/src/{cblas_cgemmt.c => cblas_cgemmtr.c} (75%) rename CBLAS/src/{cblas_dgemmt.c => cblas_dgemmtr.c} (76%) rename CBLAS/src/{cblas_sgemmt.c => cblas_sgemmtr.c} (80%) rename CBLAS/src/{cblas_zgemmt.c => cblas_zgemmtr.c} (76%) diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index c323e9e5aa..b8baf4eca5 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -472,7 +472,7 @@ void cblas_sgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const float alpha, const float *A, const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, const float beta, float *C, const CBLAS_INT ldc); -void cblas_sgemmt(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_sgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const float alpha, const float *A, const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, @@ -508,7 +508,7 @@ void cblas_dgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const double alpha, const double *A, const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, const double beta, double *C, const CBLAS_INT ldc); -void cblas_dgemmt(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_dgemmtr(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const double alpha, const double *A, const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, @@ -543,7 +543,7 @@ void cblas_cgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); -void cblas_cgemmt(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_cgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, @@ -578,7 +578,7 @@ void cblas_zgemm(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, const void *beta, void *C, const CBLAS_INT ldc); -void cblas_zgemmt(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_zgemmtr(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, diff --git a/CBLAS/include/cblas_64.h b/CBLAS/include/cblas_64.h index aa4125b9bf..16504d9142 100644 --- a/CBLAS/include/cblas_64.h +++ b/CBLAS/include/cblas_64.h @@ -423,7 +423,7 @@ void cblas_sgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const float alpha, const float *A, const int64_t lda, const float *B, const int64_t ldb, const float beta, float *C, const int64_t ldc); -void cblas_sgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_sgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const int64_t N, const int64_t K, const float alpha, const float *A, const int64_t lda, const float *B, const int64_t ldb, @@ -459,7 +459,7 @@ void cblas_dgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const double alpha, const double *A, const int64_t lda, const double *B, const int64_t ldb, const double beta, double *C, const int64_t ldc); -void cblas_dgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_dgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const int64_t N, const int64_t K, const double alpha, const double *A, const int64_t lda, const double *B, const int64_t ldb, @@ -494,7 +494,7 @@ void cblas_cgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, const void *beta, void *C, const int64_t ldc); -void cblas_cgemmt_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_cgemmtr_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const int64_t N, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, @@ -530,7 +530,7 @@ void cblas_zgemm_64(CBLAS_LAYOUT layout, CBLAS_TRANSPOSE TransA, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, const void *beta, void *C, const int64_t ldc); -void cblas_zgemmt_64(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, +void cblas_zgemmtr_64(CBLAS_LAYOUT layout,CBLAS_UPLO Uplo, CBLAS_TRANSPOSE TransA, CBLAS_TRANSPOSE TransB, const int64_t N, const int64_t K, const void *alpha, const void *A, const int64_t lda, const void *B, const int64_t ldb, diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 35bd315336..4880690f6f 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -197,28 +197,28 @@ #define F77_zherk_base F77_GLOBAL_SUFFIX(zherk,ZHERK) #define F77_zher2k_base F77_GLOBAL_SUFFIX(zher2k,ZHER2K) #define F77_sgemm_base F77_GLOBAL_SUFFIX(sgemm,SGEMM) -#define F77_sgemmt_base F77_GLOBAL_SUFFIX(sgemmt,SGEMMT) +#define F77_sgemmtr_base F77_GLOBAL_SUFFIX(sgemmtr,SGEMMTR) #define F77_ssymm_base F77_GLOBAL_SUFFIX(ssymm,SSYMM) #define F77_ssyrk_base F77_GLOBAL_SUFFIX(ssyrk,SSYRK) #define F77_ssyr2k_base F77_GLOBAL_SUFFIX(ssyr2k,SSYR2K) #define F77_strmm_base F77_GLOBAL_SUFFIX(strmm,STRMM) #define F77_strsm_base F77_GLOBAL_SUFFIX(strsm,STRSM) #define F77_dgemm_base F77_GLOBAL_SUFFIX(dgemm,DGEMM) -#define F77_dgemmt_base F77_GLOBAL_SUFFIX(dgemmt,DGEMMT) +#define F77_dgemmtr_base F77_GLOBAL_SUFFIX(dgemmtr,DGEMMTR) #define F77_dsymm_base F77_GLOBAL_SUFFIX(dsymm,DSYMM) #define F77_dsyrk_base F77_GLOBAL_SUFFIX(dsyrk,DSYRK) #define F77_dsyr2k_base F77_GLOBAL_SUFFIX(dsyr2k,DSYR2K) #define F77_dtrmm_base F77_GLOBAL_SUFFIX(dtrmm,DTRMM) #define F77_dtrsm_base F77_GLOBAL_SUFFIX(dtrsm,DTRSM) #define F77_cgemm_base F77_GLOBAL_SUFFIX(cgemm,CGEMM) -#define F77_cgemmt_base F77_GLOBAL_SUFFIX(cgemmt,CGEMMT) +#define F77_cgemmtr_base F77_GLOBAL_SUFFIX(cgemmtr,CGEMMTR) #define F77_csymm_base F77_GLOBAL_SUFFIX(csymm,CSYMM) #define F77_csyrk_base F77_GLOBAL_SUFFIX(csyrk,CSYRK) #define F77_csyr2k_base F77_GLOBAL_SUFFIX(csyr2k,CSYR2K) #define F77_ctrmm_base F77_GLOBAL_SUFFIX(ctrmm,CTRMM) #define F77_ctrsm_base F77_GLOBAL_SUFFIX(ctrsm,CTRSM) #define F77_zgemm_base F77_GLOBAL_SUFFIX(zgemm,ZGEMM) -#define F77_zgemmt_base F77_GLOBAL_SUFFIX(zgemmt,ZGEMMT) +#define F77_zgemmtr_base F77_GLOBAL_SUFFIX(zgemmtr,ZGEMMTR) #define F77_zsymm_base F77_GLOBAL_SUFFIX(zsymm,ZSYMM) #define F77_zsyrk_base F77_GLOBAL_SUFFIX(zsyrk,ZSYRK) #define F77_zsyr2k_base F77_GLOBAL_SUFFIX(zsyr2k,ZSYR2K) @@ -393,7 +393,7 @@ /* Single Precision */ #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__, 1, 1) - #define F77_sgemmt(...) F77_sgemmt_base(__VA_ARGS__, 1, 1, 1) + #define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__, 1, 1, 1) #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__, 1, 1) #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__, 1, 1) #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__, 1, 1) @@ -403,7 +403,7 @@ /* Double Precision */ #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__, 1, 1) - #define F77_dgemmt(...) F77_dgemmt_base(__VA_ARGS__, 1, 1, 1) + #define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__, 1, 1, 1) #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__, 1, 1) #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__, 1, 1) #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__, 1, 1) @@ -413,7 +413,7 @@ /* Single Complex Precision */ #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__, 1, 1) - #define F77_cgemmt(...) F77_cgemmt_base(__VA_ARGS__, 1, 1, 1) + #define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__, 1, 1, 1) #define F77_csymm(...) F77_csymm_base(__VA_ARGS__, 1, 1) #define F77_chemm(...) F77_chemm_base(__VA_ARGS__, 1, 1) #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__, 1, 1) @@ -426,7 +426,7 @@ /* Double Complex Precision */ #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__, 1, 1) - #define F77_zgemmt(...) F77_zgemmt_base(__VA_ARGS__, 1, 1, 1) + #define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__, 1, 1, 1) #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__, 1, 1) #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__, 1, 1) #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__, 1, 1) @@ -521,7 +521,7 @@ /* Single Precision */ #define F77_sgemm(...) F77_sgemm_base(__VA_ARGS__) - #define F77_sgemmt(...) F77_sgemmt_base(__VA_ARGS__) + #define F77_sgemmtr(...) F77_sgemmtr_base(__VA_ARGS__) #define F77_ssymm(...) F77_ssymm_base(__VA_ARGS__) #define F77_ssyrk(...) F77_ssyrk_base(__VA_ARGS__) #define F77_ssyr2k(...) F77_ssyr2k_base(__VA_ARGS__) @@ -531,7 +531,7 @@ /* Double Precision */ #define F77_dgemm(...) F77_dgemm_base(__VA_ARGS__) - #define F77_dgemmt(...) F77_dgemmt_base(__VA_ARGS__) + #define F77_dgemmtr(...) F77_dgemmtr_base(__VA_ARGS__) #define F77_dsymm(...) F77_dsymm_base(__VA_ARGS__) #define F77_dsyrk(...) F77_dsyrk_base(__VA_ARGS__) #define F77_dsyr2k(...) F77_dsyr2k_base(__VA_ARGS__) @@ -541,7 +541,7 @@ /* Single Complex Precision */ #define F77_cgemm(...) F77_cgemm_base(__VA_ARGS__) - #define F77_cgemmt(...) F77_cgemmt_base(__VA_ARGS__) + #define F77_cgemmtr(...) F77_cgemmtr_base(__VA_ARGS__) #define F77_csymm(...) F77_csymm_base(__VA_ARGS__) #define F77_chemm(...) F77_chemm_base(__VA_ARGS__) #define F77_csyrk(...) F77_csyrk_base(__VA_ARGS__) @@ -554,7 +554,7 @@ /* Double Complex Precision */ #define F77_zgemm(...) F77_zgemm_base(__VA_ARGS__) - #define F77_zgemmt(...) F77_zgemmt_base(__VA_ARGS__) + #define F77_zgemmtr(...) F77_zgemmtr_base(__VA_ARGS__) #define F77_zsymm(...) F77_zsymm_base(__VA_ARGS__) #define F77_zhemm(...) F77_zhemm_base(__VA_ARGS__) #define F77_zsyrk(...) F77_zsyrk_base(__VA_ARGS__) @@ -993,7 +993,7 @@ void F77_sgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const float *, const float * , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_sgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT +void F77_sgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const float *, const float *, FINT, const float *, FINT, const float *, float *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , size_t, size_t, size_t #endif @@ -1032,7 +1032,7 @@ void F77_dgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const double *, const double , FORTRAN_STRLEN, FORTRAN_STRLEN #endif ); -void F77_dgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT +void F77_dgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const double *, const double *, FINT, const double *, FINT, const double *, double *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , size_t, size_t, size_t #endif @@ -1072,7 +1072,7 @@ void F77_cgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, #endif ); -void F77_cgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +void F77_cgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif @@ -1127,7 +1127,7 @@ void F77_zgemm_base(FCHAR, FCHAR, FINT, FINT, FINT, const void *, const void *, #endif ); -void F77_zgemmt_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT +void F77_zgemmtr_base(FCHAR, FCHAR, FCHAR, FINT, FINT, const void *, const void *, FINT, const void *, FINT, const void *, void *, FINT #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN #endif diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index 9da8c28a0e..4374cb378f 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -167,28 +167,28 @@ typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX; #define F77_zherk F77_GLOBAL(czherk,CZHERK) #define F77_zher2k F77_GLOBAL(czher2k,CZHER2K) #define F77_sgemm F77_GLOBAL(csgemm,CSGEMM) -#define F77_sgemmt F77_GLOBAL(csgemmt,CSGEMMT) +#define F77_sgemmtr F77_GLOBAL(csgemmtr,CSGEMMTR) #define F77_ssymm F77_GLOBAL(cssymm,CSSYMM) #define F77_ssyrk F77_GLOBAL(cssyrk,CSSYRK) #define F77_ssyr2k F77_GLOBAL(cssyr2k,CSSYR2K) #define F77_strmm F77_GLOBAL(cstrmm,CSTRMM) #define F77_strsm F77_GLOBAL(cstrsm,CSTRSM) #define F77_dgemm F77_GLOBAL(cdgemm,CDGEMM) -#define F77_dgemmt F77_GLOBAL(cdgemmt,CDGEMMT) +#define F77_dgemmtr F77_GLOBAL(cdgemmtr,CDGEMMTR) #define F77_dsymm F77_GLOBAL(cdsymm,CDSYMM) #define F77_dsyrk F77_GLOBAL(cdsyrk,CDSYRK) #define F77_dsyr2k F77_GLOBAL(cdsyr2k,CDSYR2K) #define F77_dtrmm F77_GLOBAL(cdtrmm,CDTRMM) #define F77_dtrsm F77_GLOBAL(cdtrsm,CDTRSM) #define F77_cgemm F77_GLOBAL(ccgemm,CCGEMM) -#define F77_cgemmt F77_GLOBAL(ccgemmt,CCGEMMT) +#define F77_cgemmtr F77_GLOBAL(ccgemmtr,CCGEMMTR) #define F77_csymm F77_GLOBAL(ccsymm,CCSYMM) #define F77_csyrk F77_GLOBAL(ccsyrk,CCSYRK) #define F77_csyr2k F77_GLOBAL(ccsyr2k,CCSYR2K) #define F77_ctrmm F77_GLOBAL(cctrmm,CCTRMM) #define F77_ctrsm F77_GLOBAL(cctrsm,CCTRSM) #define F77_zgemm F77_GLOBAL(czgemm,CZGEMM) -#define F77_zgemmt F77_GLOBAL(czgemmt,CZGEMMT) +#define F77_zgemmtr F77_GLOBAL(czgemmtr,CZGEMMTR) #define F77_zsymm F77_GLOBAL(czsymm,CZSYMM) #define F77_zsyrk F77_GLOBAL(czsyrk,CZSYRK) #define F77_zsyr2k F77_GLOBAL(czsyr2k,CZSYR2K) diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 67926534e9..2979d91a6d 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -85,21 +85,21 @@ set(ZLEV2 cblas_zgemv.c cblas_zgbmv.c cblas_zhemv.c cblas_zhbmv.c cblas_zhpmv.c # Files for level 3 single precision real set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c - cblas_strsm.c cblas_sgemmt.c) + cblas_strsm.c cblas_sgemmtr.c) # Files for level 3 double precision real set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c - cblas_dtrsm.c cblas_cgemmt.c) + cblas_dtrsm.c cblas_cgemmtr.c) # Files for level 3 single precision complex set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c cblas_cher2k.c cblas_ctrmm.c cblas_ctrsm.c cblas_csyrk.c - cblas_csyr2k.c cblas_cgemmt.c) + cblas_csyr2k.c cblas_cgemmtr.c) # Files for level 3 double precision complex set(ZLEV3 cblas_zgemm.c cblas_zsymm.c cblas_zhemm.c cblas_zherk.c cblas_zher2k.c cblas_ztrmm.c cblas_ztrsm.c cblas_zsyrk.c - cblas_zsyr2k.c cblas_zgemmt.c) + cblas_zsyr2k.c cblas_zgemmtr.c) set(SOURCES) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index ba0b63a487..abc3192c6a 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -137,21 +137,21 @@ zlib2: $(zlev2) $(errhand) # Files for level 3 single precision real slev3 = cblas_sgemm.o cblas_ssymm.o cblas_ssyrk.o cblas_ssyr2k.o cblas_strmm.o \ - cblas_strsm.o cblas_sgemmt.o + cblas_strsm.o cblas_sgemmtr.o # Files for level 3 double precision real dlev3 = cblas_dgemm.o cblas_dsymm.o cblas_dsyrk.o cblas_dsyr2k.o cblas_dtrmm.o \ - cblas_dtrsm.o cblas_dgemmt.o + cblas_dtrsm.o cblas_dgemmtr.o # Files for level 3 single precision complex clev3 = cblas_cgemm.o cblas_csymm.o cblas_chemm.o cblas_cherk.o \ cblas_cher2k.o cblas_ctrmm.o cblas_ctrsm.o cblas_csyrk.o \ - cblas_csyr2k.o cblas_cgemmt.o + cblas_csyr2k.o cblas_cgemmtr.o # Files for level 3 double precision complex zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \ cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \ - cblas_zsyr2k.o cblas_zgemmt.o + cblas_zsyr2k.o cblas_zgemmtr.o .PHONY: slib3 dlib3 clib3 zlib3 # Single precision real diff --git a/CBLAS/src/cblas_cgemmt.c b/CBLAS/src/cblas_cgemmtr.c similarity index 75% rename from CBLAS/src/cblas_cgemmt.c rename to CBLAS/src/cblas_cgemmtr.c index 2d2fae25e7..9eb3592ca3 100644 --- a/CBLAS/src/cblas_cgemmt.c +++ b/CBLAS/src/cblas_cgemmtr.c @@ -9,7 +9,7 @@ #include "cblas.h" #include "cblas_f77.h" -void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, +void API_SUFFIX(cblas_cgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, @@ -47,7 +47,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, if ( Uplo == CblasUpper ) UL = 'U'; else if (Uplo == CblasLower) UL= 'L'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -58,7 +58,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmt", "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -69,7 +69,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmt", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -81,7 +81,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_cgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } else if (layout == CblasRowMajor) { @@ -90,7 +90,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, if ( Uplo == CblasUpper ) UL = 'L'; else if (Uplo == CblasLower) UL= 'U'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmt", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -101,7 +101,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmt", "Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,7 +111,7 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmt", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -123,10 +123,10 @@ void API_SUFFIX(cblas_cgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, #endif - F77_cgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); } - else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmt", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dgemmt.c b/CBLAS/src/cblas_dgemmtr.c similarity index 76% rename from CBLAS/src/cblas_dgemmt.c rename to CBLAS/src/cblas_dgemmtr.c index 84242f5c83..99a2fa81a8 100644 --- a/CBLAS/src/cblas_dgemmt.c +++ b/CBLAS/src/cblas_dgemmtr.c @@ -9,7 +9,7 @@ #include "cblas.h" #include "cblas_f77.h" -void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, +void API_SUFFIX(cblas_dgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const double alpha, const double *A, const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, @@ -43,7 +43,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, if ( Uplo == CblasUpper ) UL = 'U'; else if (Uplo == CblasLower) UL= 'L'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmt", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmt","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -68,7 +68,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmt","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_dgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, + F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); } else if (layout == CblasRowMajor) { @@ -90,7 +90,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmt","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +100,7 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmt","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,10 +111,10 @@ void API_SUFFIX(cblas_dgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_dgemmt( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, + F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); } - else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmt", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sgemmt.c b/CBLAS/src/cblas_sgemmtr.c similarity index 80% rename from CBLAS/src/cblas_sgemmt.c rename to CBLAS/src/cblas_sgemmtr.c index 89024c8998..f2f9528ee9 100644 --- a/CBLAS/src/cblas_sgemmt.c +++ b/CBLAS/src/cblas_sgemmtr.c @@ -9,7 +9,7 @@ #include "cblas.h" #include "cblas_f77.h" -void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, +void API_SUFFIX(cblas_sgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const float alpha, const float *A, const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, @@ -43,7 +43,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, if ( Uplo == CblasUpper ) UL = 'U'; else if (Uplo == CblasLower) UL= 'L'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmt", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmt", + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -69,7 +69,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmt", + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -82,7 +82,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_sgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); } else if (layout == CblasRowMajor) { RowMajorStrg = 1; @@ -91,7 +91,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmt", + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", "Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -102,7 +102,7 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmt", + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; @@ -114,9 +114,9 @@ void API_SUFFIX(cblas_sgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_sgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); } else - API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmt", + API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmtr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_zgemmt.c b/CBLAS/src/cblas_zgemmtr.c similarity index 76% rename from CBLAS/src/cblas_zgemmt.c rename to CBLAS/src/cblas_zgemmtr.c index 1bfe59e33c..c01ecb2d1d 100644 --- a/CBLAS/src/cblas_zgemmt.c +++ b/CBLAS/src/cblas_zgemmtr.c @@ -9,7 +9,7 @@ #include "cblas.h" #include "cblas_f77.h" -void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, +void API_SUFFIX(cblas_zgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, const CBLAS_INT K, const void *alpha, const void *A, const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, @@ -43,7 +43,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, if ( Uplo == CblasUpper ) UL = 'U'; else if (Uplo == CblasLower) UL= 'L'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmt", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -57,7 +57,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmt","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -68,7 +68,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmt","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -80,7 +80,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_zgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); } else if (layout == CblasRowMajor) { @@ -90,7 +90,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransA == CblasNoTrans ) TB='N'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmt","Illegal TransA setting, %d\n", TransA); + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -100,7 +100,7 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmt","Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; @@ -111,10 +111,10 @@ void API_SUFFIX(cblas_zgemmt)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, F77_UL = C2F_CHAR(&UL); #endif - F77_zgemmt(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); } - else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmt", "Illegal layout setting, %d\n", layout); + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmtr", "Illegal layout setting, %d\n", layout); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 6cbfcdd97d..d9d2e12158 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -282,8 +282,8 @@ void F77_c3chke(char * rout cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_cgemmt" ,12)==0) { - cblas_rout = "cblas_cgemmt" ; + } else if (strncmp( sf,"cblas_cgemmtr" ,12)==0) { + cblas_rout = "cblas_cgemmtr" ; cblas_info = 1; cblas_cgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, diff --git a/CBLAS/testing/c_cblas3.c b/CBLAS/testing/c_cblas3.c index eb07aaa1c5..ae5f3936b2 100644 --- a/CBLAS/testing/c_cblas3.c +++ b/CBLAS/testing/c_cblas3.c @@ -92,7 +92,7 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB b, *ldb, beta, c, *ldc ); } -void F77_cgemmt(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, +void F77_cgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc ) { @@ -152,7 +152,7 @@ void F77_cgemmt(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CB C[i*LDC+j].real=c[j*(*ldc)+i].real; C[i*LDC+j].imag=c[j*(*ldc)+i].imag; } - cblas_cgemmt( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + cblas_cgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, B, LDB, beta, C, LDC ); for( j=0; j<*n; j++ ) for( i=0; i<*n; i++ ) { @@ -164,10 +164,10 @@ void F77_cgemmt(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CB free(C); } else if (*layout == TEST_COL_MJR) - cblas_cgemmt( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + cblas_cgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); else - cblas_cgemmt( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, + cblas_cgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index eb4e1124ba..88a077350a 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -29,7 +29,7 @@ PROGRAM CBLAT3 * cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. * cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. * cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_cgemmt T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -98,7 +98,7 @@ PROGRAM CBLAT3 DATA SNAMES/'cblas_cgemm ', 'cblas_chemm ', $ 'cblas_csymm ', 'cblas_ctrmm ', 'cblas_ctrsm ', $ 'cblas_cherk ', 'cblas_csyrk ', 'cblas_cher2k', - $ 'cblas_csyr2k', 'cblas_cgemmt' / + $ 'cblas_csyr2k', 'cblas_cgemmtr' / * .. Executable Statements .. * NOUTC = NOUT @@ -367,7 +367,7 @@ PROGRAM CBLAT3 $ 1 ) END IF GO TO 190 -* Test CGEMMT, 10. +* Test CGEMMTR, 10. 185 IF (CORDER) THEN CALL CCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, @@ -2808,7 +2808,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ IORDER ) IMPLICIT NONE * -* Tests CGEMMT. +* Tests CGEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * @@ -2981,7 +2981,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC) IF( REWI ) $ REWIND NTRA - CALL CCGEMMT(IORDER, UPLO, TRANSA, TRANSB, N, + CALL CCGEMMTR(IORDER, UPLO, TRANSA, TRANSB, N, $ K, ALPHA, AA, LDA, BB, LDB, $ BETA, CC, LDC ) * diff --git a/CBLAS/testing/cin3 b/CBLAS/testing/cin3 index 3854aef885..093bf8e26a 100644 --- a/CBLAS/testing/cin3 +++ b/CBLAS/testing/cin3 @@ -20,4 +20,4 @@ cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. -cblas_cgemmt T PUT F FOR NO TEST. SAME COLUMNS. +cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS. From cb81e003b8a9defe2dbae8f1783143488914130b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jun 2024 12:37:09 +0200 Subject: [PATCH 144/206] Adjust BLAS test for routine names with at most 7 characters --- BLAS/TESTING/cblat3.f | 84 ++++++++++++++++----------- BLAS/TESTING/cblat3.in | 18 +++--- BLAS/TESTING/dblat3.f | 57 +++++++++++-------- BLAS/TESTING/dblat3.in | 12 ++-- BLAS/TESTING/sblat3.f | 125 ++++++++++++++++++++++------------------- BLAS/TESTING/sblat3.in | 12 ++-- BLAS/TESTING/zblat3.f | 84 ++++++++++++++++----------- BLAS/TESTING/zblat3.in | 18 +++--- 8 files changed, 232 insertions(+), 178 deletions(-) diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 3d9ed49d52..294fba674c 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -109,7 +109,7 @@ PROGRAM CBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -121,7 +121,7 @@ PROGRAM CBLAT3 REAL G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LCE @@ -134,7 +134,7 @@ PROGRAM CBLAT3 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -397,8 +397,8 @@ PROGRAM CBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -429,7 +429,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -714,7 +714,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -993,7 +993,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1303,7 +1303,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1635,7 +1635,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -2005,7 +2005,7 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK @@ -2969,58 +2969,76 @@ SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT ) CALL CGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL CGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 @@ -3601,7 +3619,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Executable Statements .. IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT @@ -3637,11 +3655,11 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR COMMON /SRNAMC/SRNAMT @@ -3695,7 +3713,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), diff --git a/BLAS/TESTING/cblat3.in b/BLAS/TESTING/cblat3.in index a98873cfc7..701180f550 100644 --- a/BLAS/TESTING/cblat3.in +++ b/BLAS/TESTING/cblat3.in @@ -12,13 +12,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -CGEMM T PUT F FOR NO TEST. SAME COLUMNS. -CHEMM T PUT F FOR NO TEST. SAME COLUMNS. -CSYMM T PUT F FOR NO TEST. SAME COLUMNS. -CTRMM T PUT F FOR NO TEST. SAME COLUMNS. -CTRSM T PUT F FOR NO TEST. SAME COLUMNS. -CHERK T PUT F FOR NO TEST. SAME COLUMNS. -CSYRK T PUT F FOR NO TEST. SAME COLUMNS. -CHER2K T PUT F FOR NO TEST. SAME COLUMNS. -CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +CGEMM T PUT F FOR NO TEST. SAME COLUMNS. +CHEMM T PUT F FOR NO TEST. SAME COLUMNS. +CSYMM T PUT F FOR NO TEST. SAME COLUMNS. +CTRMM T PUT F FOR NO TEST. SAME COLUMNS. +CTRSM T PUT F FOR NO TEST. SAME COLUMNS. +CHERK T PUT F FOR NO TEST. SAME COLUMNS. +CSYRK T PUT F FOR NO TEST. SAME COLUMNS. +CHER2K T PUT F FOR NO TEST. SAME COLUMNS. +CSYR2K T PUT F FOR NO TEST. SAME COLUMNS. CGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index 011cf5f45a..e45a1f91da 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -104,7 +104,7 @@ PROGRAM DBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -115,7 +115,7 @@ PROGRAM DBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE @@ -127,7 +127,7 @@ PROGRAM DBLAT3 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -387,8 +387,8 @@ PROGRAM DBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -417,7 +417,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -698,7 +698,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -968,7 +968,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1273,7 +1273,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1548,7 +1548,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1860,7 +1860,7 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK @@ -2398,31 +2398,40 @@ SUBROUTINE DCHKE( ISNUM, SRNAMT, NOUT ) CALL DGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL DGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL DGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, + $ 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 CALL DGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) @@ -2874,7 +2883,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Executable Statements .. IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT @@ -2910,11 +2919,11 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR COMMON /SRNAMC/SRNAMT @@ -2963,7 +2972,7 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), diff --git a/BLAS/TESTING/dblat3.in b/BLAS/TESTING/dblat3.in index 839163fa45..30b74c6e40 100644 --- a/BLAS/TESTING/dblat3.in +++ b/BLAS/TESTING/dblat3.in @@ -12,10 +12,10 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -DGEMM T PUT F FOR NO TEST. SAME COLUMNS. -DSYMM T PUT F FOR NO TEST. SAME COLUMNS. -DTRMM T PUT F FOR NO TEST. SAME COLUMNS. -DTRSM T PUT F FOR NO TEST. SAME COLUMNS. -DSYRK T PUT F FOR NO TEST. SAME COLUMNS. -DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +DGEMM T PUT F FOR NO TEST. SAME COLUMNS. +DSYMM T PUT F FOR NO TEST. SAME COLUMNS. +DTRMM T PUT F FOR NO TEST. SAME COLUMNS. +DTRSM T PUT F FOR NO TEST. SAME COLUMNS. +DSYRK T PUT F FOR NO TEST. SAME COLUMNS. +DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index 94a1961dab..d5c2aa7edb 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -20,7 +20,7 @@ *> *> The program must be driven by a short data file. The first 14 records *> of the file are read using list-directed input, the last 7 records -*> are read using the format ( A6, L2 ). An annotated example of a data +*> are read using the format ( A7, L2 ). An annotated example of a data *> file can be obtained by deleting the first 3 characters from the *> following 20 lines: *> 'sblat3.out' NAME OF SUMMARY OUTPUT FILE @@ -104,7 +104,7 @@ PROGRAM SBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -115,7 +115,7 @@ PROGRAM SBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LSE @@ -127,13 +127,13 @@ PROGRAM SBLAT3 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT * .. Data statements .. - DATA SNAMES/'SGEMM ', 'SSYMM ', 'STRMM ', 'STRSM ', - $ 'SSYRK ', 'SSYR2K', 'SGEMMTR'/ + DATA SNAMES/'SGEMM', 'SSYMM ', 'STRMM ', + $ 'STRSM ', 'SSYRK ', 'SSYR2K ', 'SGEMMTR'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -379,7 +379,7 @@ PROGRAM SBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN SMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1, @@ -387,8 +387,8 @@ PROGRAM SBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -417,7 +417,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -660,15 +660,15 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -698,7 +698,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -930,15 +930,15 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 120 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -968,7 +968,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1236,15 +1236,15 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1273,7 +1273,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1510,16 +1510,16 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1548,7 +1548,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1823,16 +1823,16 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1860,7 +1860,7 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK @@ -2398,31 +2398,40 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) CALL SGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL SGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL SGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL SGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 - CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) + CALL SGEMMTR( 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2, BETA, C, + $ 2 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 CALL SGEMMTR( 'U', 'N', 'T', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 ) @@ -2459,8 +2468,8 @@ SUBROUTINE SCHKE( ISNUM, SRNAMT, NOUT ) END IF RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' ) - 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****', + 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' ) + 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****', $ '**' ) * * End of SCHKE @@ -2874,7 +2883,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Executable Statements .. IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT @@ -2884,7 +2893,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) RETURN * 9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D', - $ 'ETECTED BY ', A6, ' *****' ) + $ 'ETECTED BY ', A7, ' *****' ) * * End of CHKXER * @@ -2910,11 +2919,11 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR COMMON /SRNAMC/SRNAMT @@ -2928,7 +2937,7 @@ SUBROUTINE XERBLA( SRNAME, INFO ) END IF OK = .FALSE. END IF - IF( SRNAME.NE.SRNAMT )THEN + IF( SRNAME .NE. SRNAME ) THEN WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT OK = .FALSE. END IF @@ -2936,8 +2945,8 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * 9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD', $ ' OF ', I2, ' *******' ) - 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE', - $ 'AD OF ', A6, ' *******' ) + 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A7, ' INSTE', + $ 'AD OF ', A7, ' *******' ) 9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, $ ' *******' ) * @@ -2964,7 +2973,7 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -3213,15 +3222,15 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * - 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', + 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL', $ 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, $ ' - SUSPECT *******' ) - 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',', + 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',', $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', diff --git a/BLAS/TESTING/sblat3.in b/BLAS/TESTING/sblat3.in index 2013046003..ea1a305875 100644 --- a/BLAS/TESTING/sblat3.in +++ b/BLAS/TESTING/sblat3.in @@ -12,10 +12,10 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -SGEMM T PUT F FOR NO TEST. SAME COLUMNS. -SSYMM T PUT F FOR NO TEST. SAME COLUMNS. -STRMM T PUT F FOR NO TEST. SAME COLUMNS. -STRSM T PUT F FOR NO TEST. SAME COLUMNS. -SSYRK T PUT F FOR NO TEST. SAME COLUMNS. -SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +SGEMM T PUT F FOR NO TEST. SAME COLUMNS. +SSYMM T PUT F FOR NO TEST. SAME COLUMNS. +STRMM T PUT F FOR NO TEST. SAME COLUMNS. +STRSM T PUT F FOR NO TEST. SAME COLUMNS. +SSYRK T PUT F FOR NO TEST. SAME COLUMNS. +SSYR2K T PUT F FOR NO TEST. SAME COLUMNS. SGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index a2b85ce961..06cc23aa68 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -111,7 +111,7 @@ PROGRAM ZBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR CHARACTER*1 TRANSA, TRANSB - CHARACTER*6 SNAMET + CHARACTER*7 SNAMET CHARACTER*32 SNAPS, SUMMRY * .. Local Arrays .. COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -123,7 +123,7 @@ PROGRAM ZBLAT3 DOUBLE PRECISION G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*6 SNAMES( NSUBS ) + CHARACTER*7 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LZE @@ -136,7 +136,7 @@ PROGRAM ZBLAT3 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -401,8 +401,8 @@ PROGRAM ZBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A6, L2 ) - 9987 FORMAT( 1X, A6, ' WAS NOT TESTED' ) + 9988 FORMAT( A7, L2 ) + 9987 FORMAT( 1X, A7, ' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -433,7 +433,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -718,7 +718,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -998,7 +998,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1308,7 +1308,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1641,7 +1641,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -2012,7 +2012,7 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) * * .. Scalar Arguments .. INTEGER ISNUM, NOUT - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK @@ -2978,58 +2978,76 @@ SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT ) CALL ZGEMMTR( 'U', 'T', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'N', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'C', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'C', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 ) + CALL ZGEMMTR( 'U', 'T', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, + $ 1 ) CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) INFOT = 8 @@ -3613,7 +3631,7 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * .. Scalar Arguments .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Executable Statements .. IF( .NOT.LERR )THEN WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT @@ -3649,11 +3667,11 @@ SUBROUTINE XERBLA( SRNAME, INFO ) * * .. Scalar Arguments .. INTEGER INFO - CHARACTER*6 SRNAME + CHARACTER*(*) SRNAME * .. Scalars in Common .. INTEGER INFOT, NOUT LOGICAL LERR, OK - CHARACTER*6 SRNAMT + CHARACTER*7 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUT, OK, LERR COMMON /SRNAMC/SRNAMT @@ -3709,7 +3727,7 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA LOGICAL FATAL, REWI, TRACE - CHARACTER*6 SNAME + CHARACTER*7 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), diff --git a/BLAS/TESTING/zblat3.in b/BLAS/TESTING/zblat3.in index 6160d7af99..7768859c11 100644 --- a/BLAS/TESTING/zblat3.in +++ b/BLAS/TESTING/zblat3.in @@ -12,13 +12,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. -ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. -ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. -ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. -ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. -ZHERK T PUT F FOR NO TEST. SAME COLUMNS. -ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. -ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. -ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. +ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. +ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. +ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. +ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. +ZHERK T PUT F FOR NO TEST. SAME COLUMNS. +ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. +ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. +ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. ZGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. From f9ea71ef3d10b19d654415e8b62c2a1ed02e3c5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jun 2024 13:14:37 +0200 Subject: [PATCH 145/206] Fix missing arguments in tests --- CBLAS/testing/c_c2chke.c | 4 +- CBLAS/testing/c_c3chke.c | 4 +- CBLAS/testing/c_cblas2.c | 30 ++++----- CBLAS/testing/c_cblas3.c | 18 ++--- CBLAS/testing/c_cblat3.f | 138 +++++++++++++++++++-------------------- CBLAS/testing/c_d2chke.c | 4 +- CBLAS/testing/c_d3chke.c | 4 +- CBLAS/testing/c_dblas2.c | 30 ++++----- CBLAS/testing/c_dblas3.c | 12 ++-- CBLAS/testing/c_s2chke.c | 2 +- CBLAS/testing/c_s3chke.c | 4 +- CBLAS/testing/c_sblas2.c | 30 ++++----- CBLAS/testing/c_sblas3.c | 12 ++-- CBLAS/testing/c_xerbla.c | 2 +- CBLAS/testing/c_z2chke.c | 4 +- CBLAS/testing/c_z3chke.c | 4 +- CBLAS/testing/c_zblas2.c | 30 ++++----- CBLAS/testing/c_zblas3.c | 18 ++--- 18 files changed, 175 insertions(+), 175 deletions(-) diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index 8d346bd239..e0acfab1fb 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_c2chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index d9d2e12158..4479469a2f 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_c3chke(char * rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_cblas2.c b/CBLAS/testing/c_cblas2.c index 1c87136743..38a089f0e2 100644 --- a/CBLAS/testing/c_cblas2.c +++ b/CBLAS/testing/c_cblas2.c @@ -13,7 +13,7 @@ void F77_cgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, const void *beta, void *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -47,7 +47,7 @@ void F77_cgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -154,7 +154,7 @@ void F77_chemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -189,7 +189,7 @@ void F77_chbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -256,7 +256,7 @@ void F77_chpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -316,7 +316,7 @@ void F77_ctbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_COMPLEX *A; @@ -383,7 +383,7 @@ void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { @@ -450,7 +450,7 @@ void F77_ctbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len , FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_COMPLEX *A, *AP; @@ -509,7 +509,7 @@ void F77_ctpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ctpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_COMPLEX *A, *AP; @@ -569,7 +569,7 @@ void F77_ctrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_COMPLEX *A; @@ -602,7 +602,7 @@ void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_COMPLEX *A; @@ -635,7 +635,7 @@ void F77_ctrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_chpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_COMPLEX *A, *AP; @@ -715,7 +715,7 @@ void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, CBLAS_TEST_COMPLEX *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_COMPLEX *A, *AP; @@ -795,7 +795,7 @@ void F77_chpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX void F77_cher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_COMPLEX *A; @@ -832,7 +832,7 @@ void F77_cher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_COMPLEX CBLAS_TEST_COMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_COMPLEX *y, CBLAS_INT *incy, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { diff --git a/CBLAS/testing/c_cblas3.c b/CBLAS/testing/c_cblas3.c index ae5f3936b2..4d396fe678 100644 --- a/CBLAS/testing/c_cblas3.c +++ b/CBLAS/testing/c_cblas3.c @@ -16,7 +16,7 @@ void F77_cgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len #endif ) { @@ -177,7 +177,7 @@ void F77_chemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -245,7 +245,7 @@ void F77_csymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -303,7 +303,7 @@ void F77_cherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS float *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -363,7 +363,7 @@ void F77_csyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -423,7 +423,7 @@ void F77_cher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, float *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -491,7 +491,7 @@ void F77_csyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -558,7 +558,7 @@ void F77_ctrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; @@ -621,7 +621,7 @@ void F77_ctrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_COMPLEX *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index 88a077350a..ec795fdb63 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -4,7 +4,7 @@ PROGRAM CBLAT3 * * The program must be driven by a short data file. The first 13 records * of the file are read using list-directed input, the last 10 records -* are read using the format ( A12, L2 ). An annotated example of a data +* are read using the format ( A13, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 23 lines: * 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -66,7 +66,7 @@ PROGRAM CBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. COMPLEX AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -78,7 +78,7 @@ PROGRAM CBLAT3 REAL G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LCE @@ -90,7 +90,7 @@ PROGRAM CBLAT3 * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -421,7 +421,7 @@ PROGRAM CBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT(' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1, @@ -429,8 +429,8 @@ PROGRAM CBLAT3 $ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -462,7 +462,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -710,20 +710,20 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -738,7 +738,7 @@ SUBROUTINE CPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -763,7 +763,7 @@ SUBROUTINE CPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) END @@ -792,7 +792,7 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1036,20 +1036,20 @@ SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 120 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1064,7 +1064,7 @@ SUBROUTINE CPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1085,7 +1085,7 @@ SUBROUTINE CPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3, $ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' ) END @@ -1113,7 +1113,7 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1388,20 +1388,20 @@ SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1416,7 +1416,7 @@ SUBROUTINE CPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB COMPLEX ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1449,7 +1449,7 @@ SUBROUTINE CPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',', $ F4.1, '), A,', I3, ', B,', I3, ').' ) END @@ -1478,7 +1478,7 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1770,24 +1770,24 @@ SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1802,7 +1802,7 @@ SUBROUTINE CPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1825,7 +1825,7 @@ SUBROUTINE CPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,', $ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' ) END @@ -1836,7 +1836,7 @@ SUBROUTINE CPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC REAL ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1859,7 +1859,7 @@ SUBROUTINE CPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -1888,7 +1888,7 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -2223,24 +2223,24 @@ SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -2255,7 +2255,7 @@ SUBROUTINE CPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2278,7 +2278,7 @@ SUBROUTINE CPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' ) END @@ -2290,7 +2290,7 @@ SUBROUTINE CPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, COMPLEX ALPHA REAL BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2313,7 +2313,7 @@ SUBROUTINE CPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -2827,7 +2827,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -2981,8 +2981,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ LDB, BETA, LDC) IF( REWI ) $ REWIND NTRA - CALL CCGEMMTR(IORDER, UPLO, TRANSA, TRANSB, N, - $ K, ALPHA, AA, LDA, BB, LDB, + CALL CCGEMMTR(IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, $ BETA, CC, LDC ) * * Check if error-exit was taken incorrectly. @@ -3077,20 +3077,20 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -3106,7 +3106,7 @@ SUBROUTINE CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC COMPLEX ALPHA, BETA CHARACTER*1 TRANSA, TRANSB, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB,CUPLO IF (UPLO.EQ.'U') THEN @@ -3136,7 +3136,7 @@ SUBROUTINE CPRCN8(NOUT, NC, SNAME, IORDER, UPLO, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',', + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', $ A14, ',') 9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index 6ff1160a98..f02a55dc8b 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_d2chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index 40e522361d..f8919bf92d 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_d3chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_dblas2.c b/CBLAS/testing/c_dblas2.c index 8902e2787f..e8cc2bd23d 100644 --- a/CBLAS/testing/c_dblas2.c +++ b/CBLAS/testing/c_dblas2.c @@ -12,7 +12,7 @@ void F77_dgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, doub double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -67,7 +67,7 @@ void F77_dger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, double *alpha, doub void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A; @@ -99,7 +99,7 @@ void F77_dtrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_dtrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A; @@ -128,7 +128,7 @@ void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { double *A; @@ -155,7 +155,7 @@ void F77_dsymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx, double *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { double *A; @@ -183,7 +183,7 @@ void F77_dsyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl void F77_dsyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { double *A; @@ -212,7 +212,7 @@ void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA double *alpha, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -253,7 +253,7 @@ void F77_dgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A; @@ -303,7 +303,7 @@ void F77_dtbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_dtbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A; @@ -354,7 +354,7 @@ void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, doubl double *a, CBLAS_INT *lda, double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { double *A; @@ -402,7 +402,7 @@ void F77_dsbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, doubl void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *ap, double *x, CBLAS_INT *incx, double *beta, double *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { double *A,*AP; @@ -444,7 +444,7 @@ void F77_dspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doub void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A, *AP; @@ -488,7 +488,7 @@ void F77_dtpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, double *ap, double *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { double *A, *AP; @@ -533,7 +533,7 @@ void F77_dtpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx, double *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ double *A, *AP; @@ -589,7 +589,7 @@ void F77_dspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, doubl void F77_dspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, double *x, CBLAS_INT *incx, double *y, CBLAS_INT *incy, double *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ double *A, *AP; diff --git a/CBLAS/testing/c_dblas3.c b/CBLAS/testing/c_dblas3.c index f0bc74af1b..c50b874df1 100644 --- a/CBLAS/testing/c_dblas3.c +++ b/CBLAS/testing/c_dblas3.c @@ -15,7 +15,7 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, double *beta, double *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len #endif ) { @@ -81,7 +81,7 @@ void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, double *beta, double *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -139,7 +139,7 @@ void F77_dsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS double *alpha, double *a, CBLAS_INT *lda, double *beta, double *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -191,7 +191,7 @@ void F77_dsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, double *beta, double *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -250,7 +250,7 @@ void F77_dtrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diag_len #endif ) { CBLAS_INT i,j,LDA,LDB; @@ -305,7 +305,7 @@ void F77_dtrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 2d7237f0ed..fb3bd16c2a 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -30,7 +30,7 @@ void chkxer(void) { void F77_s2chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index eb09911a53..f9772bf813 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_s3chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_sblas2.c b/CBLAS/testing/c_sblas2.c index a56893b4dd..dd1a949ef9 100644 --- a/CBLAS/testing/c_sblas2.c +++ b/CBLAS/testing/c_sblas2.c @@ -12,7 +12,7 @@ void F77_sgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, floa float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -67,7 +67,7 @@ void F77_sger(CBLAS_INT *layout, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A; @@ -99,7 +99,7 @@ void F77_strmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_strsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A; @@ -128,7 +128,7 @@ void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { float *A; @@ -155,7 +155,7 @@ void F77_ssymv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, CBLAS_INT *incx, float *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { float *A; @@ -183,7 +183,7 @@ void F77_ssyr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float void F77_ssyr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { float *A; @@ -212,7 +212,7 @@ void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA float *alpha, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -253,7 +253,7 @@ void F77_sgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A; @@ -303,7 +303,7 @@ void F77_stbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_stbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A; @@ -354,7 +354,7 @@ void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float float *a, CBLAS_INT *lda, float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { float *A; @@ -402,7 +402,7 @@ void F77_ssbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, float void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *ap, float *x, CBLAS_INT *incx, float *beta, float *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { float *A,*AP; @@ -443,7 +443,7 @@ void F77_sspmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A, *AP; @@ -486,7 +486,7 @@ void F77_stpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, float *ap, float *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { float *A, *AP; @@ -530,7 +530,7 @@ void F77_stpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, CBLAS_INT *incx, float *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ float *A, *AP; @@ -585,7 +585,7 @@ void F77_sspr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float void F77_sspr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, float *alpha, float *x, CBLAS_INT *incx, float *y, CBLAS_INT *incy, float *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ float *A, *AP; diff --git a/CBLAS/testing/c_sblas3.c b/CBLAS/testing/c_sblas3.c index 513c1e2697..5a026a3355 100644 --- a/CBLAS/testing/c_sblas3.c +++ b/CBLAS/testing/c_sblas3.c @@ -13,7 +13,7 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, float *beta, float *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len #endif ) { @@ -78,7 +78,7 @@ void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, float *beta, float *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -136,7 +136,7 @@ void F77_ssyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS float *alpha, float *a, CBLAS_INT *lda, float *beta, float *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -188,7 +188,7 @@ void F77_ssyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, float *beta, float *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -247,7 +247,7 @@ void F77_strmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; @@ -302,7 +302,7 @@ void F77_strsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index f1505dfc3a..a3ce836e7d 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -90,7 +90,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END -, FORTRAN_STRLEN +, FORTRAN_STRLEN srname_len #endif ) { diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 7d51372ae6..e526905cc9 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_z2chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index 37a6ff5037..113b054d97 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -13,7 +13,7 @@ void F77_xerbla(F77_Char F77_srname, void *vinfo void F77_xerbla(char *srname, void *vinfo #endif #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN srname_len #endif ); @@ -30,7 +30,7 @@ void chkxer(void) { void F77_z3chke(char *rout #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN rout_len #endif ) { char *sf = ( rout ) ; diff --git a/CBLAS/testing/c_zblas2.c b/CBLAS/testing/c_zblas2.c index e305711f51..0de71d2497 100644 --- a/CBLAS/testing/c_zblas2.c +++ b/CBLAS/testing/c_zblas2.c @@ -13,7 +13,7 @@ void F77_zgemv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, const void *x, CBLAS_INT *incx, const void *beta, void *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -47,7 +47,7 @@ void F77_zgbmv(CBLAS_INT *layout, char *transp, CBLAS_INT *m, CBLAS_INT *n, CBLA CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN transp_len #endif ) { @@ -154,7 +154,7 @@ void F77_zhemv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -189,7 +189,7 @@ void F77_zhbmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -256,7 +256,7 @@ void F77_zhpmv(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ){ @@ -316,7 +316,7 @@ void F77_ztbmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_ZOMPLEX *A; @@ -383,7 +383,7 @@ void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { @@ -450,7 +450,7 @@ void F77_ztbsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_ZOMPLEX *A, *AP; @@ -509,7 +509,7 @@ void F77_ztpmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_ztpsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_ZOMPLEX *A, *AP; @@ -569,7 +569,7 @@ void F77_ztrmv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_ZOMPLEX *A; @@ -602,7 +602,7 @@ void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_TEST_ZOMPLEX *A; @@ -635,7 +635,7 @@ void F77_ztrsv(CBLAS_INT *layout, char *uplow, char *transp, char *diagn, void F77_zhpr(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_ZOMPLEX *A, *AP; @@ -715,7 +715,7 @@ void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, CBLAS_TEST_ZOMPLEX *ap #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_ZOMPLEX *A, *AP; @@ -795,7 +795,7 @@ void F77_zhpr2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX void F77_zher(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, double *alpha, CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { CBLAS_TEST_ZOMPLEX *A; @@ -832,7 +832,7 @@ void F77_zher2(CBLAS_INT *layout, char *uplow, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX CBLAS_TEST_ZOMPLEX *x, CBLAS_INT *incx, CBLAS_TEST_ZOMPLEX *y, CBLAS_INT *incy, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len #endif ) { diff --git a/CBLAS/testing/c_zblas3.c b/CBLAS/testing/c_zblas3.c index f8223c572e..c21adf71e4 100644 --- a/CBLAS/testing/c_zblas3.c +++ b/CBLAS/testing/c_zblas3.c @@ -16,7 +16,7 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len #endif ) { @@ -96,7 +96,7 @@ void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -164,7 +164,7 @@ void F77_zsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_I CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len #endif ) { @@ -222,7 +222,7 @@ void F77_zherk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS double *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -282,7 +282,7 @@ void F77_zsyrk(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLAS CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { @@ -342,7 +342,7 @@ void F77_zher2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, double *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -410,7 +410,7 @@ void F77_zsyr2k(CBLAS_INT *layout, char *uplow, char *transp, CBLAS_INT *n, CBLA CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len #endif ) { CBLAS_INT i,j,LDA,LDB,LDC; @@ -477,7 +477,7 @@ void F77_ztrmm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; @@ -540,7 +540,7 @@ void F77_ztrsm(CBLAS_INT *layout, char *rtlf, char *uplow, char *transp, char *d CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb #ifdef BLAS_FORTRAN_STRLEN_END - , FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN, FORTRAN_STRLEN + , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len #endif ) { CBLAS_INT i,j,LDA,LDB; From 60d0e76444a18cb9ebf5243a84736e7dc72ac482 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Fri, 21 Jun 2024 14:07:47 +0200 Subject: [PATCH 146/206] Adding cblas_zgemmtr test --- CBLAS/testing/c_cblat3.f | 22 +- CBLAS/testing/c_zblas3.c | 82 +++++ CBLAS/testing/c_zblat3.f | 702 +++++++++++++++++++++++++++++++++++---- CBLAS/testing/zin3 | 19 +- 4 files changed, 733 insertions(+), 92 deletions(-) diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index ec795fdb63..8a275b96ae 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -20,15 +20,15 @@ PROGRAM CBLAT3 * (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_chemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ctrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ctrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cherk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS. * cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS. * * See: @@ -2852,7 +2852,7 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LCE, LCERES EXTERNAL LCE, LCERES * .. External Subroutines .. - EXTERNAL CCGEMM, CMAKE, CMMCH + EXTERNAL CCGEMMTR, CMAKE, CMMTCH, CPRCN8 * .. Intrinsic Functions .. INTRINSIC MAX * .. Scalars in Common .. @@ -3341,7 +3341,7 @@ SUBROUTINE CMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) * -* End of CMMCH. +* End of CMMTCH. * END diff --git a/CBLAS/testing/c_zblas3.c b/CBLAS/testing/c_zblas3.c index c21adf71e4..77f2f8a529 100644 --- a/CBLAS/testing/c_zblas3.c +++ b/CBLAS/testing/c_zblas3.c @@ -91,6 +91,88 @@ void F77_zgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB cblas_zgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda, b, *ldb, beta, c, *ldc ); } + + +void F77_zgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, + CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, + CBLAS_TEST_ZOMPLEX *c, CBLAS_INT *ldc ) { + + CBLAS_TEST_ZOMPLEX *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + else { + LDA = *n+1; + A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + else { + LDB = *k+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + + LDC = *n+1; + C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j].real=c[j*(*ldc)+i].real; + C[i*LDC+j].imag=c[j*(*ldc)+i].imag; + } + cblas_cgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + B, LDB, beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i].real=C[i*LDC+j].real; + c[j*(*ldc)+i].imag=C[i*LDC+j].imag; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + cblas_zgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); + else + cblas_zgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); +} + + void F77_zhemm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, CBLAS_INT *lda, CBLAS_TEST_ZOMPLEX *b, CBLAS_INT *ldb, CBLAS_TEST_ZOMPLEX *beta, diff --git a/CBLAS/testing/c_zblat3.f b/CBLAS/testing/c_zblat3.f index 21e743d171..a93e201a80 100644 --- a/CBLAS/testing/c_zblat3.f +++ b/CBLAS/testing/c_zblat3.f @@ -4,7 +4,7 @@ PROGRAM ZBLAT3 * * The program must be driven by a short data file. The first 13 records * of the file are read using list-directed input, the last 9 records -* are read using the format ( A12,L2 ). An annotated example of a data +* are read using the format ( A13,L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 22 lines: * 'CBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -20,16 +20,17 @@ PROGRAM ZBLAT3 * (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -* ZGEMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZHEMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZTRMM T PUT F FOR NO TEST. SAME COLUMNS. -* ZTRSM T PUT F FOR NO TEST. SAME COLUMNS. -* ZHERK T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYRK T PUT F FOR NO TEST. SAME COLUMNS. -* ZHER2K T PUT F FOR NO TEST. SAME COLUMNS. -* ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS. -* +* cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS. + * See: * * Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S. @@ -49,7 +50,7 @@ PROGRAM ZBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 9 ) + PARAMETER ( NSUBS = 10 ) COMPLEX*16 ZERO, ONE PARAMETER ( ZERO = ( 0.0D0, 0.0D0 ), $ ONE = ( 1.0D0, 0.0D0 ) ) @@ -66,7 +67,7 @@ PROGRAM ZBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. COMPLEX*16 AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -78,19 +79,19 @@ PROGRAM ZBLAT3 DOUBLE PRECISION G( NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LZE EXTERNAL DDIFF, LZE * .. External Subroutines .. - EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5,ZMMCH + EXTERNAL ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHK6, ZMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL LERR, OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK, LERR COMMON /SRNAMC/SRNAMT @@ -98,7 +99,7 @@ PROGRAM ZBLAT3 DATA SNAMES/'cblas_zgemm ', 'cblas_zhemm ', $ 'cblas_zsymm ', 'cblas_ztrmm ', 'cblas_ztrsm ', $ 'cblas_zherk ', 'cblas_zsyrk ', 'cblas_zher2k', - $ 'cblas_zsyr2k'/ + $ 'cblas_zsyr2k', 'cblas_zgemmtr'/ * .. Executable Statements .. * NOUTC = NOUT @@ -296,7 +297,7 @@ PROGRAM ZBLAT3 OK = .TRUE. FATAL = .FALSE. GO TO ( 140, 150, 150, 160, 160, 170, 170, - $ 180, 180 )ISNUM + $ 180, 180, 185) ISNUM * Test ZGEMM, 01. 140 IF (CORDER) THEN CALL ZCHK1(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -367,6 +368,20 @@ PROGRAM ZBLAT3 $ 1 ) END IF GO TO 190 +* Test ZGEMMTR, 10 + 185 IF (CORDER) THEN + CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 0 ) + END IF + IF (RORDER) THEN + CALL ZCHK6(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C, + $ CC, CS, CT, G, 1 ) + END IF + GO TO 190 * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -406,7 +421,7 @@ PROGRAM ZBLAT3 $ 7( '(', F4.1, ',', F4.1, ') ', : ) ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT(' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT(' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT(' ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1, @@ -414,8 +429,8 @@ PROGRAM ZBLAT3 $ ' ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -447,7 +462,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -695,20 +710,20 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -723,7 +738,7 @@ SUBROUTINE ZPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -748,7 +763,7 @@ SUBROUTINE ZPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 3( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) END @@ -777,7 +792,7 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1021,20 +1036,20 @@ SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 120 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1049,7 +1064,7 @@ SUBROUTINE ZPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1070,7 +1085,7 @@ SUBROUTINE ZPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( I3, ',' ),' (',F4.1,',',F4.1, '), A,', I3, $ ', B,', I3, ', (',F4.1,',',F4.1, '), ', 'C,', I3, ').' ) END @@ -1098,7 +1113,7 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1373,20 +1388,20 @@ SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT(' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT(' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT(1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', $ ' .' ) 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1401,7 +1416,7 @@ SUBROUTINE ZPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB DOUBLE COMPLEX ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1434,7 +1449,7 @@ SUBROUTINE ZPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 10X, 2( A14, ',') , 2( I3, ',' ), ' (', F4.1, ',', $ F4.1, '), A,', I3, ', B,', I3, ').' ) END @@ -1463,7 +1478,7 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1755,24 +1770,24 @@ SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, $ '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1787,7 +1802,7 @@ SUBROUTINE ZPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1810,7 +1825,7 @@ SUBROUTINE ZPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1 ,'), A,', $ I3, ', (', F4.1,',', F4.1, '), C,', I3, ').' ) END @@ -1821,7 +1836,7 @@ SUBROUTINE ZPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1844,7 +1859,7 @@ SUBROUTINE ZPRCN6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -1873,7 +1888,7 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. COMPLEX*16 AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -2208,24 +2223,24 @@ SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, $ ', C,', I3, ') .' ) - 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9993 FORMAT(1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, $ ',', F4.1, '), C,', I3, ') .' ) 9992 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -2240,7 +2255,7 @@ SUBROUTINE ZPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC DOUBLE COMPLEX ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2263,7 +2278,7 @@ SUBROUTINE ZPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ', (', F4.1, ',', F4.1, '), C,', I3, ').' ) END @@ -2275,7 +2290,7 @@ SUBROUTINE ZPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, DOUBLE COMPLEX ALPHA DOUBLE PRECISION BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2298,7 +2313,7 @@ SUBROUTINE ZPRCN7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 10X, 2( I3, ',' ), ' (', F4.1, ',', F4.1, '), A,', $ I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -2790,3 +2805,546 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) * END + SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER ) + IMPLICIT NONE +* +* Tests CGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO + PARAMETER ( RZERO = 0.0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*13 SNAME +* .. Array Arguments .. + COMPLEX*16 A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ) + DOUBLE PRECISION G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + COMPLEX*16 ALPHA, ALS, BETA, BLS + DOUBLE PRECISION ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LZE, LZERES + EXTERNAL LZE, LZERES +* .. External Subroutines .. + EXTERNAL CZGEMMTR, ZMAKE, ZMMTCH, ZPRCN8 +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = RZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0. +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL ZMAKE( 'ge', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL ZMAKE( 'ge', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + DO 45 IS = 1, 2 + UPLO = ISHAPE(IS:IS) +* +* Generate the matrix C. +* + CALL ZMAKE( 'ge', UPLO, ' ', N, N, C, NMAX, + $ CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL ZPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CZGEMMTR(IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO .EQ. UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LZE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LZE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LZE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LZERES( 'ge', ' ', N, N, CS, + $ CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL ZMMTCH( UPLO, TRANSA, TRANSB, N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + RETURN +* +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT(' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', + $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, + $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) + 9994 FORMAT(' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of ZCHK6. +* + END + + SUBROUTINE ZPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + COMPLEX*16 ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*13 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' (', F4.1,',',F4.1,') , A,', + $ I3, ', B,', I3, ', (', F4.1,',',F4.1,') , C,', I3, ').' ) + END + + SUBROUTINE ZMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, + $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, + $ NOUT, MV ) + IMPLICIT NONE +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 8-February-1989. +* Jack Dongarra, Argonne National Laboratory. +* Iain Duff, AERE Harwell. +* Jeremy Du Croz, Numerical Algorithms Group Ltd. +* Sven Hammarling, Numerical Algorithms Group Ltd. +* +* .. Parameters .. + COMPLEX*16 ZERO + PARAMETER ( ZERO = ( 0.0, 0.0 ) ) + DOUBLE PRECISION RZERO, RONE + PARAMETER ( RZERO = 0.0, RONE = 1.0 ) +* .. Scalar Arguments .. + COMPLEX*16 ALPHA, BETA + DOUBLE PRECISION EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 TRANSA, TRANSB, UPLO +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ) + DOUBLE PRECISION G( * ) +* .. Local Scalars .. + COMPLEX*16 CL + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, DIMAG, DCONJG, MAX, REAL, DBLE, SQRT +* .. Statement Functions .. + DOUBLE PRECISION ABS1 +* .. Statement Function definitions .. + ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) +* .. Executable Statements .. + + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' + CTRANA = TRANSA.EQ.'C' + CTRANB = TRANSB.EQ.'C' + + ISTART = 1 + ISTOP = N +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + DO 220 J = 1, N +* + IF (UPPER) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = RZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + IF( CTRANA )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( K, J ) ) + 60 CONTINUE + 70 CONTINUE + END IF + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + IF( CTRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + ELSE + DO 110 K = 1, KK + DO 100 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS1( A( I, K ) )* + $ ABS1( B( J, K ) ) + 100 CONTINUE + 110 CONTINUE + END IF + ELSE IF( TRANA.AND.TRANB )THEN + IF( CTRANA )THEN + IF( CTRANB )THEN + DO 130 K = 1, KK + DO 120 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )* + $ DCONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 120 CONTINUE + 130 CONTINUE + ELSE + DO 150 K = 1, KK + DO 140 I = ISTART, ISTOP + CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 140 CONTINUE + 150 CONTINUE + END IF + ELSE + IF( CTRANB )THEN + DO 170 K = 1, KK + DO 160 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*DCONJG( B( J, K ) ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 160 CONTINUE + 170 CONTINUE + ELSE + DO 190 K = 1, KK + DO 180 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS1( A( K, I ) )* + $ ABS1( B( J, K ) ) + 180 CONTINUE + 190 CONTINUE + END IF + END IF + END IF + DO 200 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS1( ALPHA )*G( I ) + + $ ABS1( BETA )*ABS1( C( I, J ) ) + 200 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 210 I = ISTART, ISTOP + ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.RZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*DSQRT( EPS ).GE.RONE ) + $ GO TO 230 + 210 CONTINUE +* + 220 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 250 +* +* Report fatal error. +* + 230 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 240 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 240 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 250 CONTINUE + RETURN +* + 9999 FORMAT(' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RE', + $ 'SULT COMPUTED RESULT' ) + 9998 FORMAT( 1X, I7, 2( ' (', G15.6, ',', G15.6, ')' ) ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of ZMMTCH. +* + END + diff --git a/CBLAS/testing/zin3 b/CBLAS/testing/zin3 index 90a657592c..7e00e13ced 100644 --- a/CBLAS/testing/zin3 +++ b/CBLAS/testing/zin3 @@ -11,12 +11,13 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. (0.0,0.0) (1.0,0.0) (0.7,-0.9) VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA (0.0,0.0) (1.0,0.0) (1.3,-1.1) VALUES OF BETA -cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. -cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zhemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ztrmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ztrsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zherk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS. From b721a550483e8a2a00e8ecc2a3b91841016a7468 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 10:15:00 +0200 Subject: [PATCH 147/206] Working CBLAS_ZGEMMTR Test --- BLAS/SRC/cgemmtr.f | 3 +- BLAS/SRC/zgemmtr.f | 7 +- CBLAS/src/cblas_cgemmtr.c | 187 +++++++++++++++++------------------ CBLAS/src/cblas_zgemmtr.c | 198 ++++++++++++++++++++------------------ CBLAS/testing/c_cblat3.f | 16 +-- CBLAS/testing/c_zblas3.c | 119 +++++++++++------------ CBLAS/testing/c_zblat3.f | 20 ++-- 7 files changed, 276 insertions(+), 274 deletions(-) diff --git a/BLAS/SRC/cgemmtr.f b/BLAS/SRC/cgemmtr.f index 5124a4a195..84bd22277c 100644 --- a/BLAS/SRC/cgemmtr.f +++ b/BLAS/SRC/cgemmtr.f @@ -278,8 +278,7 @@ SUBROUTINE CGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * * Quick return if possible. * - IF ((N.EQ.0) .OR. - + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN + IF (N.EQ.0) RETURN * * And when alpha.eq.zero. * diff --git a/BLAS/SRC/zgemmtr.f b/BLAS/SRC/zgemmtr.f index 18adf02dd7..5907a4d532 100644 --- a/BLAS/SRC/zgemmtr.f +++ b/BLAS/SRC/zgemmtr.f @@ -222,9 +222,9 @@ SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * .. * .. Parameters .. COMPLEX*16 ONE - PARAMETER (ONE= (1.0E+0,0.0E+0)) + PARAMETER (ONE= (1.0D+0,0.0D+0)) COMPLEX*16 ZERO - PARAMETER (ZERO= (0.0E+0,0.0E+0)) + PARAMETER (ZERO= (0.0D+0,0.0D+0)) * .. * * Set NOTA and NOTB as true if A and B respectively are not @@ -278,8 +278,7 @@ SUBROUTINE ZGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * * Quick return if possible. * - IF ((N.EQ.0) .OR. - + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN + IF (N.EQ.0) RETURN * * And when alpha.eq.zero. * diff --git a/CBLAS/src/cblas_cgemmtr.c b/CBLAS/src/cblas_cgemmtr.c index 9eb3592ca3..f3bc600e02 100644 --- a/CBLAS/src/cblas_cgemmtr.c +++ b/CBLAS/src/cblas_cgemmtr.c @@ -10,124 +10,125 @@ #include "cblas.h" #include "cblas_f77.h" void API_SUFFIX(cblas_cgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, - const CBLAS_INT K, const void *alpha, const void *A, - const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, - const void *beta, void *C, const CBLAS_INT ldc) + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) { - char TA, TB; - char UL; + char TA, TB; + char UL; #ifdef F77_CHAR - F77_CHAR F77_TA, F77_TB, F77_UL; + F77_CHAR F77_TA, F77_TB, F77_UL; #else - #define F77_TA &TA - #define F77_TB &TB - #define F77_UL &UL +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL #endif #ifdef F77_INT - F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; - F77_INT F77_ldc=ldc; + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; #else - #define F77_N N - #define F77_K K - #define F77_lda lda - #define F77_ldb ldb - #define F77_ldc ldc +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc #endif - extern int CBLAS_CallFromC; - extern int RowMajorStrg; - RowMajorStrg = 0; - CBLAS_CallFromC = 1; + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; - if( layout == CblasColMajor ) - { - if ( Uplo == CblasUpper ) UL = 'U'; - else if (Uplo == CblasLower) UL= 'L'; - else { + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; - } + } - if(TransA == CblasTrans) TA='T'; - else if ( TransA == CblasConjTrans ) TA='C'; - else if ( TransA == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - if(TransB == CblasTrans) TB='T'; - else if ( TransB == CblasConjTrans ) TB='C'; - else if ( TransB == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif - F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, - &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); - } else if (layout == CblasRowMajor) - { - RowMajorStrg = 1; + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; - if ( Uplo == CblasUpper ) UL = 'L'; - else if (Uplo == CblasLower) UL= 'U'; - else { + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; - } + } - if(TransA == CblasTrans) TB='T'; - else if ( TransA == CblasConjTrans ) TB='C'; - else if ( TransA == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TA='T'; - else if ( TransB == CblasConjTrans ) TA='C'; - else if ( TransB == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); - #endif +#endif - F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, - &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); - } - else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; + F77_cgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_cgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; } diff --git a/CBLAS/src/cblas_zgemmtr.c b/CBLAS/src/cblas_zgemmtr.c index c01ecb2d1d..23eebe516a 100644 --- a/CBLAS/src/cblas_zgemmtr.c +++ b/CBLAS/src/cblas_zgemmtr.c @@ -10,112 +10,126 @@ #include "cblas.h" #include "cblas_f77.h" void API_SUFFIX(cblas_zgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, - const CBLAS_INT K, const void *alpha, const void *A, - const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, - const void *beta, void *C, const CBLAS_INT ldc) + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const void *alpha, const void *A, + const CBLAS_INT lda, const void *B, const CBLAS_INT ldb, + const void *beta, void *C, const CBLAS_INT ldc) { - char TA, TB, UL; + char TA, TB, UL; #ifdef F77_CHAR - F77_CHAR F77_TA, F77_TB, F77_UL; + F77_CHAR F77_TA, F77_TB, F77_UL; #else - #define F77_TA &TA - #define F77_TB &TB - #define F77_UL &UL +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL #endif #ifdef F77_INT - F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; - F77_INT F77_ldc=ldc; + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; #else - #define F77_N N - #define F77_K K - #define F77_lda lda - #define F77_ldb ldb - #define F77_ldc ldc +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc #endif - extern int CBLAS_CallFromC; - extern int RowMajorStrg; - RowMajorStrg = 0; - CBLAS_CallFromC = 1; + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; - if ( Uplo == CblasUpper ) UL = 'U'; - else if (Uplo == CblasLower) UL= 'L'; - else { - API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_zgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - if( layout == CblasColMajor ) - { - if(TransA == CblasTrans) TA='T'; - else if ( TransA == CblasConjTrans ) TA='C'; - else if ( TransA == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TB='T'; - else if ( TransB == CblasConjTrans ) TB='C'; - else if ( TransB == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, - &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); - } else if (layout == CblasRowMajor) - { - RowMajorStrg = 1; - if(TransA == CblasTrans) TB='T'; - else if ( TransA == CblasConjTrans ) TB='C'; - else if ( TransA == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_zgemmtr","Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TA='T'; - else if ( TransB == CblasConjTrans ) TA='C'; - else if ( TransB == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_zgemmtr","Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, A, + &F77_lda, B, &F77_ldb, beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + RowMajorStrg = 1; + + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_cgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "zblas_cgemmtr", "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "zblas_cgemmtr", "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); + +#endif + + F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, + &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); + } - F77_zgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, alpha, B, - &F77_ldb, A, &F77_lda, beta, C, &F77_ldc); - } - else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmtr", "Illegal layout setting, %d\n", layout); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; + else API_SUFFIX(cblas_xerbla)(1, "cblas_zgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; } diff --git a/CBLAS/testing/c_cblat3.f b/CBLAS/testing/c_cblat3.f index 8a275b96ae..07be55c929 100644 --- a/CBLAS/testing/c_cblat3.f +++ b/CBLAS/testing/c_cblat3.f @@ -2812,11 +2812,8 @@ SUBROUTINE CCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Auxiliary routine for test program for Level 3 Blas. * -* -- Written on 8-February-1989. -* Jack Dongarra, Argonne National Laboratory. -* Iain Duff, AERE Harwell. -* Jeremy Du Croz, Numerical Algorithms Group Ltd. -* Sven Hammarling, Numerical Algorithms Group Ltd. +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute Magdeburg * * .. Parameters .. COMPLEX ZERO @@ -3148,15 +3145,12 @@ SUBROUTINE CMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, $ NOUT, MV ) IMPLICIT NONE * -* Checks the results of the computational tests. +* Checks the results of the computational tests for GEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * -* -- Written on 8-February-1989. -* Jack Dongarra, Argonne National Laboratory. -* Iain Duff, AERE Harwell. -* Jeremy Du Croz, Numerical Algorithms Group Ltd. -* Sven Hammarling, Numerical Algorithms Group Ltd. +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute, Magdeburg * * .. Parameters .. COMPLEX ZERO diff --git a/CBLAS/testing/c_zblas3.c b/CBLAS/testing/c_zblas3.c index 77f2f8a529..43dd335df7 100644 --- a/CBLAS/testing/c_zblas3.c +++ b/CBLAS/testing/c_zblas3.c @@ -5,6 +5,7 @@ * Modified by T. H. Do, 4/15/98, SGI/CRAY Research. */ #include +#include #include "cblas.h" #include "cblas_test.h" #define TEST_COL_MJR 0 @@ -108,68 +109,68 @@ void F77_zgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, C get_uplo_type(uplop, &uplo); if (*layout == TEST_ROW_MJR) { - if (transa == CblasNoTrans) { - LDA = *k+1; - A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); - for( i=0; i<*n; i++ ) - for( j=0; j<*k; j++ ) { - A[i*LDA+j].real=a[j*(*lda)+i].real; - A[i*LDA+j].imag=a[j*(*lda)+i].imag; - } - } - else { - LDA = *n+1; - A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX)); - for( i=0; i<*k; i++ ) - for( j=0; j<*n; j++ ) { - A[i*LDA+j].real=a[j*(*lda)+i].real; - A[i*LDA+j].imag=a[j*(*lda)+i].imag; - } - } - - if (transb == CblasNoTrans) { - LDB = *n+1; - B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) ); - for( i=0; i<*k; i++ ) - for( j=0; j<*n; j++ ) { - B[i*LDB+j].real=b[j*(*ldb)+i].real; - B[i*LDB+j].imag=b[j*(*ldb)+i].imag; - } - } - else { - LDB = *k+1; - B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX)); - for( i=0; i<*n; i++ ) - for( j=0; j<*k; j++ ) { - B[i*LDB+j].real=b[j*(*ldb)+i].real; - B[i*LDB+j].imag=b[j*(*ldb)+i].imag; - } - } - - LDC = *n+1; - C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX)); - for( j=0; j<*n; j++ ) - for( i=0; i<*n; i++ ) { - C[i*LDC+j].real=c[j*(*ldc)+i].real; - C[i*LDC+j].imag=c[j*(*ldc)+i].imag; - } - cblas_cgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, - B, LDB, beta, C, LDC ); - for( j=0; j<*n; j++ ) - for( i=0; i<*n; i++ ) { - c[j*(*ldc)+i].real=C[i*LDC+j].real; - c[j*(*ldc)+i].imag=C[i*LDC+j].imag; - } - free(A); - free(B); - free(C); + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + else { + LDA = *n+1; + A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j].real=a[j*(*lda)+i].real; + A[i*LDA+j].imag=a[j*(*lda)+i].imag; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + else { + LDB = *k+1; + B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j].real=b[j*(*ldb)+i].real; + B[i*LDB+j].imag=b[j*(*ldb)+i].imag; + } + } + + LDC = *n+1; + C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j].real=c[j*(*ldc)+i].real; + C[i*LDC+j].imag=c[j*(*ldc)+i].imag; + } + cblas_zgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA, + B, LDB, beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i].real=C[i*LDC+j].real; + c[j*(*ldc)+i].imag=C[i*LDC+j].imag; + } + free(A); + free(B); + free(C); } else if (*layout == TEST_COL_MJR) - cblas_zgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, - b, *ldb, beta, c, *ldc ); + cblas_zgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); else - cblas_zgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, - b, *ldb, beta, c, *ldc ); + cblas_zgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda, + b, *ldb, beta, c, *ldc ); } diff --git a/CBLAS/testing/c_zblat3.f b/CBLAS/testing/c_zblat3.f index a93e201a80..bab4f06ddd 100644 --- a/CBLAS/testing/c_zblat3.f +++ b/CBLAS/testing/c_zblat3.f @@ -2815,11 +2815,8 @@ SUBROUTINE ZCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * * Auxiliary routine for test program for Level 3 Blas. * -* -- Written on 8-February-1989. -* Jack Dongarra, Argonne National Laboratory. -* Iain Duff, AERE Harwell. -* Jeremy Du Croz, Numerical Algorithms Group Ltd. -* Sven Hammarling, Numerical Algorithms Group Ltd. +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute Magdeburg * * .. Parameters .. COMPLEX*16 ZERO @@ -3151,15 +3148,12 @@ SUBROUTINE ZMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, $ NOUT, MV ) IMPLICIT NONE * -* Checks the results of the computational tests. +* Checks the results of the computational tests for GEMMTR. * * Auxiliary routine for test program for Level 3 Blas. * -* -- Written on 8-February-1989. -* Jack Dongarra, Argonne National Laboratory. -* Iain Duff, AERE Harwell. -* Jeremy Du Croz, Numerical Algorithms Group Ltd. -* Sven Hammarling, Numerical Algorithms Group Ltd. +* -- Written on 24-June-2024. +* Martin Koehler, Max Planck Institute, Magdeburg * * .. Parameters .. COMPLEX*16 ZERO @@ -3182,11 +3176,11 @@ SUBROUTINE ZMMTCH(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, INTEGER I, J, K, ISTART, ISTOP LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER * .. Intrinsic Functions .. - INTRINSIC ABS, DIMAG, DCONJG, MAX, REAL, DBLE, SQRT + INTRINSIC DABS, DIMAG, DCONJG, MAX, DBLE, DSQRT * .. Statement Functions .. DOUBLE PRECISION ABS1 * .. Statement Function definitions .. - ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) ) + ABS1( CL ) = DABS( DBLE( CL ) ) + DABS( DIMAG( CL ) ) * .. Executable Statements .. UPPER = UPLO.EQ.'U' From adaf7248e787681fce028d460cad2601b2b094de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 10:20:17 +0200 Subject: [PATCH 148/206] Update comments --- CBLAS/src/cblas_cgemmtr.c | 8 ++++---- CBLAS/src/cblas_zgemmtr.c | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/CBLAS/src/cblas_cgemmtr.c b/CBLAS/src/cblas_cgemmtr.c index f3bc600e02..5717dc4097 100644 --- a/CBLAS/src/cblas_cgemmtr.c +++ b/CBLAS/src/cblas_cgemmtr.c @@ -1,9 +1,9 @@ /* * - * cblas_cgemm.c - * This program is a C interface to cgemm. - * Written by Keita Teranishi - * 4/8/1998 + * cblas_cgemmtr.c + * This program is a C interface to cgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 * */ diff --git a/CBLAS/src/cblas_zgemmtr.c b/CBLAS/src/cblas_zgemmtr.c index 23eebe516a..4d884d944a 100644 --- a/CBLAS/src/cblas_zgemmtr.c +++ b/CBLAS/src/cblas_zgemmtr.c @@ -1,9 +1,9 @@ /* * - * cblas_zgemm.c - * This program is a C interface to zgemm. - * Written by Keita Teranishi - * 4/8/1998 + * cblas_zgemmtr.c + * This program is a C interface to zgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 * */ From b681b1eaecd8813ba9b0a822b97aa2556856b8f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 13:43:23 +0200 Subject: [PATCH 149/206] Add cblas_dgemmtr test --- BLAS/SRC/dgemmtr.f | 3 +- BLAS/TESTING/dblat3.f | 12 +- CBLAS/src/cblas_dgemmtr.c | 197 ++++++------ CBLAS/testing/c_cblat2.f | 4 +- CBLAS/testing/c_dblas3.c | 79 +++++ CBLAS/testing/c_dblat3.f | 631 +++++++++++++++++++++++++++++++++----- CBLAS/testing/c_sblas3.c | 76 +++++ CBLAS/testing/c_zblat2.f | 4 +- CBLAS/testing/c_zblat3.f | 8 +- CBLAS/testing/din3 | 13 +- 10 files changed, 841 insertions(+), 186 deletions(-) diff --git a/BLAS/SRC/dgemmtr.f b/BLAS/SRC/dgemmtr.f index 3a54f17b6f..acaaa351e0 100644 --- a/BLAS/SRC/dgemmtr.f +++ b/BLAS/SRC/dgemmtr.f @@ -272,8 +272,7 @@ SUBROUTINE DGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * * Quick return if possible. * - IF ((N.EQ.0) .OR. - + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN + IF (N.EQ.0) RETURN * * And if alpha.eq.zero. * diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index e45a1f91da..e95da164a8 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -37,12 +37,12 @@ *> 0.0 1.0 0.7 VALUES OF ALPHA *> 3 NUMBER OF VALUES OF BETA *> 0.0 1.0 1.3 VALUES OF BETA -*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS. -*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. -*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. +*> DGEMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DTRMM T PUT F FOR NO TEST. SAME COLUMNS. +*> DTRSM T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYRK T PUT F FOR NO TEST. SAME COLUMNS. +*> DSYR2K T PUT F FOR NO TEST. SAME COLUMNS. *> DGEMMTR T PUT F FOR NO TEST. SAME COLUMNS. *> *> Further Details diff --git a/CBLAS/src/cblas_dgemmtr.c b/CBLAS/src/cblas_dgemmtr.c index 99a2fa81a8..ac605e31db 100644 --- a/CBLAS/src/cblas_dgemmtr.c +++ b/CBLAS/src/cblas_dgemmtr.c @@ -10,112 +10,125 @@ #include "cblas.h" #include "cblas_f77.h" void API_SUFFIX(cblas_dgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, - const CBLAS_INT K, const double alpha, const double *A, - const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, - const double beta, double *C, const CBLAS_INT ldc) + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const double alpha, const double *A, + const CBLAS_INT lda, const double *B, const CBLAS_INT ldb, + const double beta, double *C, const CBLAS_INT ldc) { - char TA, TB, UL; + char TA, TB, UL; #ifdef F77_CHAR - F77_CHAR F77_TA, F77_TB. F77_UL; + F77_CHAR F77_TA, F77_TB. F77_UL; #else - #define F77_TA &TA - #define F77_TB &TB - #define F77_UL &UL +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL #endif #ifdef F77_INT - F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; - F77_INT F77_ldc=ldc; + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; #else - #define F77_N N - #define F77_K K - #define F77_lda lda - #define F77_ldb ldb - #define F77_ldc ldc +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc #endif - extern int CBLAS_CallFromC; - extern int RowMajorStrg; - RowMajorStrg = 0; - CBLAS_CallFromC = 1; + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; - if ( Uplo == CblasUpper ) UL = 'U'; - else if (Uplo == CblasLower) UL= 'L'; - else { - API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - if( layout == CblasColMajor ) - { - if(TransA == CblasTrans) TA='T'; - else if ( TransA == CblasConjTrans ) TA='C'; - else if ( TransA == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TB='T'; - else if ( TransB == CblasConjTrans ) TB='C'; - else if ( TransB == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, - &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); - } else if (layout == CblasRowMajor) - { - RowMajorStrg = 1; - if(TransA == CblasTrans) TB='T'; - else if ( TransA == CblasConjTrans ) TB='C'; - else if ( TransA == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TA='T'; - else if ( TransB == CblasConjTrans ) TA='C'; - else if ( TransB == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, - &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); - } - else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_dgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, + &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_dgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + + + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_dgemmtr","Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_dgemmtr","Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif + + F77_dgemmtr( F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, + &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } + else API_SUFFIX(cblas_xerbla)(1, "cblas_dgemmtr", "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; } diff --git a/CBLAS/testing/c_cblat2.f b/CBLAS/testing/c_cblat2.f index d934ebb49d..072b6a3b18 100644 --- a/CBLAS/testing/c_cblat2.f +++ b/CBLAS/testing/c_cblat2.f @@ -349,13 +349,13 @@ PROGRAM CBLAT2 CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 1 ) + $ 1 ) END IF GO TO 200 * Test CGERC, 12, CGERU, 13. diff --git a/CBLAS/testing/c_dblas3.c b/CBLAS/testing/c_dblas3.c index c50b874df1..675f0ebfc0 100644 --- a/CBLAS/testing/c_dblas3.c +++ b/CBLAS/testing/c_dblas3.c @@ -77,6 +77,85 @@ void F77_dgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB cblas_dgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } + +void F77_dgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, double *alpha, double *a, CBLAS_INT *lda, + double *b, CBLAS_INT *ldb, double *beta, + double *c, CBLAS_INT *ldc ) { + + double *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(double*)malloc((*n)*LDA*sizeof(double)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + else { + LDA = *n+1; + A=(double* )malloc(LDA*(*k)*sizeof(double)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(double* )malloc((*k)*LDB*sizeof(double) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + else { + LDB = *k+1; + B=(double* )malloc(LDB*(*n)*sizeof(double)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + + LDC = *n+1; + C=(double* )malloc((*n)*LDC*sizeof(double)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j]=c[j*(*ldc)+i]; + } + cblas_dgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA, + B, LDB, *beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i]=C[i*LDC+j]; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR){ + cblas_dgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); + } + else + cblas_dgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); +} + + + + + void F77_dsymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, double *alpha, double *a, CBLAS_INT *lda, double *b, CBLAS_INT *ldb, double *beta, double *c, CBLAS_INT *ldc diff --git a/CBLAS/testing/c_dblat3.f b/CBLAS/testing/c_dblat3.f index 72ad80c925..e88a77dc7b 100644 --- a/CBLAS/testing/c_dblat3.f +++ b/CBLAS/testing/c_dblat3.f @@ -4,7 +4,7 @@ PROGRAM DBLAT3 * * The program must be driven by a short data file. The first 13 records * of the file are read using list-directed input, the last 6 records -* are read using the format ( A12, L2 ). An annotated example of a data +* are read using the format ( A13, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 19 lines: * 'DBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -20,12 +20,13 @@ PROGRAM DBLAT3 * 0.0 1.0 0.7 VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * 0.0 1.0 1.3 VALUES OF BETA -* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS. * * See: * @@ -46,7 +47,7 @@ PROGRAM DBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 7 ) DOUBLE PRECISION ZERO, HALF, ONE PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0 ) INTEGER NMAX @@ -56,11 +57,11 @@ PROGRAM DBLAT3 * .. Local Scalars .. DOUBLE PRECISION EPS, ERR, THRESH INTEGER I, ISNUM, J, N, NALF, NBET, NIDIM, NTRA, - $ LAYOUT + $ LAYOUT LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -71,27 +72,27 @@ PROGRAM DBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. DOUBLE PRECISION DDIFF LOGICAL LDE EXTERNAL DDIFF, LDE * .. External Subroutines .. EXTERNAL DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, CD3CHKE, - $ DMMCH + $ DMMCH * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ', $ 'cblas_dtrmm ', 'cblas_dtrsm ','cblas_dsyrk ', - $ 'cblas_dsyr2k'/ + $ 'cblas_dsyr2k', 'cblas_dgemmtr'/ * .. Executable Statements .. * * Read name and unit number for summary output file and open file. @@ -289,7 +290,7 @@ PROGRAM DBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM * Test DGEMM, 01. 140 IF (CORDER) THEN CALL DCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -323,13 +324,13 @@ PROGRAM DBLAT3 CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL DCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test DSYRK, 05. @@ -351,15 +352,30 @@ PROGRAM DBLAT3 CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL DCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) END IF GO TO 190 +* Test DGEMMTR, 07. + 185 IF (CORDER) THEN + CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, + $ 0 ) + END IF + IF (RORDER) THEN + CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, + $ 1 ) + END IF + GO TO 190 + * 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 @@ -397,7 +413,7 @@ PROGRAM DBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* T', + 9990 FORMAT( ' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* T', $ 'ESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN DMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1, @@ -405,8 +421,8 @@ PROGRAM DBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -435,7 +451,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -588,7 +604,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDGEMM( IORDER, TRANSA, TRANSB, M, N, $ K, ALPHA, AA, LDA, BB, LDB, - $ BETA, CC, LDC ) + $ BETA, CC, LDC ) * * Check if error-exit was taken incorrectly. * @@ -681,20 +697,20 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -708,7 +724,7 @@ SUBROUTINE DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -733,7 +749,7 @@ SUBROUTINE DPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END @@ -759,7 +775,7 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -994,20 +1010,20 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 120 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1022,7 +1038,7 @@ SUBROUTINE DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1043,7 +1059,7 @@ SUBROUTINE DPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END @@ -1069,7 +1085,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1201,7 +1217,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDTRMM( IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, AA, LDA, - $ BB, LDB ) + $ BB, LDB ) ELSE IF( SNAME( 10: 11 ).EQ.'sm' )THEN IF( TRACE ) $ CALL DPRCN3( NTRA, NC, SNAME, IORDER, @@ -1211,7 +1227,7 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDTRSM( IORDER, SIDE, UPLO, TRANSA, $ DIAG, M, N, ALPHA, AA, LDA, - $ BB, LDB ) + $ BB, LDB ) END IF * * Check if error-exit was taken incorrectly. @@ -1342,20 +1358,20 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1369,7 +1385,7 @@ SUBROUTINE DPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB DOUBLE PRECISION ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1402,7 +1418,7 @@ SUBROUTINE DPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ').' ) END @@ -1428,7 +1444,7 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1667,21 +1683,21 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1695,7 +1711,7 @@ SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1718,7 +1734,7 @@ SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -1726,7 +1742,7 @@ SUBROUTINE DPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ IORDER ) + $ IORDER ) * * Tests DSYR2K. * @@ -1745,7 +1761,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, DOUBLE PRECISION EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. DOUBLE PRECISION AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -1888,7 +1904,7 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, $ REWIND NTRA CALL CDSYR2K( IORDER, UPLO, TRANS, N, K, $ ALPHA, AA, LDA, BB, LDB, BETA, - $ CC, LDC ) + $ CC, LDC ) * * Check if error-exit was taken incorrectly. * @@ -2023,21 +2039,21 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -2052,7 +2068,7 @@ SUBROUTINE DPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2075,7 +2091,7 @@ SUBROUTINE DPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -2474,3 +2490,474 @@ DOUBLE PRECISION FUNCTION DDIFF( X, Y ) * End of DDIFF. * END + + SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER) +* +* Tests DGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*13 SNAME +* .. Array Arguments .. + DOUBLE PRECISION A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + DOUBLE PRECISION ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LDE, LDERES + EXTERNAL LDE, LDERES +* .. External Subroutines .. + EXTERNAL CDGEMMTR, DMAKE, DMMTCH +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL DMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL DMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL DMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL DPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CDGEMMTR( IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LDE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LDE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LDE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LDERES( 'GE', ' ', N, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL DMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL DPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + RETURN +* +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', + $ 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of DCHK6 +* + END + + SUBROUTINE DPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + DOUBLE PRECISION ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*13 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,', + $ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' ) + END + + SUBROUTINE DMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Scalar Arguments .. + DOUBLE PRECISION ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + DOUBLE PRECISION ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of DMMTCH +* + END + + diff --git a/CBLAS/testing/c_sblas3.c b/CBLAS/testing/c_sblas3.c index 5a026a3355..5a0744e116 100644 --- a/CBLAS/testing/c_sblas3.c +++ b/CBLAS/testing/c_sblas3.c @@ -74,6 +74,82 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda, b, *ldb, *beta, c, *ldc ); } + +void F77_cgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, + CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, + float *b, CBLAS_INT *ldb, float *beta, + float *c, CBLAS_INT *ldc ) { + + float *A, *B, *C; + CBLAS_INT i,j,LDA, LDB, LDC; + CBLAS_TRANSPOSE transa, transb; + CBLAS_UPLO uplo; + + get_transpose_type(transpa, &transa); + get_transpose_type(transpb, &transb); + get_uplo_type(uplop, &uplo); + + if (*layout == TEST_ROW_MJR) { + if (transa == CblasNoTrans) { + LDA = *k+1; + A=(float*)malloc((*n)*LDA*sizeof(float)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + else { + LDA = *n+1; + A=(float* )malloc(LDA*(*k)*sizeof(float)); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + A[i*LDA+j]=a[j*(*lda)+i]; + } + } + + if (transb == CblasNoTrans) { + LDB = *n+1; + B=(float* )malloc((*k)*LDB*sizeof(float) ); + for( i=0; i<*k; i++ ) + for( j=0; j<*n; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + else { + LDB = *k+1; + B=(float* )malloc(LDB*(*n)*sizeof(float)); + for( i=0; i<*n; i++ ) + for( j=0; j<*k; j++ ) { + B[i*LDB+j]=b[j*(*ldb)+i]; + } + } + + LDC = *n+1; + C=(float* )malloc((*n)*LDC*sizeof(float)); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + C[i*LDC+j]=c[j*(*ldc)+i]; + } + cblas_sgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA, + B, LDB, *beta, C, LDC ); + for( j=0; j<*n; j++ ) + for( i=0; i<*n; i++ ) { + c[j*(*ldc)+i]=C[i*LDC+j]; + } + free(A); + free(B); + free(C); + } + else if (*layout == TEST_COL_MJR) + cblas_sgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); + else + cblas_sgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda, + b, *ldb, *beta, c, *ldc ); +} + + + void F77_ssymm(CBLAS_INT *layout, char *rtlf, char *uplow, CBLAS_INT *m, CBLAS_INT *n, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, float *beta, float *c, CBLAS_INT *ldc diff --git a/CBLAS/testing/c_zblat2.f b/CBLAS/testing/c_zblat2.f index 4392602302..a46e62137c 100644 --- a/CBLAS/testing/c_zblat2.f +++ b/CBLAS/testing/c_zblat2.f @@ -349,13 +349,13 @@ PROGRAM ZBLAT2 CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, $ NMAX, INCMAX, A, AA, AS, Y, YY, YS, YT, G, Z, - $ 1 ) + $ 1 ) END IF GO TO 200 * Test ZGERC, 12, ZGERU, 13. diff --git a/CBLAS/testing/c_zblat3.f b/CBLAS/testing/c_zblat3.f index bab4f06ddd..23ee361acc 100644 --- a/CBLAS/testing/c_zblat3.f +++ b/CBLAS/testing/c_zblat3.f @@ -331,13 +331,13 @@ PROGRAM ZBLAT3 CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK3(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB, $ AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test ZHERK, 06, ZSYRK, 07. @@ -359,13 +359,13 @@ PROGRAM ZBLAT3 CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 0 ) + $ 0 ) END IF IF (RORDER) THEN CALL ZCHK5(SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, - $ 1 ) + $ 1 ) END IF GO TO 190 * Test ZGEMMTR, 10 diff --git a/CBLAS/testing/din3 b/CBLAS/testing/din3 index 1f777156f0..350544d66f 100644 --- a/CBLAS/testing/din3 +++ b/CBLAS/testing/din3 @@ -11,9 +11,10 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dtrsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS. From 63d2b3af5810da7be2b6c58939f32c1ccb5988bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 14:03:08 +0200 Subject: [PATCH 150/206] add cblas_sgemmtr tests --- BLAS/SRC/sgemmtr.f | 3 +- CBLAS/src/cblas_dgemmtr.c | 8 +- CBLAS/src/cblas_sgemmtr.c | 209 +++++++------ CBLAS/testing/c_sblas3.c | 2 +- CBLAS/testing/c_sblat3.f | 616 ++++++++++++++++++++++++++++++++++---- CBLAS/testing/sin3 | 13 +- 6 files changed, 677 insertions(+), 174 deletions(-) diff --git a/BLAS/SRC/sgemmtr.f b/BLAS/SRC/sgemmtr.f index 053075f2ff..1f0ed17bf4 100644 --- a/BLAS/SRC/sgemmtr.f +++ b/BLAS/SRC/sgemmtr.f @@ -272,8 +272,7 @@ SUBROUTINE SGEMMTR(UPLO,TRANSA,TRANSB,N,K,ALPHA,A,LDA,B,LDB, * * Quick return if possible. * - IF ((N.EQ.0) .OR. - + (((ALPHA.EQ.ZERO).OR. (K.EQ.0)).AND. (BETA.EQ.ONE))) RETURN + IF (N.EQ.0) RETURN * * And if alpha.eq.zero. * diff --git a/CBLAS/src/cblas_dgemmtr.c b/CBLAS/src/cblas_dgemmtr.c index ac605e31db..d64c664ba2 100644 --- a/CBLAS/src/cblas_dgemmtr.c +++ b/CBLAS/src/cblas_dgemmtr.c @@ -1,9 +1,9 @@ /* * - * cblas_dgemm.c - * This program is a C interface to dgemm. - * Written by Keita Teranishi - * 4/8/1998 + * cblas_dgemmtr.c + * This program is a C interface to dgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 * */ diff --git a/CBLAS/src/cblas_sgemmtr.c b/CBLAS/src/cblas_sgemmtr.c index f2f9528ee9..065a031bec 100644 --- a/CBLAS/src/cblas_sgemmtr.c +++ b/CBLAS/src/cblas_sgemmtr.c @@ -1,123 +1,136 @@ + /* * - * cblas_sgemm.c - * This program is a C interface to sgemm. - * Written by Keita Teranishi - * 4/8/1998 + * cblas_sgemmtr.c + * This program is a C interface to sgemmtr. + * Written by Martin Koehler, MPI Magdeburg + * 06/24/2024 * */ #include "cblas.h" #include "cblas_f77.h" void API_SUFFIX(cblas_sgemmtr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_TRANSPOSE TransA, - const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, - const CBLAS_INT K, const float alpha, const float *A, - const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, - const float beta, float *C, const CBLAS_INT ldc) + const CBLAS_TRANSPOSE TransB, const CBLAS_INT N, + const CBLAS_INT K, const float alpha, const float *A, + const CBLAS_INT lda, const float *B, const CBLAS_INT ldb, + const float beta, float *C, const CBLAS_INT ldc) { - char TA, TB, UL; + char TA, TB, UL; #ifdef F77_CHAR - F77_CHAR F77_TA, F77_TB, F77_UL; + F77_CHAR F77_TA, F77_TB, F77_UL; #else - #define F77_TA &TA - #define F77_TB &TB - #define F77_UL &UL +#define F77_TA &TA +#define F77_TB &TB +#define F77_UL &UL #endif #ifdef F77_INT - F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; - F77_INT F77_ldc=ldc; + F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb; + F77_INT F77_ldc=ldc; #else - #define F77_N N - #define F77_K K - #define F77_lda lda - #define F77_ldb ldb - #define F77_ldc ldc +#define F77_N N +#define F77_K K +#define F77_lda lda +#define F77_ldb ldb +#define F77_ldc ldc #endif - extern int CBLAS_CallFromC; - extern int RowMajorStrg; - RowMajorStrg = 0; - CBLAS_CallFromC = 1; + extern int CBLAS_CallFromC; + extern int RowMajorStrg; + RowMajorStrg = 0; + CBLAS_CallFromC = 1; + + + if( layout == CblasColMajor ) + { + if ( Uplo == CblasUpper ) UL = 'U'; + else if (Uplo == CblasLower) UL= 'L'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + - if ( Uplo == CblasUpper ) UL = 'U'; - else if (Uplo == CblasLower) UL= 'L'; - else { - API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + if(TransA == CblasTrans) TA='T'; + else if ( TransA == CblasConjTrans ) TA='C'; + else if ( TransA == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TB='T'; + else if ( TransB == CblasConjTrans ) TB='C'; + else if ( TransB == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - if( layout == CblasColMajor ) - { - if(TransA == CblasTrans) TA='T'; - else if ( TransA == CblasConjTrans ) TA='C'; - else if ( TransA == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", - "Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif - if(TransB == CblasTrans) TB='T'; - else if ( TransB == CblasConjTrans ) TB='C'; - else if ( TransB == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", - "Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); + } + else if (layout == CblasRowMajor) + { + if ( Uplo == CblasUpper ) UL = 'L'; + else if (Uplo == CblasLower) UL= 'U'; + else { + API_SUFFIX(cblas_xerbla)(2, "cblas_sgemmtr", "Illegal Uplo setting, %d\n", Uplo); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif - F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc); - } else if (layout == CblasRowMajor) - { - RowMajorStrg = 1; - if(TransA == CblasTrans) TB='T'; - else if ( TransA == CblasConjTrans ) TB='C'; - else if ( TransA == CblasNoTrans ) TB='N'; - else - { - API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", - "Illegal TransA setting, %d\n", TransA); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - if(TransB == CblasTrans) TA='T'; - else if ( TransB == CblasConjTrans ) TA='C'; - else if ( TransB == CblasNoTrans ) TA='N'; - else - { - API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", - "Illegal TransB setting, %d\n", TransB); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; - return; - } - #ifdef F77_CHAR - F77_TA = C2F_CHAR(&TA); - F77_TB = C2F_CHAR(&TB); - F77_UL = C2F_CHAR(&UL); - #endif + RowMajorStrg = 1; + if(TransA == CblasTrans) TB='T'; + else if ( TransA == CblasConjTrans ) TB='C'; + else if ( TransA == CblasNoTrans ) TB='N'; + else + { + API_SUFFIX(cblas_xerbla)(3, "cblas_sgemmtr", + "Illegal TransA setting, %d\n", TransA); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } + if(TransB == CblasTrans) TA='T'; + else if ( TransB == CblasConjTrans ) TA='C'; + else if ( TransB == CblasNoTrans ) TA='N'; + else + { + API_SUFFIX(cblas_xerbla)(4, "cblas_sgemmtr", + "Illegal TransB setting, %d\n", TransB); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; + return; + } +#ifdef F77_CHAR + F77_TA = C2F_CHAR(&TA); + F77_TB = C2F_CHAR(&TB); + F77_UL = C2F_CHAR(&UL); +#endif - F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); - } else - API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmtr", - "Illegal layout setting, %d\n", layout); - CBLAS_CallFromC = 0; - RowMajorStrg = 0; + F77_sgemmtr(F77_UL, F77_TA, F77_TB, &F77_N, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc); + } else + API_SUFFIX(cblas_xerbla)(1, "cblas_sgemmtr", + "Illegal layout setting, %d\n", layout); + CBLAS_CallFromC = 0; + RowMajorStrg = 0; } diff --git a/CBLAS/testing/c_sblas3.c b/CBLAS/testing/c_sblas3.c index 5a0744e116..0aaa57d2d8 100644 --- a/CBLAS/testing/c_sblas3.c +++ b/CBLAS/testing/c_sblas3.c @@ -75,7 +75,7 @@ void F77_sgemm(CBLAS_INT *layout, char *transpa, char *transpb, CBLAS_INT *m, CB b, *ldb, *beta, c, *ldc ); } -void F77_cgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, +void F77_sgemmtr(CBLAS_INT *layout, char *uplop, char *transpa, char *transpb, CBLAS_INT *n, CBLAS_INT *k, float *alpha, float *a, CBLAS_INT *lda, float *b, CBLAS_INT *ldb, float *beta, float *c, CBLAS_INT *ldc ) { diff --git a/CBLAS/testing/c_sblat3.f b/CBLAS/testing/c_sblat3.f index 31babd9a12..c6f6961900 100644 --- a/CBLAS/testing/c_sblat3.f +++ b/CBLAS/testing/c_sblat3.f @@ -4,7 +4,7 @@ PROGRAM SBLAT3 * * The program must be driven by a short data file. The first 13 records * of the file are read using list-directed input, the last 6 records -* are read using the format ( A12, L2 ). An annotated example of a data +* are read using the format ( A13, L2 ). An annotated example of a data * file can be obtained by deleting the first 3 characters from the * following 19 lines: * 'SBLAT3.SNAP' NAME OF SNAPSHOT OUTPUT FILE @@ -20,12 +20,14 @@ PROGRAM SBLAT3 * 0.0 1.0 0.7 VALUES OF ALPHA * 3 NUMBER OF VALUES OF BETA * 0.0 1.0 1.3 VALUES OF BETA -* cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. -* cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +* cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS. + * * See: * @@ -46,7 +48,7 @@ PROGRAM SBLAT3 INTEGER NIN, NOUT PARAMETER ( NIN = 5, NOUT = 6 ) INTEGER NSUBS - PARAMETER ( NSUBS = 6 ) + PARAMETER ( NSUBS = 7 ) REAL ZERO, HALF, ONE PARAMETER ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 ) INTEGER NMAX @@ -60,7 +62,7 @@ PROGRAM SBLAT3 LOGICAL FATAL, LTESTT, REWI, SAME, SFATAL, TRACE, $ TSTERR, CORDER, RORDER CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAMET + CHARACTER*13 SNAMET CHARACTER*32 SNAPS * .. Local Arrays .. REAL AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ), @@ -71,27 +73,27 @@ PROGRAM SBLAT3 $ G( NMAX ), W( 2*NMAX ) INTEGER IDIM( NIDMAX ) LOGICAL LTEST( NSUBS ) - CHARACTER*12 SNAMES( NSUBS ) + CHARACTER*13 SNAMES( NSUBS ) * .. External Functions .. REAL SDIFF LOGICAL LSE EXTERNAL SDIFF, LSE * .. External Subroutines .. EXTERNAL SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, CS3CHKE, - $ SMMCH + $ SMMCH, SCHK6 * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. Scalars in Common .. INTEGER INFOT, NOUTC LOGICAL OK - CHARACTER*12 SRNAMT + CHARACTER*13 SRNAMT * .. Common blocks .. COMMON /INFOC/INFOT, NOUTC, OK COMMON /SRNAMC/SRNAMT * .. Data statements .. DATA SNAMES/'cblas_sgemm ', 'cblas_ssymm ', $ 'cblas_strmm ', 'cblas_strsm ','cblas_ssyrk ', - $ 'cblas_ssyr2k'/ + $ 'cblas_ssyr2k', 'cblas_sgemmtr'/ * .. Executable Statements .. * NOUTC = NOUT @@ -288,7 +290,7 @@ PROGRAM SBLAT3 INFOT = 0 OK = .TRUE. FATAL = .FALSE. - GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM + GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM * Test SGEMM, 01. 140 IF (CORDER) THEN CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, @@ -359,8 +361,24 @@ PROGRAM SBLAT3 $ 1 ) END IF GO TO 190 +* Test SGEMMTR, 07. + 185 IF (CORDER) THEN + CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, + $ 0 ) + + END IF + IF (RORDER) THEN + CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE, + $ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, + $ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W, + $ 1 ) + END IF + GO TO 190 * - 190 IF( FATAL.AND.SFATAL ) + + 190 IF( FATAL.AND.SFATAL ) $ GO TO 210 END IF 200 CONTINUE @@ -396,7 +414,7 @@ PROGRAM SBLAT3 9992 FORMAT( ' FOR BETA ', 7F6.1 ) 9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM', $ /' ******* TESTS ABANDONED *******' ) - 9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* ', + 9990 FORMAT( ' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* ', $ 'TESTS ABANDONED *******' ) 9989 FORMAT( ' ERROR IN SMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU', $ 'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1, @@ -404,8 +422,8 @@ PROGRAM SBLAT3 $ 'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ', $ 'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ', $ '*******' ) - 9988 FORMAT( A12,L2 ) - 9987 FORMAT( 1X, A12,' WAS NOT TESTED' ) + 9988 FORMAT( A13,L2 ) + 9987 FORMAT( 1X, A13,' WAS NOT TESTED' ) 9986 FORMAT( /' END OF TESTS' ) 9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' ) 9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' ) @@ -435,7 +453,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -681,20 +699,20 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',', $ 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', $ 'C,', I3, ').' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -711,7 +729,7 @@ SUBROUTINE SPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC REAL ALPHA, BETA CHARACTER*1 TRANSA, TRANSB - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CTA,CTB IF (TRANSA.EQ.'N')THEN @@ -736,7 +754,7 @@ SUBROUTINE SPRCN1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END @@ -763,7 +781,7 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -998,20 +1016,20 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 120 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -1026,7 +1044,7 @@ SUBROUTINE SPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC REAL ALPHA, BETA CHARACTER*1 SIDE, UPLO - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS,CU IF (SIDE.EQ.'L')THEN @@ -1047,7 +1065,7 @@ SUBROUTINE SPRCN2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', $ F4.1, ', ', 'C,', I3, ').' ) END @@ -1073,7 +1091,7 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1346,20 +1364,20 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) - 9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ') .' ) 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1373,7 +1391,7 @@ SUBROUTINE SPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, M, N, LDA, LDB REAL ALPHA CHARACTER*1 SIDE, UPLO, TRANSA, DIAG - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CS, CU, CA, CD IF (SIDE.EQ.'L')THEN @@ -1406,7 +1424,7 @@ SUBROUTINE SPRCN3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB - 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',') + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',') 9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ').' ) END @@ -1433,7 +1451,7 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), $ AS( NMAX*NMAX ), B( NMAX, NMAX ), @@ -1672,21 +1690,21 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 130 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', $ '******' ) @@ -1700,7 +1718,7 @@ SUBROUTINE SPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDC REAL ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -1723,7 +1741,7 @@ SUBROUTINE SPRCN4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -1750,7 +1768,7 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, REAL EPS, THRESH INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER LOGICAL FATAL, REWI, TRACE - CHARACTER*12 SNAME + CHARACTER*13 SNAME * .. Array Arguments .. REAL AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ), $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ), @@ -2027,21 +2045,21 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, 160 CONTINUE RETURN * -10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', $ 'RATIO ', F8.2, ' - SUSPECT *******' ) -10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) -10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', $ ' (', I6, ' CALL', 'S)' ) 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', $ 'ANGED INCORRECTLY *******' ) - 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' ) + 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' ) 9995 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) - 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), + 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), $ F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ') ', $ ' .' ) 9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', @@ -2056,7 +2074,7 @@ SUBROUTINE SPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC REAL ALPHA, BETA CHARACTER*1 UPLO, TRANSA - CHARACTER*12 SNAME + CHARACTER*13 SNAME CHARACTER*14 CRC, CU, CA IF (UPLO.EQ.'U')THEN @@ -2079,7 +2097,7 @@ SUBROUTINE SPRCN5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC - 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') ) + 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') ) 9994 FORMAT( 20X, 2( I3, ',' ), $ F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' ) END @@ -2478,3 +2496,475 @@ REAL FUNCTION SDIFF( X, Y ) * End of SDIFF. * END + + + SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, + $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX, + $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G, + $ IORDER) +* +* Tests SGEMMTR. +* +* Auxiliary routine for test program for Level 3 Blas. +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0 ) +* .. Scalar Arguments .. + REAL EPS, THRESH + INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER + LOGICAL FATAL, REWI, TRACE + CHARACTER*13 SNAME +* .. Array Arguments .. + REAL A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ), + $ AS( NMAX*NMAX ), B( NMAX, NMAX ), + $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ), + $ C( NMAX, NMAX ), CC( NMAX*NMAX ), + $ CS( NMAX*NMAX ), CT( NMAX ), G( NMAX ) + INTEGER IDIM( NIDIM ) +* .. Local Scalars .. + REAL ALPHA, ALS, BETA, BLS, ERR, ERRMAX + INTEGER I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA, + $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, + $ MA, MB, N, NA, NARGS, NB, NC, NS, IS + LOGICAL NULL, RESET, SAME, TRANA, TRANB + CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS + CHARACTER*3 ICH + CHARACTER*2 ISHAPE +* .. Local Arrays .. + LOGICAL ISAME( 13 ) +* .. External Functions .. + LOGICAL LSE, LSERES + EXTERNAL LSE, LSERES +* .. External Subroutines .. + EXTERNAL CSGEMMTR, SMAKE, SMMTCH, SPRCN8 +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. Scalars in Common .. + INTEGER INFOT, NOUTC + LOGICAL LERR, OK +* .. Common blocks .. + COMMON /INFOC/INFOT, NOUTC, OK, LERR +* .. Data statements .. + DATA ICH/'NTC'/ + DATA ISHAPE/'UL'/ +* .. Executable Statements .. +* + NARGS = 13 + NC = 0 + RESET = .TRUE. + ERRMAX = ZERO +* + DO 100 IN = 1, NIDIM + N = IDIM( IN ) +* Set LDC to 1 more than minimum value if room. + LDC = N + IF( LDC.LT.NMAX ) + $ LDC = LDC + 1 +* Skip tests if not enough room. + IF( LDC.GT.NMAX ) + $ GO TO 100 + LCC = LDC*N + NULL = N.LE.0 +* + DO 90 IK = 1, NIDIM + K = IDIM( IK ) +* + DO 80 ICA = 1, 3 + TRANSA = ICH( ICA: ICA ) + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' +* + IF( TRANA )THEN + MA = K + NA = N + ELSE + MA = N + NA = K + END IF +* Set LDA to 1 more than minimum value if room. + LDA = MA + IF( LDA.LT.NMAX ) + $ LDA = LDA + 1 +* Skip tests if not enough room. + IF( LDA.GT.NMAX ) + $ GO TO 80 + LAA = LDA*NA +* +* Generate the matrix A. +* + CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA, + $ RESET, ZERO ) +* + DO 70 ICB = 1, 3 + TRANSB = ICH( ICB: ICB ) + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* + IF( TRANB )THEN + MB = N + NB = K + ELSE + MB = K + NB = N + END IF +* Set LDB to 1 more than minimum value if room. + LDB = MB + IF( LDB.LT.NMAX ) + $ LDB = LDB + 1 +* Skip tests if not enough room. + IF( LDB.GT.NMAX ) + $ GO TO 70 + LBB = LDB*NB +* +* Generate the matrix B. +* + CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB, + $ LDB, RESET, ZERO ) +* + DO 60 IA = 1, NALF + ALPHA = ALF( IA ) +* + DO 50 IB = 1, NBET + BETA = BET( IB ) + + DO 45 IS = 1, 2 + UPLO = ISHAPE( IS: IS ) + +* +* Generate the matrix C. +* + CALL SMAKE( 'GE', UPLO, ' ', N, N, C, + $ NMAX, CC, LDC, RESET, ZERO ) +* + NC = NC + 1 +* +* Save every datum before calling the +* subroutine. +* + UPLOS = UPLO + TRANAS = TRANSA + TRANBS = TRANSB + NS = N + KS = K + ALS = ALPHA + DO 10 I = 1, LAA + AS( I ) = AA( I ) + 10 CONTINUE + LDAS = LDA + DO 20 I = 1, LBB + BS( I ) = BB( I ) + 20 CONTINUE + LDBS = LDB + BLS = BETA + DO 30 I = 1, LCC + CS( I ) = CC( I ) + 30 CONTINUE + LDCS = LDC +* +* Call the subroutine. +* + IF( TRACE ) + $ CALL SPRCN8(NTRA, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, K, ALPHA, LDA, + $ LDB, BETA, LDC) + IF( REWI ) + $ REWIND NTRA + CALL CSGEMMTR( IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, AA, LDA, BB, LDB, + $ BETA, CC, LDC ) +* +* Check if error-exit was taken incorrectly. +* + IF( .NOT.OK )THEN + WRITE( NOUT, FMT = 9994 ) + FATAL = .TRUE. + GO TO 120 + END IF +* +* See what data changed inside subroutines. +* + ISAME( 1 ) = UPLO.EQ.UPLOS + ISAME( 2 ) = TRANSA.EQ.TRANAS + ISAME( 3 ) = TRANSB.EQ.TRANBS + ISAME( 4 ) = NS.EQ.N + ISAME( 5 ) = KS.EQ.K + ISAME( 6 ) = ALS.EQ.ALPHA + ISAME( 7 ) = LSE( AS, AA, LAA ) + ISAME( 8 ) = LDAS.EQ.LDA + ISAME( 9 ) = LSE( BS, BB, LBB ) + ISAME( 10 ) = LDBS.EQ.LDB + ISAME( 11 ) = BLS.EQ.BETA + IF( NULL )THEN + ISAME( 12 ) = LSE( CS, CC, LCC ) + ELSE + ISAME( 12 ) = LSERES( 'GE', ' ', N, N, + $ CS, CC, LDC ) + END IF + ISAME( 13 ) = LDCS.EQ.LDC +* +* If data was incorrectly changed, report +* and return. +* + SAME = .TRUE. + DO 40 I = 1, NARGS + SAME = SAME.AND.ISAME( I ) + IF( .NOT.ISAME( I ) ) + $ WRITE( NOUT, FMT = 9998 )I + 40 CONTINUE + IF( .NOT.SAME )THEN + FATAL = .TRUE. + GO TO 120 + END IF +* + IF( .NOT.NULL )THEN +* +* Check the result. +* + CALL SMMTCH( UPLO, TRANSA, TRANSB, + $ N, K, + $ ALPHA, A, NMAX, B, NMAX, BETA, + $ C, NMAX, CT, G, CC, LDC, EPS, + $ ERR, FATAL, NOUT, .TRUE. ) + ERRMAX = MAX( ERRMAX, ERR ) +* If got really bad answer, report and +* return. + IF( FATAL ) + $ GO TO 120 + END IF +* + 45 CONTINUE +* + 50 CONTINUE +* + 60 CONTINUE +* + 70 CONTINUE +* + 80 CONTINUE +* + 90 CONTINUE +* + 100 CONTINUE +* +* +* Report result. +* + IF( ERRMAX.LT.THRESH )THEN + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC + ELSE + IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX + IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX + END IF + GO TO 130 +* + 120 CONTINUE + WRITE( NOUT, FMT = 9996 )SNAME + CALL SPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB, + $ N, K, ALPHA, LDA, LDB, BETA, LDC) +* + 130 CONTINUE + RETURN +* +10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ', + $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ', + $ 'RATIO ', F8.2, ' - SUSPECT *******' ) +10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) +10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS', + $ ' (', I6, ' CALL', 'S)' ) + 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH', + $ 'ANGED INCORRECTLY *******' ) + 9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C', + $ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2, + $ ' - SUSPECT *******' ) + 9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' ) + 9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',', + $ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ', + $ 'C,', I3, ').' ) + 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *', + $ '******' ) +* +* End of SCHK6 +* + END + + SUBROUTINE SPRCN8(NOUT, NC, SNAME, IORDER, UPLO, + $ TRANSA, TRANSB, N, + $ K, ALPHA, LDA, LDB, BETA, LDC) + INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC + REAL ALPHA, BETA + CHARACTER*1 TRANSA, TRANSB, UPLO + CHARACTER*13 SNAME + CHARACTER*14 CRC, CTA,CTB,CUPLO + + IF (UPLO.EQ.'U') THEN + CUPLO = 'CblasUpper' + ELSE + CUPLO = 'CblasLower' + END IF + IF (TRANSA.EQ.'N')THEN + CTA = ' CblasNoTrans' + ELSE IF (TRANSA.EQ.'T')THEN + CTA = ' CblasTrans' + ELSE + CTA = 'CblasConjTrans' + END IF + IF (TRANSB.EQ.'N')THEN + CTB = ' CblasNoTrans' + ELSE IF (TRANSB.EQ.'T')THEN + CTB = ' CblasTrans' + ELSE + CTB = 'CblasConjTrans' + END IF + IF (IORDER.EQ.1)THEN + CRC = ' CblasRowMajor' + ELSE + CRC = ' CblasColMajor' + END IF + WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB + WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC + + 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',', + $ A14, ',') + 9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,', + $ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' ) + END + + SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA, + $ B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, + $ FATAL, NOUT, MV ) +* +* Checks the results of the computational tests. +* +* Auxiliary routine for test program for Level 3 Blas. (DGEMMTR) +* +* -- Written on 19-July-2023. +* Martin Koehler, MPI Magdeburg +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0, ONE = 1.0 ) +* .. Scalar Arguments .. + REAL ALPHA, BETA, EPS, ERR + INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT + LOGICAL FATAL, MV + CHARACTER*1 UPLO, TRANSA, TRANSB +* .. Array Arguments .. + REAL A( LDA, * ), B( LDB, * ), C( LDC, * ), + $ CC( LDCC, * ), CT( * ), G( * ) +* .. Local Scalars .. + REAL ERRI + INTEGER I, J, K, ISTART, ISTOP + LOGICAL TRANA, TRANB, UPPER +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. Executable Statements .. + UPPER = UPLO.EQ.'U' + TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C' + TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C' +* +* Compute expected result, one column at a time, in CT using data +* in A, B and C. +* Compute gauges in G. +* + ISTART = 1 + ISTOP = N + + DO 120 J = 1, N +* + IF ( UPPER ) THEN + ISTART = 1 + ISTOP = J + ELSE + ISTART = J + ISTOP = N + END IF + DO 10 I = ISTART, ISTOP + CT( I ) = ZERO + G( I ) = ZERO + 10 CONTINUE + IF( .NOT.TRANA.AND..NOT.TRANB )THEN + DO 30 K = 1, KK + DO 20 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( K, J ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) ) + 20 CONTINUE + 30 CONTINUE + ELSE IF( TRANA.AND..NOT.TRANB )THEN + DO 50 K = 1, KK + DO 40 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( K, J ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) ) + 40 CONTINUE + 50 CONTINUE + ELSE IF( .NOT.TRANA.AND.TRANB )THEN + DO 70 K = 1, KK + DO 60 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( I, K )*B( J, K ) + G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) ) + 60 CONTINUE + 70 CONTINUE + ELSE IF( TRANA.AND.TRANB )THEN + DO 90 K = 1, KK + DO 80 I = ISTART, ISTOP + CT( I ) = CT( I ) + A( K, I )*B( J, K ) + G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) ) + 80 CONTINUE + 90 CONTINUE + END IF + DO 100 I = ISTART, ISTOP + CT( I ) = ALPHA*CT( I ) + BETA*C( I, J ) + G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) ) + 100 CONTINUE +* +* Compute the error ratio for this result. +* + ERR = ZERO + DO 110 I = ISTART, ISTOP + ERRI = ABS( CT( I ) - CC( I, J ) )/EPS + IF( G( I ).NE.ZERO ) + $ ERRI = ERRI/G( I ) + ERR = MAX( ERR, ERRI ) + IF( ERR*SQRT( EPS ).GE.ONE ) + $ GO TO 130 + 110 CONTINUE +* + 120 CONTINUE +* +* If the loop completes, all results are at least half accurate. + GO TO 150 +* +* Report fatal error. +* + 130 FATAL = .TRUE. + WRITE( NOUT, FMT = 9999 ) + DO 140 I = ISTART, ISTOP + IF( MV )THEN + WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J ) + ELSE + WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I ) + END IF + 140 CONTINUE + IF( N.GT.1 ) + $ WRITE( NOUT, FMT = 9997 )J +* + 150 CONTINUE + RETURN +* + 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL', + $ 'F ACCURATE *******', /' EXPECTED RESULT COMPU', + $ 'TED RESULT' ) + 9998 FORMAT( 1X, I7, 2G18.6 ) + 9997 FORMAT( ' THESE ARE THE RESULTS FOR COLUMN ', I3 ) +* +* End of SMMTCH +* + END + + diff --git a/CBLAS/testing/sin3 b/CBLAS/testing/sin3 index aa18530cb4..f332c8a9e0 100644 --- a/CBLAS/testing/sin3 +++ b/CBLAS/testing/sin3 @@ -11,9 +11,10 @@ T LOGICAL FLAG, T TO TEST ERROR EXITS. 0.0 1.0 0.7 VALUES OF ALPHA 3 NUMBER OF VALUES OF BETA 0.0 1.0 1.3 VALUES OF BETA -cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. -cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgemm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssymm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strmm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_strsm T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyrk T PUT F FOR NO TEST. SAME COLUMNS. +cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS. +cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS. From 85717807e9bb33151ae2f33d3aea03f8c6156647 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 15:12:49 +0200 Subject: [PATCH 151/206] Working error tests on cblas_cgemmtr --- CBLAS/testing/c_c3chke.c | 188 ++++++++++++++++++++------------------- CBLAS/testing/c_xerbla.c | 13 ++- 2 files changed, 104 insertions(+), 97 deletions(-) diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index 4479469a2f..2f48430b69 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -55,235 +55,238 @@ void F77_c3chke(char * rout } #endif - if (strncmp( sf,"cblas_cgemm" ,11)==0) { - cblas_rout = "cblas_cgemm" ; + if (strncmp( sf,"cblas_cgemmtr" ,13)==0) { + cblas_rout = "cblas_cgemmtr" ; cblas_info = 1; - cblas_cgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, + cblas_cgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasNoTrans, CblasTrans, 0, 0, 0, + cblas_cgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasTrans, CblasNoTrans, 0, 0, 0, + cblas_cgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 1; - cblas_cgemm( INVALID, CblasTrans, CblasTrans, 0, 0, 0, + cblas_cgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, INVALID, CblasNoTrans, 0, 0, 0, + + cblas_info = 1; + cblas_cgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, INVALID, CblasTrans, 0, 0, 0, + cblas_info = 1; + cblas_cgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0, + cblas_info = 1; + cblas_cgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, INVALID, 0, 0, 0, + cblas_info = 1; + cblas_cgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, + + cblas_info = 2; RowMajorStrg = FALSE; + cblas_cgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, + cblas_info = 2; RowMajorStrg = FALSE; + cblas_cgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + cblas_cgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_cgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 4; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, INVALID, 0, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 11; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 0, 2, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasNoTrans, 2, 0, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasNoTrans, CblasTrans, 2, 0, 0, - ALPHA, A, 2, B, 1, BETA, C, 1 ); + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasNoTrans, 2, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = FALSE; - cblas_cgemm( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, INVALID, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, INVALID, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 4; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, INVALID, 0, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); + + /* Row Major */ cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 5; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, INVALID, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 6; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, INVALID, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 0, 2, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 2, 0, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 9; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 2, 0, 0, + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, - ALPHA, A, 2, B, 1, BETA, C, 1 ); - chkxer(); - cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 0, 2, + cblas_cgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, 0, 2, 0, - ALPHA, A, 1, B, 2, BETA, C, 1 ); + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasNoTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasNoTrans, 0, 2, 0, - ALPHA, A, 1, B, 2, BETA, C, 1 ); + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); cblas_info = 14; RowMajorStrg = TRUE; - cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + cblas_cgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_cgemmtr" ,12)==0) { - cblas_rout = "cblas_cgemmtr" ; + + } else if (strncmp( sf,"cblas_cgemm" ,11)==0) { + cblas_rout = "cblas_cgemm" ; cblas_info = 1; cblas_cgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, @@ -509,7 +512,6 @@ void F77_c3chke(char * rout cblas_cgemm( CblasRowMajor, CblasTrans, CblasTrans, 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); - } else if (strncmp( sf,"cblas_chemm" ,11)==0) { cblas_rout = "cblas_chemm" ; @@ -1937,7 +1939,7 @@ void F77_c3chke(char * rout } if (cblas_ok == 1 ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); } diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index a3ce836e7d..2af45f4a4c 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -33,13 +33,18 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...) * for A and B, lda is in position 11 instead of 9, and ldb is in * position 9 instead of 11. */ - if (strstr(rout,"gemm") != 0) + if (strstr(rout,"gemm") != 0 && strstr(rout, "gemmtr") == 0) { if (info == 5 ) info = 4; else if (info == 4 ) info = 5; else if (info == 11) info = 9; else if (info == 9 ) info = 11; + } else if (strstr(rout, "gemmtr") != 0) + { + if (info == 11) info = 9; + else if (info == 9 ) info = 11; } + else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0) { if (info == 5 ) info = 4; @@ -98,7 +103,7 @@ void F77_xerbla(char *srname, void *vinfo char *srname; #endif - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'}; + char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0'}; #ifdef F77_Integer F77_Integer *info=vinfo; @@ -119,8 +124,8 @@ void F77_xerbla(char *srname, void *vinfo link_xerbla = 0; return; } - for(i=0; i < 6; i++) rout[i+6] = tolower(srname[i]); - for(i=11; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; + for(i=0; i < 7; i++) rout[i+6] = tolower(srname[i]); + for(i=12; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; /* We increment *info by 1 since the CBLAS interface adds one more * argument to all level 2 and 3 routines. From 34adaba0e6829c3cc43cda4aba6e78c44ac93b8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 15:18:22 +0200 Subject: [PATCH 152/206] Add tests for cblas_s/d/zgemmtr --- CBLAS/testing/c_d3chke.c | 234 ++++++++++++++++++++++++++++++++++++++- CBLAS/testing/c_s3chke.c | 234 ++++++++++++++++++++++++++++++++++++++- CBLAS/testing/c_z3chke.c | 233 +++++++++++++++++++++++++++++++++++++- 3 files changed, 695 insertions(+), 6 deletions(-) diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index f8919bf92d..6d27bc6cfc 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -53,7 +53,237 @@ void F77_d3chke(char *rout cblas_ok = TRUE ; cblas_lerr = PASSED ; - if (strncmp( sf,"cblas_dgemm" ,11)==0) { + if (strncmp( sf,"cblas_dgemmtr" ,13)==0) { + cblas_rout = "cblas_dgemmtr" ; + + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_dgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + /* Row Major */ + cblas_info = 5; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_dgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_dgemm" ,11)==0) { cblas_rout = "cblas_dgemm" ; cblas_info = 1; @@ -1275,7 +1505,7 @@ void F77_d3chke(char *rout chkxer(); } if (cblas_ok == TRUE ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); } diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index f9772bf813..2009e388af 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -53,7 +53,237 @@ void F77_s3chke(char *rout cblas_ok = TRUE ; cblas_lerr = PASSED ; - if (strncmp( sf,"cblas_sgemm" ,11)==0) { + if (strncmp( sf,"cblas_sgemmtr" ,13)==0) { + cblas_rout = "cblas_sgemmtr" ; + + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_sgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + /* Row Major */ + cblas_info = 5; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_sgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_sgemm" ,11)==0) { cblas_rout = "cblas_sgemm" ; cblas_info = 1; cblas_sgemm( INVALID, CblasNoTrans, CblasNoTrans, 0, 0, 0, @@ -1277,7 +1507,7 @@ void F77_s3chke(char *rout chkxer(); } if (cblas_ok == TRUE ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); } diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index 113b054d97..72c960735f 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -54,8 +54,237 @@ void F77_z3chke(char *rout F77_xerbla(cblas_rout,&cblas_info, 1); } #endif + if (strncmp( sf,"cblas_zgemmtr" ,13)==0) { + cblas_rout = "cblas_zgemmtr" ; - if (strncmp( sf,"cblas_zgemm" ,11)==0) { + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasUpper, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasUpper,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasUpper, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasLower, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasLower, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasLower,CblasTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 1; + cblas_zgemmtr( INVALID, CblasLower, CblasTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 2; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, INVALID, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, INVALID, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, INVALID, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, INVALID, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 5; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + + cblas_info = 9; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = FALSE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + /* Row Major */ + cblas_info = 5; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 6; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 6; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 9; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, + ALPHA, A, 1, B, 2, BETA, C, 2 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 9; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 11; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 14; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + cblas_info = 14; RowMajorStrg = TRUE; + cblas_zgemmtr( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + ALPHA, A, 2, B, 2, BETA, C, 1 ); + chkxer(); + + } else if (strncmp( sf,"cblas_zgemm" ,11)==0) { cblas_rout = "cblas_zgemm" ; cblas_info = 1; @@ -1710,7 +1939,7 @@ void F77_z3chke(char *rout } if (cblas_ok == 1 ) - printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); + printf(" %-13s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout); else printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout); } From 0e37c5cc375ce6ab46e958c076ba6fe3faed7881 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Mon, 24 Jun 2024 15:35:14 +0200 Subject: [PATCH 153/206] Fix CMake Build --- CBLAS/src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 2979d91a6d..8dcb2f2931 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -89,7 +89,7 @@ set(SLEV3 cblas_sgemm.c cblas_ssymm.c cblas_ssyrk.c cblas_ssyr2k.c cblas_strmm.c # Files for level 3 double precision real set(DLEV3 cblas_dgemm.c cblas_dsymm.c cblas_dsyrk.c cblas_dsyr2k.c cblas_dtrmm.c - cblas_dtrsm.c cblas_cgemmtr.c) + cblas_dtrsm.c cblas_dgemmtr.c) # Files for level 3 single precision complex set(CLEV3 cblas_cgemm.c cblas_csymm.c cblas_chemm.c cblas_cherk.c From c57c156bd10eb7923a24dfe3ef664c4f90034dce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20K=C3=B6hler?= Date: Thu, 27 Jun 2024 14:01:49 +0200 Subject: [PATCH 154/206] Add gemmtr group to Doxygen updated: * BLAS/SRC/sgemmtr.f * BLAS/SRC/zgemmtr.f * BLAS/SRC/cgemmtr.f * BLAS/SRC/dgemmtr.f --- BLAS/SRC/cgemmtr.f | 2 +- BLAS/SRC/dgemmtr.f | 2 +- BLAS/SRC/sgemmtr.f | 2 +- BLAS/SRC/zgemmtr.f | 2 +- DOCS/groups-usr.dox | 2 ++ 5 files changed, 6 insertions(+), 4 deletions(-) diff --git a/BLAS/SRC/cgemmtr.f b/BLAS/SRC/cgemmtr.f index 84bd22277c..68063cbdaf 100644 --- a/BLAS/SRC/cgemmtr.f +++ b/BLAS/SRC/cgemmtr.f @@ -172,7 +172,7 @@ * *> \author Martin Koehler * -*> \ingroup gemm +*> \ingroup gemmtr * *> \par Further Details: * ===================== diff --git a/BLAS/SRC/dgemmtr.f b/BLAS/SRC/dgemmtr.f index acaaa351e0..74e0ce0dac 100644 --- a/BLAS/SRC/dgemmtr.f +++ b/BLAS/SRC/dgemmtr.f @@ -172,7 +172,7 @@ * *> \author Martin Koehler * -*> \ingroup gemm +*> \ingroup gemmtr * *> \par Further Details: * ===================== diff --git a/BLAS/SRC/sgemmtr.f b/BLAS/SRC/sgemmtr.f index 1f0ed17bf4..1aeff65e03 100644 --- a/BLAS/SRC/sgemmtr.f +++ b/BLAS/SRC/sgemmtr.f @@ -172,7 +172,7 @@ * *> \author Martin Koehler * -*> \ingroup gemm +*> \ingroup gemmtr * *> \par Further Details: * ===================== diff --git a/BLAS/SRC/zgemmtr.f b/BLAS/SRC/zgemmtr.f index 5907a4d532..9f30488021 100644 --- a/BLAS/SRC/zgemmtr.f +++ b/BLAS/SRC/zgemmtr.f @@ -172,7 +172,7 @@ * *> \author Martin Koehler * -*> \ingroup gemm +*> \ingroup gemmtr * *> \par Further Details: * ===================== diff --git a/DOCS/groups-usr.dox b/DOCS/groups-usr.dox index cbd7471657..0234f83d96 100644 --- a/DOCS/groups-usr.dox +++ b/DOCS/groups-usr.dox @@ -961,6 +961,8 @@ https://www.netlib.org/xblas/ @defgroup blas3_grp Level 3 BLAS: matrix-matrix ops @{ @defgroup gemm gemm: general matrix-matrix multiply + @defgroup gemmtr gemmtr: general matrix-matrix multiply with triangular output + @defgroup hemm {he,sy}mm: Hermitian/symmetric matrix-matrix multiply @defgroup herk {he,sy}rk: Hermitian/symmetric rank-k update From 22f9be6a47cee65f40db9dd5ee7eb34b91b19cf0 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 12 Jul 2024 14:52:11 +0100 Subject: [PATCH 155/206] Added parentheses to multiplications to prevent compilers from using FMAs where the different rounding can lead to a change in control flow. --- SRC/dlanv2.f | 8 ++++++-- SRC/slanv2.f | 10 +++++++--- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/SRC/dlanv2.f b/SRC/dlanv2.f index c55b0ce510..a4bd262c98 100644 --- a/SRC/dlanv2.f +++ b/SRC/dlanv2.f @@ -248,10 +248,14 @@ SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) * * Compute [ A B ] = [ CS SN ] [ AA BB ] * [ C D ] [-SN CS ] [ CC DD ] +* +* Note: Some of the multiplications are wrapped in parentheses to +* prevent compilers from using FMA instructions. See +* https://github.com/Reference-LAPACK/lapack/issues/1031. * A = AA*CS + CC*SN - B = BB*CS + DD*SN - C = -AA*SN + CC*CS + B = ( BB*CS ) + ( DD*SN ) + C = -( AA*SN ) + ( CC*CS ) D = -BB*SN + DD*CS * TEMP = HALF*( A+D ) diff --git a/SRC/slanv2.f b/SRC/slanv2.f index ac1a197822..40470867e7 100644 --- a/SRC/slanv2.f +++ b/SRC/slanv2.f @@ -144,7 +144,7 @@ SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) * .. * .. Local Scalars .. REAL AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB, - $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z, SAFMIN, + $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z, SAFMIN, $ SAFMN2, SAFMX2 INTEGER COUNT * .. @@ -248,10 +248,14 @@ SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) * * Compute [ A B ] = [ CS SN ] [ AA BB ] * [ C D ] [-SN CS ] [ CC DD ] +* +* Note: Some of the multiplications are wrapped in parentheses to +* prevent compilers from using FMA instructions. See +* https://github.com/Reference-LAPACK/lapack/issues/1031. * A = AA*CS + CC*SN - B = BB*CS + DD*SN - C = -AA*SN + CC*CS + B = ( BB*CS ) + ( DD*SN ) + C = -( AA*SN ) + ( CC*CS ) D = -BB*SN + DD*CS * TEMP = HALF*( A+D ) From 349b76a5ee8586c6cbddfee5a08ff536707fe2ff Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 12 Jul 2024 15:00:39 +0100 Subject: [PATCH 156/206] Remove trailing whitespace --- SRC/dlanv2.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SRC/dlanv2.f b/SRC/dlanv2.f index a4bd262c98..9008fdde08 100644 --- a/SRC/dlanv2.f +++ b/SRC/dlanv2.f @@ -144,7 +144,7 @@ SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) * .. * .. Local Scalars .. DOUBLE PRECISION AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB, - $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z, SAFMIN, + $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z, SAFMIN, $ SAFMN2, SAFMX2 INTEGER COUNT * .. From 5475251aba635560a9e006febf29348a574b3b6c Mon Sep 17 00:00:00 2001 From: GYT Date: Wed, 1 Nov 2023 20:28:00 +0100 Subject: [PATCH 157/206] Add note to *TRTRS and *TBTRS about how only exact singularity is checked --- SRC/ctbtrs.f | 10 ++++++++-- SRC/ctrtrs.f | 10 ++++++++-- SRC/dtbtrs.f | 10 ++++++++-- SRC/dtrtrs.f | 10 ++++++++-- SRC/stbtrs.f | 10 ++++++++-- SRC/strtrs.f | 10 ++++++++-- SRC/ztbtrs.f | 10 ++++++++-- SRC/ztrtrs.f | 10 ++++++++-- 8 files changed, 64 insertions(+), 16 deletions(-) diff --git a/SRC/ctbtrs.f b/SRC/ctbtrs.f index e5da1aeae8..95cbc27a86 100644 --- a/SRC/ctbtrs.f +++ b/SRC/ctbtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular band matrix of order N, and B is an -*> N-by-NRHS matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular band matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/ctrtrs.f b/SRC/ctrtrs.f index e17785402d..9318ab090a 100644 --- a/SRC/ctrtrs.f +++ b/SRC/ctrtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular matrix of order N, and B is an N-by-NRHS -*> matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/dtbtrs.f b/SRC/dtbtrs.f index 166cd0dc33..01657501ba 100644 --- a/SRC/dtbtrs.f +++ b/SRC/dtbtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular band matrix of order N, and B is an -*> N-by NRHS matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular band matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/dtrtrs.f b/SRC/dtrtrs.f index 184b213e6b..13c5ee091c 100644 --- a/SRC/dtrtrs.f +++ b/SRC/dtrtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular matrix of order N, and B is an N-by-NRHS -*> matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/stbtrs.f b/SRC/stbtrs.f index 103e1d28ce..a5ea539df7 100644 --- a/SRC/stbtrs.f +++ b/SRC/stbtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular band matrix of order N, and B is an -*> N-by NRHS matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular band matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/strtrs.f b/SRC/strtrs.f index 6cba2e842b..19dd4f75d9 100644 --- a/SRC/strtrs.f +++ b/SRC/strtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular matrix of order N, and B is an N-by-NRHS -*> matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/ztbtrs.f b/SRC/ztbtrs.f index d21efe61d2..62c7a0453d 100644 --- a/SRC/ztbtrs.f +++ b/SRC/ztbtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular band matrix of order N, and B is an -*> N-by-NRHS matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular band matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: diff --git a/SRC/ztrtrs.f b/SRC/ztrtrs.f index 728e0a403d..63b64026f4 100644 --- a/SRC/ztrtrs.f +++ b/SRC/ztrtrs.f @@ -39,8 +39,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular matrix of order N, and B is an N-by-NRHS -*> matrix. A check is made to verify that A is nonsingular. +*> where A is a triangular matrix of order N, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: From 4afdca25b22817b3b0a67eeb377814e8c4464f21 Mon Sep 17 00:00:00 2001 From: GYT Date: Wed, 1 Nov 2023 20:51:18 +0100 Subject: [PATCH 158/206] Add "exact" to *TRTRS and *TBTRS info value descriptions --- SRC/ctbtrs.f | 2 +- SRC/ctrtrs.f | 2 +- SRC/dtbtrs.f | 2 +- SRC/dtrtrs.f | 2 +- SRC/stbtrs.f | 2 +- SRC/strtrs.f | 2 +- SRC/ztbtrs.f | 2 +- SRC/ztrtrs.f | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/SRC/ctbtrs.f b/SRC/ctbtrs.f index 95cbc27a86..cb62eb339f 100644 --- a/SRC/ctbtrs.f +++ b/SRC/ctbtrs.f @@ -131,7 +131,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/ctrtrs.f b/SRC/ctrtrs.f index 9318ab090a..18b493c836 100644 --- a/SRC/ctrtrs.f +++ b/SRC/ctrtrs.f @@ -125,7 +125,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the solutions *> X have not been computed. *> \endverbatim diff --git a/SRC/dtbtrs.f b/SRC/dtbtrs.f index 01657501ba..93e7c55520 100644 --- a/SRC/dtbtrs.f +++ b/SRC/dtbtrs.f @@ -131,7 +131,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/dtrtrs.f b/SRC/dtrtrs.f index 13c5ee091c..2c23850d9f 100644 --- a/SRC/dtrtrs.f +++ b/SRC/dtrtrs.f @@ -125,7 +125,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the solutions *> X have not been computed. *> \endverbatim diff --git a/SRC/stbtrs.f b/SRC/stbtrs.f index a5ea539df7..2c59b36161 100644 --- a/SRC/stbtrs.f +++ b/SRC/stbtrs.f @@ -131,7 +131,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/strtrs.f b/SRC/strtrs.f index 19dd4f75d9..609344c618 100644 --- a/SRC/strtrs.f +++ b/SRC/strtrs.f @@ -125,7 +125,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the solutions *> X have not been computed. *> \endverbatim diff --git a/SRC/ztbtrs.f b/SRC/ztbtrs.f index 62c7a0453d..66aface3e1 100644 --- a/SRC/ztbtrs.f +++ b/SRC/ztbtrs.f @@ -131,7 +131,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/ztrtrs.f b/SRC/ztrtrs.f index 63b64026f4..c4735f126f 100644 --- a/SRC/ztrtrs.f +++ b/SRC/ztrtrs.f @@ -125,7 +125,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the solutions *> X have not been computed. *> \endverbatim From 6922840707c3a74273aab04c95b2f105a4c11e11 Mon Sep 17 00:00:00 2001 From: GYT Date: Wed, 1 Nov 2023 20:57:22 +0100 Subject: [PATCH 159/206] Add notes to *TPTRS about how only exact singularity is checked --- SRC/ctptrs.f | 13 +++++++++---- SRC/dtptrs.f | 13 +++++++++---- SRC/stptrs.f | 13 +++++++++---- SRC/ztptrs.f | 13 +++++++++---- 4 files changed, 36 insertions(+), 16 deletions(-) diff --git a/SRC/ctptrs.f b/SRC/ctptrs.f index 456e1b7824..368f58ec97 100644 --- a/SRC/ctptrs.f +++ b/SRC/ctptrs.f @@ -38,9 +38,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular matrix of order N stored in packed format, -*> and B is an N-by-NRHS matrix. A check is made to verify that A is -*> nonsingular. +*> where A is a triangular matrix of order N stored in packed format, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: @@ -110,7 +115,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/dtptrs.f b/SRC/dtptrs.f index 3b3a8906b3..1fb5eebaae 100644 --- a/SRC/dtptrs.f +++ b/SRC/dtptrs.f @@ -38,9 +38,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular matrix of order N stored in packed format, -*> and B is an N-by-NRHS matrix. A check is made to verify that A is -*> nonsingular. +*> where A is a triangular matrix of order N stored in packed format, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: @@ -110,7 +115,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/stptrs.f b/SRC/stptrs.f index 556f03c642..71a4e12299 100644 --- a/SRC/stptrs.f +++ b/SRC/stptrs.f @@ -38,9 +38,14 @@ *> *> A * X = B or A**T * X = B, *> -*> where A is a triangular matrix of order N stored in packed format, -*> and B is an N-by-NRHS matrix. A check is made to verify that A is -*> nonsingular. +*> where A is a triangular matrix of order N stored in packed format, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: @@ -110,7 +115,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim diff --git a/SRC/ztptrs.f b/SRC/ztptrs.f index cfddc32513..fcc4b03551 100644 --- a/SRC/ztptrs.f +++ b/SRC/ztptrs.f @@ -38,9 +38,14 @@ *> *> A * X = B, A**T * X = B, or A**H * X = B, *> -*> where A is a triangular matrix of order N stored in packed format, -*> and B is an N-by-NRHS matrix. A check is made to verify that A is -*> nonsingular. +*> where A is a triangular matrix of order N stored in packed format, and B is an N-by-NRHS matrix. +*> +*> This subroutine verifies that A is nonsingular, but callers should note that only exact +*> singularity is detected. It is conceivable for one or more diagonal elements of A to be +*> subnormally tiny numbers without this subroutine signalling an error. +*> +*> If a possible loss of numerical precision due to near-singular matrices is a concern, the +*> caller should verify that A is nonsingular within some tolerance before calling this subroutine. *> \endverbatim * * Arguments: @@ -110,7 +115,7 @@ *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, the i-th diagonal element of A is zero, +*> > 0: if INFO = i, the i-th diagonal element of A is exactly zero, *> indicating that the matrix is singular and the *> solutions X have not been computed. *> \endverbatim From 1bf0ea2f93cec3f7ad8c927af1af3afb738abe41 Mon Sep 17 00:00:00 2001 From: GYT Date: Wed, 1 Nov 2023 21:55:28 +0100 Subject: [PATCH 160/206] Add notes to *GELS about how only exact rank-deficiency is checked --- SRC/cgels.f | 14 ++++++++++++-- SRC/dgels.f | 14 ++++++++++++-- SRC/sgels.f | 14 ++++++++++++-- SRC/zgels.f | 14 ++++++++++++-- 4 files changed, 48 insertions(+), 8 deletions(-) diff --git a/SRC/cgels.f b/SRC/cgels.f index 740bac890e..4dda66f910 100644 --- a/SRC/cgels.f +++ b/SRC/cgels.f @@ -37,7 +37,17 @@ *> *> CGELS solves overdetermined or underdetermined complex linear systems *> involving an M-by-N matrix A, or its conjugate-transpose, using a QR -*> or LQ factorization of A. It is assumed that A has full rank. +*> or LQ factorization of A. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -161,7 +171,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/dgels.f b/SRC/dgels.f index 90b2c91aa2..2376330a15 100644 --- a/SRC/dgels.f +++ b/SRC/dgels.f @@ -37,7 +37,17 @@ *> *> DGELS solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its transpose, using a QR or LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -162,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/sgels.f b/SRC/sgels.f index 9a311a8254..1630ec239e 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -37,7 +37,17 @@ *> *> SGELS solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its transpose, using a QR or LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -162,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/zgels.f b/SRC/zgels.f index 2b8913c198..b373d9a226 100644 --- a/SRC/zgels.f +++ b/SRC/zgels.f @@ -37,7 +37,17 @@ *> *> ZGELS solves overdetermined or underdetermined complex linear systems *> involving an M-by-N matrix A, or its conjugate-transpose, using a QR -*> or LQ factorization of A. It is assumed that A has full rank. +*> or LQ factorization of A. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -161,7 +171,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim From ba91e7eddbbe54f5fc55bce06a1e9bef81cf14a5 Mon Sep 17 00:00:00 2001 From: GYT Date: Thu, 2 Nov 2023 01:55:27 +0100 Subject: [PATCH 161/206] Add notes to *GELST about how only exact rank-deficiency is checked --- SRC/cgelst.f | 13 +++++++++++-- SRC/dgelst.f | 13 +++++++++++-- SRC/sgelst.f | 13 +++++++++++-- SRC/zgelst.f | 13 +++++++++++-- 4 files changed, 44 insertions(+), 8 deletions(-) diff --git a/SRC/cgelst.f b/SRC/cgelst.f index 0178c53dcb..fe0ea3be88 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -38,7 +38,16 @@ *> CGELST solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its conjugate-transpose, using a QR *> or LQ factorization of A with compact WY representation of Q. -*> It is assumed that A has full rank. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -163,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/dgelst.f b/SRC/dgelst.f index aadb5af57f..24129517e7 100644 --- a/SRC/dgelst.f +++ b/SRC/dgelst.f @@ -38,7 +38,16 @@ *> DGELST solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its transpose, using a QR or LQ *> factorization of A with compact WY representation of Q. -*> It is assumed that A has full rank. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -163,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/sgelst.f b/SRC/sgelst.f index 3c6ccf16f9..613a2b0d01 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -38,7 +38,16 @@ *> SGELST solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its transpose, using a QR or LQ *> factorization of A with compact WY representation of Q. -*> It is assumed that A has full rank. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -163,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/zgelst.f b/SRC/zgelst.f index 09f7ccd7b2..9c1767f847 100644 --- a/SRC/zgelst.f +++ b/SRC/zgelst.f @@ -38,7 +38,16 @@ *> ZGELST solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, or its conjugate-transpose, using a QR *> or LQ factorization of A with compact WY representation of Q. -*> It is assumed that A has full rank. +*> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> The following options are provided: *> @@ -163,7 +172,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim From 3ed4768ed021cd595e79a333d9d556343c2fe474 Mon Sep 17 00:00:00 2001 From: GYT Date: Wed, 22 Nov 2023 15:12:20 +0100 Subject: [PATCH 162/206] Add notes to *GETSLS about how only exact rank-deficiency is checked --- SRC/cgetsls.f | 13 +++++++++++-- SRC/dgetsls.f | 13 +++++++++++-- SRC/sgetsls.f | 13 +++++++++++-- SRC/zgetsls.f | 13 +++++++++++-- 4 files changed, 44 insertions(+), 8 deletions(-) diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index 606e814374..87bf2dd71a 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -22,8 +22,17 @@ *> *> CGETSLS solves overdetermined or underdetermined complex linear systems *> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. *> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> *> The following options are provided: @@ -141,7 +150,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index 73b505ff7e..9db9b491cc 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -22,8 +22,17 @@ *> *> DGETSLS solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. *> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> *> The following options are provided: @@ -141,7 +150,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index ce4e02d4f5..2946d732e0 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -22,8 +22,17 @@ *> *> SGETSLS solves overdetermined or underdetermined real linear systems *> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. *> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> *> The following options are provided: @@ -141,7 +150,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index 26311c611b..20b2278ccb 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -22,8 +22,17 @@ *> *> ZGETSLS solves overdetermined or underdetermined complex linear systems *> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ -*> factorization of A. It is assumed that A has full rank. +*> factorization of A. *> +*> It is assumed that A has full rank, and only a rudimentary protection +*> against rank-deficient matrices is provided. This subroutine only detects +*> exact rank-deficiency, where a diagonal element of the triangular factor +*> of A is exactly zero. +*> +*> It is conceivable for one (or more) of the diagonal elements of the triangular +*> factor of A to be subnormally tiny numbers without this subroutine signalling +*> an error. The solutions computed for such almost-rank-deficient matrices may +*> be less accurate due to a loss of numerical precision. *> *> *> The following options are provided: @@ -141,7 +150,7 @@ *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> > 0: if INFO = i, the i-th diagonal element of the -*> triangular factor of A is zero, so that A does not have +*> triangular factor of A is exactly zero, so that A does not have *> full rank; the least squares solution could not be *> computed. *> \endverbatim From b7335217c138dce0e01a6ab9b8c9ce51f3299a47 Mon Sep 17 00:00:00 2001 From: GYT Date: Fri, 24 Nov 2023 19:15:41 +0100 Subject: [PATCH 163/206] Add notes to *GGLSE about how only exact rank-deficiency is checked --- SRC/cgglse.f | 14 ++++++++++++-- SRC/dgglse.f | 14 ++++++++++++-- SRC/sgglse.f | 14 ++++++++++++-- SRC/zgglse.f | 14 ++++++++++++-- 4 files changed, 48 insertions(+), 8 deletions(-) diff --git a/SRC/cgglse.f b/SRC/cgglse.f index 6fbd71d1ba..836d3496fa 100644 --- a/SRC/cgglse.f +++ b/SRC/cgglse.f @@ -52,6 +52,16 @@ *> matrices (B, A) given by *> *> B = (0 R)*Q, A = Z*T*Q. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The CTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized RQ +*> factorization of the pair (B, A) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -153,12 +163,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with B in the -*> generalized RQ factorization of the pair (B, A) is +*> generalized RQ factorization of the pair (B, A) is exactly *> singular, so that rank(B) < P; the least squares *> solution could not be computed. *> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor *> T associated with A in the generalized RQ factorization -*> of the pair (B, A) is singular, so that +*> of the pair (B, A) is exactly singular, so that *> rank( (A) ) < N; the least squares solution could not *> ( (B) ) *> be computed. diff --git a/SRC/dgglse.f b/SRC/dgglse.f index 45e89eebe4..181a42373f 100644 --- a/SRC/dgglse.f +++ b/SRC/dgglse.f @@ -52,6 +52,16 @@ *> matrices (B, A) given by *> *> B = (0 R)*Q, A = Z*T*Q. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The DTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized RQ +*> factorization of the pair (B, A) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -153,12 +163,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with B in the -*> generalized RQ factorization of the pair (B, A) is +*> generalized RQ factorization of the pair (B, A) is exactly *> singular, so that rank(B) < P; the least squares *> solution could not be computed. *> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor *> T associated with A in the generalized RQ factorization -*> of the pair (B, A) is singular, so that +*> of the pair (B, A) is exactly singular, so that *> rank( (A) ) < N; the least squares solution could not *> ( (B) ) *> be computed. diff --git a/SRC/sgglse.f b/SRC/sgglse.f index 527e7b3718..96cb5876e2 100644 --- a/SRC/sgglse.f +++ b/SRC/sgglse.f @@ -52,6 +52,16 @@ *> matrices (B, A) given by *> *> B = (0 R)*Q, A = Z*T*Q. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The STRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized RQ +*> factorization of the pair (B, A) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -153,12 +163,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with B in the -*> generalized RQ factorization of the pair (B, A) is +*> generalized RQ factorization of the pair (B, A) is exactly *> singular, so that rank(B) < P; the least squares *> solution could not be computed. *> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor *> T associated with A in the generalized RQ factorization -*> of the pair (B, A) is singular, so that +*> of the pair (B, A) is exactly singular, so that *> rank( (A) ) < N; the least squares solution could not *> ( (B) ) *> be computed. diff --git a/SRC/zgglse.f b/SRC/zgglse.f index abefbae1e5..30e7783cc3 100644 --- a/SRC/zgglse.f +++ b/SRC/zgglse.f @@ -52,6 +52,16 @@ *> matrices (B, A) given by *> *> B = (0 R)*Q, A = Z*T*Q. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The ZTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized RQ +*> factorization of the pair (B, A) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -153,12 +163,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with B in the -*> generalized RQ factorization of the pair (B, A) is +*> generalized RQ factorization of the pair (B, A) is exactly *> singular, so that rank(B) < P; the least squares *> solution could not be computed. *> = 2: the (N-P) by (N-P) part of the upper trapezoidal factor *> T associated with A in the generalized RQ factorization -*> of the pair (B, A) is singular, so that +*> of the pair (B, A) is exactly singular, so that *> rank( (A) ) < N; the least squares solution could not *> ( (B) ) *> be computed. From c3c505b1c74b95ffd73ffa85f39b4da5c1db1f9f Mon Sep 17 00:00:00 2001 From: GYT Date: Sun, 26 Nov 2023 18:48:01 +0100 Subject: [PATCH 164/206] Add notes to *GGGLM about how only exact rank-deficiency is checked --- SRC/cggglm.f | 14 ++++++++++++-- SRC/dggglm.f | 14 ++++++++++++-- SRC/sggglm.f | 14 ++++++++++++-- SRC/zggglm.f | 14 ++++++++++++-- 4 files changed, 48 insertions(+), 8 deletions(-) diff --git a/SRC/cggglm.f b/SRC/cggglm.f index 60828cf687..1e666a366e 100644 --- a/SRC/cggglm.f +++ b/SRC/cggglm.f @@ -61,6 +61,16 @@ *> x *> *> where inv(B) denotes the inverse of B. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The CTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized QR +*> factorization of the pair (A, B) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -159,12 +169,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with A in the -*> generalized QR factorization of the pair (A, B) is +*> generalized QR factorization of the pair (A, B) is exactly *> singular, so that rank(A) < M; the least squares *> solution could not be computed. *> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal *> factor T associated with B in the generalized QR -*> factorization of the pair (A, B) is singular, so that +*> factorization of the pair (A, B) is exactly singular, so that *> rank( A B ) < N; the least squares solution could not *> be computed. *> \endverbatim diff --git a/SRC/dggglm.f b/SRC/dggglm.f index 56a168415f..1fe366e73a 100644 --- a/SRC/dggglm.f +++ b/SRC/dggglm.f @@ -61,6 +61,16 @@ *> x *> *> where inv(B) denotes the inverse of B. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The DTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized QR +*> factorization of the pair (A, B) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -159,12 +169,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with A in the -*> generalized QR factorization of the pair (A, B) is +*> generalized QR factorization of the pair (A, B) is exactly *> singular, so that rank(A) < M; the least squares *> solution could not be computed. *> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal *> factor T associated with B in the generalized QR -*> factorization of the pair (A, B) is singular, so that +*> factorization of the pair (A, B) is exactly singular, so that *> rank( A B ) < N; the least squares solution could not *> be computed. *> \endverbatim diff --git a/SRC/sggglm.f b/SRC/sggglm.f index 52c59b8bf2..d7b3cb5d72 100644 --- a/SRC/sggglm.f +++ b/SRC/sggglm.f @@ -61,6 +61,16 @@ *> x *> *> where inv(B) denotes the inverse of B. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The STRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized QR +*> factorization of the pair (A, B) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -159,12 +169,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with A in the -*> generalized QR factorization of the pair (A, B) is +*> generalized QR factorization of the pair (A, B) is exactly *> singular, so that rank(A) < M; the least squares *> solution could not be computed. *> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal *> factor T associated with B in the generalized QR -*> factorization of the pair (A, B) is singular, so that +*> factorization of the pair (A, B) is exactly singular, so that *> rank( A B ) < N; the least squares solution could not *> be computed. *> \endverbatim diff --git a/SRC/zggglm.f b/SRC/zggglm.f index 6a7c3da5fe..830193664e 100644 --- a/SRC/zggglm.f +++ b/SRC/zggglm.f @@ -61,6 +61,16 @@ *> x *> *> where inv(B) denotes the inverse of B. +*> +*> Callers of this subroutine should note that the singularity/rank-deficiency checks +*> implemented in this subroutine are rudimentary. The ZTRTRS subroutine called by this +*> subroutine only signals a failure due to singularity if the problem is exactly singular. +*> +*> It is conceivable for one (or more) of the factors involved in the generalized QR +*> factorization of the pair (A, B) to be subnormally close to singularity without this +*> subroutine signalling an error. The solutions computed for such almost-rank-deficient +*> problems may be less accurate due to a loss of numerical precision. +*> *> \endverbatim * * Arguments: @@ -159,12 +169,12 @@ *> = 0: successful exit. *> < 0: if INFO = -i, the i-th argument had an illegal value. *> = 1: the upper triangular factor R associated with A in the -*> generalized QR factorization of the pair (A, B) is +*> generalized QR factorization of the pair (A, B) is exactly *> singular, so that rank(A) < M; the least squares *> solution could not be computed. *> = 2: the bottom (N-M) by (N-M) part of the upper trapezoidal *> factor T associated with B in the generalized QR -*> factorization of the pair (A, B) is singular, so that +*> factorization of the pair (A, B) is exactly singular, so that *> rank( A B ) < N; the least squares solution could not *> be computed. *> \endverbatim From 6411588a7278562b2b06b743e729ce9026550600 Mon Sep 17 00:00:00 2001 From: Harmen Stoppels Date: Wed, 7 Aug 2024 09:59:52 +0200 Subject: [PATCH 165/206] Remove CMake < 3 CMP0042 workarounds CMake only sets install names on darwin to `@rpath/` (which is desired otherwise rpaths don't work at all) when CMP0042 is ON. That's the default when CMake 3.0 or higher is required. And lapack requires it already for years: as of v3.9.1 (8f004b353a876a117b9e9428fff3becdd22c79ce). So, delete the old workarounds that effectively set CMP0042 to ON. Further, delete the following three options that are redefinitions of builtin with values that are builtin defaults: - `CMAKE_MACOSX_RPATH` - `CMAKE_SKIP_BUILD_RPATH` - `CMAKE_BUILD_WITH_INSTALL_RPATH` Lastly, lapack automatically sets `CMAKE_INSTALL_RPATH_USE_LINK_PATH` to `ON` whenever installing to a non-system dir. The assumption is that whenever you install something to a non-system dir, you need rpaths to locate dependencies. But this is just an assumption which may or may not hold. The downside of it is that the option can be annoying when lapack is used as a sub-project as it affects a global CMake variable (for example OpenBLAS uses lapack as a sub-project). Instead, let users or packagers provide this on the command line if they really need it -- remove it from lapack as it's as helpful as it is harmful. --- CMakeLists.txt | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index f5ed2ba325..fe76ffbf91 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -123,30 +123,6 @@ message(STATUS "Build Index-64 API as extended API with _64 suffix: ${BUILD_INDE include(GNUInstallDirs) -# Updated OSX RPATH settings -# In response to CMake 3.0 generating warnings regarding policy CMP0042, -# the OSX RPATH settings have been updated per recommendations found -# in the CMake Wiki: -# http://www.cmake.org/Wiki/CMake_RPATH_handling#Mac_OS_X_and_the_RPATH -option(CMAKE_MACOSX_RPATH "Enable macOS RPATH" ON) -message(STATUS "Enable macOS RPATH: ${CMAKE_MACOSX_RPATH}") -option(CMAKE_SKIP_BUILD_RPATH "Skip build-time RPATH" OFF) -message(STATUS "Skip build-time RPATH: ${CMAKE_SKIP_BUILD_RPATH}") -option(CMAKE_BUILD_WITH_INSTALL_RPATH "Build with install RPATH" OFF) -message(STATUS "Build with install RPATH: ${CMAKE_BUILD_WITH_INSTALL_RPATH}") - -list(FIND CMAKE_PLATFORM_IMPLICIT_LINK_DIRECTORIES ${CMAKE_INSTALL_FULL_LIBDIR} isSystemDir) - -if ("${isSystemDir}" STREQUAL "-1") - if(${CMAKE_INSTALL_FULL_LIBDIR}) - set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_FULL_LIBDIR}) - endif() - message(STATUS "Install RPATH: ${CMAKE_INSTALL_RPATH}") - option(CMAKE_INSTALL_RPATH_USE_LINK_PATH "Use link path for RPATH" TRUE) - message(STATUS "Install RPATH use link path: ${CMAKE_INSTALL_RPATH_USE_LINK_PATH}") -endif() - - # Configure the warning and code coverage suppression file configure_file( "${LAPACK_SOURCE_DIR}/CTestCustom.cmake.in" From 7fd3d47b0321b50f193422c82e5676ee7d9ea750 Mon Sep 17 00:00:00 2001 From: sergey-v-kuznetsov Date: Fri, 9 Aug 2024 17:17:35 -0700 Subject: [PATCH 166/206] PR contains bug fixes found in ?tfsm --- LAPACKE/src/lapacke_ctfsm.c | 4 +++- LAPACKE/src/lapacke_ctfsm_work.c | 8 +++++--- LAPACKE/src/lapacke_dtfsm.c | 4 +++- LAPACKE/src/lapacke_dtfsm_work.c | 8 +++++--- LAPACKE/src/lapacke_stfsm.c | 4 +++- LAPACKE/src/lapacke_stfsm_work.c | 8 +++++--- LAPACKE/src/lapacke_ztfsm.c | 4 +++- LAPACKE/src/lapacke_ztfsm_work.c | 10 ++++++---- SRC/ctfsm.f | 5 +++-- SRC/dtfsm.f | 3 ++- SRC/stfsm.f | 3 ++- SRC/ztfsm.f | 3 ++- 12 files changed, 42 insertions(+), 22 deletions(-) diff --git a/LAPACKE/src/lapacke_ctfsm.c b/LAPACKE/src/lapacke_ctfsm.c index ab9d8d1b02..fc75890bd5 100644 --- a/LAPACKE/src/lapacke_ctfsm.c +++ b/LAPACKE/src/lapacke_ctfsm.c @@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side, } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { + lapack_int mn = m; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_C_NONZERO(alpha) ) { - if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; } } diff --git a/LAPACKE/src/lapacke_ctfsm_work.c b/LAPACKE/src/lapacke_ctfsm_work.c index 98bc661d55..50f123579c 100644 --- a/LAPACKE/src/lapacke_ctfsm_work.c +++ b/LAPACKE/src/lapacke_ctfsm_work.c @@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,m); + lapack_int mn = m; lapack_complex_float* b_t = NULL; lapack_complex_float* a_t = NULL; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ - if( ldb < n ) { + if( ldb < m ) { info = -12; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info ); return info; @@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char if( IS_C_NONZERO(alpha) ) { a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * - ( MAX(1,n) * MAX(2,n+1) ) / 2 ); + ( MAX(1,mn) * MAX(2,mn+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -77,7 +79,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_C_NONZERO(alpha) ) { - API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_ctfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, diff --git a/LAPACKE/src/lapacke_dtfsm.c b/LAPACKE/src/lapacke_dtfsm.c index 8ce40723cd..c0a33f3188 100644 --- a/LAPACKE/src/lapacke_dtfsm.c +++ b/LAPACKE/src/lapacke_dtfsm.c @@ -44,8 +44,10 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ + lapack_int mn = m; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; if( IS_D_NONZERO(alpha) ) { - if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; } } diff --git a/LAPACKE/src/lapacke_dtfsm_work.c b/LAPACKE/src/lapacke_dtfsm_work.c index 0857b45f7c..938de2f96e 100644 --- a/LAPACKE/src/lapacke_dtfsm_work.c +++ b/LAPACKE/src/lapacke_dtfsm_work.c @@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,m); + lapack_int mn = m; double* b_t = NULL; double* a_t = NULL; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ - if( ldb < n ) { + if( ldb < m ) { info = -12; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info ); return info; @@ -64,7 +66,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char if( IS_D_NONZERO(alpha) ) { a_t = (double*) LAPACKE_malloc( sizeof(double) * - ( MAX(1,n) * MAX(2,n+1) ) / 2 ); + ( MAX(1,mn) * MAX(2,mn+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -75,7 +77,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_D_NONZERO(alpha) ) { - API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, diff --git a/LAPACKE/src/lapacke_stfsm.c b/LAPACKE/src/lapacke_stfsm.c index 890a5e5c2d..23c8730c8c 100644 --- a/LAPACKE/src/lapacke_stfsm.c +++ b/LAPACKE/src/lapacke_stfsm.c @@ -43,9 +43,11 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side, } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { + lapack_int mn = m; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_S_NONZERO(alpha) ) { - if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; } } diff --git a/LAPACKE/src/lapacke_stfsm_work.c b/LAPACKE/src/lapacke_stfsm_work.c index 9687741f99..c601472d64 100644 --- a/LAPACKE/src/lapacke_stfsm_work.c +++ b/LAPACKE/src/lapacke_stfsm_work.c @@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,m); + lapack_int mn = MAX(1,m); float* b_t = NULL; float* a_t = NULL; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ - if( ldb < n ) { + if( ldb < m ) { info = -12; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info ); return info; @@ -63,7 +65,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char } if( IS_S_NONZERO(alpha) ) { a_t = (float*) - LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); + LAPACKE_malloc( sizeof(float) * ( MAX(1,mn) * MAX(2,mn+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -74,7 +76,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_S_NONZERO(alpha) ) { - API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, diff --git a/LAPACKE/src/lapacke_ztfsm.c b/LAPACKE/src/lapacke_ztfsm.c index e20bca24b7..43ea9aabe8 100644 --- a/LAPACKE/src/lapacke_ztfsm.c +++ b/LAPACKE/src/lapacke_ztfsm.c @@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side, } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { + lapack_int mn = m; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_Z_NONZERO(alpha) ) { - if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) { + if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; } } diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index 00b0917cb3..11e269598f 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,m); + lapack_int mn = m; lapack_complex_double* b_t = NULL; lapack_complex_double* a_t = NULL; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ - if( ldb < n ) { + if( ldb < m ) { info = -12; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info ); return info; @@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char if( IS_Z_NONZERO(alpha) ) { a_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * - ( MAX(1,n) * MAX(2,n+1) ) / 2 ); + ( MAX(1,mn) * MAX(2,mn+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; @@ -77,14 +79,14 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t ); } if( IS_Z_NONZERO(alpha) ) { - API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t ); + API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t ); } /* Call LAPACK function and adjust info */ LAPACK_ztfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_Z_NONZERO(alpha) ) { LAPACKE_free( a_t ); diff --git a/SRC/ctfsm.f b/SRC/ctfsm.f index e381f476ac..f7cc01caed 100644 --- a/SRC/ctfsm.f +++ b/SRC/ctfsm.f @@ -140,8 +140,9 @@ *> *> \param[in] A *> \verbatim -*> A is COMPLEX array, dimension (N*(N+1)/2) -*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format. +*> A is COMPLEX array, dimension (NT) +*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise. +*> On entry, the 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 (0:N-1,0:K) when N is odd; K=N/2. If diff --git a/SRC/dtfsm.f b/SRC/dtfsm.f index 7b75a8d285..6d7f28a5e6 100644 --- a/SRC/dtfsm.f +++ b/SRC/dtfsm.f @@ -141,7 +141,8 @@ *> \param[in] A *> \verbatim *> A is DOUBLE PRECISION array, dimension (NT) -*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format. +*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise. +*> On entry, the 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 (0:N-1,0:K) when N is odd; K=N/2. If diff --git a/SRC/stfsm.f b/SRC/stfsm.f index c167f80c09..813b56f858 100644 --- a/SRC/stfsm.f +++ b/SRC/stfsm.f @@ -141,7 +141,8 @@ *> \param[in] A *> \verbatim *> A is REAL array, dimension (NT) -*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format. +*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise. +*> On entry, the 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 (0:N-1,0:K) when N is odd; K=N/2. If diff --git a/SRC/ztfsm.f b/SRC/ztfsm.f index 98d1820690..184f367df7 100644 --- a/SRC/ztfsm.f +++ b/SRC/ztfsm.f @@ -141,7 +141,8 @@ *> \param[in] A *> \verbatim *> A is COMPLEX*16 array, dimension (N*(N+1)/2) -*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format. +*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise. +*> On entry, the 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 (0:N-1,0:K) when N is odd; K=N/2. If From 9f998c493e356a8f8a21198ec206b8eb1c0b64e0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 15:10:00 +0200 Subject: [PATCH 167/206] Declare dependency on C to avoid the CMAKE default of C,C++ --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fe76ffbf91..1753fa4cf9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,6 @@ cmake_minimum_required(VERSION 3.13) -project(LAPACK) +project(LAPACK C) set(LAPACK_MAJOR_VERSION 3) set(LAPACK_MINOR_VERSION 12) From 87ffaf9e173250481ddbbf2c81fb2118d6547916 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 16:16:24 +0200 Subject: [PATCH 168/206] Use gcc-14 on MacOS following removal of gcc-11 --- .github/workflows/cmake.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/cmake.yml b/.github/workflows/cmake.yml index 71c592e2dd..087ed262d4 100644 --- a/.github/workflows/cmake.yml +++ b/.github/workflows/cmake.yml @@ -75,12 +75,12 @@ jobs: - name: Install ninja-build tool uses: seanmiddleditch/gha-setup-ninja@16b940825621068d98711680b6c3ff92201f8fc0 # v3 - - name: Use GCC-11 on MacOS + - name: Use GCC-14 on MacOS if: ${{ matrix.os == 'macos-latest' }} run: > cmake -B build -G Ninja - -D CMAKE_C_COMPILER="gcc-11" - -D CMAKE_Fortran_COMPILER="gfortran-11" + -D CMAKE_C_COMPILER="gcc-14" + -D CMAKE_Fortran_COMPILER="gfortran-14" -D USE_FLAT_NAMESPACE:BOOL=ON - name: Special flags for Windows @@ -237,4 +237,4 @@ jobs: fi done exit 0 - fi \ No newline at end of file + fi From 43add02e4f5b2ed711495be367b43043d8a6eb73 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 16:18:12 +0200 Subject: [PATCH 169/206] Update to gcc-14 on MacOS following removal of gcc-11 --- .github/workflows/makefile.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml index 81a39302af..eb6720dbaa 100644 --- a/.github/workflows/makefile.yml +++ b/.github/workflows/makefile.yml @@ -90,8 +90,8 @@ jobs: echo "DOCSDIR = ${{github.workspace}}/DOCS" >> make.inc - name: Alias for GCC compilers run: | - sudo ln -s $(which gcc-11) /usr/local/bin/gcc - sudo ln -s $(which gfortran-11) /usr/local/bin/gfortran + sudo ln -s $(which gcc-14) /usr/local/bin/gcc + sudo ln -s $(which gfortran-14) /usr/local/bin/gfortran - name: Install run: | make -s -j2 all From 5c03f7361154678a1fadb9d408e4f16011f9a325 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:05:15 +0200 Subject: [PATCH 170/206] add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_ctfsm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_ctfsm.c b/LAPACKE/src/lapacke_ctfsm.c index fc75890bd5..1d50a59707 100644 --- a/LAPACKE/src/lapacke_ctfsm.c +++ b/LAPACKE/src/lapacke_ctfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_C_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { From 4b85a11e56e5b69b929efeafc1bdc9f135ee2a36 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:07:42 +0200 Subject: [PATCH 171/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_ctfsm_work.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_ctfsm_work.c b/LAPACKE/src/lapacke_ctfsm_work.c index 50f123579c..1916df9d5a 100644 --- a/LAPACKE/src/lapacke_ctfsm_work.c +++ b/LAPACKE/src/lapacke_ctfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_float* b_t = NULL; lapack_complex_float* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; From e612c6df83bd19c5bff083d083773e4c788192dc Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:09:17 +0200 Subject: [PATCH 172/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_dtfsm_work.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_dtfsm_work.c b/LAPACKE/src/lapacke_dtfsm_work.c index 938de2f96e..30396d6ed7 100644 --- a/LAPACKE/src/lapacke_dtfsm_work.c +++ b/LAPACKE/src/lapacke_dtfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; double* b_t = NULL; double* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; From a7b82edbae14b4ee3dd160ae97be2f5f0631ff8b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:10:17 +0200 Subject: [PATCH 173/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_dtfsm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_dtfsm.c b/LAPACKE/src/lapacke_dtfsm.c index c0a33f3188..964d500815 100644 --- a/LAPACKE/src/lapacke_dtfsm.c +++ b/LAPACKE/src/lapacke_dtfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side, if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; if( IS_D_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; From 04b02f01074c92b644d0e8fd51987baefeec8f95 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:11:12 +0200 Subject: [PATCH 174/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_stfsm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_stfsm.c b/LAPACKE/src/lapacke_stfsm.c index 23c8730c8c..55f0b1a2e7 100644 --- a/LAPACKE/src/lapacke_stfsm.c +++ b/LAPACKE/src/lapacke_stfsm.c @@ -44,7 +44,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_S_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { From 8048b74f54dd37bbfb9d3f064a98ac6a31540ffa Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:11:57 +0200 Subject: [PATCH 175/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_stfsm_work.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_stfsm_work.c b/LAPACKE/src/lapacke_stfsm_work.c index c601472d64..8d828c0828 100644 --- a/LAPACKE/src/lapacke_stfsm_work.c +++ b/LAPACKE/src/lapacke_stfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char lapack_int mn = MAX(1,m); float* b_t = NULL; float* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; From 4416581d7532317932e3b7fc37a60cdc399b4a46 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:12:47 +0200 Subject: [PATCH 176/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_ztfsm_work.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index 11e269598f..9ffeb83c16 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_double* b_t = NULL; lapack_complex_double* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; From 9d56cfff6daa66eaca3a38f5a2a859613af26682 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:13:38 +0200 Subject: [PATCH 177/206] Add missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_ztfsm.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_ztfsm.c b/LAPACKE/src/lapacke_ztfsm.c index 43ea9aabe8..bde4b044b6 100644 --- a/LAPACKE/src/lapacke_ztfsm.c +++ b/LAPACKE/src/lapacke_ztfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_Z_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { From 427a9b4526f99b194ead02bd21eb0349691ffc6f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 20 Aug 2024 17:16:31 +0200 Subject: [PATCH 178/206] Add another missing API_SUFFIX wrapper --- LAPACKE/src/lapacke_ztfsm_work.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index 9ffeb83c16..d1d139f028 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -86,7 +86,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_Z_NONZERO(alpha) ) { LAPACKE_free( a_t ); From 4d1f73ccdba308f05cc17bd122f7923b51fcef96 Mon Sep 17 00:00:00 2001 From: Ilhan Polat Date: Sat, 14 Sep 2024 15:09:24 +0200 Subject: [PATCH 179/206] DOC:trsly3: Add dtrsyl3/strsyl3 grouping statements --- SRC/dtrsyl3.f | 2 ++ SRC/strsyl3.f | 2 ++ 2 files changed, 4 insertions(+) diff --git a/SRC/dtrsyl3.f b/SRC/dtrsyl3.f index 7d794819ca..79fcf4a013 100644 --- a/SRC/dtrsyl3.f +++ b/SRC/dtrsyl3.f @@ -178,6 +178,8 @@ *> A and B are unchanged). *> \endverbatim * +*> \ingroup trsyl3 +* * ===================================================================== * References: * E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of diff --git a/SRC/strsyl3.f b/SRC/strsyl3.f index baa1ce5c39..5f1d70dbba 100644 --- a/SRC/strsyl3.f +++ b/SRC/strsyl3.f @@ -177,6 +177,8 @@ *> A and B are unchanged). *> \endverbatim * +*> \ingroup trsyl3 +* * ===================================================================== * References: * E. S. Quintana-Orti and R. A. Van De Geijn (2003). Formal derivation of From dd627fcb2004569c8a8cb1180084b0f9bfc09b1f Mon Sep 17 00:00:00 2001 From: langou Date: Tue, 1 Oct 2024 09:04:40 -0600 Subject: [PATCH 180/206] Revert "Add a few forgotten API_SUFFIX wrappers in the recently changed LAPACKE ?TFSM" --- LAPACKE/src/lapacke_ctfsm.c | 2 +- LAPACKE/src/lapacke_ctfsm_work.c | 2 +- LAPACKE/src/lapacke_dtfsm.c | 2 +- LAPACKE/src/lapacke_dtfsm_work.c | 2 +- LAPACKE/src/lapacke_stfsm.c | 2 +- LAPACKE/src/lapacke_stfsm_work.c | 2 +- LAPACKE/src/lapacke_ztfsm.c | 2 +- LAPACKE/src/lapacke_ztfsm_work.c | 4 ++-- 8 files changed, 9 insertions(+), 9 deletions(-) diff --git a/LAPACKE/src/lapacke_ctfsm.c b/LAPACKE/src/lapacke_ctfsm.c index 1d50a59707..fc75890bd5 100644 --- a/LAPACKE/src/lapacke_ctfsm.c +++ b/LAPACKE/src/lapacke_ctfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_C_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_ctfsm_work.c b/LAPACKE/src/lapacke_ctfsm_work.c index 1916df9d5a..50f123579c 100644 --- a/LAPACKE/src/lapacke_ctfsm_work.c +++ b/LAPACKE/src/lapacke_ctfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_float* b_t = NULL; lapack_complex_float* a_t = NULL; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_dtfsm.c b/LAPACKE/src/lapacke_dtfsm.c index 964d500815..c0a33f3188 100644 --- a/LAPACKE/src/lapacke_dtfsm.c +++ b/LAPACKE/src/lapacke_dtfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side, if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ lapack_int mn = m; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; if( IS_D_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; diff --git a/LAPACKE/src/lapacke_dtfsm_work.c b/LAPACKE/src/lapacke_dtfsm_work.c index 30396d6ed7..938de2f96e 100644 --- a/LAPACKE/src/lapacke_dtfsm_work.c +++ b/LAPACKE/src/lapacke_dtfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; double* b_t = NULL; double* a_t = NULL; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_stfsm.c b/LAPACKE/src/lapacke_stfsm.c index 55f0b1a2e7..23c8730c8c 100644 --- a/LAPACKE/src/lapacke_stfsm.c +++ b/LAPACKE/src/lapacke_stfsm.c @@ -44,7 +44,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_S_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_stfsm_work.c b/LAPACKE/src/lapacke_stfsm_work.c index 8d828c0828..c601472d64 100644 --- a/LAPACKE/src/lapacke_stfsm_work.c +++ b/LAPACKE/src/lapacke_stfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char lapack_int mn = MAX(1,m); float* b_t = NULL; float* a_t = NULL; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_ztfsm.c b/LAPACKE/src/lapacke_ztfsm.c index bde4b044b6..43ea9aabe8 100644 --- a/LAPACKE/src/lapacke_ztfsm.c +++ b/LAPACKE/src/lapacke_ztfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_Z_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index d1d139f028..11e269598f 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_double* b_t = NULL; lapack_complex_double* a_t = NULL; - if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; + if( LAPACKE_lsame( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; @@ -86,7 +86,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_Z_NONZERO(alpha) ) { LAPACKE_free( a_t ); From 17e7f9ee2265a9517efd148e8c612a1638fdbb6a Mon Sep 17 00:00:00 2001 From: "Weslley S. Pereira" Date: Wed, 2 Oct 2024 10:01:14 -0600 Subject: [PATCH 181/206] Revert "Revert "Add a few forgotten API_SUFFIX wrappers in the recently changed LAPACKE ?TFSM"" --- LAPACKE/src/lapacke_ctfsm.c | 2 +- LAPACKE/src/lapacke_ctfsm_work.c | 2 +- LAPACKE/src/lapacke_dtfsm.c | 2 +- LAPACKE/src/lapacke_dtfsm_work.c | 2 +- LAPACKE/src/lapacke_stfsm.c | 2 +- LAPACKE/src/lapacke_stfsm_work.c | 2 +- LAPACKE/src/lapacke_ztfsm.c | 2 +- LAPACKE/src/lapacke_ztfsm_work.c | 4 ++-- 8 files changed, 9 insertions(+), 9 deletions(-) diff --git a/LAPACKE/src/lapacke_ctfsm.c b/LAPACKE/src/lapacke_ctfsm.c index fc75890bd5..1d50a59707 100644 --- a/LAPACKE/src/lapacke_ctfsm.c +++ b/LAPACKE/src/lapacke_ctfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_C_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_ctfsm_work.c b/LAPACKE/src/lapacke_ctfsm_work.c index 50f123579c..1916df9d5a 100644 --- a/LAPACKE/src/lapacke_ctfsm_work.c +++ b/LAPACKE/src/lapacke_ctfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_float* b_t = NULL; lapack_complex_float* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_dtfsm.c b/LAPACKE/src/lapacke_dtfsm.c index c0a33f3188..964d500815 100644 --- a/LAPACKE/src/lapacke_dtfsm.c +++ b/LAPACKE/src/lapacke_dtfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side, if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; if( IS_D_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { return -10; diff --git a/LAPACKE/src/lapacke_dtfsm_work.c b/LAPACKE/src/lapacke_dtfsm_work.c index 938de2f96e..30396d6ed7 100644 --- a/LAPACKE/src/lapacke_dtfsm_work.c +++ b/LAPACKE/src/lapacke_dtfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; double* b_t = NULL; double* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_stfsm.c b/LAPACKE/src/lapacke_stfsm.c index 23c8730c8c..55f0b1a2e7 100644 --- a/LAPACKE/src/lapacke_stfsm.c +++ b/LAPACKE/src/lapacke_stfsm.c @@ -44,7 +44,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_S_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_stfsm_work.c b/LAPACKE/src/lapacke_stfsm_work.c index c601472d64..8d828c0828 100644 --- a/LAPACKE/src/lapacke_stfsm_work.c +++ b/LAPACKE/src/lapacke_stfsm_work.c @@ -50,7 +50,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char lapack_int mn = MAX(1,m); float* b_t = NULL; float* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; diff --git a/LAPACKE/src/lapacke_ztfsm.c b/LAPACKE/src/lapacke_ztfsm.c index 43ea9aabe8..bde4b044b6 100644 --- a/LAPACKE/src/lapacke_ztfsm.c +++ b/LAPACKE/src/lapacke_ztfsm.c @@ -45,7 +45,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { lapack_int mn = m; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Optionally check input matrices for NaNs */ if( IS_Z_NONZERO(alpha) ) { if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) { diff --git a/LAPACKE/src/lapacke_ztfsm_work.c b/LAPACKE/src/lapacke_ztfsm_work.c index 11e269598f..d1d139f028 100644 --- a/LAPACKE/src/lapacke_ztfsm_work.c +++ b/LAPACKE/src/lapacke_ztfsm_work.c @@ -51,7 +51,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char lapack_int mn = m; lapack_complex_double* b_t = NULL; lapack_complex_double* a_t = NULL; - if( LAPACKE_lsame( side, 'r' ) ) mn = n; + if( API_SUFFIX(LAPACKE_lsame)( side, 'r' ) ) mn = n; /* Check leading dimension(s) */ if( ldb < m ) { info = -12; @@ -86,7 +86,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ if( IS_Z_NONZERO(alpha) ) { LAPACKE_free( a_t ); From f04808c2ab30d5bf4fb7da6a51f74ee5e62e2dfa Mon Sep 17 00:00:00 2001 From: "Lucas M. Schnorr" Date: Sat, 12 Oct 2024 01:14:13 -0300 Subject: [PATCH 182/206] remove comparison as these conditions are never true --- LAPACKE/src/lapacke_ctpmqrt_work.c | 4 ++-- LAPACKE/src/lapacke_dtpmqrt_work.c | 4 ++-- LAPACKE/src/lapacke_stpmqrt_work.c | 4 ++-- LAPACKE/src/lapacke_ztpmqrt_work.c | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/LAPACKE/src/lapacke_ctpmqrt_work.c b/LAPACKE/src/lapacke_ctpmqrt_work.c index e625410b3b..afce8f8cc0 100644 --- a/LAPACKE/src/lapacke_ctpmqrt_work.c +++ b/LAPACKE/src/lapacke_ctpmqrt_work.c @@ -51,8 +51,8 @@ lapack_int API_SUFFIX(LAPACKE_ctpmqrt_work)( int matrix_layout, char side, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctpmqrt_work", info ); diff --git a/LAPACKE/src/lapacke_dtpmqrt_work.c b/LAPACKE/src/lapacke_dtpmqrt_work.c index a2f17d9700..2dea60cdae 100644 --- a/LAPACKE/src/lapacke_dtpmqrt_work.c +++ b/LAPACKE/src/lapacke_dtpmqrt_work.c @@ -49,8 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_dtpmqrt_work)( int matrix_layout, char side, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtpmqrt_work", info ); diff --git a/LAPACKE/src/lapacke_stpmqrt_work.c b/LAPACKE/src/lapacke_stpmqrt_work.c index 47fdd32196..4e06221a78 100644 --- a/LAPACKE/src/lapacke_stpmqrt_work.c +++ b/LAPACKE/src/lapacke_stpmqrt_work.c @@ -49,8 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_stpmqrt_work)( int matrix_layout, char side, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stpmqrt_work", info ); diff --git a/LAPACKE/src/lapacke_ztpmqrt_work.c b/LAPACKE/src/lapacke_ztpmqrt_work.c index eb0ee3f55c..82d8de96b5 100644 --- a/LAPACKE/src/lapacke_ztpmqrt_work.c +++ b/LAPACKE/src/lapacke_ztpmqrt_work.c @@ -51,8 +51,8 @@ lapack_int API_SUFFIX(LAPACKE_ztpmqrt_work)( int matrix_layout, char side, char } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrowsA, ncolsA, nrowsV; - if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } - else if ( side == API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } + if ( API_SUFFIX(LAPACKE_lsame)(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; } + else if ( API_SUFFIX(LAPACKE_lsame)(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; } else { info = -2; API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztpmqrt_work", info ); From 5efeb474ec90ab9e2178cfdb6a1bdc25c080eb5c Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Mon, 14 Oct 2024 18:52:58 +0700 Subject: [PATCH 183/206] fix leading dimension for matrix B in test routine get52 --- TESTING/EIG/cget52.f | 2 +- TESTING/EIG/dget52.f | 10 +++++----- TESTING/EIG/sget52.f | 10 +++++----- TESTING/EIG/zget52.f | 2 +- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/TESTING/EIG/cget52.f b/TESTING/EIG/cget52.f index 30bf6ba394..558ec60ba6 100644 --- a/TESTING/EIG/cget52.f +++ b/TESTING/EIG/cget52.f @@ -256,7 +256,7 @@ SUBROUTINE CGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, END IF CALL CGEMV( TRANS, N, N, ACOEFF, A, LDA, E( 1, JVEC ), 1, $ CZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL CGEMV( TRANS, N, N, -BCOEFF, B, LDA, E( 1, JVEC ), 1, + CALL CGEMV( TRANS, N, N, -BCOEFF, B, LDB, E( 1, JVEC ), 1, $ CONE, WORK( N*( JVEC-1 )+1 ), 1 ) 10 CONTINUE * diff --git a/TESTING/EIG/dget52.f b/TESTING/EIG/dget52.f index 68196f5f3b..b662bb6945 100644 --- a/TESTING/EIG/dget52.f +++ b/TESTING/EIG/dget52.f @@ -293,7 +293,7 @@ SUBROUTINE DGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, BCOEFR = SCALE*SALFR CALL DGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC ), 1, $ ZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC ), + CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) ELSE * @@ -323,16 +323,16 @@ SUBROUTINE DGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, * CALL DGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC ), 1, $ ZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC ), + CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL DGEMV( TRANS, N, N, BCOEFI, B, LDA, E( 1, JVEC+1 ), + CALL DGEMV( TRANS, N, N, BCOEFI, B, LDB, E( 1, JVEC+1 ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) * CALL DGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC+1 ), $ 1, ZERO, WORK( N*JVEC+1 ), 1 ) - CALL DGEMV( TRANS, N, N, -BCOEFI, B, LDA, E( 1, JVEC ), + CALL DGEMV( TRANS, N, N, -BCOEFI, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*JVEC+1 ), 1 ) - CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC+1 ), + CALL DGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC+1 ), $ 1, ONE, WORK( N*JVEC+1 ), 1 ) END IF END IF diff --git a/TESTING/EIG/sget52.f b/TESTING/EIG/sget52.f index 9f54126021..5bd5e414c2 100644 --- a/TESTING/EIG/sget52.f +++ b/TESTING/EIG/sget52.f @@ -293,7 +293,7 @@ SUBROUTINE SGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, BCOEFR = SCALE*SALFR CALL SGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC ), 1, $ ZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC ), + CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) ELSE * @@ -323,16 +323,16 @@ SUBROUTINE SGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHAR, * CALL SGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC ), 1, $ ZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC ), + CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL SGEMV( TRANS, N, N, BCOEFI, B, LDA, E( 1, JVEC+1 ), + CALL SGEMV( TRANS, N, N, BCOEFI, B, LDB, E( 1, JVEC+1 ), $ 1, ONE, WORK( N*( JVEC-1 )+1 ), 1 ) * CALL SGEMV( TRANS, N, N, ACOEF, A, LDA, E( 1, JVEC+1 ), $ 1, ZERO, WORK( N*JVEC+1 ), 1 ) - CALL SGEMV( TRANS, N, N, -BCOEFI, B, LDA, E( 1, JVEC ), + CALL SGEMV( TRANS, N, N, -BCOEFI, B, LDB, E( 1, JVEC ), $ 1, ONE, WORK( N*JVEC+1 ), 1 ) - CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDA, E( 1, JVEC+1 ), + CALL SGEMV( TRANS, N, N, -BCOEFR, B, LDB, E( 1, JVEC+1 ), $ 1, ONE, WORK( N*JVEC+1 ), 1 ) END IF END IF diff --git a/TESTING/EIG/zget52.f b/TESTING/EIG/zget52.f index e22939a6c2..1e9ebafe55 100644 --- a/TESTING/EIG/zget52.f +++ b/TESTING/EIG/zget52.f @@ -257,7 +257,7 @@ SUBROUTINE ZGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, END IF CALL ZGEMV( TRANS, N, N, ACOEFF, A, LDA, E( 1, JVEC ), 1, $ CZERO, WORK( N*( JVEC-1 )+1 ), 1 ) - CALL ZGEMV( TRANS, N, N, -BCOEFF, B, LDA, E( 1, JVEC ), 1, + CALL ZGEMV( TRANS, N, N, -BCOEFF, B, LDB, E( 1, JVEC ), 1, $ CONE, WORK( N*( JVEC-1 )+1 ), 1 ) 10 CONTINUE * From 212270836bd59a8b179d6c19d3c5095246491107 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Mon, 14 Oct 2024 11:16:34 -0600 Subject: [PATCH 184/206] DO NOT MERGE: demonstrating changes work --- SRC/Makefile | 1 + SRC/dgelqf.f | 6 +- SRC/dgeqlf.f | 7 +- SRC/dgeqrf.f | 4 +- SRC/dgeqrfp.f | 4 +- SRC/dgerqf.f | 7 +- SRC/dlarft.f | 2 + SRC/dorglq.f | 6 +- SRC/dorgql.f | 7 +- SRC/dorgqr.f | 4 +- SRC/dorgrq.f | 7 +- SRC/dormlq.f | 6 +- SRC/dormql.f | 6 +- SRC/dormqr.f | 6 +- SRC/dormrq.f | 4 +- SRC/my_dlarft_rec.f | 239 ++++++++++++++++++++++++++++++++++++++++++++ st7lLjwJ | 1 + 17 files changed, 282 insertions(+), 35 deletions(-) create mode 100644 SRC/my_dlarft_rec.f create mode 100644 st7lLjwJ diff --git a/SRC/Makefile b/SRC/Makefile index 0191626f0e..7d1ca17981 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -340,6 +340,7 @@ DLASRC = \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o dlarf1f.o dlarf1l.o\ + my_dlarft_rec.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 03bbb8e1e3..254bd1b68e 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -161,7 +161,7 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGELQ2, DLARFB, DLARFT, XERBLA + EXTERNAL DGELQ2, DLARFB, MY_DLARFT_REC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -251,8 +251,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, - $ I ), + CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB, + $ A( I, I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index d472e3365e..e1287116be 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -156,7 +156,7 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ MU, NB, NBMIN, NU, NX * .. * .. External Subroutines .. - EXTERNAL DGEQL2, DLARFB, DLARFT, XERBLA + EXTERNAL DGEQL2, DLARFB, MY_DLARFT_REC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -256,8 +256,9 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, - $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK ) + CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1, + $ IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, + $ LDWORK ) * * Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * diff --git a/SRC/dgeqrf.f b/SRC/dgeqrf.f index c005d47af5..8e02d6bc24 100644 --- a/SRC/dgeqrf.f +++ b/SRC/dgeqrf.f @@ -163,7 +163,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA + EXTERNAL DGEQR2, DLARFB, MY_DLARFT_REC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -253,7 +253,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, + CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i:m,i+ib:n) from the left diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f index aa757e96cf..65e5d51009 100644 --- a/SRC/dgeqrfp.f +++ b/SRC/dgeqrfp.f @@ -167,7 +167,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA + EXTERNAL DGEQR2P, DLARFB, MY_DLARFT_REC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -259,7 +259,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, + CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i:m,i+ib:n) from the left diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 8cabdc36ee..048483c807 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -156,7 +156,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ MU, NB, NBMIN, NU, NX * .. * .. External Subroutines .. - EXTERNAL DGERQ2, DLARFB, DLARFT, XERBLA + EXTERNAL DGERQ2, DLARFB, MY_DLARFT_REC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -256,8 +256,9 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, - $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK ) + CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1, + $ IB, A( M-K+I, 1 ), LDA, TAU( I ), WORK, + $ LDWORK ) * * Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * diff --git a/SRC/dlarft.f b/SRC/dlarft.f index d9ef2f77b6..81ffb39857 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -196,6 +196,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) IF( N.EQ.0 ) $ RETURN * + WRITE(*,*) "in dlarft, n = ", N, " k = ", K, "flags: ", DIRECT, + $ " ", STOREV IF( LSAME( DIRECT, 'F' ) ) THEN PREVLASTV = N DO I = 1, K diff --git a/SRC/dorglq.f b/SRC/dorglq.f index c41367ced4..6057a96338 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -148,7 +148,7 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORGL2, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORGL2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -253,8 +253,8 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, - $ I ), + CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB, + $ A( I, I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right diff --git a/SRC/dorgql.f b/SRC/dorgql.f index f931f5a9c8..4920a705bf 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -149,7 +149,7 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORG2L, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORG2L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -260,8 +260,9 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, - $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK ) + CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1, + $ IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, + $ LDWORK ) * * Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f index fd88519871..5823cf8ae4 100644 --- a/SRC/dorgqr.f +++ b/SRC/dorgqr.f @@ -149,7 +149,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORG2R, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORG2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -254,7 +254,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, + CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i:m,i+ib:n) from the left diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index c805484578..2f2c84d9c3 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -149,7 +149,7 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORGR2, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORGR2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -261,8 +261,9 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, - $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK ) + CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1, + $ IB, A( II, 1 ), LDA, TAU( I ), WORK, + $ LDWORK) * * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * diff --git a/SRC/dormlq.f b/SRC/dormlq.f index 85ca134737..cb68138cb6 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -196,7 +196,7 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORML2, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORML2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -316,8 +316,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ), - $ LDA, TAU( I ), WORK( IWT ), LDT ) + CALL MY_DLARFT_REC( 'Forward', 'Rowwise', NQ-I+1, IB, + $ A( I, I ), LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * * H or H**T is applied to C(i:m,1:n) diff --git a/SRC/dormql.f b/SRC/dormql.f index 11022d78c6..c28e0d0e70 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -195,7 +195,7 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORM2L, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORM2L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -310,8 +310,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, - $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) + CALL MY_DLARFT_REC( 'Backward', 'Columnwise', NQ-K+I+IB-1, + $ IB, A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT) IF( LEFT ) THEN * * H or H**T is applied to C(1:m-k+i+ib-1,1:n) diff --git a/SRC/dormqr.f b/SRC/dormqr.f index a9f8ba2279..e35534067f 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -195,7 +195,7 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -309,8 +309,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, - $ I ), + CALL MY_DLARFT_REC( 'Forward', 'Columnwise', NQ-I+1, IB, + $ A(I, I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/dormrq.f b/SRC/dormrq.f index 03159e4961..dcefe8d1df 100644 --- a/SRC/dormrq.f +++ b/SRC/dormrq.f @@ -196,7 +196,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, DLARFT, DORMR2, XERBLA + EXTERNAL DLARFB, MY_DLARFT_REC, DORMR2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -317,7 +317,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB, + CALL MY_DLARFT_REC( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB, $ A( I, 1 ), LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/my_dlarft_rec.f b/SRC/my_dlarft_rec.f new file mode 100644 index 0000000000..15dd59dee1 --- /dev/null +++ b/SRC/my_dlarft_rec.f @@ -0,0 +1,239 @@ +c Cost: n > k: 1/6 * (k^2-1)(2n+k) +c n = k: 1/2 * (n^3-n) + RECURSIVE SUBROUTINE MY_DLARFT_REC( DIRECT, STOREV, N, K, V, LDV, + $ TAU, T, LDT) + IMPLICIT NONE + ! Arguemnts + ! Scalars + INTEGER N, K, LDV, LDT + CHARACTER DIRECT, STOREV + ! Matrix + DOUBLE PRECISION V(LDV,*), T(LDT,*), TAU(N) + + ! Local variables + INTEGER I,J,L,MINNK + LOGICAL QR,LQ,QL,DIRF,COLV + ! Parameters + DOUBLE PRECISION ONE, NEG_ONE, ZERO + PARAMETER(ONE=1.0D+0, ZERO = 0.0, NEG_ONE=-1.0D+0) + ! External functions + LOGICAL LSAME + EXTERNAL LSAME + ! External subroutines + EXTERNAL DTRMM,DGEMM,DLACPY + + ! Break V apart into 6 components + ! V = |---------------| + ! |V_{1,1} 0 | + ! |V_{2,1} V_{2,2}| + ! |V_{3,1} V_{3,2}| + ! |---------------| + ! V_{1,1}\in\R^{k,k} unit lower triangular + ! V_{2,1}\in\R^{n-k,k} rectangular + ! V_{3,1}\in\R^{m-n,k} rectangular + ! + ! V_{2,2}\in\R^{n-k,n-k} unit upper triangular + ! V_{3,2}\in\R^{m-n,n-k} rectangular + + ! We will construct the T matrix + ! T = |---------------| = |--------| + ! |T_{1,1} T_{1,2}| |T_1 T_3| + ! |0 T_{2,2}| |0 T_2| + ! |---------------| |--------| + + ! T is the triangular factor attained from block reflectors. + ! To motivate the structure, consider the product + ! + ! (I - V_1T_1V_1^\top)(I - V_2T_2V_2^\top) + ! = I - V_1T_1V_1^\top - V_2T_2V_2^\top + V_1T_1V_1^\topV_2T_2V_2^\top + ! + ! Define T_3 = -T_1V_1^\topV_2T_2 + ! + ! Then, we can define the matrix V as + ! V = |-------| + ! |V_1 V_2| + ! |-------| + ! + ! So, our product is equivalent to the matrix product + ! I - VTV^\top + ! So, we compute T_1, then T_2, then use these values to get T_3 + ! + ! The general scheme used is inspired by the approach inside DGEQRT3 + ! which was (at the time of writing this code): + ! Based on the algorithm of Elmroth and Gustavson, + ! IBM J. Res. Develop. Vol 44 No. 4 July 2000. + + IF(K.EQ.0.OR.N.EQ.0) THEN + RETURN + END IF + ! Base case + IF(K.EQ.1.OR.N.EQ.1) THEN + T(1,1) = TAU(1) + RETURN + END IF + + ! Beginning of executable statements +! MINNK = MIN(N,K) +! L = MINNK / 2 + L = K / 2 + ! Determine what kind of Q we need to compute + ! We assume that if the user doesn't provide 'F' for DIRECT, + ! then they meant to provide 'B' and if they don't provide + ! 'C' for STOREV, then they meant to provide 'R' + DIRF = LSAME(DIRECT,'F') + COLV = LSAME(STOREV,'C') + ! QR happens when we have forward direction in column storage + QR = DIRF.AND.COLV + ! LQ happens when we have Forward direction in row storage + LQ = DIRF.AND.(.NOT.COLV) + ! QL happens when we have backward direction in column storage + QL = (.NOT.DIRF).AND.COLV + ! The last case is RQ. Due to how we strucutured this, if the + ! above 3 are false, then RQ must be true, so we never store + ! this + ! RQ happens when we have backward direction in row storage + !RQ = (.NOT.DIRF).AND.(.NOT.COLV) + + + ! Compute T3 + IF(QR) THEN + ! If we are wide, then our + ! Compute T_1 + CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V, LDV, TAU, T, + $ LDT) + ! Compute T_2 + CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), + $ LDV, TAU(L+1), T(L+1,L+1), LDT) + ! Compute T_3 + ! T_3 = V_{2,1}^\top + DO J = 1, L + DO I = 1, K-L + T(J,L+I) = V(L+I,J) + END DO + END DO + ! T_3 = V_{2,1}^\top * V_{2,2} + CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', + $ L, K - L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + + IF(N.GT.K) THEN + ! T_3 = T_3 + V_{3,1}^\topV_{3,2} + CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, + $ ONE, V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, + $ T(1, L+1), LDT) + END IF + + ! At this point, we have that T_3 = V_1^\top *V_2 + ! All that is left is to pre and post multiply by -T_1 and T_2 + ! respectively. + + ! T_3 = -T_1*T_3 + CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', + $ L, K - L, NEG_ONE, T, LDT, T(1, L+1), LDT) + ! T_3 = T_3*T_2 + CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', + $ L, K - L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + + ELSE IF(LQ) THEN + ! Compute T_1 + CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V, LDV, TAU, T, + $ LDT) + ! Compute T_2 + CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), + $ LDV, TAU(L+1), T(L+1,L+1), LDT) + + ! Begin computing T_3 + ! First, T_3 = V_1V_2^\top + ! T_3 = V_{12} + CALL DLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) + + ! T_3 = V_{12}V_{22}^\top = T_3V_{22}^\top + CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + + ! If needed, use the trailing components + IF(N.GT.K) THEN + CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, + $ ONE, V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, + $ T(1, L+1), LDT) + END IF + + ! T_3 = -T_1T_3 + CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', + $ L, K - L, NEG_ONE, T, LDT, T(1, L+1), LDT) + + ! T_3 = T_3T_1 + CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', + $ L, K - L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + ELSE IF(QL) THEN + ! Compute T_1 + CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, + $ T, LDT) + ! Compute T_2 + CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + + ! Begin computing T_3 = T_2V_2^\topV_1T_1 + + ! T_3 = V_2^\top V_1 + + ! T_3 = V_{2,2}^\top + DO J = 1, K-L + DO I = 1, L + T(K-L+I,J) = V(N-K+J, K-L+I) + END DO + END DO + + ! T_3 = V_{2,2}^\topV_{2,1} = T_3V_{2,1} + CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', + $ L, K - L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + + ! If needed, T_3 = V_{1,2}^\topV_{1,1} + T_3 + IF(N.GT.K) THEN + CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, + $ ONE, V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + END IF + + ! T_3 = -T_2T_3 + CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', + $ L, K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + ! T_3 = T_3T_1 + CALL DTRMM('Right', 'Lower', 'No transpose', 'Non-unit', + $ L, K-L, ONE, T, LDT, T(K-L+1,1), LDT) + ELSE + ! Else means RQ + ! Compute T_1 + CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, + $ T, LDT) + ! Compute T_2 + CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + + ! Begin computing T_3 = T_2V_2V_1^\topT_1 + + ! T_3 = V_2V_1^\top + + ! T_3 = V_{2,2} + CALL DLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, + $ T(K-L+1,1), LDT) + + ! T_3 = T_3V_{1,2}^\top + CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', + $ L, K-L, ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) + + ! If needed, T_3 = V_{2,1}V_{1,1}^\top + T_3 + IF(N.GT.K) THEN + CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, + $ ONE, V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + END IF + + ! T_3 = -T_2T_3 + CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', + $ L, K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + + ! T_3 = T_3T_1 + CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', + $ L, K-L, ONE, T, LDT, T(K-L+1,1), LDT) + END IF + + ! Now, we have T in the correct form! + END SUBROUTINE diff --git a/st7lLjwJ b/st7lLjwJ new file mode 100644 index 0000000000..8b277f0dd5 --- /dev/null +++ b/st7lLjwJ @@ -0,0 +1 @@ +! From a848e1e760c3f15f47a2919d541a3a1b08068fc3 Mon Sep 17 00:00:00 2001 From: "Lucas M. Schnorr" Date: Tue, 15 Oct 2024 10:10:37 -0300 Subject: [PATCH 185/206] fix environment variable name --- LAPACKE/src/lapacke_nancheck.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/LAPACKE/src/lapacke_nancheck.c b/LAPACKE/src/lapacke_nancheck.c index 55b82e203e..c7d5c33f1c 100644 --- a/LAPACKE/src/lapacke_nancheck.c +++ b/LAPACKE/src/lapacke_nancheck.c @@ -47,7 +47,7 @@ int LAPACKE_get_nancheck( ) } /* Check environment variable, once and only once */ - env = getenv( "API_SUFFIX(LAPACKE_)NANCHECK" ); + env = getenv( "LAPACKE_NANCHECK" ); if ( !env ) { /* By default, NaN checking is enabled */ nancheck_flag = 1; From 54956283e297afe6cc8efb77d1ee5a1cca3c1a2a Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 16 Oct 2024 11:08:37 -0600 Subject: [PATCH 186/206] CAN MERGE: Implemented my version of xlarft with comments added, and moved the previous version into VARIANTS --- SRC/Makefile | 1 - SRC/VARIANTS/larft/LL-LVL2/clarft.f | 328 +++++++++++++++ SRC/VARIANTS/larft/LL-LVL2/dlarft.f | 326 +++++++++++++++ SRC/VARIANTS/larft/LL-LVL2/slarft.f | 326 +++++++++++++++ SRC/VARIANTS/larft/LL-LVL2/zlarft.f | 327 +++++++++++++++ SRC/clarft.f | 592 +++++++++++++++++++++------- SRC/dgelqf.f | 5 +- SRC/dgeqlf.f | 4 +- SRC/dgeqrf.f | 4 +- SRC/dgeqrfp.f | 4 +- SRC/dgerqf.f | 6 +- SRC/dlarft.f | 582 ++++++++++++++++++++------- SRC/dorglq.f | 5 +- SRC/dorgql.f | 7 +- SRC/dorgqr.f | 4 +- SRC/dorgrq.f | 7 +- SRC/dormlq.f | 6 +- SRC/dormql.f | 6 +- SRC/dormqr.f | 5 +- SRC/dormrq.f | 4 +- SRC/my_dlarft_rec.f | 239 ----------- SRC/slarft.f | 576 ++++++++++++++++++++------- SRC/zlarft.f | 591 ++++++++++++++++++++------- st7lLjwJ | 1 - 24 files changed, 3102 insertions(+), 854 deletions(-) create mode 100644 SRC/VARIANTS/larft/LL-LVL2/clarft.f create mode 100644 SRC/VARIANTS/larft/LL-LVL2/dlarft.f create mode 100644 SRC/VARIANTS/larft/LL-LVL2/slarft.f create mode 100644 SRC/VARIANTS/larft/LL-LVL2/zlarft.f delete mode 100644 SRC/my_dlarft_rec.f delete mode 100644 st7lLjwJ diff --git a/SRC/Makefile b/SRC/Makefile index 7d1ca17981..0191626f0e 100644 --- a/SRC/Makefile +++ b/SRC/Makefile @@ -340,7 +340,6 @@ DLASRC = \ dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \ dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \ dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o dlarf1f.o dlarf1l.o\ - my_dlarft_rec.o \ dlargv.o dlarmm.o dlarrv.o dlartv.o \ dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \ dlasyf.o dlasyf_rook.o dlasyf_rk.o \ diff --git a/SRC/VARIANTS/larft/LL-LVL2/clarft.f b/SRC/VARIANTS/larft/LL-LVL2/clarft.f new file mode 100644 index 0000000000..9e2e4503e3 --- /dev/null +++ b/SRC/VARIANTS/larft/LL-LVL2/clarft.f @@ -0,0 +1,328 @@ +*> \brief \b CLARFT forms the triangular factor T of a block reflector H = I - vtvH +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CLARFT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* .. Scalar Arguments .. +* CHARACTER DIRECT, STOREV +* INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. +* COMPLEX T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CLARFT forms the triangular factor T of a complex block reflector H +*> of order n, which is defined as a product of k elementary reflectors. +*> +*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; +*> +*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. +*> +*> If STOREV = 'C', the vector which defines the elementary reflector +*> H(i) is stored in the i-th column of the array V, and +*> +*> H = I - V * T * V**H +*> +*> If STOREV = 'R', the vector which defines the elementary reflector +*> H(i) is stored in the i-th row of the array V, and +*> +*> H = I - V**H * T * V +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] DIRECT +*> \verbatim +*> DIRECT is CHARACTER*1 +*> Specifies the order in which the elementary reflectors are +*> multiplied to form the block reflector: +*> = 'F': H = H(1) H(2) . . . H(k) (Forward) +*> = 'B': H = H(k) . . . H(2) H(1) (Backward) +*> \endverbatim +*> +*> \param[in] STOREV +*> \verbatim +*> STOREV is CHARACTER*1 +*> Specifies how the vectors which define the elementary +*> reflectors are stored (see also Further Details): +*> = 'C': columnwise +*> = 'R': rowwise +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the block reflector H. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The order of the triangular factor T (= the number of +*> elementary reflectors). K >= 1. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX array, dimension +*> (LDV,K) if STOREV = 'C' +*> (LDV,N) if STOREV = 'R' +*> The matrix V. See further details. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is COMPLEX array, dimension (LDT,K) +*> The k by k triangular factor T of the block reflector. +*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is +*> lower triangular. The rest of the array is not used. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= K. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larft +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The shape of the matrix V and the storage of the vectors which define +*> the H(i) is best illustrated by the following example with n = 5 and +*> k = 3. The elements equal to 1 are not stored. +*> +*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': +*> +*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) +*> ( v1 1 ) ( 1 v2 v2 v2 ) +*> ( v1 v2 1 ) ( 1 v3 v3 ) +*> ( v1 v2 v3 ) +*> ( v1 v2 v3 ) +*> +*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': +*> +*> V = ( v1 v2 v3 ) V = ( v1 v1 1 ) +*> ( v1 v2 v3 ) ( v2 v2 v2 1 ) +*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) +*> ( 1 v3 ) +*> ( 1 ) +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. + COMPLEX T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX ONE, ZERO + PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), + $ ZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + INTEGER I, J, PREVLASTV, LASTV +* .. +* .. External Subroutines .. + EXTERNAL CGEMM, CGEMV, CTRMV +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Executable Statements .. +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( LSAME( DIRECT, 'F' ) ) THEN + PREVLASTV = N + DO I = 1, K + PREVLASTV = MAX( PREVLASTV, I ) + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = 1, I + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * CONJG( V( I , J ) ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i) +* + CALL CGEMV( 'Conjugate transpose', J-I, I-1, + $ -TAU( I ), V( I+1, 1 ), LDV, + $ V( I+1, I ), 1, + $ ONE, T( 1, I ), 1 ) + ELSE +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( J , I ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H +* + CALL CGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ), + $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, + $ ONE, T( 1, I ), LDT ) + END IF +* +* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) +* + CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, + $ LDT, T( 1, I ), 1 ) + T( I, I ) = TAU( I ) + IF( I.GT.1 ) THEN + PREVLASTV = MAX( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + END DO + ELSE + PREVLASTV = 1 + DO I = K, 1, -1 + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = I, K + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( I.LT.K ) THEN + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i) +* + CALL CGEMV( 'Conjugate transpose', N-K+I-J, K-I, + $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ), + $ 1, ONE, T( I+1, I ), 1 ) + ELSE +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( J, N-K+I ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H +* + CALL CGEMM( '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 ) + END IF +* +* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) +* + CALL CTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, + $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) + IF( I.GT.1 ) THEN + PREVLASTV = MIN( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + T( I, I ) = TAU( I ) + END IF + END DO + END IF + RETURN +* +* End of CLARFT +* + END diff --git a/SRC/VARIANTS/larft/LL-LVL2/dlarft.f b/SRC/VARIANTS/larft/LL-LVL2/dlarft.f new file mode 100644 index 0000000000..d9ef2f77b6 --- /dev/null +++ b/SRC/VARIANTS/larft/LL-LVL2/dlarft.f @@ -0,0 +1,326 @@ +*> \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLARFT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* .. Scalar Arguments .. +* CHARACTER DIRECT, STOREV +* INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLARFT forms the triangular factor T of a real block reflector H +*> of order n, which is defined as a product of k elementary reflectors. +*> +*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; +*> +*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. +*> +*> If STOREV = 'C', the vector which defines the elementary reflector +*> H(i) is stored in the i-th column of the array V, and +*> +*> H = I - V * T * V**T +*> +*> If STOREV = 'R', the vector which defines the elementary reflector +*> H(i) is stored in the i-th row of the array V, and +*> +*> H = I - V**T * T * V +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] DIRECT +*> \verbatim +*> DIRECT is CHARACTER*1 +*> Specifies the order in which the elementary reflectors are +*> multiplied to form the block reflector: +*> = 'F': H = H(1) H(2) . . . H(k) (Forward) +*> = 'B': H = H(k) . . . H(2) H(1) (Backward) +*> \endverbatim +*> +*> \param[in] STOREV +*> \verbatim +*> STOREV is CHARACTER*1 +*> Specifies how the vectors which define the elementary +*> reflectors are stored (see also Further Details): +*> = 'C': columnwise +*> = 'R': rowwise +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the block reflector H. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The order of the triangular factor T (= the number of +*> elementary reflectors). K >= 1. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> (LDV,K) if STOREV = 'C' +*> (LDV,N) if STOREV = 'R' +*> The matrix V. See further details. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is DOUBLE PRECISION array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is DOUBLE PRECISION array, dimension (LDT,K) +*> The k by k triangular factor T of the block reflector. +*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is +*> lower triangular. The rest of the array is not used. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= K. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larft +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The shape of the matrix V and the storage of the vectors which define +*> the H(i) is best illustrated by the following example with n = 5 and +*> k = 3. The elements equal to 1 are not stored. +*> +*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': +*> +*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) +*> ( v1 1 ) ( 1 v2 v2 v2 ) +*> ( v1 v2 1 ) ( 1 v3 v3 ) +*> ( v1 v2 v3 ) +*> ( v1 v2 v3 ) +*> +*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': +*> +*> V = ( v1 v2 v3 ) V = ( v1 v1 1 ) +*> ( v1 v2 v3 ) ( v2 v2 v2 1 ) +*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) +*> ( 1 v3 ) +*> ( 1 ) +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. + DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + INTEGER I, J, PREVLASTV, LASTV +* .. +* .. External Subroutines .. + EXTERNAL DGEMV, DTRMV +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Executable Statements .. +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( LSAME( DIRECT, 'F' ) ) THEN + PREVLASTV = N + DO I = 1, K + PREVLASTV = MAX( I, PREVLASTV ) + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = 1, I + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( I , J ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i) +* + CALL DGEMV( 'Transpose', J-I, I-1, -TAU( I ), + $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE, + $ T( 1, I ), 1 ) + ELSE +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( J , I ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T +* + CALL DGEMV( 'No transpose', I-1, J-I, -TAU( I ), + $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, ONE, + $ T( 1, I ), 1 ) + END IF +* +* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) +* + CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, + $ LDT, T( 1, I ), 1 ) + T( I, I ) = TAU( I ) + IF( I.GT.1 ) THEN + PREVLASTV = MAX( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + END DO + ELSE + PREVLASTV = 1 + DO I = K, 1, -1 + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = I, K + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( I.LT.K ) THEN + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( N-K+I , J ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) +* + CALL DGEMV( 'Transpose', N-K+I-J, K-I, + $ -TAU( I ), + $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, + $ T( I+1, I ), 1 ) + ELSE +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( J, N-K+I ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T +* + CALL DGEMV( 'No transpose', K-I, N-K+I-J, + $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV, + $ ONE, T( I+1, I ), 1 ) + END IF +* +* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) +* + CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, + $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) + IF( I.GT.1 ) THEN + PREVLASTV = MIN( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + T( I, I ) = TAU( I ) + END IF + END DO + END IF + RETURN +* +* End of DLARFT +* + END diff --git a/SRC/VARIANTS/larft/LL-LVL2/slarft.f b/SRC/VARIANTS/larft/LL-LVL2/slarft.f new file mode 100644 index 0000000000..31b7951819 --- /dev/null +++ b/SRC/VARIANTS/larft/LL-LVL2/slarft.f @@ -0,0 +1,326 @@ +*> \brief \b SLARFT forms the triangular factor T of a block reflector H = I - vtvH +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SLARFT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* .. Scalar Arguments .. +* CHARACTER DIRECT, STOREV +* INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. +* REAL T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SLARFT forms the triangular factor T of a real block reflector H +*> of order n, which is defined as a product of k elementary reflectors. +*> +*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; +*> +*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. +*> +*> If STOREV = 'C', the vector which defines the elementary reflector +*> H(i) is stored in the i-th column of the array V, and +*> +*> H = I - V * T * V**T +*> +*> If STOREV = 'R', the vector which defines the elementary reflector +*> H(i) is stored in the i-th row of the array V, and +*> +*> H = I - V**T * T * V +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] DIRECT +*> \verbatim +*> DIRECT is CHARACTER*1 +*> Specifies the order in which the elementary reflectors are +*> multiplied to form the block reflector: +*> = 'F': H = H(1) H(2) . . . H(k) (Forward) +*> = 'B': H = H(k) . . . H(2) H(1) (Backward) +*> \endverbatim +*> +*> \param[in] STOREV +*> \verbatim +*> STOREV is CHARACTER*1 +*> Specifies how the vectors which define the elementary +*> reflectors are stored (see also Further Details): +*> = 'C': columnwise +*> = 'R': rowwise +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the block reflector H. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The order of the triangular factor T (= the number of +*> elementary reflectors). K >= 1. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is REAL array, dimension +*> (LDV,K) if STOREV = 'C' +*> (LDV,N) if STOREV = 'R' +*> The matrix V. See further details. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is REAL array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is REAL array, dimension (LDT,K) +*> The k by k triangular factor T of the block reflector. +*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is +*> lower triangular. The rest of the array is not used. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= K. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larft +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The shape of the matrix V and the storage of the vectors which define +*> the H(i) is best illustrated by the following example with n = 5 and +*> k = 3. The elements equal to 1 are not stored. +*> +*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': +*> +*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) +*> ( v1 1 ) ( 1 v2 v2 v2 ) +*> ( v1 v2 1 ) ( 1 v3 v3 ) +*> ( v1 v2 v3 ) +*> ( v1 v2 v3 ) +*> +*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': +*> +*> V = ( v1 v2 v3 ) V = ( v1 v1 1 ) +*> ( v1 v2 v3 ) ( v2 v2 v2 1 ) +*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) +*> ( 1 v3 ) +*> ( 1 ) +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. + REAL T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE, ZERO + PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) +* .. +* .. Local Scalars .. + INTEGER I, J, PREVLASTV, LASTV +* .. +* .. External Subroutines .. + EXTERNAL SGEMV, STRMV +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Executable Statements .. +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( LSAME( DIRECT, 'F' ) ) THEN + PREVLASTV = N + DO I = 1, K + PREVLASTV = MAX( I, PREVLASTV ) + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = 1, I + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( I , J ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i) +* + CALL SGEMV( 'Transpose', J-I, I-1, -TAU( I ), + $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE, + $ T( 1, I ), 1 ) + ELSE +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( J , I ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T +* + CALL SGEMV( 'No transpose', I-1, J-I, -TAU( I ), + $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, + $ ONE, T( 1, I ), 1 ) + END IF +* +* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) +* + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, + $ LDT, T( 1, I ), 1 ) + T( I, I ) = TAU( I ) + IF( I.GT.1 ) THEN + PREVLASTV = MAX( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + END DO + ELSE + PREVLASTV = 1 + DO I = K, 1, -1 + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = I, K + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( I.LT.K ) THEN + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( N-K+I , J ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) +* + CALL SGEMV( 'Transpose', N-K+I-J, K-I, + $ -TAU( I ), + $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, + $ T( I+1, I ), 1 ) + ELSE +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( J, N-K+I ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T +* + CALL SGEMV( 'No transpose', K-I, N-K+I-J, + $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV, + $ ONE, T( I+1, I ), 1 ) + END IF +* +* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) +* + CALL STRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, + $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) + IF( I.GT.1 ) THEN + PREVLASTV = MIN( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + T( I, I ) = TAU( I ) + END IF + END DO + END IF + RETURN +* +* End of SLARFT +* + END diff --git a/SRC/VARIANTS/larft/LL-LVL2/zlarft.f b/SRC/VARIANTS/larft/LL-LVL2/zlarft.f new file mode 100644 index 0000000000..be773becc2 --- /dev/null +++ b/SRC/VARIANTS/larft/LL-LVL2/zlarft.f @@ -0,0 +1,327 @@ +*> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLARFT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* .. Scalar Arguments .. +* CHARACTER DIRECT, STOREV +* INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. +* COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLARFT forms the triangular factor T of a complex block reflector H +*> of order n, which is defined as a product of k elementary reflectors. +*> +*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; +*> +*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. +*> +*> If STOREV = 'C', the vector which defines the elementary reflector +*> H(i) is stored in the i-th column of the array V, and +*> +*> H = I - V * T * V**H +*> +*> If STOREV = 'R', the vector which defines the elementary reflector +*> H(i) is stored in the i-th row of the array V, and +*> +*> H = I - V**H * T * V +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] DIRECT +*> \verbatim +*> DIRECT is CHARACTER*1 +*> Specifies the order in which the elementary reflectors are +*> multiplied to form the block reflector: +*> = 'F': H = H(1) H(2) . . . H(k) (Forward) +*> = 'B': H = H(k) . . . H(2) H(1) (Backward) +*> \endverbatim +*> +*> \param[in] STOREV +*> \verbatim +*> STOREV is CHARACTER*1 +*> Specifies how the vectors which define the elementary +*> reflectors are stored (see also Further Details): +*> = 'C': columnwise +*> = 'R': rowwise +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the block reflector H. N >= 0. +*> \endverbatim +*> +*> \param[in] K +*> \verbatim +*> K is INTEGER +*> The order of the triangular factor T (= the number of +*> elementary reflectors). K >= 1. +*> \endverbatim +*> +*> \param[in] V +*> \verbatim +*> V is COMPLEX*16 array, dimension +*> (LDV,K) if STOREV = 'C' +*> (LDV,N) if STOREV = 'R' +*> The matrix V. See further details. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. +*> \endverbatim +*> +*> \param[in] TAU +*> \verbatim +*> TAU is COMPLEX*16 array, dimension (K) +*> TAU(i) must contain the scalar factor of the elementary +*> reflector H(i). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is COMPLEX*16 array, dimension (LDT,K) +*> The k by k triangular factor T of the block reflector. +*> If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is +*> lower triangular. The rest of the array is not used. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= K. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup larft +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The shape of the matrix V and the storage of the vectors which define +*> the H(i) is best illustrated by the following example with n = 5 and +*> k = 3. The elements equal to 1 are not stored. +*> +*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': +*> +*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) +*> ( v1 1 ) ( 1 v2 v2 v2 ) +*> ( v1 v2 1 ) ( 1 v3 v3 ) +*> ( v1 v2 v3 ) +*> ( v1 v2 v3 ) +*> +*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': +*> +*> V = ( v1 v2 v3 ) V = ( v1 v1 1 ) +*> ( v1 v2 v3 ) ( v2 v2 v2 1 ) +*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) +*> ( 1 v3 ) +*> ( 1 ) +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* +* -- LAPACK auxiliary routine -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N +* .. +* .. Array Arguments .. + COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE, ZERO + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), + $ ZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + INTEGER I, J, PREVLASTV, LASTV +* .. +* .. External Subroutines .. + EXTERNAL ZGEMV, ZTRMV, ZGEMM +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. Executable Statements .. +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* + IF( LSAME( DIRECT, 'F' ) ) THEN + PREVLASTV = N + DO I = 1, K + PREVLASTV = MAX( PREVLASTV, I ) + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = 1, I + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * CONJG( V( I , J ) ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i) +* + CALL ZGEMV( 'Conjugate transpose', J-I, I-1, + $ -TAU( I ), V( I+1, 1 ), LDV, + $ V( I+1, I ), 1, ONE, T( 1, I ), 1 ) + ELSE +* Skip any trailing zeros. + DO LASTV = N, I+1, -1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = 1, I-1 + T( J, I ) = -TAU( I ) * V( J , I ) + END DO + J = MIN( LASTV, PREVLASTV ) +* +* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H +* + CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ), + $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, + $ ONE, T( 1, I ), LDT ) + END IF +* +* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) +* + CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, + $ T, + $ LDT, T( 1, I ), 1 ) + T( I, I ) = TAU( I ) + IF( I.GT.1 ) THEN + PREVLASTV = MAX( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + END DO + ELSE + PREVLASTV = 1 + DO I = K, 1, -1 + IF( TAU( I ).EQ.ZERO ) THEN +* +* H(i) = I +* + DO J = I, K + T( J, I ) = ZERO + END DO + ELSE +* +* general case +* + IF( I.LT.K ) THEN + IF( LSAME( STOREV, 'C' ) ) THEN +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( LASTV, I ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i) +* + CALL ZGEMV( 'Conjugate transpose', N-K+I-J, K-I, + $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ), + $ 1, ONE, T( I+1, I ), 1 ) + ELSE +* Skip any leading zeros. + DO LASTV = 1, I-1 + IF( V( I, LASTV ).NE.ZERO ) EXIT + END DO + DO J = I+1, K + T( J, I ) = -TAU( I ) * V( J, N-K+I ) + END DO + J = MAX( LASTV, PREVLASTV ) +* +* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H +* + 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 ) + END IF +* +* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) +* + CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', + $ K-I, + $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) + IF( I.GT.1 ) THEN + PREVLASTV = MIN( PREVLASTV, LASTV ) + ELSE + PREVLASTV = LASTV + END IF + END IF + T( I, I ) = TAU( I ) + END IF + END DO + END IF + RETURN +* +* End of ZLARFT +* + END diff --git a/SRC/clarft.f b/SRC/clarft.f index 9e2e4503e3..4517bb9b31 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -18,7 +18,7 @@ * Definition: * =========== * -* SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * .. Scalar Arguments .. * CHARACTER DIRECT, STOREV @@ -159,170 +159,468 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, + $ LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -* .. Scalar Arguments .. - CHARACTER DIRECT, STOREV - INTEGER K, LDT, LDV, N +* .. Scalar Arguments +* + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N * .. * .. Array Arguments .. - COMPLEX T( LDT, * ), TAU( * ), V( LDV, * ) -* .. * -* ===================================================================== + COMPLEX T( LDT, * ), TAU( * ), V( LDV, * ) +* .. * * .. Parameters .. - COMPLEX ONE, ZERO - PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), - $ ZERO = ( 0.0E+0, 0.0E+0 ) ) -* .. +* + COMPLEX ONE, NEG_ONE, ZERO + PARAMETER(ONE=1.0D+0, ZERO = 0.0D+0, NEG_ONE=-1.0D+0) +* * .. Local Scalars .. - INTEGER I, J, PREVLASTV, LASTV -* .. +* + INTEGER I,J,L + LOGICAL QR,LQ,QL,DIRF,COLV +* * .. External Subroutines .. - EXTERNAL CGEMM, CGEMV, CTRMV -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME +* + EXTERNAL CTRMM,CGEMM,CLACPY +* +* .. External Functions.. +* + LOGICAL LSAME + EXTERNAL LSAME +* +* .. Intrinsic Functions.. +* + INTRINSIC CONJG +* +* The general scheme used is inspired by the approach inside DGEQRT3 +* which was (at the time of writing this code): +* Based on the algorithm of Elmroth and Gustavson, +* IBM J. Res. Develop. Vol 44 No. 4 July 2000. * .. * .. Executable Statements .. * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN -* - IF( LSAME( DIRECT, 'F' ) ) THEN - PREVLASTV = N - DO I = 1, K - PREVLASTV = MAX( PREVLASTV, I ) - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = 1, I - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * CONJG( V( I , J ) ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i) -* - CALL CGEMV( 'Conjugate transpose', J-I, I-1, - $ -TAU( I ), V( I+1, 1 ), LDV, - $ V( I+1, I ), 1, - $ ONE, T( 1, I ), 1 ) - ELSE -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( J , I ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H -* - CALL CGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ), - $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, - $ ONE, T( 1, I ), LDT ) - END IF -* -* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) -* - CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, - $ T, - $ LDT, T( 1, I ), 1 ) - T( I, I ) = TAU( I ) - IF( I.GT.1 ) THEN - PREVLASTV = MAX( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF + IF(N.EQ.0.OR.K.EQ.0) THEN + RETURN + END IF +* +* Base case +* + IF(N.EQ.1.OR.K.EQ.1) THEN + T(1,1) = TAU(1) + RETURN + END IF +* +* Beginning of executable statements +* + L = K / 2 +* +* Determine what kind of Q we need to compute +* We assume that if the user doesn't provide 'F' for DIRECT, +* then they meant to provide 'B' and if they don't provide +* 'C' for STOREV, then they meant to provide 'R' +* + DIRF = LSAME(DIRECT,'F') + COLV = LSAME(STOREV,'C') +* +* QR happens when we have forward direction in column storage +* + QR = DIRF.AND.COLV +* +* LQ happens when we have Forward direction in row storage +* + LQ = DIRF.AND.(.NOT.COLV) +* +* QL happens when we have backward direction in column storage +* + QL = (.NOT.DIRF).AND.COLV +* +* The last case is RQ. Due to how we structured this, if the +* above 3 are false, then RQ must be true, so we never store +* this +* RQ happens when we have backward direction in row storage +* RQ = (.NOT.DIRF).AND.(.NOT.COLV) +* + IF(QR) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} 0 | +* |V_{2,1} V_{2,2}| +* |V_{3,1} V_{3,2}| +* |---------------| +* +* V_{1,1}\in\C^{l,l} unit lower triangular +* V_{2,1}\in\C^{k-l,l} rectangular +* V_{3,1}\in\C^{n-k,l} rectangular +* +* V_{2,2}\in\C^{k-l,k-l} unit lower triangular +* V_{3,2}\in\C^{n-k,k-l} rectangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{l, l} upper triangular +* T_2\in\C^{k-l, k-l} upper triangular +* T_3\in\C^{l, k-l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_1T_1V_1')(I - V_2T_2V_2') +* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* +* Define T_3 = -T_1V_1'V_2T_2 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL CLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,1}' +* + DO J = 1, L + DO I = 1, K-L + T(J,L+I) = CONJG(V(L+I,J)) + END DO END DO - ELSE - PREVLASTV = 1 - DO I = K, 1, -1 - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = I, K - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( I.LT.K ) THEN - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i) -* - CALL CGEMV( 'Conjugate transpose', N-K+I-J, K-I, - $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ), - $ 1, ONE, T( I+1, I ), 1 ) - ELSE -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( J, N-K+I ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H -* - CALL CGEMM( '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 ) - END IF -* -* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) -* - CALL CTRMV( 'Lower', 'No transpose', 'Non-unit', - $ K-I, - $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) - IF( I.GT.1 ) THEN - PREVLASTV = MIN( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF - T( I, I ) = TAU( I ) - END IF +* +* T_3 = T_3V_{2,2} +* + CALL CTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{3,1}'V_{3,2} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, + $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1'V_2 +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) +* +* T_3 = T_3T_2 +* + CALL CTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + + ELSE IF(LQ) THEN +* +* Break V apart into 6 components +* +* V = |----------------------| +* |V_{1,1} V_{1,2} V{1,3}| +* |0 V_{2,2} V{2,3}| +* |----------------------| +* +* V_{1,1}\in\C^{l,l} unit upper triangular +* V_{1,2}\in\C^{l,k-l} rectangular +* V_{1,3}\in\C^{l,n-k} rectangular +* +* V_{2,2}\in\C^{k-l,k-l} unit upper triangular +* V_{2,3}\in\C^{k-l,n-k} rectangular +* +* Where l = floor(k/2) +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{l, l} upper triangular +* T_2\in\C^{k-l, k-l} upper triangular +* T_3\in\C^{l, k-l} rectangular +* +* Then, consider the product: +* +* (I - V_1'T_1V_1)(I - V_2'T_2V_2) +* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* +* Define T_3 = -T_1V_1V_2'T_2 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL CLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) + +* +* Compute T_3 +* T_3 = V_{1,2} +* + CALL CLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) +* +* T_3 = T_3V_{2,2}' +* + CALL CTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, + $ V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{1,3}V_{2,3}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL CGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1V_2' +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T, LDT, T(1, L+1), LDT) + +* +* T_3 = T_3T_2 +* + CALL CTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + ELSE IF(QL) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} V_{1,2}| +* |V_{2,1} V_{2,2}| +* |0 V_{3,2}| +* |---------------| +* +* V_{1,1}\in\C^{n-k,k-l} rectangular +* V_{2,1}\in\C^{k-l,k-l} unit upper triangular +* +* V_{1,2}\in\C^{n-k,l} rectangular +* V_{2,2}\in\C^{k-l,l} rectangular +* V_{3,2}\in\C^{l,l} unit upper triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{k-l, k-l} non-unit lower triangular +* T_2\in\C^{l, l} non-unit lower triangular +* T_3\in\C^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2T_2V_2')(I - V_1T_1V_1') +* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* +* Define T_3 = -T_2V_2'V_1T_1 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL CLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2}' +* + DO J = 1, K-L + DO I = 1, L + T(K-L+I,J) = CONJG(V(N-K+J, K-L+I)) + END DO END DO - END IF - RETURN * -* End of CLARFT +* T_3 = T_3V_{2,1} +* + CALL CTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, + $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,2}'V_{2,1} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, + $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) +* +* At this point, we have that T_3 = V_2'V_1 +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 * - END + CALL CTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) +* +* T_3 = T_3T_1 +* + CALL CTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + ELSE +* +* Else means RQ case +* +* Break V apart into 6 components +* +* V = |-----------------------| +* |V_{1,1} V_{1,2} 0 | +* |V_{2,1} V_{2,2} V_{2,3}| +* |-----------------------| +* +* V_{1,1}\in\C^{k-l,n-k} rectangular +* V_{1,2}\in\C^{k-l,k-l} unit lower triangular +* +* V_{2,1}\in\C^{l,n-k} rectangular +* V_{2,2}\in\C^{l,k-l} rectangular +* V_{2,3}\in\C^{l,l} unit lower triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{k-l, k-l} non-unit lower triangular +* T_2\in\C^{l, l} non-unit lower triangular +* T_3\in\C^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2'T_2V_2)(I - V_1'T_1V_1) +* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* +* Define T_3 = -T_2V_2V_1'T_1 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL CLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2} +* + CALL CLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), + $ LDT) + +* +* T_3 = T_3V_{1,2}' +* + CALL CTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, + $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,1}V_{1,1}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL CGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, + $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + +* +* At this point, we have that T_3 = V_2V_1' +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL CTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + +* +* T_3 = T_3T_1 +* + CALL CTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ ONE, T, LDT, T(K-L+1,1), LDT) + END IF + END SUBROUTINE diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 254bd1b68e..f0eb00a55d 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -161,7 +161,7 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGELQ2, DLARFB, MY_DLARFT_REC, XERBLA + EXTERNAL DGELQ2, DLARFB, DLARFT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -251,8 +251,7 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB, - $ A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index e1287116be..7da963aeaf 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -156,7 +156,7 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ MU, NB, NBMIN, NU, NX * .. * .. External Subroutines .. - EXTERNAL DGEQL2, DLARFB, MY_DLARFT_REC, XERBLA + EXTERNAL DGEQL2, DLARFB, DLARFT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -256,7 +256,7 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1, + CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, $ IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, $ LDWORK ) * diff --git a/SRC/dgeqrf.f b/SRC/dgeqrf.f index 8e02d6bc24..c005d47af5 100644 --- a/SRC/dgeqrf.f +++ b/SRC/dgeqrf.f @@ -163,7 +163,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGEQR2, DLARFB, MY_DLARFT_REC, XERBLA + EXTERNAL DGEQR2, DLARFB, DLARFT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -253,7 +253,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, + CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i:m,i+ib:n) from the left diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f index 65e5d51009..aa757e96cf 100644 --- a/SRC/dgeqrfp.f +++ b/SRC/dgeqrfp.f @@ -167,7 +167,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DGEQR2P, DLARFB, MY_DLARFT_REC, XERBLA + EXTERNAL DGEQR2P, DLARFB, DLARFT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -259,7 +259,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, + CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i:m,i+ib:n) from the left diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 048483c807..8760ee04b3 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -156,7 +156,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) $ MU, NB, NBMIN, NU, NX * .. * .. External Subroutines .. - EXTERNAL DGERQ2, DLARFB, MY_DLARFT_REC, XERBLA + EXTERNAL DGERQ2, DLARFB, DLARFT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -256,8 +256,8 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1, - $ IB, A( M-K+I, 1 ), LDA, TAU( I ), WORK, + CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, + $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, $ LDWORK ) * * Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 81ffb39857..d3f0b87454 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -18,7 +18,7 @@ * Definition: * =========== * -* SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * .. Scalar Arguments .. * CHARACTER DIRECT, STOREV @@ -159,170 +159,464 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, + $ LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -* .. Scalar Arguments .. +* .. Scalar Arguments +* CHARACTER DIRECT, STOREV INTEGER K, LDT, LDV, N * .. * .. Array Arguments .. +* DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * ) * .. * -* ===================================================================== -* * .. Parameters .. - DOUBLE PRECISION ONE, ZERO - PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) -* .. +* + DOUBLE PRECISION ONE, NEG_ONE, ZERO + PARAMETER(ONE=1.0D+0, ZERO = 0.0D+0, NEG_ONE=-1.0D+0) +* * .. Local Scalars .. - INTEGER I, J, PREVLASTV, LASTV -* .. +* + INTEGER I,J,L + LOGICAL QR,LQ,QL,DIRF,COLV +* * .. External Subroutines .. - EXTERNAL DGEMV, DTRMV -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME +* + EXTERNAL DTRMM,DGEMM,DLACPY +* +* .. External Functions.. +* + LOGICAL LSAME + EXTERNAL LSAME +* +* The general scheme used is inspired by the approach inside DGEQRT3 +* which was (at the time of writing this code): +* Based on the algorithm of Elmroth and Gustavson, +* IBM J. Res. Develop. Vol 44 No. 4 July 2000. * .. * .. Executable Statements .. * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN -* - WRITE(*,*) "in dlarft, n = ", N, " k = ", K, "flags: ", DIRECT, - $ " ", STOREV - IF( LSAME( DIRECT, 'F' ) ) THEN - PREVLASTV = N - DO I = 1, K - PREVLASTV = MAX( I, PREVLASTV ) - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = 1, I - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( I , J ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i) -* - CALL DGEMV( 'Transpose', J-I, I-1, -TAU( I ), - $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE, - $ T( 1, I ), 1 ) - ELSE -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( J , I ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T -* - CALL DGEMV( 'No transpose', I-1, J-I, -TAU( I ), - $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, ONE, - $ T( 1, I ), 1 ) - END IF -* -* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) -* - CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, - $ T, - $ LDT, T( 1, I ), 1 ) - T( I, I ) = TAU( I ) - IF( I.GT.1 ) THEN - PREVLASTV = MAX( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF + IF(N.EQ.0.OR.K.EQ.0) THEN + RETURN + END IF +* +* Base case +* + IF(N.EQ.1.OR.K.EQ.1) THEN + T(1,1) = TAU(1) + RETURN + END IF +* +* Beginning of executable statements +* + L = K / 2 +* +* Determine what kind of Q we need to compute +* We assume that if the user doesn't provide 'F' for DIRECT, +* then they meant to provide 'B' and if they don't provide +* 'C' for STOREV, then they meant to provide 'R' +* + DIRF = LSAME(DIRECT,'F') + COLV = LSAME(STOREV,'C') +* +* QR happens when we have forward direction in column storage +* + QR = DIRF.AND.COLV +* +* LQ happens when we have Forward direction in row storage +* + LQ = DIRF.AND.(.NOT.COLV) +* +* QL happens when we have backward direction in column storage +* + QL = (.NOT.DIRF).AND.COLV +* +* The last case is RQ. Due to how we structured this, if the +* above 3 are false, then RQ must be true, so we never store +* this +* RQ happens when we have backward direction in row storage +* RQ = (.NOT.DIRF).AND.(.NOT.COLV) +* + IF(QR) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} 0 | +* |V_{2,1} V_{2,2}| +* |V_{3,1} V_{3,2}| +* |---------------| +* +* V_{1,1}\in\R^{l,l} unit lower triangular +* V_{2,1}\in\R^{k-l,l} rectangular +* V_{3,1}\in\R^{n-k,l} rectangular +* +* V_{2,2}\in\R^{k-l,k-l} unit lower triangular +* V_{3,2}\in\R^{n-k,k-l} rectangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{l, l} upper triangular +* T_2\in\R^{k-l, k-l} upper triangular +* T_3\in\R^{l, k-l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_1T_1V_1')(I - V_2T_2V_2') +* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* +* Define T_3 = -T_1V_1'V_2T_2 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL DLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,1}' +* + DO J = 1, L + DO I = 1, K-L + T(J,L+I) = V(L+I,J) + END DO END DO - ELSE - PREVLASTV = 1 - DO I = K, 1, -1 - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = I, K - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( I.LT.K ) THEN - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( N-K+I , J ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) -* - CALL DGEMV( 'Transpose', N-K+I-J, K-I, - $ -TAU( I ), - $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, - $ T( I+1, I ), 1 ) - ELSE -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( J, N-K+I ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T -* - CALL DGEMV( 'No transpose', K-I, N-K+I-J, - $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV, - $ ONE, T( I+1, I ), 1 ) - END IF -* -* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) -* - CALL DTRMV( 'Lower', 'No transpose', 'Non-unit', - $ K-I, - $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) - IF( I.GT.1 ) THEN - PREVLASTV = MIN( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF - T( I, I ) = TAU( I ) - END IF +* +* T_3 = T_3V_{2,2} +* + CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{3,1}'V_{3,2} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, + $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1'V_2 +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) +* +* T_3 = T_3T_2 +* + CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + + ELSE IF(LQ) THEN +* +* Break V apart into 6 components +* +* V = |----------------------| +* |V_{1,1} V_{1,2} V{1,3}| +* |0 V_{2,2} V{2,3}| +* |----------------------| +* +* V_{1,1}\in\R^{l,l} unit upper triangular +* V_{1,2}\in\R^{l,k-l} rectangular +* V_{1,3}\in\R^{l,n-k} rectangular +* +* V_{2,2}\in\R^{k-l,k-l} unit upper triangular +* V_{2,3}\in\R^{k-l,n-k} rectangular +* +* Where l = floor(k/2) +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{l, l} upper triangular +* T_2\in\R^{k-l, k-l} upper triangular +* T_3\in\R^{l, k-l} rectangular +* +* Then, consider the product: +* +* (I - V_1'T_1V_1)(I - V_2'T_2V_2) +* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* +* Define T_3 = -T_1V_1V_2'T_2 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL DLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) + +* +* Compute T_3 +* T_3 = V_{1,2} +* + CALL DLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) +* +* T_3 = T_3V_{2,2}' +* + CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, + $ V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{1,3}V_{2,3}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1V_2' +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T, LDT, T(1, L+1), LDT) + +* +* T_3 = T_3T_2 +* + CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + ELSE IF(QL) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} V_{1,2}| +* |V_{2,1} V_{2,2}| +* |0 V_{3,2}| +* |---------------| +* +* V_{1,1}\in\R^{n-k,k-l} rectangular +* V_{2,1}\in\R^{k-l,k-l} unit upper triangular +* +* V_{1,2}\in\R^{n-k,l} rectangular +* V_{2,2}\in\R^{k-l,l} rectangular +* V_{3,2}\in\R^{l,l} unit upper triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{k-l, k-l} non-unit lower triangular +* T_2\in\R^{l, l} non-unit lower triangular +* T_3\in\R^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2T_2V_2')(I - V_1T_1V_1') +* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* +* Define T_3 = -T_2V_2'V_1T_1 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL DLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2}' +* + DO J = 1, K-L + DO I = 1, L + T(K-L+I,J) = V(N-K+J, K-L+I) + END DO END DO - END IF - RETURN * -* End of DLARFT +* T_3 = T_3V_{2,1} +* + CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, + $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,2}'V_{2,1} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, + $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) +* +* At this point, we have that T_3 = V_2'V_1 +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * - END +* T_3 = T_3T_1 +* + CALL DTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + ELSE +* +* Else means RQ case +* +* Break V apart into 6 components +* +* V = |-----------------------| +* |V_{1,1} V_{1,2} 0 | +* |V_{2,1} V_{2,2} V_{2,3}| +* |-----------------------| +* +* V_{1,1}\in\R^{k-l,n-k} rectangular +* V_{1,2}\in\R^{k-l,k-l} unit lower triangular +* +* V_{2,1}\in\R^{l,n-k} rectangular +* V_{2,2}\in\R^{l,k-l} rectangular +* V_{2,3}\in\R^{l,l} unit lower triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{k-l, k-l} non-unit lower triangular +* T_2\in\R^{l, l} non-unit lower triangular +* T_3\in\R^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2'T_2V_2)(I - V_1'T_1V_1) +* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* +* Define T_3 = -T_2V_2V_1'T_1 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2} +* + CALL DLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), + $ LDT) + +* +* T_3 = T_3V_{1,2}' +* + CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, + $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,1}V_{1,1}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, + $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + +* +* At this point, we have that T_3 = V_2V_1' +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + +* +* T_3 = T_3T_1 +* + CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ ONE, T, LDT, T(K-L+1,1), LDT) + END IF + END SUBROUTINE diff --git a/SRC/dorglq.f b/SRC/dorglq.f index 6057a96338..47edfe4eda 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -148,7 +148,7 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORGL2, XERBLA + EXTERNAL DLARFB, DLARFT, DORGL2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -253,8 +253,7 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB, - $ A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right diff --git a/SRC/dorgql.f b/SRC/dorgql.f index 4920a705bf..8ac4cbf003 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -149,7 +149,7 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORG2L, XERBLA + EXTERNAL DLARFB, DLARFT, DORG2L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -260,9 +260,8 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1, - $ IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, - $ LDWORK ) + CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, + $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f index 5823cf8ae4..fd88519871 100644 --- a/SRC/dorgqr.f +++ b/SRC/dorgqr.f @@ -149,7 +149,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORG2R, XERBLA + EXTERNAL DLARFB, DLARFT, DORG2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -254,7 +254,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB, + CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB, $ A( I, I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i:m,i+ib:n) from the left diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index 2f2c84d9c3..54e109b492 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -149,7 +149,7 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) $ LWKOPT, NB, NBMIN, NX * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORGR2, XERBLA + EXTERNAL DLARFB, DLARFT, DORGR2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -261,9 +261,8 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1, - $ IB, A( II, 1 ), LDA, TAU( I ), WORK, - $ LDWORK) + CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, + $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK) * * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * diff --git a/SRC/dormlq.f b/SRC/dormlq.f index cb68138cb6..ac6f931047 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -196,7 +196,7 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORML2, XERBLA + EXTERNAL DLARFB, DLARFT, DORML2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -316,8 +316,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Rowwise', NQ-I+1, IB, - $ A( I, I ), LDA, TAU( I ), WORK( IWT ), LDT ) + CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ), + $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * * H or H**T is applied to C(i:m,1:n) diff --git a/SRC/dormql.f b/SRC/dormql.f index c28e0d0e70..9020c6abd9 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -195,7 +195,7 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORM2L, XERBLA + EXTERNAL DLARFB, DLARFT, DORM2L, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -310,8 +310,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Columnwise', NQ-K+I+IB-1, - $ IB, A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT) + CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, + $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT) IF( LEFT ) THEN * * H or H**T is applied to C(1:m-k+i+ib-1,1:n) diff --git a/SRC/dormqr.f b/SRC/dormqr.f index e35534067f..7793103b33 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -195,7 +195,7 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORM2R, XERBLA + EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -309,8 +309,7 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL MY_DLARFT_REC( 'Forward', 'Columnwise', NQ-I+1, IB, - $ A(I, I ), + CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/dormrq.f b/SRC/dormrq.f index dcefe8d1df..03159e4961 100644 --- a/SRC/dormrq.f +++ b/SRC/dormrq.f @@ -196,7 +196,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, EXTERNAL LSAME, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLARFB, MY_DLARFT_REC, DORMR2, XERBLA + EXTERNAL DLARFB, DLARFT, DORMR2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -317,7 +317,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL MY_DLARFT_REC( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB, + CALL DLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB, $ A( I, 1 ), LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/my_dlarft_rec.f b/SRC/my_dlarft_rec.f deleted file mode 100644 index 15dd59dee1..0000000000 --- a/SRC/my_dlarft_rec.f +++ /dev/null @@ -1,239 +0,0 @@ -c Cost: n > k: 1/6 * (k^2-1)(2n+k) -c n = k: 1/2 * (n^3-n) - RECURSIVE SUBROUTINE MY_DLARFT_REC( DIRECT, STOREV, N, K, V, LDV, - $ TAU, T, LDT) - IMPLICIT NONE - ! Arguemnts - ! Scalars - INTEGER N, K, LDV, LDT - CHARACTER DIRECT, STOREV - ! Matrix - DOUBLE PRECISION V(LDV,*), T(LDT,*), TAU(N) - - ! Local variables - INTEGER I,J,L,MINNK - LOGICAL QR,LQ,QL,DIRF,COLV - ! Parameters - DOUBLE PRECISION ONE, NEG_ONE, ZERO - PARAMETER(ONE=1.0D+0, ZERO = 0.0, NEG_ONE=-1.0D+0) - ! External functions - LOGICAL LSAME - EXTERNAL LSAME - ! External subroutines - EXTERNAL DTRMM,DGEMM,DLACPY - - ! Break V apart into 6 components - ! V = |---------------| - ! |V_{1,1} 0 | - ! |V_{2,1} V_{2,2}| - ! |V_{3,1} V_{3,2}| - ! |---------------| - ! V_{1,1}\in\R^{k,k} unit lower triangular - ! V_{2,1}\in\R^{n-k,k} rectangular - ! V_{3,1}\in\R^{m-n,k} rectangular - ! - ! V_{2,2}\in\R^{n-k,n-k} unit upper triangular - ! V_{3,2}\in\R^{m-n,n-k} rectangular - - ! We will construct the T matrix - ! T = |---------------| = |--------| - ! |T_{1,1} T_{1,2}| |T_1 T_3| - ! |0 T_{2,2}| |0 T_2| - ! |---------------| |--------| - - ! T is the triangular factor attained from block reflectors. - ! To motivate the structure, consider the product - ! - ! (I - V_1T_1V_1^\top)(I - V_2T_2V_2^\top) - ! = I - V_1T_1V_1^\top - V_2T_2V_2^\top + V_1T_1V_1^\topV_2T_2V_2^\top - ! - ! Define T_3 = -T_1V_1^\topV_2T_2 - ! - ! Then, we can define the matrix V as - ! V = |-------| - ! |V_1 V_2| - ! |-------| - ! - ! So, our product is equivalent to the matrix product - ! I - VTV^\top - ! So, we compute T_1, then T_2, then use these values to get T_3 - ! - ! The general scheme used is inspired by the approach inside DGEQRT3 - ! which was (at the time of writing this code): - ! Based on the algorithm of Elmroth and Gustavson, - ! IBM J. Res. Develop. Vol 44 No. 4 July 2000. - - IF(K.EQ.0.OR.N.EQ.0) THEN - RETURN - END IF - ! Base case - IF(K.EQ.1.OR.N.EQ.1) THEN - T(1,1) = TAU(1) - RETURN - END IF - - ! Beginning of executable statements -! MINNK = MIN(N,K) -! L = MINNK / 2 - L = K / 2 - ! Determine what kind of Q we need to compute - ! We assume that if the user doesn't provide 'F' for DIRECT, - ! then they meant to provide 'B' and if they don't provide - ! 'C' for STOREV, then they meant to provide 'R' - DIRF = LSAME(DIRECT,'F') - COLV = LSAME(STOREV,'C') - ! QR happens when we have forward direction in column storage - QR = DIRF.AND.COLV - ! LQ happens when we have Forward direction in row storage - LQ = DIRF.AND.(.NOT.COLV) - ! QL happens when we have backward direction in column storage - QL = (.NOT.DIRF).AND.COLV - ! The last case is RQ. Due to how we strucutured this, if the - ! above 3 are false, then RQ must be true, so we never store - ! this - ! RQ happens when we have backward direction in row storage - !RQ = (.NOT.DIRF).AND.(.NOT.COLV) - - - ! Compute T3 - IF(QR) THEN - ! If we are wide, then our - ! Compute T_1 - CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V, LDV, TAU, T, - $ LDT) - ! Compute T_2 - CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), - $ LDV, TAU(L+1), T(L+1,L+1), LDT) - ! Compute T_3 - ! T_3 = V_{2,1}^\top - DO J = 1, L - DO I = 1, K-L - T(J,L+I) = V(L+I,J) - END DO - END DO - ! T_3 = V_{2,1}^\top * V_{2,2} - CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', - $ L, K - L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) - - IF(N.GT.K) THEN - ! T_3 = T_3 + V_{3,1}^\topV_{3,2} - CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, - $ ONE, V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, - $ T(1, L+1), LDT) - END IF - - ! At this point, we have that T_3 = V_1^\top *V_2 - ! All that is left is to pre and post multiply by -T_1 and T_2 - ! respectively. - - ! T_3 = -T_1*T_3 - CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', - $ L, K - L, NEG_ONE, T, LDT, T(1, L+1), LDT) - ! T_3 = T_3*T_2 - CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', - $ L, K - L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) - - ELSE IF(LQ) THEN - ! Compute T_1 - CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V, LDV, TAU, T, - $ LDT) - ! Compute T_2 - CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), - $ LDV, TAU(L+1), T(L+1,L+1), LDT) - - ! Begin computing T_3 - ! First, T_3 = V_1V_2^\top - ! T_3 = V_{12} - CALL DLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) - - ! T_3 = V_{12}V_{22}^\top = T_3V_{22}^\top - CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) - - ! If needed, use the trailing components - IF(N.GT.K) THEN - CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, - $ ONE, V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, - $ T(1, L+1), LDT) - END IF - - ! T_3 = -T_1T_3 - CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', - $ L, K - L, NEG_ONE, T, LDT, T(1, L+1), LDT) - - ! T_3 = T_3T_1 - CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', - $ L, K - L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) - ELSE IF(QL) THEN - ! Compute T_1 - CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, - $ T, LDT) - ! Compute T_2 - CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) - - ! Begin computing T_3 = T_2V_2^\topV_1T_1 - - ! T_3 = V_2^\top V_1 - - ! T_3 = V_{2,2}^\top - DO J = 1, K-L - DO I = 1, L - T(K-L+I,J) = V(N-K+J, K-L+I) - END DO - END DO - - ! T_3 = V_{2,2}^\topV_{2,1} = T_3V_{2,1} - CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', - $ L, K - L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) - - ! If needed, T_3 = V_{1,2}^\topV_{1,1} + T_3 - IF(N.GT.K) THEN - CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, - $ ONE, V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) - END IF - - ! T_3 = -T_2T_3 - CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', - $ L, K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) - ! T_3 = T_3T_1 - CALL DTRMM('Right', 'Lower', 'No transpose', 'Non-unit', - $ L, K-L, ONE, T, LDT, T(K-L+1,1), LDT) - ELSE - ! Else means RQ - ! Compute T_1 - CALL MY_DLARFT_REC(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, - $ T, LDT) - ! Compute T_2 - CALL MY_DLARFT_REC(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) - - ! Begin computing T_3 = T_2V_2V_1^\topT_1 - - ! T_3 = V_2V_1^\top - - ! T_3 = V_{2,2} - CALL DLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, - $ T(K-L+1,1), LDT) - - ! T_3 = T_3V_{1,2}^\top - CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', - $ L, K-L, ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) - - ! If needed, T_3 = V_{2,1}V_{1,1}^\top + T_3 - IF(N.GT.K) THEN - CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, - $ ONE, V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) - END IF - - ! T_3 = -T_2T_3 - CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', - $ L, K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) - - ! T_3 = T_3T_1 - CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', - $ L, K-L, ONE, T, LDT, T(K-L+1,1), LDT) - END IF - - ! Now, we have T in the correct form! - END SUBROUTINE diff --git a/SRC/slarft.f b/SRC/slarft.f index 31b7951819..f6e647e470 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -18,7 +18,7 @@ * Definition: * =========== * -* SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * .. Scalar Arguments .. * CHARACTER DIRECT, STOREV @@ -159,168 +159,464 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, + $ LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -* .. Scalar Arguments .. +* .. Scalar Arguments +* CHARACTER DIRECT, STOREV INTEGER K, LDT, LDV, N * .. * .. Array Arguments .. +* REAL T( LDT, * ), TAU( * ), V( LDV, * ) * .. * -* ===================================================================== -* * .. Parameters .. - REAL ONE, ZERO - PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) -* .. +* + REAL ONE, NEG_ONE, ZERO + PARAMETER(ONE=1.0E+0, ZERO = 0.0E+0, NEG_ONE=-1.0E+0) +* * .. Local Scalars .. - INTEGER I, J, PREVLASTV, LASTV -* .. +* + INTEGER I,J,L + LOGICAL QR,LQ,QL,DIRF,COLV +* * .. External Subroutines .. - EXTERNAL SGEMV, STRMV -* .. -* .. External Functions .. +* + EXTERNAL STRMM,SGEMM,SLACPY +* +* .. External Functions.. +* LOGICAL LSAME EXTERNAL LSAME +* +* The general scheme used is inspired by the approach inside DGEQRT3 +* which was (at the time of writing this code): +* Based on the algorithm of Elmroth and Gustavson, +* IBM J. Res. Develop. Vol 44 No. 4 July 2000. * .. * .. Executable Statements .. * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN -* - IF( LSAME( DIRECT, 'F' ) ) THEN - PREVLASTV = N - DO I = 1, K - PREVLASTV = MAX( I, PREVLASTV ) - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = 1, I - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( I , J ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i) -* - CALL SGEMV( 'Transpose', J-I, I-1, -TAU( I ), - $ V( I+1, 1 ), LDV, V( I+1, I ), 1, ONE, - $ T( 1, I ), 1 ) - ELSE -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( J , I ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T -* - CALL SGEMV( 'No transpose', I-1, J-I, -TAU( I ), - $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, - $ ONE, T( 1, I ), 1 ) - END IF -* -* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) -* - CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, - $ T, - $ LDT, T( 1, I ), 1 ) - T( I, I ) = TAU( I ) - IF( I.GT.1 ) THEN - PREVLASTV = MAX( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF + IF(N.EQ.0.OR.K.EQ.0) THEN + RETURN + END IF +* +* Base case +* + IF(N.EQ.1.OR.K.EQ.1) THEN + T(1,1) = TAU(1) + RETURN + END IF +* +* Beginning of executable statements +* + L = K / 2 +* +* Determine what kind of Q we need to compute +* We assume that if the user doesn't provide 'F' for DIRECT, +* then they meant to provide 'B' and if they don't provide +* 'C' for STOREV, then they meant to provide 'R' +* + DIRF = LSAME(DIRECT,'F') + COLV = LSAME(STOREV,'C') +* +* QR happens when we have forward direction in column storage +* + QR = DIRF.AND.COLV +* +* LQ happens when we have Forward direction in row storage +* + LQ = DIRF.AND.(.NOT.COLV) +* +* QL happens when we have backward direction in column storage +* + QL = (.NOT.DIRF).AND.COLV +* +* The last case is RQ. Due to how we structured this, if the +* above 3 are false, then RQ must be true, so we never store +* this +* RQ happens when we have backward direction in row storage +* RQ = (.NOT.DIRF).AND.(.NOT.COLV) +* + IF(QR) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} 0 | +* |V_{2,1} V_{2,2}| +* |V_{3,1} V_{3,2}| +* |---------------| +* +* V_{1,1}\in\R^{l,l} unit lower triangular +* V_{2,1}\in\R^{k-l,l} rectangular +* V_{3,1}\in\R^{n-k,l} rectangular +* +* V_{2,2}\in\R^{k-l,k-l} unit lower triangular +* V_{3,2}\in\R^{n-k,k-l} rectangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{l, l} upper triangular +* T_2\in\R^{k-l, k-l} upper triangular +* T_3\in\R^{l, k-l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_1T_1V_1')(I - V_2T_2V_2') +* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* +* Define T_3 = -T_1V_1'V_2T_2 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL SLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,1}' +* + DO J = 1, L + DO I = 1, K-L + T(J,L+I) = V(L+I,J) + END DO END DO - ELSE - PREVLASTV = 1 - DO I = K, 1, -1 - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = I, K - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( I.LT.K ) THEN - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( N-K+I , J ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i) -* - CALL SGEMV( 'Transpose', N-K+I-J, K-I, - $ -TAU( I ), - $ V( J, I+1 ), LDV, V( J, I ), 1, ONE, - $ T( I+1, I ), 1 ) - ELSE -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( J, N-K+I ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T -* - CALL SGEMV( 'No transpose', K-I, N-K+I-J, - $ -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV, - $ ONE, T( I+1, I ), 1 ) - END IF -* -* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) -* - CALL STRMV( 'Lower', 'No transpose', 'Non-unit', - $ K-I, - $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) - IF( I.GT.1 ) THEN - PREVLASTV = MIN( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF - T( I, I ) = TAU( I ) - END IF +* +* T_3 = T_3V_{2,2} +* + CALL STRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{3,1}'V_{3,2} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, + $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1'V_2 +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) +* +* T_3 = T_3T_2 +* + CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + + ELSE IF(LQ) THEN +* +* Break V apart into 6 components +* +* V = |----------------------| +* |V_{1,1} V_{1,2} V{1,3}| +* |0 V_{2,2} V{2,3}| +* |----------------------| +* +* V_{1,1}\in\R^{l,l} unit upper triangular +* V_{1,2}\in\R^{l,k-l} rectangular +* V_{1,3}\in\R^{l,n-k} rectangular +* +* V_{2,2}\in\R^{k-l,k-l} unit upper triangular +* V_{2,3}\in\R^{k-l,n-k} rectangular +* +* Where l = floor(k/2) +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{l, l} upper triangular +* T_2\in\R^{k-l, k-l} upper triangular +* T_3\in\R^{l, k-l} rectangular +* +* Then, consider the product: +* +* (I - V_1'T_1V_1)(I - V_2'T_2V_2) +* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* +* Define T_3 = -T_1V_1V_2'T_2 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL SLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) + +* +* Compute T_3 +* T_3 = V_{1,2} +* + CALL SLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) +* +* T_3 = T_3V_{2,2}' +* + CALL STRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, + $ V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{1,3}V_{2,3}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1V_2' +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T, LDT, T(1, L+1), LDT) + +* +* T_3 = T_3T_2 +* + CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + ELSE IF(QL) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} V_{1,2}| +* |V_{2,1} V_{2,2}| +* |0 V_{3,2}| +* |---------------| +* +* V_{1,1}\in\R^{n-k,k-l} rectangular +* V_{2,1}\in\R^{k-l,k-l} unit upper triangular +* +* V_{1,2}\in\R^{n-k,l} rectangular +* V_{2,2}\in\R^{k-l,l} rectangular +* V_{3,2}\in\R^{l,l} unit upper triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{k-l, k-l} non-unit lower triangular +* T_2\in\R^{l, l} non-unit lower triangular +* T_3\in\R^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2T_2V_2')(I - V_1T_1V_1') +* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* +* Define T_3 = -T_2V_2'V_1T_1 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL SLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2}' +* + DO J = 1, K-L + DO I = 1, L + T(K-L+I,J) = V(N-K+J, K-L+I) + END DO END DO - END IF - RETURN * -* End of SLARFT +* T_3 = T_3V_{2,1} +* + CALL STRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, + $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,2}'V_{2,1} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, + $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) +* +* At this point, we have that T_3 = V_2'V_1 +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL STRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * - END +* T_3 = T_3T_1 +* + CALL STRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + ELSE +* +* Else means RQ case +* +* Break V apart into 6 components +* +* V = |-----------------------| +* |V_{1,1} V_{1,2} 0 | +* |V_{2,1} V_{2,2} V_{2,3}| +* |-----------------------| +* +* V_{1,1}\in\R^{k-l,n-k} rectangular +* V_{1,2}\in\R^{k-l,k-l} unit lower triangular +* +* V_{2,1}\in\R^{l,n-k} rectangular +* V_{2,2}\in\R^{l,k-l} rectangular +* V_{2,3}\in\R^{l,l} unit lower triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\R^{k-l, k-l} non-unit lower triangular +* T_2\in\R^{l, l} non-unit lower triangular +* T_3\in\R^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2'T_2V_2)(I - V_1'T_1V_1) +* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* +* Define T_3 = -T_2V_2V_1'T_1 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL SLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2} +* + CALL SLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), + $ LDT) + +* +* T_3 = T_3V_{1,2}' +* + CALL STRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, + $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,1}V_{1,1}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, + $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + +* +* At this point, we have that T_3 = V_2V_1' +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL STRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + +* +* T_3 = T_3T_1 +* + CALL STRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ ONE, T, LDT, T(K-L+1,1), LDT) + END IF + END SUBROUTINE diff --git a/SRC/zlarft.f b/SRC/zlarft.f index be773becc2..eaada56253 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -18,7 +18,7 @@ * Definition: * =========== * -* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) +* RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * * .. Scalar Arguments .. * CHARACTER DIRECT, STOREV @@ -159,169 +159,468 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, + $ LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -* .. Scalar Arguments .. - CHARACTER DIRECT, STOREV - INTEGER K, LDT, LDV, N +* .. Scalar Arguments +* + CHARACTER DIRECT, STOREV + INTEGER K, LDT, LDV, N * .. * .. Array Arguments .. - COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * ) -* .. * -* ===================================================================== + COMPLEX*16 T( LDT, * ), TAU( * ), V( LDV, * ) +* .. * * .. Parameters .. - COMPLEX*16 ONE, ZERO - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. +* + COMPLEX*16 ONE, NEG_ONE, ZERO + PARAMETER(ONE=1.0D+0, ZERO = 0.0D+0, NEG_ONE=-1.0D+0) +* * .. Local Scalars .. - INTEGER I, J, PREVLASTV, LASTV -* .. +* + INTEGER I,J,L + LOGICAL QR,LQ,QL,DIRF,COLV +* * .. External Subroutines .. - EXTERNAL ZGEMV, ZTRMV, ZGEMM -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME +* + EXTERNAL ZTRMM,ZGEMM,ZLACPY +* +* .. External Functions.. +* + LOGICAL LSAME + EXTERNAL LSAME +* +* .. Intrinsic Functions.. +* + INTRINSIC CONJG +* +* The general scheme used is inspired by the approach inside DGEQRT3 +* which was (at the time of writing this code): +* Based on the algorithm of Elmroth and Gustavson, +* IBM J. Res. Develop. Vol 44 No. 4 July 2000. * .. * .. Executable Statements .. * * Quick return if possible * - IF( N.EQ.0 ) - $ RETURN -* - IF( LSAME( DIRECT, 'F' ) ) THEN - PREVLASTV = N - DO I = 1, K - PREVLASTV = MAX( PREVLASTV, I ) - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = 1, I - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * CONJG( V( I , J ) ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**H * V(i:j,i) -* - CALL ZGEMV( 'Conjugate transpose', J-I, I-1, - $ -TAU( I ), V( I+1, 1 ), LDV, - $ V( I+1, I ), 1, ONE, T( 1, I ), 1 ) - ELSE -* Skip any trailing zeros. - DO LASTV = N, I+1, -1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = 1, I-1 - T( J, I ) = -TAU( I ) * V( J , I ) - END DO - J = MIN( LASTV, PREVLASTV ) -* -* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H -* - CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ), - $ V( 1, I+1 ), LDV, V( I, I+1 ), LDV, - $ ONE, T( 1, I ), LDT ) - END IF -* -* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) -* - CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, - $ T, - $ LDT, T( 1, I ), 1 ) - T( I, I ) = TAU( I ) - IF( I.GT.1 ) THEN - PREVLASTV = MAX( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF + IF(N.EQ.0.OR.K.EQ.0) THEN + RETURN + END IF +* +* Base case +* + IF(N.EQ.1.OR.K.EQ.1) THEN + T(1,1) = TAU(1) + RETURN + END IF +* +* Beginning of executable statements +* + L = K / 2 +* +* Determine what kind of Q we need to compute +* We assume that if the user doesn't provide 'F' for DIRECT, +* then they meant to provide 'B' and if they don't provide +* 'C' for STOREV, then they meant to provide 'R' +* + DIRF = LSAME(DIRECT,'F') + COLV = LSAME(STOREV,'C') +* +* QR happens when we have forward direction in column storage +* + QR = DIRF.AND.COLV +* +* LQ happens when we have Forward direction in row storage +* + LQ = DIRF.AND.(.NOT.COLV) +* +* QL happens when we have backward direction in column storage +* + QL = (.NOT.DIRF).AND.COLV +* +* The last case is RQ. Due to how we structured this, if the +* above 3 are false, then RQ must be true, so we never store +* this +* RQ happens when we have backward direction in row storage +* RQ = (.NOT.DIRF).AND.(.NOT.COLV) +* + IF(QR) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} 0 | +* |V_{2,1} V_{2,2}| +* |V_{3,1} V_{3,2}| +* |---------------| +* +* V_{1,1}\in\C^{l,l} unit lower triangular +* V_{2,1}\in\C^{k-l,l} rectangular +* V_{3,1}\in\C^{n-k,l} rectangular +* +* V_{2,2}\in\C^{k-l,k-l} unit lower triangular +* V_{3,2}\in\C^{n-k,k-l} rectangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{l, l} upper triangular +* T_2\in\C^{k-l, k-l} upper triangular +* T_3\in\C^{l, k-l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_1T_1V_1')(I - V_2T_2V_2') +* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* +* Define T_3 = -T_1V_1'V_2T_2 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,1}' +* + DO J = 1, L + DO I = 1, K-L + T(J,L+I) = CONJG(V(L+I,J)) + END DO END DO - ELSE - PREVLASTV = 1 - DO I = K, 1, -1 - IF( TAU( I ).EQ.ZERO ) THEN -* -* H(i) = I -* - DO J = I, K - T( J, I ) = ZERO - END DO - ELSE -* -* general case -* - IF( I.LT.K ) THEN - IF( LSAME( STOREV, 'C' ) ) THEN -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( LASTV, I ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)**H * V(j:n-k+i,i) -* - CALL ZGEMV( 'Conjugate transpose', N-K+I-J, K-I, - $ -TAU( I ), V( J, I+1 ), LDV, V( J, I ), - $ 1, ONE, T( I+1, I ), 1 ) - ELSE -* Skip any leading zeros. - DO LASTV = 1, I-1 - IF( V( I, LASTV ).NE.ZERO ) EXIT - END DO - DO J = I+1, K - T( J, I ) = -TAU( I ) * V( J, N-K+I ) - END DO - J = MAX( LASTV, PREVLASTV ) -* -* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H -* - 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 ) - END IF -* -* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) -* - CALL ZTRMV( 'Lower', 'No transpose', 'Non-unit', - $ K-I, - $ T( I+1, I+1 ), LDT, T( I+1, I ), 1 ) - IF( I.GT.1 ) THEN - PREVLASTV = MIN( PREVLASTV, LASTV ) - ELSE - PREVLASTV = LASTV - END IF - END IF - T( I, I ) = TAU( I ) - END IF +* +* T_3 = T_3V_{2,2} +* + CALL ZTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{3,1}'V_{3,2} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, + $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1'V_2 +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) +* +* T_3 = T_3T_2 +* + CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + + ELSE IF(LQ) THEN +* +* Break V apart into 6 components +* +* V = |----------------------| +* |V_{1,1} V_{1,2} V{1,3}| +* |0 V_{2,2} V{2,3}| +* |----------------------| +* +* V_{1,1}\in\C^{l,l} unit upper triangular +* V_{1,2}\in\C^{l,k-l} rectangular +* V_{1,3}\in\C^{l,n-k} rectangular +* +* V_{2,2}\in\C^{k-l,k-l} unit upper triangular +* V_{2,3}\in\C^{k-l,n-k} rectangular +* +* Where l = floor(k/2) +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} T_{1,2}| |T_1 T_3| +* |0 T_{2,2}| |0 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{l, l} upper triangular +* T_2\in\C^{k-l, k-l} upper triangular +* T_3\in\C^{l, k-l} rectangular +* +* Then, consider the product: +* +* (I - V_1'T_1V_1)(I - V_2'T_2V_2) +* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* +* Define T_3 = -T_1V_1V_2'T_2 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, + $ TAU(L+1), T(L+1,L+1), LDT) + +* +* Compute T_3 +* T_3 = V_{1,2} +* + CALL ZLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) +* +* T_3 = T_3V_{2,2}' +* + CALL ZTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, + $ V(L+1, L+1), LDV, T(1, L+1), LDT) + +* +* T_3 = V_{1,3}V_{2,3}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) +* +* At this point, we have that T_3 = V_1V_2' +* All that is left is to pre and post multiply by -T_1 and T_2 +* respectively. +* +* T_3 = -T_1T_3 +* + CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T, LDT, T(1, L+1), LDT) + +* +* T_3 = T_3T_2 +* + CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + ELSE IF(QL) THEN +* +* Break V apart into 6 components +* +* V = |---------------| +* |V_{1,1} V_{1,2}| +* |V_{2,1} V_{2,2}| +* |0 V_{3,2}| +* |---------------| +* +* V_{1,1}\in\C^{n-k,k-l} rectangular +* V_{2,1}\in\C^{k-l,k-l} unit upper triangular +* +* V_{1,2}\in\C^{n-k,l} rectangular +* V_{2,2}\in\C^{k-l,l} rectangular +* V_{3,2}\in\C^{l,l} unit upper triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{k-l, k-l} non-unit lower triangular +* T_2\in\C^{l, l} non-unit lower triangular +* T_3\in\C^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2T_2V_2')(I - V_1T_1V_1') +* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* +* Define T_3 = -T_2V_2'V_1T_1 +* +* Then, we can define the matrix V as +* V = |-------| +* |V_1 V_2| +* |-------| +* +* So, our product is equivalent to the matrix product +* I - VTV' +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL ZLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2}' +* + DO J = 1, K-L + DO I = 1, L + T(K-L+I,J) = CONJG(V(N-K+J, K-L+I)) + END DO END DO - END IF - RETURN * -* End of ZLARFT +* T_3 = T_3V_{2,1} +* + CALL ZTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, + $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,2}'V_{2,1} + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, + $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) +* +* At this point, we have that T_3 = V_2'V_1 +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 * - END + CALL ZTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) +* +* T_3 = T_3T_1 +* + CALL ZTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + ELSE +* +* Else means RQ case +* +* Break V apart into 6 components +* +* V = |-----------------------| +* |V_{1,1} V_{1,2} 0 | +* |V_{2,1} V_{2,2} V_{2,3}| +* |-----------------------| +* +* V_{1,1}\in\C^{k-l,n-k} rectangular +* V_{1,2}\in\C^{k-l,k-l} unit lower triangular +* +* V_{2,1}\in\C^{l,n-k} rectangular +* V_{2,2}\in\C^{l,k-l} rectangular +* V_{2,3}\in\C^{l,l} unit lower triangular +* +* We will construct the T matrix +* T = |---------------| = |--------| +* |T_{1,1} 0 | |T_1 0 | +* |T_{2,1} T_{2,2}| |T_3 T_2| +* |---------------| |--------| +* +* T is the triangular factor attained from block reflectors. +* To motivate the structure, assume we have already computed T_1 +* and T_2. Then collect the associated reflectors in V_1 and V_2 +* +* T_1\in\C^{k-l, k-l} non-unit lower triangular +* T_2\in\C^{l, l} non-unit lower triangular +* T_3\in\C^{k-l, l} rectangular +* +* Where l = floor(k/2) +* +* Then, consider the product: +* +* (I - V_2'T_2V_2)(I - V_1'T_1V_1) +* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* +* Define T_3 = -T_2V_2V_1'T_1 +* +* Then, we can define the matrix V as +* V = |---| +* |V_1| +* |V_2| +* |---| +* +* So, our product is equivalent to the matrix product +* I - V'TV +* This means, we can compute T_1 and T_2, then use this information +* to compute T_3 +* +* Compute T_1 recursively +* + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) +* +* Compute T_2 recursively +* + CALL ZLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), + $ T(K-L+1,K-L+1), LDT) +* +* Compute T_3 +* T_3 = V_{2,2} +* + CALL ZLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), + $ LDT) + +* +* T_3 = T_3V_{1,2}' +* + CALL ZTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, + $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + +* +* T_3 = V_{2,1}V_{1,1}' + T_3 +* Note: We assume K <= N, and GEMM will do nothing if N=K +* + CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, + $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + +* +* At this point, we have that T_3 = V_2V_1' +* All that is left is to pre and post multiply by -T_2 and T_1 +* respectively. +* +* T_3 = -T_2T_3 +* + CALL ZTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + +* +* T_3 = T_3T_1 +* + CALL ZTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, + $ ONE, T, LDT, T(K-L+1,1), LDT) + END IF + END SUBROUTINE diff --git a/st7lLjwJ b/st7lLjwJ deleted file mode 100644 index 8b277f0dd5..0000000000 --- a/st7lLjwJ +++ /dev/null @@ -1 +0,0 @@ -! From 1ba075ccd8bf4d1c4029699d817882839d98bbe5 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Wed, 16 Oct 2024 11:40:20 -0600 Subject: [PATCH 187/206] updating parameter definition in the single complex version --- SRC/clarft.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SRC/clarft.f b/SRC/clarft.f index 4517bb9b31..f1af5d3b33 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -179,7 +179,7 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * .. Parameters .. * COMPLEX ONE, NEG_ONE, ZERO - PARAMETER(ONE=1.0D+0, ZERO = 0.0D+0, NEG_ONE=-1.0D+0) + PARAMETER(ONE=1.0E+0, ZERO = 0.0E+0, NEG_ONE=-1.0E+0) * * .. Local Scalars .. * From 09cb849a23df7977164d44cbcaa397e38debd901 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Sun, 25 Aug 2024 13:25:02 +0200 Subject: [PATCH 188/206] Use GEMMTR for SY/HE linear updates --- SRC/clahef.f | 55 +++++++++------------------------------------- SRC/clahef_rk.f | 54 ++++++++------------------------------------- SRC/clasyf.f | 49 +++++++---------------------------------- SRC/clasyf_rk.f | 48 ++++++---------------------------------- SRC/clasyf_rook.f | 50 +++++++++--------------------------------- SRC/dlasyf.f | 50 +++++++----------------------------------- SRC/dlasyf_rk.f | 50 +++++++----------------------------------- SRC/dlasyf_rook.f | 50 +++++++----------------------------------- SRC/slasyf.f | 50 +++++++----------------------------------- SRC/slasyf_rk.f | 48 ++++++---------------------------------- SRC/slasyf_rook.f | 50 +++++++----------------------------------- SRC/zlahef.f | 55 +++++++++------------------------------------- SRC/zlahef_rk.f | 56 +++++++++-------------------------------------- SRC/zlasyf.f | 49 +++++++---------------------------------- SRC/zlasyf_rk.f | 48 ++++++---------------------------------- SRC/zlasyf_rook.f | 50 +++++++++--------------------------------- 16 files changed, 136 insertions(+), 676 deletions(-) diff --git a/SRC/clahef.f b/SRC/clahef.f index 1372673027..1697a1d430 100644 --- a/SRC/clahef.f +++ b/SRC/clahef.f @@ -200,7 +200,7 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW REAL ABSAKK, ALPHA, COLMAX, R1, ROWMAX, T COMPLEX D11, D21, D22, Z @@ -211,7 +211,7 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMM, CGEMV, CLACGV, CSSCAL, + EXTERNAL CCOPY, CGEMMTR, CGEMV, CLACGV, CSSCAL, $ CSWAP * .. * .. Intrinsic Functions .. @@ -552,28 +552,11 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**H = A11 - U12*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL CGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in of rows in columns k+1:n looping backwards from k+1 to n @@ -916,29 +899,11 @@ SUBROUTINE CLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**H = A22 - L21*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL CGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/clahef_rk.f b/SRC/clahef_rk.f index b97d68b14a..baba1016f2 100644 --- a/SRC/clahef_rk.f +++ b/SRC/clahef_rk.f @@ -286,7 +286,7 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, II, J, JB, JJ, JMAX, K, KK, KKW, + INTEGER IMAX, ITEMP, II, J, JMAX, K, KK, KKW, $ KP, KSTEP, KW, P REAL ABSAKK, ALPHA, COLMAX, STEMP, R1, ROWMAX, T, $ SFMIN @@ -755,29 +755,11 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**H = A11 - U12*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL CGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -1203,29 +1185,11 @@ SUBROUTINE CLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**H = A22 - L21*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - A( JJ, JJ ) = REAL( A( JJ, JJ ) ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL CGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/clasyf.f b/SRC/clasyf.f index 4de35fa3a4..46056a16d0 100644 --- a/SRC/clasyf.f +++ b/SRC/clasyf.f @@ -200,7 +200,7 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW REAL ABSAKK, ALPHA, COLMAX, ROWMAX COMPLEX D11, D21, D22, R1, T, Z @@ -211,7 +211,7 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMM, CGEMV, CSCAL, CSWAP + EXTERNAL CCOPY, CGEMMTR, CGEMV, CSCAL, CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, MIN, REAL, SQRT @@ -482,25 +482,9 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL CGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n looping backwards from k+1 to n @@ -778,26 +762,9 @@ SUBROUTINE CLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL CGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/clasyf_rk.f b/SRC/clasyf_rk.f index 654d0f0cce..ac437205b4 100644 --- a/SRC/clasyf_rk.f +++ b/SRC/clasyf_rk.f @@ -298,7 +298,7 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMM, CGEMV, CSCAL, CSWAP + EXTERNAL CCOPY, CGEMMTR, CGEMV, CSCAL, CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, MIN, REAL, SQRT @@ -627,26 +627,9 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), - $ LDW, CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL CGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -945,26 +928,9 @@ SUBROUTINE CLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL CGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/clasyf_rook.f b/SRC/clasyf_rook.f index 3b76c09e15..e66f21d518 100644 --- a/SRC/clasyf_rook.f +++ b/SRC/clasyf_rook.f @@ -208,7 +208,7 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, J, JB, JJ, JMAX, JP1, JP2, K, KK, + INTEGER IMAX, ITEMP, J, JJ, JMAX, JP1, JP2, K, KK, $ KW, KKW, KP, KSTEP, P, II REAL ABSAKK, ALPHA, COLMAX, ROWMAX, STEMP, SFMIN COMPLEX D11, D12, D21, D22, R1, T, Z @@ -220,7 +220,7 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ICAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMM, CGEMV, CSCAL, CSWAP + EXTERNAL CCOPY, CGEMMTR, CGEMV, CSCAL, CSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT, AIMAG, REAL @@ -525,26 +525,11 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL CGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL CGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n @@ -846,26 +831,11 @@ SUBROUTINE CLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL CGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL CGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL CGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * in columns 1:k-1 diff --git a/SRC/dlasyf.f b/SRC/dlasyf.f index 5b1ca4e564..c4f8d1b31e 100644 --- a/SRC/dlasyf.f +++ b/SRC/dlasyf.f @@ -197,7 +197,7 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D21, D22, R1, $ ROWMAX, T @@ -208,7 +208,7 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IDAMAX * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DGEMV, DSCAL, DSWAP + EXTERNAL DCOPY, DGEMMTR, DGEMV, DSCAL, DSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -474,26 +474,9 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -ONE, - $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE, - $ A( 1, J ), LDA ) - 50 CONTINUE + CALL DGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n looping backwards from k+1 to n @@ -770,26 +753,9 @@ SUBROUTINE DLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL DGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/dlasyf_rk.f b/SRC/dlasyf_rk.f index 3de5cdb7f1..7e6e5ba632 100644 --- a/SRC/dlasyf_rk.f +++ b/SRC/dlasyf_rk.f @@ -283,7 +283,7 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, J, JB, JJ, JMAX, K, KK, KW, KKW, + INTEGER IMAX, ITEMP, J, JMAX, K, KK, KW, KKW, $ KP, KSTEP, P, II DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, $ DTEMP, R1, ROWMAX, T, SFMIN @@ -295,7 +295,7 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, IDAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DGEMV, DSCAL, DSWAP + EXTERNAL DCOPY, DGEMMTR, DGEMV, DSCAL, DSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -618,26 +618,9 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ), - $ LDW, ONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL DGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -936,26 +919,9 @@ SUBROUTINE DLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL DGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/dlasyf_rook.f b/SRC/dlasyf_rook.f index f9d34c9a87..87e961e5d8 100644 --- a/SRC/dlasyf_rook.f +++ b/SRC/dlasyf_rook.f @@ -205,7 +205,7 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, J, JB, JJ, JMAX, JP1, JP2, K, KK, + INTEGER IMAX, ITEMP, J, JJ, JMAX, JP1, JP2, K, KK, $ KW, KKW, KP, KSTEP, P, II DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, @@ -218,7 +218,7 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IDAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMM, DGEMV, DSCAL, DSWAP + EXTERNAL DCOPY, DGEMMTR, DGEMV, DSCAL, DSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -517,26 +517,9 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL DGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ ONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL DGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n @@ -838,26 +821,9 @@ SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL DGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL DGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL DGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * in columns 1:k-1 diff --git a/SRC/slasyf.f b/SRC/slasyf.f index adde278267..17d3ee7f01 100644 --- a/SRC/slasyf.f +++ b/SRC/slasyf.f @@ -197,7 +197,7 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( EIGHT = 8.0E+0, SEVTEN = 17.0E+0 ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW REAL ABSAKK, ALPHA, COLMAX, D11, D21, D22, R1, $ ROWMAX, T @@ -208,7 +208,7 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ISAMAX * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SGEMV, SSCAL, SSWAP + EXTERNAL SCOPY, SGEMMTR, SGEMV, SSCAL, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -474,26 +474,9 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -ONE, - $ A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, ONE, - $ A( 1, J ), LDA ) - 50 CONTINUE + CALL SGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n looping backwards from k+1 to n @@ -770,26 +753,9 @@ SUBROUTINE SLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL SGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/slasyf_rk.f b/SRC/slasyf_rk.f index a19a39b7ad..97293a41d1 100644 --- a/SRC/slasyf_rk.f +++ b/SRC/slasyf_rk.f @@ -295,7 +295,7 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, ISAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SGEMV, SSCAL, SSWAP + EXTERNAL SCOPY, SGEMMTR, SGEMV, SSCAL, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -618,26 +618,9 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ), - $ LDW, ONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL SGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -936,26 +919,9 @@ SUBROUTINE SLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL SGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/slasyf_rook.f b/SRC/slasyf_rook.f index c214ae0a85..d2d445e7a8 100644 --- a/SRC/slasyf_rook.f +++ b/SRC/slasyf_rook.f @@ -205,7 +205,7 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, J, JB, JJ, JMAX, JP1, JP2, K, KK, + INTEGER IMAX, ITEMP, J, JJ, JMAX, JP1, JP2, K, KK, $ KW, KKW, KP, KSTEP, P, II REAL ABSAKK, ALPHA, COLMAX, D11, D12, D21, D22, @@ -218,7 +218,7 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, ISAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMM, SGEMV, SSCAL, SSWAP + EXTERNAL SCOPY, SGEMMTR, SGEMV, SSCAL, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -517,26 +517,9 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', JJ-J+1, N-K, -ONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, ONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL SGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -ONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ ONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL SGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -ONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ ONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n @@ -838,26 +821,9 @@ SUBROUTINE SLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL SGEMV( 'No transpose', J+JB-JJ, K-1, -ONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, ONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL SGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -ONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ ONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL SGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -ONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ ONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * in columns 1:k-1 diff --git a/SRC/zlahef.f b/SRC/zlahef.f index 1df25bea06..1e124bccb6 100644 --- a/SRC/zlahef.f +++ b/SRC/zlahef.f @@ -200,7 +200,7 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, R1, ROWMAX, T COMPLEX*16 D11, D21, D22, Z @@ -211,7 +211,7 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, + EXTERNAL ZCOPY, ZDSCAL, ZGEMMTR, ZGEMV, ZLACGV, $ ZSWAP * .. * .. Intrinsic Functions .. @@ -551,28 +551,11 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**H = A11 - U12*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n looping backwards from k+1 to n @@ -915,29 +898,11 @@ SUBROUTINE ZLAHEF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**H = A22 - L21*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/zlahef_rk.f b/SRC/zlahef_rk.f index 3e9b2dcc9b..03417895a5 100644 --- a/SRC/zlahef_rk.f +++ b/SRC/zlahef_rk.f @@ -287,7 +287,7 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, II, J, JB, JJ, JMAX, K, KK, KKW, + INTEGER IMAX, ITEMP, II, J, JMAX, K, KK, KKW, $ KP, KSTEP, KW, P DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, DTEMP, R1, ROWMAX, T, $ SFMIN @@ -300,7 +300,7 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZDSCAL, ZGEMM, ZGEMV, ZLACGV, + EXTERNAL ZCOPY, ZDSCAL, ZGEMMTR, ZGEMV, ZLACGV, $ ZSWAP * .. * .. Intrinsic Functions .. @@ -755,29 +755,11 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**H = A11 - U12*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -1203,29 +1185,11 @@ SUBROUTINE ZLAHEF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**H = A22 - L21*W**H * -* computing blocks of NB columns at a time (note that conjg(W) is -* actually stored) -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - A( JJ, JJ ) = DBLE( A( JJ, JJ ) ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/zlasyf.f b/SRC/zlasyf.f index d5728b00a5..ca70f451cc 100644 --- a/SRC/zlasyf.f +++ b/SRC/zlasyf.f @@ -200,7 +200,7 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) * .. * .. Local Scalars .. - INTEGER IMAX, J, JB, JJ, JMAX, JP, K, KK, KKW, KP, + INTEGER IMAX, J, JJ, JMAX, JP, K, KK, KKW, KP, $ KSTEP, KW DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, ROWMAX COMPLEX*16 D11, D21, D22, R1, T, Z @@ -211,7 +211,7 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGEMM, ZGEMV, ZSCAL, ZSWAP + EXTERNAL ZCOPY, ZGEMMTR, ZGEMV, ZSCAL, ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN, SQRT @@ -481,25 +481,9 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, N-K, - $ -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n looping backwards from k+1 to n @@ -776,26 +760,9 @@ SUBROUTINE ZLASYF( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * of rows in columns 1:k-1 looping backwards from k-1 to 1 diff --git a/SRC/zlasyf_rk.f b/SRC/zlasyf_rk.f index 29a6684b67..67fe8c848c 100644 --- a/SRC/zlasyf_rk.f +++ b/SRC/zlasyf_rk.f @@ -298,7 +298,7 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGEMM, ZGEMV, ZSCAL, ZSWAP + EXTERNAL ZCOPY, ZGEMMTR, ZGEMV, ZSCAL, ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX, MIN, SQRT @@ -627,26 +627,9 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time -* - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), - $ LDW, CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Set KB to the number of columns factorized * @@ -945,26 +928,9 @@ SUBROUTINE ZLASYF_RK( UPLO, N, NB, KB, A, LDA, E, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block -* - IF( J+JB.LE.N ) - $ CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), - $ LDW, CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Set KB to the number of columns factorized * diff --git a/SRC/zlasyf_rook.f b/SRC/zlasyf_rook.f index 3d1c1c9cdd..b5b2f58288 100644 --- a/SRC/zlasyf_rook.f +++ b/SRC/zlasyf_rook.f @@ -208,7 +208,7 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * .. * .. Local Scalars .. LOGICAL DONE - INTEGER IMAX, ITEMP, J, JB, JJ, JMAX, JP1, JP2, K, KK, + INTEGER IMAX, ITEMP, J, JJ, JMAX, JP1, JP2, K, KK, $ KW, KKW, KP, KSTEP, P, II DOUBLE PRECISION ABSAKK, ALPHA, COLMAX, ROWMAX, DTEMP, SFMIN COMPLEX*16 D11, D12, D21, D22, R1, T, Z @@ -220,7 +220,7 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, EXTERNAL LSAME, IZAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGEMM, ZGEMV, ZSCAL, ZSWAP + EXTERNAL ZCOPY, ZGEMMTR, ZGEMV, ZSCAL, ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT, DIMAG, DBLE @@ -525,26 +525,11 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A11 := A11 - U12*D*U12**T = A11 - U12*W**T * -* computing blocks of NB columns at a time +* (note that conjg(W) is actually stored) * - DO 50 J = ( ( K-1 ) / NB )*NB + 1, 1, -NB - JB = MIN( NB, K-J+1 ) -* -* Update the upper triangle of the diagonal block -* - DO 40 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', JJ-J+1, N-K, -CONE, - $ A( J, K+1 ), LDA, W( JJ, KW+1 ), LDW, CONE, - $ A( J, JJ ), 1 ) - 40 CONTINUE -* -* Update the rectangular superdiagonal block -* - IF( J.GE.2 ) - $ CALL ZGEMM( 'No transpose', 'Transpose', J-1, JB, - $ N-K, -CONE, A( 1, K+1 ), LDA, W( J, KW+1 ), LDW, - $ CONE, A( 1, J ), LDA ) - 50 CONTINUE + CALL ZGEMMTR( 'Upper', 'No transpose', 'Transpose', K, N-K, + $ -CONE, A( 1, K+1 ), LDA, W( 1, KW+1 ), LDW, + $ CONE, A( 1, 1 ), LDA ) * * Put U12 in standard form by partially undoing the interchanges * in columns k+1:n @@ -846,26 +831,11 @@ SUBROUTINE ZLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, * * A22 := A22 - L21*D*L21**T = A22 - L21*W**T * -* computing blocks of NB columns at a time -* - DO 110 J = K, N, NB - JB = MIN( NB, N-J+1 ) -* -* Update the lower triangle of the diagonal block -* - DO 100 JJ = J, J + JB - 1 - CALL ZGEMV( 'No transpose', J+JB-JJ, K-1, -CONE, - $ A( JJ, 1 ), LDA, W( JJ, 1 ), LDW, CONE, - $ A( JJ, JJ ), 1 ) - 100 CONTINUE -* -* Update the rectangular subdiagonal block +* (note that conjg(W) is actually stored) * - IF( J+JB.LE.N ) - $ CALL ZGEMM( 'No transpose', 'Transpose', N-J-JB+1, JB, - $ K-1, -CONE, A( J+JB, 1 ), LDA, W( J, 1 ), LDW, - $ CONE, A( J+JB, J ), LDA ) - 110 CONTINUE + CALL ZGEMMTR( 'Lower', 'No transpose', 'Transpose', N-K+1, + $ K-1, -CONE, A( K, 1 ), LDA, W( K, 1 ), LDW, + $ CONE, A( K, K ), LDA ) * * Put L21 in standard form by partially undoing the interchanges * in columns 1:k-1 From 747d97113697f94bb9862df870f3212263ccf206 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Tue, 5 Nov 2024 22:27:13 +0100 Subject: [PATCH 189/206] [Github workflow] Bump scorecard version --- .github/workflows/scorecard.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/scorecard.yml b/.github/workflows/scorecard.yml index db98283837..99ab75d5ad 100644 --- a/.github/workflows/scorecard.yml +++ b/.github/workflows/scorecard.yml @@ -32,12 +32,12 @@ jobs: steps: - name: "Checkout code" - uses: actions/checkout@c85c95e3d7251135ab7dc9ce3241c5835cc595a9 # v3.5.3 + uses: actions/checkout@d632683dd7b4114ad314bca15554477dd762a938 # tag=v4.2.0 with: persist-credentials: false - name: "Run analysis" - uses: ossf/scorecard-action@08b4669551908b1024bb425080c797723083c031 # v2.2.0 + uses: ossf/scorecard-action@62b2cac7ed8198b15735ed49ab1e5cf35480ba46 # v2.4.0 with: results_file: results.sarif results_format: sarif @@ -59,7 +59,7 @@ jobs: # Upload the results as artifacts (optional). Commenting out will disable uploads of run results in SARIF # format to the repository Actions tab. - name: "Upload artifact" - uses: actions/upload-artifact@0b7f8abb1508181956e8e162db84b466c27e18ce # v3.1.2 + uses: actions/upload-artifact@b4b15b8c7c6ac21ea08fcf65892d2ee8f75cf882 # v4.4.3 with: name: SARIF file path: results.sarif @@ -67,6 +67,6 @@ jobs: # Upload the results to GitHub's code scanning dashboard. - name: "Upload to code-scanning" - uses: github/codeql-action/upload-sarif@f9a7c6738f28efb36e31d49c53a201a9c5d6a476 # v2.14.2 + uses: github/codeql-action/upload-sarif@662472033e021d55d94146f66f6058822b0b39fd # v3.27.0 with: sarif_file: results.sarif From 2534b59e3128640ec5ff0d0053423458d99dd0f6 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Fri, 22 Nov 2024 16:08:21 -0700 Subject: [PATCH 190/206] updating documentation to be more descriptive --- SRC/clarft.f | 210 +++++++++++++++++++++++++-------------------------- SRC/dlarft.f | 210 +++++++++++++++++++++++++-------------------------- SRC/slarft.f | 210 +++++++++++++++++++++++++-------------------------- SRC/zlarft.f | 210 +++++++++++++++++++++++++-------------------------- 4 files changed, 420 insertions(+), 420 deletions(-) diff --git a/SRC/clarft.f b/SRC/clarft.f index f1af5d3b33..08ef9cc224 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -235,7 +235,7 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * QR = DIRF.AND.COLV * -* LQ happens when we have Forward direction in row storage +* LQ happens when we have forward direction in row storage * LQ = DIRF.AND.(.NOT.COLV) * @@ -267,27 +267,27 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\C^{n-k,k-l} rectangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{l, l} upper triangular -* T_2\in\C^{k-l, k-l} upper triangular -* T_3\in\C^{l, k-l} rectangular +* T_{1,1}\in\C^{l, l} upper triangular +* T_{2,2}\in\C^{k-l, k-l} upper triangular +* T_{1,2}\in\C^{l, k-l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_1T_1V_1')(I - V_2T_2V_2') -* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* (I - V_1*T_{1,1}*V_1')*(I - V_2*T_{2,2}*V_2') +* = I - V_1*T_{1,1}*V_1' - V_2*T_{2,2}*V_2' + V_1*T_{1,1}*V_1'*V_2*T_{2,2}*V_2' * -* Define T_3 = -T_1V_1'V_2T_2 +* Define T{1,2} = -T_{1,1}*V_1'*V_2*T_{2,2} * * Then, we can define the matrix V as * V = |-------| @@ -295,21 +295,21 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,1}' +* Compute T_{1,2} +* T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L @@ -317,28 +317,28 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,2} +* T_{1,2} = T_{1,2}*V_{2,2} * CALL CTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{3,1}'V_{3,2} + T_3 +* T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1'V_2 -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1'*V_2 +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL CTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -362,25 +362,25 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * Where l = floor(k/2) * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{l, l} upper triangular -* T_2\in\C^{k-l, k-l} upper triangular -* T_3\in\C^{l, k-l} rectangular +* T_{1,1}\in\C^{l, l} upper triangular +* T_{2,2}\in\C^{k-l, k-l} upper triangular +* T_{1,2}\in\C^{l, k-l} rectangular * * Then, consider the product: * -* (I - V_1'T_1V_1)(I - V_2'T_2V_2) -* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* (I - V_1'*T_{1,1}*V_1)*(I - V_2'*T_{2,2}*V_2) +* = I - V_1'*T_{1,1}*V_1 - V_2'*T_{2,2}*V_2 + V_1'*T_{1,1}*V_1*V_2'*T_{2,2}*V_2 * -* Define T_3 = -T_1V_1V_2'T_2 +* Define T_{1,2} = -T_{1,1}*V_1*V_2'*T_{2,2} * * Then, we can define the matrix V as * V = |---| @@ -389,48 +389,48 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{1,2} +* Compute T_{1,2} +* T_{1,2} = V_{1,2} * CALL CLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) * -* T_3 = T_3V_{2,2}' +* T_{1,2} = T_{1,2}*V_{2,2}' * CALL CTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, $ V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{1,3}V_{2,3}' + T_3 +* T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1V_2' -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1*V_2' +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL CTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -452,27 +452,27 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\C^{l,l} unit upper triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{k-l, k-l} non-unit lower triangular -* T_2\in\C^{l, l} non-unit lower triangular -* T_3\in\C^{k-l, l} rectangular +* T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\C^{l, l} non-unit lower triangular +* T_{2,1}\in\C^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2T_2V_2')(I - V_1T_1V_1') -* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* (I - V_2*T_{2,2}*V_2')*(I - V_1*T_{1,1}*V_1') +* = I - V_2*T_{2,2}*V_2' - V_1*T_{1,1}*V_1' + V_2*T_{2,2}*V_2'*V_1*T_{1,1}*V_1' * -* Define T_3 = -T_2V_2'V_1T_1 +* Define T_{2,1} = -T_{2,2}*V_2'*V_1*T_{1,1} * * Then, we can define the matrix V as * V = |-------| @@ -480,21 +480,21 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL CLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2}' +* Compute T_{2,1} +* T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L @@ -502,28 +502,28 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,1} +* T_{2,1} = T_{2,1}*V_{2,1} * CALL CTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,2}'V_{2,1} + T_3 +* T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2'V_1 -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2'*V_1 +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL CTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL CTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) @@ -546,27 +546,27 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{2,3}\in\C^{l,l} unit lower triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{k-l, k-l} non-unit lower triangular -* T_2\in\C^{l, l} non-unit lower triangular -* T_3\in\C^{k-l, l} rectangular +* T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\C^{l, l} non-unit lower triangular +* T_{2,1}\in\C^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2'T_2V_2)(I - V_1'T_1V_1) -* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* (I - V_2'*T_{2,2}*V_2)*(I - V_1'*T_{1,1}*V_1) +* = I - V_2'*T_{2,2}*V_2 - V_1'*T_{1,1}*V_1 + V_2'*T_{2,2}*V_2*V_1'*T_{1,1}*V_1 * -* Define T_3 = -T_2V_2V_1'T_1 +* Define T_{2,1} = -T_{2,2}*V_2*V_1'*T_{1,1} * * Then, we can define the matrix V as * V = |---| @@ -575,50 +575,50 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL CLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2} +* Compute T_{2,1} +* T_{2,1} = V_{2,2} * CALL CLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), $ LDT) * -* T_3 = T_3V_{1,2}' +* T_{2,1} = T_{2,1}*V_{1,2}' * CALL CTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,1}V_{1,1}' + T_3 +* T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2V_1' -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2*V_1' +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL CTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL CTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ ONE, T, LDT, T(K-L+1,1), LDT) diff --git a/SRC/dlarft.f b/SRC/dlarft.f index d3f0b87454..66b8c3d922 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -231,7 +231,7 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * QR = DIRF.AND.COLV * -* LQ happens when we have Forward direction in row storage +* LQ happens when we have forward direction in row storage * LQ = DIRF.AND.(.NOT.COLV) * @@ -263,27 +263,27 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\R^{n-k,k-l} rectangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{l, l} upper triangular -* T_2\in\R^{k-l, k-l} upper triangular -* T_3\in\R^{l, k-l} rectangular +* T_{1,1}\in\R^{l, l} upper triangular +* T_{2,2}\in\R^{k-l, k-l} upper triangular +* T_{1,2}\in\R^{l, k-l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_1T_1V_1')(I - V_2T_2V_2') -* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* (I - V_1*T_{1,1}*V_1')*(I - V_2*T_{2,2}*V_2') +* = I - V_1*T_{1,1}*V_1' - V_2*T_{2,2}*V_2' + V_1*T_{1,1}*V_1'*V_2*T_{2,2}*V_2' * -* Define T_3 = -T_1V_1'V_2T_2 +* Define T_{1,2} = -T_{1,1}*V_1'*V_2*T_{2,2} * * Then, we can define the matrix V as * V = |-------| @@ -291,21 +291,21 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL DLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,1}' +* Compute T_{1,2} +* T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L @@ -313,28 +313,28 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,2} +* T_{1,2} = T_{1,2}*V_{2,2} * CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{3,1}'V_{3,2} + T_3 +* T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1'V_2 -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1'*V_2 +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -358,25 +358,25 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * Where l = floor(k/2) * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{l, l} upper triangular -* T_2\in\R^{k-l, k-l} upper triangular -* T_3\in\R^{l, k-l} rectangular +* T_{1,1}\in\R^{l, l} upper triangular +* T_{2,2}\in\R^{k-l, k-l} upper triangular +* T_{1,2}\in\R^{l, k-l} rectangular * * Then, consider the product: * -* (I - V_1'T_1V_1)(I - V_2'T_2V_2) -* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* (I - V_1'*T_{1,1}*V_1)*(I - V_2'*T_{2,2}*V_2) +* = I - V_1'*T_{1,1}*V_1 - V_2'*T_{2,2}*V_2 + V_1'*T_{1,1}*V_1*V_2'*T_{2,2}*V_2 * -* Define T_3 = -T_1V_1V_2'T_2 +* Define T_{1,2} = -T_{1,1}*V_1*V_2'*T_{2,2} * * Then, we can define the matrix V as * V = |---| @@ -385,48 +385,48 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL DLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{1,2} +* Compute T_{1,2} +* T_{1,2} = V_{1,2} * CALL DLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) * -* T_3 = T_3V_{2,2}' +* T_{1,2} = T_{1,2}*V_{2,2}' * CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, $ V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{1,3}V_{2,3}' + T_3 +* T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1V_2' -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1*V_2' +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -448,27 +448,27 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\R^{l,l} unit upper triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{k-l, k-l} non-unit lower triangular -* T_2\in\R^{l, l} non-unit lower triangular -* T_3\in\R^{k-l, l} rectangular +* T_{1,1}\in\R^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\R^{l, l} non-unit lower triangular +* T_{2,1}\in\R^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2T_2V_2')(I - V_1T_1V_1') -* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* (I - V_2*T_{2,2}*V_2')*(I - V_1*T_{1,1}*V_1') +* = I - V_2*T_{2,2}*V_2' - V_1*T_{1,1}*V_1' + V_2*T_{2,2}*V_2'*V_1*T_{1,1}*V_1' * -* Define T_3 = -T_2V_2'V_1T_1 +* Define T_{2,1} = -T_{2,2}*V_2'*V_1*T_{1,1} * * Then, we can define the matrix V as * V = |-------| @@ -476,21 +476,21 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL DLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL DLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2}' +* Compute T_{2,1} +* T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L @@ -498,28 +498,28 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,1} +* T_{2,1} = T_{2,1}*V_{2,1} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,2}'V_{2,1} + T_3 +* T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2'V_1 -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2'*V_1 +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL DTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) @@ -542,27 +542,27 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{2,3}\in\R^{l,l} unit lower triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{k-l, k-l} non-unit lower triangular -* T_2\in\R^{l, l} non-unit lower triangular -* T_3\in\R^{k-l, l} rectangular +* T_{1,1}\in\R^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\R^{l, l} non-unit lower triangular +* T_{2,1}\in\R^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2'T_2V_2)(I - V_1'T_1V_1) -* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* (I - V_2'*T_{2,2}*V_2)*(I - V_1'*T_{1,1}*V_1) +* = I - V_2'*T_{2,2}*V_2 - V_1'*T_{1,1}*V_1 + V_2'*T_{2,2}*V_2*V_1'*T_{1,1}*V_1 * -* Define T_3 = -T_2V_2V_1'T_1 +* Define T_{2,1} = -T_{2,2}*V_2*V_1'*T_{1,1} * * Then, we can define the matrix V as * V = |---| @@ -571,50 +571,50 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL DLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2} +* Compute T_{2,1} +* T_{2,1} = V_{2,2} * CALL DLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), $ LDT) * -* T_3 = T_3V_{1,2}' +* T_{2,1} = T_{2,1}*V_{1,2}' * CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,1}V_{1,1}' + T_3 +* T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2V_1' -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2*V_1' +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ ONE, T, LDT, T(K-L+1,1), LDT) diff --git a/SRC/slarft.f b/SRC/slarft.f index f6e647e470..449c4b5a75 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -127,7 +127,7 @@ * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver +*> \author Johnathan Rhyne, Univ. of Colorado Denver (original author, 2024) *> \author NAG Ltd. * *> \ingroup larft @@ -231,7 +231,7 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * QR = DIRF.AND.COLV * -* LQ happens when we have Forward direction in row storage +* LQ happens when we have forward direction in row storage * LQ = DIRF.AND.(.NOT.COLV) * @@ -263,27 +263,27 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\R^{n-k,k-l} rectangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{l, l} upper triangular -* T_2\in\R^{k-l, k-l} upper triangular -* T_3\in\R^{l, k-l} rectangular +* T_{1,1}\in\R^{l, l} upper triangular +* T_{2,2}\in\R^{k-l, k-l} upper triangular +* T_{1,2}\in\R^{l, k-l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_1T_1V_1')(I - V_2T_2V_2') -* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* (I - V_1*T_{1,1}*V_1')*(I - V_2*T_{2,2}*V_2') +* = I - V_1*T_{1,1}*V_1' - V_2*T_{2,2}*V_2' + V_1*T_{1,1}*V_1'*V_2*T_{2,2}*V_2' * -* Define T_3 = -T_1V_1'V_2T_2 +* Define T_{1,2} = -T_{1,1}*V_1'*V_2*T_{2,2} * * Then, we can define the matrix V as * V = |-------| @@ -291,21 +291,21 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL SLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,1}' +* Compute T_{1,2} +* T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L @@ -313,28 +313,28 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,2} +* T_{1,2} = T_{1,2}*V_{2,2} * CALL STRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{3,1}'V_{3,2} + T_3 +* T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1'V_2 -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1'*V_2 +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -358,25 +358,25 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * Where l = floor(k/2) * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{l, l} upper triangular -* T_2\in\R^{k-l, k-l} upper triangular -* T_3\in\R^{l, k-l} rectangular +* T_{1,1}\in\R^{l, l} upper triangular +* T_{2,2}\in\R^{k-l, k-l} upper triangular +* T_{1,2}\in\R^{l, k-l} rectangular * * Then, consider the product: * -* (I - V_1'T_1V_1)(I - V_2'T_2V_2) -* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* (I - V_1'*T_{1,1}*V_1)*(I - V_2'*T_{2,2}*V_2) +* = I - V_1'*T_{1,1}*V_1 - V_2'*T_{2,2}*V_2 + V_1'*T_{1,1}*V_1*V_2'*T_{2,2}*V_2 * -* Define T_3 = -T_1V_1V_2'T_2 +* Define T_{1,2} = -T_{1,1}*V_1*V_2'*T_{2,2} * * Then, we can define the matrix V as * V = |---| @@ -385,48 +385,48 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL SLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{1,2} +* Compute T_{1,2} +* T_{1,2} = V_{1,2} * CALL SLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) * -* T_3 = T_3V_{2,2}' +* T_{1,2} = T_{1,2}*V_{2,2}' * CALL STRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, $ V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{1,3}V_{2,3}' + T_3 +* T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1V_2' -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1*V_2' +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -448,27 +448,27 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\R^{l,l} unit upper triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{k-l, k-l} non-unit lower triangular -* T_2\in\R^{l, l} non-unit lower triangular -* T_3\in\R^{k-l, l} rectangular +* T_{1,1}\in\R^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\R^{l, l} non-unit lower triangular +* T_{2,1}\in\R^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2T_2V_2')(I - V_1T_1V_1') -* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* (I - V_2*T_{2,2}*V_2')*(I - V_1*T_{1,1}*V_1') +* = I - V_2*T_{2,2}*V_2' - V_1*T_{1,1}*V_1' + V_2*T_{2,2}*V_2'*V_1*T_{1,1}*V_1' * -* Define T_3 = -T_2V_2'V_1T_1 +* Define T_{2,1} = -T_{2,2}*V_2'*V_1*T_{1,1} * * Then, we can define the matrix V as * V = |-------| @@ -476,21 +476,21 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL SLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL SLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2}' +* Compute T_{2,1} +* T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L @@ -498,28 +498,28 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,1} +* T_{2,1} = T_{2,1}*V_{2,1} * CALL STRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,2}'V_{2,1} + T_3 +* T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2'V_1 -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2'*V_1 +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL STRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL STRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) @@ -542,27 +542,27 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{2,3}\in\R^{l,l} unit lower triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\R^{k-l, k-l} non-unit lower triangular -* T_2\in\R^{l, l} non-unit lower triangular -* T_3\in\R^{k-l, l} rectangular +* T_{1,1}\in\R^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\R^{l, l} non-unit lower triangular +* T_{2,1}\in\R^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2'T_2V_2)(I - V_1'T_1V_1) -* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* (I - V_2'*T_{2,2}*V_2)*(I - V_1'*T_{1,1}*V_1) +* = I - V_2'*T_{2,2}*V_2 - V_1'*T_{1,1}*V_1 + V_2'*T_{2,2}*V_2*V_1'*T_{1,1}*V_1 * -* Define T_3 = -T_2V_2V_1'T_1 +* Define T_{2,1} = -T_{2,2}*V_2*V_1'*T_{1,1} * * Then, we can define the matrix V as * V = |---| @@ -572,49 +572,49 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * So, our product is equivalent to the matrix product * I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL SLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL SLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2} +* Compute T_{2,1} +* T_{2,1} = V_{2,2} * CALL SLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), $ LDT) * -* T_3 = T_3V_{1,2}' +* T_{2,1} = T_{2,1}*V_{1,2}' * CALL STRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,1}V_{1,1}' + T_3 +* T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2V_1' -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2*V_1' +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL STRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL STRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ ONE, T, LDT, T(K-L+1,1), LDT) diff --git a/SRC/zlarft.f b/SRC/zlarft.f index eaada56253..bccb4325e9 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -235,7 +235,7 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * QR = DIRF.AND.COLV * -* LQ happens when we have Forward direction in row storage +* LQ happens when we have forward direction in row storage * LQ = DIRF.AND.(.NOT.COLV) * @@ -267,27 +267,27 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\C^{n-k,k-l} rectangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{l, l} upper triangular -* T_2\in\C^{k-l, k-l} upper triangular -* T_3\in\C^{l, k-l} rectangular +* T_{1,1}\in\C^{l, l} upper triangular +* T_{2,2}\in\C^{k-l, k-l} upper triangular +* T_{1,2}\in\C^{l, k-l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_1T_1V_1')(I - V_2T_2V_2') -* = I - V_1T_1V_1' - V_2T_2V_2' + V_1T_1V_1'V_2T_2V_2' +* (I - V_1*T_{1,1}*V_1')*(I - V_2*T_{2,2}*V_2') +* = I - V_1*T_{1,1}*V_1' - V_2*T_{2,2}*V_2' + V_1*T_{1,1}*V_1'*V_2*T_{2,2}*V_2' * -* Define T_3 = -T_1V_1'V_2T_2 +* Define T_{1,2} = -T_{1,1}*V_1'*V_2*T_{2,2} * * Then, we can define the matrix V as * V = |-------| @@ -295,21 +295,21 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,1}' +* Compute T_{1,2} +* T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L @@ -317,28 +317,28 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,2} +* T_{1,2} = T_{1,2}*V_{2,2} * CALL ZTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{3,1}'V_{3,2} + T_3 +* T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1'V_2 -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1'*V_2 +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -362,25 +362,25 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * Where l = floor(k/2) * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} T_{1,2}| |T_1 T_3| -* |0 T_{2,2}| |0 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} T_{1,2}| +* |0 T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{l, l} upper triangular -* T_2\in\C^{k-l, k-l} upper triangular -* T_3\in\C^{l, k-l} rectangular +* T_{1,1}\in\C^{l, l} upper triangular +* T_{2,2}\in\C^{k-l, k-l} upper triangular +* T_{1,2}\in\C^{l, k-l} rectangular * * Then, consider the product: * -* (I - V_1'T_1V_1)(I - V_2'T_2V_2) -* = I - V_1'T_1V_1 - V_2'T_2V_2 + V_1'T_1V_1V_2'T_2V_2 +* (I - V_1'*T_{1,1}*V_1)*(I - V_2'*T_{2,2}*V_2) +* = I - V_1'*T_{1,1}*V_1 - V_2'*T_{2,2}*V_2 + V_1'*T_{1,1}*V_1*V_2'*T_{2,2}*V_2 * -* Define T_3 = -T_1V_1V_2'T_2 +* Define T_{1,2} = -T_{1,1}*V_1*V_2'*T_{2,2} * * Then, we can define the matrix V as * V = |---| @@ -389,48 +389,48 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{1,2} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL ZLARFT(DIRECT, STOREV, N, L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, $ TAU(L+1), T(L+1,L+1), LDT) * -* Compute T_3 -* T_3 = V_{1,2} +* Compute T_{1,2} +* T_{1,2} = V_{1,2} * CALL ZLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) * -* T_3 = T_3V_{2,2}' +* T_{1,2} = T_{1,2}*V_{2,2}' * CALL ZTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, $ V(L+1, L+1), LDV, T(1, L+1), LDT) * -* T_3 = V_{1,3}V_{2,3}' + T_3 +* T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) * -* At this point, we have that T_3 = V_1V_2' -* All that is left is to pre and post multiply by -T_1 and T_2 +* At this point, we have that T_{1,2} = V_1*V_2' +* All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} * respectively. * -* T_3 = -T_1T_3 +* T_{1,2} = -T_{1,1}*T_{1,2} * CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T, LDT, T(1, L+1), LDT) * -* T_3 = T_3T_2 +* T_{1,2} = T_{1,2}*T_{2,2} * CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) @@ -452,27 +452,27 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{3,2}\in\C^{l,l} unit upper triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{k-l, k-l} non-unit lower triangular -* T_2\in\C^{l, l} non-unit lower triangular -* T_3\in\C^{k-l, l} rectangular +* T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\C^{l, l} non-unit lower triangular +* T_{2,1}\in\C^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2T_2V_2')(I - V_1T_1V_1') -* = I - V_2T_2V_2' - V_1T_1V_1' + V_2T_2V_2'V_1T_1V_1' +* (I - V_2*T_{2,2}*V_2')*(I - V_1*T_{1,1}*V_1') +* = I - V_2*T_{2,2}*V_2' - V_1*T_{1,1}*V_1' + V_2*T_{2,2}*V_2'*V_1*T_{1,1}*V_1' * -* Define T_3 = -T_2V_2'V_1T_1 +* Define T_{2,1} = -T_{2,2}*V_2'*V_1*T_{1,1} * * Then, we can define the matrix V as * V = |-------| @@ -480,21 +480,21 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |-------| * * So, our product is equivalent to the matrix product -* I - VTV' -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V*T*V' +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL ZLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2}' +* Compute T_{2,1} +* T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L @@ -502,28 +502,28 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, END DO END DO * -* T_3 = T_3V_{2,1} +* T_{2,1} = T_{2,1}*V_{2,1} * CALL ZTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,2}'V_{2,1} + T_3 +* T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2'V_1 -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2'*V_1 +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL ZTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL ZTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) @@ -546,27 +546,27 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * V_{2,3}\in\C^{l,l} unit lower triangular * * We will construct the T matrix -* T = |---------------| = |--------| -* |T_{1,1} 0 | |T_1 0 | -* |T_{2,1} T_{2,2}| |T_3 T_2| -* |---------------| |--------| +* T = |---------------| +* |T_{1,1} 0 | +* |T_{2,1} T_{2,2}| +* |---------------| * -* T is the triangular factor attained from block reflectors. -* To motivate the structure, assume we have already computed T_1 -* and T_2. Then collect the associated reflectors in V_1 and V_2 +* T is the triangular factor obtained from block reflectors. +* To motivate the structure, assume we have already computed T_{1,1} +* and T_{2,2}. Then collect the associated reflectors in V_1 and V_2 * -* T_1\in\C^{k-l, k-l} non-unit lower triangular -* T_2\in\C^{l, l} non-unit lower triangular -* T_3\in\C^{k-l, l} rectangular +* T_{1,1}\in\C^{k-l, k-l} non-unit lower triangular +* T_{2,2}\in\C^{l, l} non-unit lower triangular +* T_{2,1}\in\C^{k-l, l} rectangular * * Where l = floor(k/2) * * Then, consider the product: * -* (I - V_2'T_2V_2)(I - V_1'T_1V_1) -* = I - V_2'T_2V_2 - V_1'T_1V_1 + V_2'T_2V_2V_1'T_1V_1 +* (I - V_2'*T_{2,2}*V_2)*(I - V_1'*T_{1,1}*V_1) +* = I - V_2'*T_{2,2}*V_2 - V_1'*T_{1,1}*V_1 + V_2'*T_{2,2}*V_2*V_1'*T_{1,1}*V_1 * -* Define T_3 = -T_2V_2V_1'T_1 +* Define T_{2,1} = -T_{2,2}*V_2*V_1'*T_{1,1} * * Then, we can define the matrix V as * V = |---| @@ -575,50 +575,50 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * |---| * * So, our product is equivalent to the matrix product -* I - V'TV -* This means, we can compute T_1 and T_2, then use this information -* to compute T_3 +* I - V'*T*V +* This means, we can compute T_{1,1} and T_{2,2}, then use this information +* to compute T_{2,1} * -* Compute T_1 recursively +* Compute T_{1,1} recursively * CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V, LDV, TAU, T, LDT) * -* Compute T_2 recursively +* Compute T_{2,2} recursively * CALL ZLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), $ T(K-L+1,K-L+1), LDT) * -* Compute T_3 -* T_3 = V_{2,2} +* Compute T_{2,1} +* T_{2,1} = V_{2,2} * CALL ZLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), $ LDT) * -* T_3 = T_3V_{1,2}' +* T_{2,1} = T_{2,1}*V_{1,2}' * CALL ZTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) * -* T_3 = V_{2,1}V_{1,1}' + T_3 +* T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) * -* At this point, we have that T_3 = V_2V_1' -* All that is left is to pre and post multiply by -T_2 and T_1 +* At this point, we have that T_{2,1} = V_2*V_1' +* All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} * respectively. * -* T_3 = -T_2T_3 +* T_{2,1} = -T_{2,2}*T_{2,1} * CALL ZTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * -* T_3 = T_3T_1 +* T_{2,1} = T_{2,1}*T_{1,1} * CALL ZTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, $ ONE, T, LDT, T(K-L+1,1), LDT) From 3f9b12c4caf43b0d220fc9018aa7b7e15bf023c5 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:10:45 +0100 Subject: [PATCH 191/206] The extended API needs extra space for _64 For the extended API subroutine names are extended with _64 (e.g. CGEGS becomes CGEGS_64). Extra space is needed so that the extension does not violate Fortran line length conventions. --- SRC/DEPRECATED/cgegs.f | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/SRC/DEPRECATED/cgegs.f b/SRC/DEPRECATED/cgegs.f index b6adf91118..62fdcb145e 100644 --- a/SRC/DEPRECATED/cgegs.f +++ b/SRC/DEPRECATED/cgegs.f @@ -219,9 +219,9 @@ *> \ingroup complexGEeigen * * ===================================================================== - SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, - $ VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK, - $ INFO ) + SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, + $ BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, + $ RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILASCL ) THEN - CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -380,7 +381,8 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -493,12 +495,14 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, * Undo scaling * IF( ILASCL ) THEN - CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, IINFO ) + CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -506,12 +510,14 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN From 47f3d2ae07d3b786efc71ee4ef21191c94634657 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:21:28 +0100 Subject: [PATCH 192/206] Add extra space for extended API --- SRC/DEPRECATED/cgelsx.f | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/SRC/DEPRECATED/cgelsx.f b/SRC/DEPRECATED/cgelsx.f index 54c7f58b7d..9faffeb711 100644 --- a/SRC/DEPRECATED/cgelsx.f +++ b/SRC/DEPRECATED/cgelsx.f @@ -179,8 +179,8 @@ *> \ingroup complexGEsolve * * ===================================================================== - SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, RWORK, INFO ) + SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -420,18 +420,22 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE From 97c78455111bccb2903862ebb9795ab9cb6c9344 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:23:28 +0100 Subject: [PATCH 193/206] And once more. --- SRC/DEPRECATED/cgelsx.f | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/SRC/DEPRECATED/cgelsx.f b/SRC/DEPRECATED/cgelsx.f index 9faffeb711..b55fe1565b 100644 --- a/SRC/DEPRECATED/cgelsx.f +++ b/SRC/DEPRECATED/cgelsx.f @@ -294,13 +294,15 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, * * Scale matrix norm up to SMLNUM * - CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * From 494425c908416cabaea2a3b704be2ab03aa88486 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:29:49 +0100 Subject: [PATCH 194/206] Add extra space for extended API --- SRC/DEPRECATED/cggsvp.f | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/SRC/DEPRECATED/cggsvp.f b/SRC/DEPRECATED/cggsvp.f index f919a55114..00903fa887 100644 --- a/SRC/DEPRECATED/cggsvp.f +++ b/SRC/DEPRECATED/cggsvp.f @@ -382,7 +382,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -444,8 +445,9 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), - $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) + CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, + $ MIN( M, N-L ), A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, + $ INFO ) * IF( WANTU ) THEN * @@ -453,8 +455,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL CLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) + $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) CALL CUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF * @@ -474,7 +476,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -511,9 +514,9 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL CUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL CUNM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up From 97e39473f39eb3a61ceb53a6dd0c694c84219f2a Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:36:07 +0100 Subject: [PATCH 195/206] Add extra space for extended API --- SRC/DEPRECATED/clahrd.f | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/SRC/DEPRECATED/clahrd.f b/SRC/DEPRECATED/clahrd.f index a9445f3641..6d0e02eb92 100644 --- a/SRC/DEPRECATED/clahrd.f +++ b/SRC/DEPRECATED/clahrd.f @@ -236,13 +236,14 @@ SUBROUTINE CLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**H *w * - CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1, - $ T, LDT, T( 1, NB ), 1 ) + CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ I-1, T, LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -263,20 +264,20 @@ SUBROUTINE CLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE, $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ), $ 1 ) - CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, + $ T( 1, I ), 1, ONE, Y( 1, I ), 1 ) CALL CSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL CSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE From 76361efae0894fb913e0e26813b6db0452fc0b73 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:38:40 +0100 Subject: [PATCH 196/206] Add extra space for extended API --- SRC/DEPRECATED/clatzm.f | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/SRC/DEPRECATED/clatzm.f b/SRC/DEPRECATED/clatzm.f index 160b58a082..ffad13e477 100644 --- a/SRC/DEPRECATED/clatzm.f +++ b/SRC/DEPRECATED/clatzm.f @@ -148,7 +148,8 @@ *> \ingroup latzm * * ===================================================================== - SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -206,8 +207,8 @@ SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL CCOPY( M, C1, 1, WORK, 1 ) - CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H] * From 37e4061ec46520ede467c191981894982c241365 Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 12:41:58 +0100 Subject: [PATCH 197/206] Add extra space for extended API --- SRC/DEPRECATED/ctzrqf.f | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/SRC/DEPRECATED/ctzrqf.f b/SRC/DEPRECATED/ctzrqf.f index 0f83dd6dc0..5da7c3c903 100644 --- a/SRC/DEPRECATED/ctzrqf.f +++ b/SRC/DEPRECATED/ctzrqf.f @@ -217,14 +217,15 @@ SUBROUTINE CTZRQF( M, N, A, LDA, TAU, INFO ) * * Form w = a( k ) + B*z( k ) in TAU. * - CALL CGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ), - $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 ) + CALL CGEMV( 'No transpose', K-1, N-M, CONE, + $ A( 1, M1 ), LDA, A( K, M1 ), LDA, CONE, + $ TAU, 1 ) * * Now form a( k ) := a( k ) - conjg(tau)*w * and B := B - conjg(tau)*w*z( k )**H. * - CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, A( 1, K ), - $ 1 ) + CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, + $ A( 1, K ), 1 ) CALL CGERC( K-1, N-M, -CONJG( TAU( K ) ), TAU, 1, $ A( K, M1 ), LDA, A( 1, M1 ), LDA ) END IF From 0e4c25b00e06d8cab59af11ccc5f6552b7b76b8b Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 15:28:34 +0100 Subject: [PATCH 198/206] Adding extra space for extended API --- SRC/DEPRECATED/cggsvp.f | 8 ++++---- SRC/DEPRECATED/dgegs.f | 15 ++++++++++----- SRC/DEPRECATED/dgegv.f | 5 +++-- SRC/DEPRECATED/dgelqs.f | 11 ++++++----- SRC/DEPRECATED/dgelsx.f | 29 ++++++++++++++++++----------- SRC/DEPRECATED/dgeqpf.f | 7 ++++--- SRC/DEPRECATED/dggsvp.f | 24 +++++++++++++----------- SRC/DEPRECATED/dlahrd.f | 21 +++++++++++---------- SRC/DEPRECATED/dlatzm.f | 7 ++++--- SRC/DEPRECATED/dtzrqf.f | 7 ++++--- SRC/DEPRECATED/sgegs.f | 15 ++++++++++----- SRC/DEPRECATED/sgegv.f | 5 +++-- SRC/DEPRECATED/sgelqs.f | 11 ++++++----- SRC/DEPRECATED/sgelsx.f | 33 ++++++++++++++++++++------------- SRC/DEPRECATED/sgeqpf.f | 7 ++++--- SRC/DEPRECATED/sggsvp.f | 21 +++++++++++---------- SRC/DEPRECATED/slahrd.f | 33 +++++++++++++++++---------------- SRC/DEPRECATED/slatzm.f | 7 ++++--- SRC/DEPRECATED/stzrqf.f | 7 ++++--- SRC/DEPRECATED/zgegs.f | 24 +++++++++++++++--------- SRC/DEPRECATED/zgelsx.f | 34 ++++++++++++++++++++-------------- SRC/DEPRECATED/zggsvp.f | 32 ++++++++++++++++++-------------- SRC/DEPRECATED/zlahrd.f | 21 +++++++++++---------- SRC/DEPRECATED/zlatzm.f | 7 ++++--- SRC/DEPRECATED/ztzrqf.f | 9 +++++---- 25 files changed, 229 insertions(+), 171 deletions(-) diff --git a/SRC/DEPRECATED/cggsvp.f b/SRC/DEPRECATED/cggsvp.f index 00903fa887..d5c855c5b5 100644 --- a/SRC/DEPRECATED/cggsvp.f +++ b/SRC/DEPRECATED/cggsvp.f @@ -401,8 +401,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, - $ TAU, A, LDA, WORK, INFO ) + CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * * Update Q := Q*Z**H @@ -489,8 +489,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, - $ LDA, TAU, Q, LDQ, WORK, INFO ) + CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, LDA, TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A diff --git a/SRC/DEPRECATED/dgegs.f b/SRC/DEPRECATED/dgegs.f index 02e9fdcb21..9e4df7e10b 100644 --- a/SRC/DEPRECATED/dgegs.f +++ b/SRC/DEPRECATED/dgegs.f @@ -358,7 +358,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILASCL ) THEN - CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -378,7 +379,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -496,7 +498,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, * Undo scaling * IF( ILASCL ) THEN - CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -516,12 +519,14 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/dgegv.f b/SRC/DEPRECATED/dgegv.f index 0b5c489222..0bbb8ca820 100644 --- a/SRC/DEPRECATED/dgegv.f +++ b/SRC/DEPRECATED/dgegv.f @@ -301,8 +301,9 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, - $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) + SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/DEPRECATED/dgelqs.f b/SRC/DEPRECATED/dgelqs.f index ecbb5893c3..dc08f2398b 100644 --- a/SRC/DEPRECATED/dgelqs.f +++ b/SRC/DEPRECATED/dgelqs.f @@ -174,18 +174,19 @@ SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, * * Solve L*X = B(1:m,:) * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS, - $ ONE, A, LDA, B, LDB ) + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, ONE, A, LDA, B, LDB ) * * Set B(m+1:n,:) to zero * IF( M.LT.N ) - $ CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB ) + $ CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), + $ LDB ) * * B := Q' * B * - CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB, - $ WORK, LWORK, INFO ) + CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, + $ LDB, WORK, LWORK, INFO ) * RETURN * diff --git a/SRC/DEPRECATED/dgelsx.f b/SRC/DEPRECATED/dgelsx.f index 548cf67123..8dfcbc698a 100644 --- a/SRC/DEPRECATED/dgelsx.f +++ b/SRC/DEPRECATED/dgelsx.f @@ -173,8 +173,8 @@ *> \ingroup doubleGEsolve * * ===================================================================== - SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, INFO ) + SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -283,20 +283,23 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO ) + CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ INFO ) * * workspace 3*N. Details of Householder rotations stored * in WORK(1:MN). @@ -350,8 +353,8 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), - $ B, LDB, WORK( 2*MN+1 ), INFO ) + CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * @@ -408,18 +411,22 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/dgeqpf.f b/SRC/DEPRECATED/dgeqpf.f index 69f9542acb..36f6fb50e9 100644 --- a/SRC/DEPRECATED/dgeqpf.f +++ b/SRC/DEPRECATED/dgeqpf.f @@ -253,7 +253,8 @@ SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * Generate elementary reflector H(i) * IF( I.LT.M ) THEN - CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) ) + CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, + $ TAU( I ) ) ELSE CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) ) END IF @@ -264,8 +265,8 @@ SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK( 2*N+1 ) ) + CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, + $ TAU( I ), A( I, I+1 ), LDA, WORK( 2*N+1 ) ) A( I, I ) = AII END IF * diff --git a/SRC/DEPRECATED/dggsvp.f b/SRC/DEPRECATED/dggsvp.f index 87a2fd670c..cef3b47524 100644 --- a/SRC/DEPRECATED/dggsvp.f +++ b/SRC/DEPRECATED/dggsvp.f @@ -392,8 +392,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, - $ LDQ, WORK, INFO ) + CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, LDQ, WORK, INFO ) END IF * * Clean up B @@ -439,9 +439,10 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL DLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) - CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) + $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) + CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, + $ INFO ) END IF * IF( WANTQ ) THEN @@ -460,7 +461,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -472,8 +474,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, - $ Q, LDQ, WORK, INFO ) + CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -497,9 +499,9 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL DORM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/dlahrd.f b/SRC/DEPRECATED/dlahrd.f index 59406b7de7..2f86da73c0 100644 --- a/SRC/DEPRECATED/dlahrd.f +++ b/SRC/DEPRECATED/dlahrd.f @@ -221,8 +221,8 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * w := V1**T * b1 * CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) - CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ), - $ LDA, T( 1, NB ), 1 ) + CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, + $ A( K+1, 1 ), LDA, T( 1, NB ), 1 ) * * w := w + V2**T *b2 * @@ -236,8 +236,9 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * b2 := b2 - V2*w * - CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -258,12 +259,12 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA, - $ A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), + $ LDA, A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) + CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL DSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) diff --git a/SRC/DEPRECATED/dlatzm.f b/SRC/DEPRECATED/dlatzm.f index 1e8cc9f57f..5cb985d654 100644 --- a/SRC/DEPRECATED/dlatzm.f +++ b/SRC/DEPRECATED/dlatzm.f @@ -147,7 +147,8 @@ *> \ingroup doubleOTHERcomputational * * ===================================================================== - SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -202,8 +203,8 @@ SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL DCOPY( M, C1, 1, WORK, 1 ) - CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T] * diff --git a/SRC/DEPRECATED/dtzrqf.f b/SRC/DEPRECATED/dtzrqf.f index efd7c2497a..75f30d4804 100644 --- a/SRC/DEPRECATED/dtzrqf.f +++ b/SRC/DEPRECATED/dtzrqf.f @@ -194,7 +194,8 @@ SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO ) * Use a Householder reflection to zero the kth row of A. * First set up the reflection. * - CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) ) + CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, + $ TAU( K ) ) * IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN * @@ -216,8 +217,8 @@ SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO ) * and B := B - tau*w*z( k )**T. * CALL DAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 ) - CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA, - $ A( 1, M1 ), LDA ) + CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), + $ LDA, A( 1, M1 ), LDA ) END IF 20 CONTINUE END IF diff --git a/SRC/DEPRECATED/sgegs.f b/SRC/DEPRECATED/sgegs.f index 11ecc67acb..c45ddca1d8 100644 --- a/SRC/DEPRECATED/sgegs.f +++ b/SRC/DEPRECATED/sgegs.f @@ -358,7 +358,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILASCL ) THEN - CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -378,7 +379,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -496,7 +498,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, * Undo scaling * IF( ILASCL ) THEN - CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -516,12 +519,14 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/sgegv.f b/SRC/DEPRECATED/sgegv.f index 97556e3711..005af7589d 100644 --- a/SRC/DEPRECATED/sgegv.f +++ b/SRC/DEPRECATED/sgegv.f @@ -301,8 +301,9 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, - $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) + SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/DEPRECATED/sgelqs.f b/SRC/DEPRECATED/sgelqs.f index 83afb4690b..330d4d5850 100644 --- a/SRC/DEPRECATED/sgelqs.f +++ b/SRC/DEPRECATED/sgelqs.f @@ -174,18 +174,19 @@ SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, * * Solve L*X = B(1:m,:) * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS, - $ ONE, A, LDA, B, LDB ) + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, ONE, A, LDA, B, LDB ) * * Set B(m+1:n,:) to zero * IF( M.LT.N ) - $ CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB ) + $ CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), + $ LDB ) * * B := Q' * B * - CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB, - $ WORK, LWORK, INFO ) + CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, + $ LDB, WORK, LWORK, INFO ) * RETURN * diff --git a/SRC/DEPRECATED/sgelsx.f b/SRC/DEPRECATED/sgelsx.f index 2f132399b9..b3920d523c 100644 --- a/SRC/DEPRECATED/sgelsx.f +++ b/SRC/DEPRECATED/sgelsx.f @@ -173,8 +173,8 @@ *> \ingroup realGEsolve * * ===================================================================== - SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, INFO ) + SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -283,20 +283,23 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO ) + CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ INFO ) * * workspace 3*N. Details of Householder rotations stored * in WORK(1:MN). @@ -350,15 +353,15 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), - $ B, LDB, WORK( 2*MN+1 ), INFO ) + CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * * B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS) * - CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK, - $ NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', + $ RANK, NRHS, ONE, A, LDA, B, LDB ) * DO 40 I = RANK + 1, N DO 30 J = 1, NRHS @@ -408,18 +411,22 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/sgeqpf.f b/SRC/DEPRECATED/sgeqpf.f index f5a2494691..7963bd8e7e 100644 --- a/SRC/DEPRECATED/sgeqpf.f +++ b/SRC/DEPRECATED/sgeqpf.f @@ -253,7 +253,8 @@ SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * Generate elementary reflector H(i) * IF( I.LT.M ) THEN - CALL SLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) ) + CALL SLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, + $ TAU( I ) ) ELSE CALL SLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) ) END IF @@ -264,8 +265,8 @@ SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK( 2*N+1 ) ) + CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, + $ TAU( I ), A( I, I+1 ), LDA, WORK( 2*N+1 ) ) A( I, I ) = AII END IF * diff --git a/SRC/DEPRECATED/sggsvp.f b/SRC/DEPRECATED/sggsvp.f index 4ecebdf14e..33fe6edb4f 100644 --- a/SRC/DEPRECATED/sggsvp.f +++ b/SRC/DEPRECATED/sggsvp.f @@ -392,8 +392,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, - $ LDQ, WORK, INFO ) + CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, LDQ, WORK, INFO ) END IF * * Clean up B @@ -439,8 +439,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL SLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) + $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) CALL SORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF * @@ -460,7 +460,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -472,8 +473,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, - $ Q, LDQ, WORK, INFO ) + CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -497,9 +498,9 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL SORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL SORM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/slahrd.f b/SRC/DEPRECATED/slahrd.f index e7989b8eb8..63cf160b3a 100644 --- a/SRC/DEPRECATED/slahrd.f +++ b/SRC/DEPRECATED/slahrd.f @@ -221,8 +221,8 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * w := V1**T * b1 * CALL SCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) - CALL STRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ), - $ LDA, T( 1, NB ), 1 ) + CALL STRMV( 'Lower', 'Transpose', 'Unit', I-1, + $ A( K+1, 1 ), LDA, T( 1, NB ), 1 ) * * w := w + V2**T *b2 * @@ -231,13 +231,14 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**T *w * - CALL STRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, NB ), 1 ) + CALL STRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL SGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL SGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -251,26 +252,26 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(i) to annihilate * A(k+i+1:n,i) * - CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, - $ TAU( I ) ) + CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE * * Compute Y(1:n,i) * - CALL SGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA, - $ A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL SGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), + $ LDA, A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) + CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL SSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL SSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE diff --git a/SRC/DEPRECATED/slatzm.f b/SRC/DEPRECATED/slatzm.f index bb24c281ba..4e3088427f 100644 --- a/SRC/DEPRECATED/slatzm.f +++ b/SRC/DEPRECATED/slatzm.f @@ -147,7 +147,8 @@ *> \ingroup realOTHERcomputational * * ===================================================================== - SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -202,8 +203,8 @@ SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL SCOPY( M, C1, 1, WORK, 1 ) - CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T] * diff --git a/SRC/DEPRECATED/stzrqf.f b/SRC/DEPRECATED/stzrqf.f index c2f55f367c..170798c777 100644 --- a/SRC/DEPRECATED/stzrqf.f +++ b/SRC/DEPRECATED/stzrqf.f @@ -194,7 +194,8 @@ SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO ) * Use a Householder reflection to zero the kth row of A. * First set up the reflection. * - CALL SLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) ) + CALL SLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, + $ TAU( K ) ) * IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN * @@ -216,8 +217,8 @@ SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO ) * and B := B - tau*w*z( k )**T. * CALL SAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 ) - CALL SGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA, - $ A( 1, M1 ), LDA ) + CALL SGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), + $ LDA, A( 1, M1 ), LDA ) END IF 20 CONTINUE END IF diff --git a/SRC/DEPRECATED/zgegs.f b/SRC/DEPRECATED/zgegs.f index 23f8d43d18..9ee4dac035 100644 --- a/SRC/DEPRECATED/zgegs.f +++ b/SRC/DEPRECATED/zgegs.f @@ -219,9 +219,9 @@ *> \ingroup complex16GEeigen * * ===================================================================== - SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, - $ VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK, - $ INFO ) + SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, + $ BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, + $ RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILASCL ) THEN - CALL ZLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL ZLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -380,7 +381,8 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL ZLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL ZLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -493,12 +495,14 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, * Undo scaling * IF( ILASCL ) THEN - CALL ZLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL ZLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL ZLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, IINFO ) + CALL ZLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -506,12 +510,14 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL ZLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL ZLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL ZLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL ZLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/zgelsx.f b/SRC/DEPRECATED/zgelsx.f index a879381968..e82fdb9bb0 100644 --- a/SRC/DEPRECATED/zgelsx.f +++ b/SRC/DEPRECATED/zgelsx.f @@ -179,8 +179,8 @@ *> \ingroup complex16GEsolve * * ===================================================================== - SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, RWORK, INFO ) + SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -294,21 +294,23 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL ZGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), RWORK, - $ INFO ) + CALL ZGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ RWORK, INFO ) * * complex workspace MN+N. Real workspace 2*N. Details of Householder * rotations stored in WORK(1:MN). @@ -362,8 +364,8 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL ZUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA, - $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) + CALL ZUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, + $ LDA, WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * @@ -382,8 +384,8 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * IF( RANK.LT.N ) THEN DO 50 I = 1, RANK - CALL ZLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), LDA, - $ DCONJG( WORK( MN+I ) ), B( I, 1 ), + CALL ZLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), + $ LDA, DCONJG( WORK( MN+I ) ), B( I, 1 ), $ B( RANK+1, 1 ), LDB, WORK( 2*MN+1 ) ) 50 CONTINUE END IF @@ -420,18 +422,22 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/zggsvp.f b/SRC/DEPRECATED/zggsvp.f index 6c37ec1089..eb582f0d40 100644 --- a/SRC/DEPRECATED/zggsvp.f +++ b/SRC/DEPRECATED/zggsvp.f @@ -385,7 +385,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -403,8 +404,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, - $ TAU, A, LDA, WORK, INFO ) + CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * * Update Q := Q*Z**H @@ -447,8 +448,9 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), - $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) + CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, + $ MIN( M, N-L ), A, LDA, TAU, A( 1, N-L+1 ), LDA, + $ WORK, INFO ) * IF( WANTU ) THEN * @@ -456,9 +458,10 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL ZLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) - CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) + $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) + CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, + $ INFO ) END IF * IF( WANTQ ) THEN @@ -477,7 +480,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -489,8 +493,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, - $ LDA, TAU, Q, LDQ, WORK, INFO ) + CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, LDA, TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -514,9 +518,9 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL ZUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL ZUNM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/zlahrd.f b/SRC/DEPRECATED/zlahrd.f index 6cb3d2a3f3..3b23b3db60 100644 --- a/SRC/DEPRECATED/zlahrd.f +++ b/SRC/DEPRECATED/zlahrd.f @@ -236,13 +236,14 @@ SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**H *w * - CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1, - $ T, LDT, T( 1, NB ), 1 ) + CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ I-1, T, LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -263,20 +264,20 @@ SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE, $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ), $ 1 ) - CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL ZSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE diff --git a/SRC/DEPRECATED/zlatzm.f b/SRC/DEPRECATED/zlatzm.f index c0986e1b8c..a9d0fd346c 100644 --- a/SRC/DEPRECATED/zlatzm.f +++ b/SRC/DEPRECATED/zlatzm.f @@ -148,7 +148,8 @@ *> \ingroup latzm * * ===================================================================== - SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -206,8 +207,8 @@ SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL ZCOPY( M, C1, 1, WORK, 1 ) - CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H] * diff --git a/SRC/DEPRECATED/ztzrqf.f b/SRC/DEPRECATED/ztzrqf.f index dcd7cf45bf..9e0136e304 100644 --- a/SRC/DEPRECATED/ztzrqf.f +++ b/SRC/DEPRECATED/ztzrqf.f @@ -217,14 +217,15 @@ SUBROUTINE ZTZRQF( M, N, A, LDA, TAU, INFO ) * * Form w = a( k ) + B*z( k ) in TAU. * - CALL ZGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ), - $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 ) + CALL ZGEMV( 'No transpose', K-1, N-M, CONE, + $ A( 1, M1 ), LDA, A( K, M1 ), LDA, CONE, TAU, + $ 1 ) * * Now form a( k ) := a( k ) - conjg(tau)*w * and B := B - conjg(tau)*w*z( k )**H. * - CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, A( 1, K ), - $ 1 ) + CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, + $ A( 1, K ), 1 ) CALL ZGERC( K-1, N-M, -DCONJG( TAU( K ) ), TAU, 1, $ A( K, M1 ), LDA, A( 1, M1 ), LDA ) END IF From a6c1dd6ce88018c0fecade66ffd41a972852382a Mon Sep 17 00:00:00 2001 From: Hubertus van Dam Date: Thu, 28 Nov 2024 19:39:21 +0100 Subject: [PATCH 199/206] Adding missing entries --- SRC/lapack_64.h | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 4d7318d978..e8000bf2c4 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -56,8 +56,10 @@ #define CGELQ CGELQ_64 #define CGELQ2 CGELQ2_64 #define CGELQF CGELQF_64 +#define CGELQS CGELQS_64 #define CGELQT CGELQT_64 #define CGELQT3 CGELQT3_64 +#define CGELRS CGELRS_64 #define CGELS CGELS_64 #define CGELSD CGELSD_64 #define CGELSS CGELSS_64 @@ -81,6 +83,7 @@ #define CGEQRF CGEQRF_64 #define CGEQRF CGEQRF_64 #define CGEQRFP CGEQRFP_64 +#define CGEQRS CGEQRS_64 #define CGEQRT CGEQRT_64 #define CGEQRT2 CGEQRT2_64 #define CGEQRT3 CGEQRT3_64 @@ -612,8 +615,10 @@ #define DGELQ DGELQ_64 #define DGELQ2 DGELQ2_64 #define DGELQF DGELQF_64 +#define DGELQS DGELQS_64 #define DGELQT DGELQT_64 #define DGELQT3 DGELQT3_64 +#define DGELRS DGELRS_64 #define DGELS DGELS_64 #define DGELSD DGELSD_64 #define DGELSS DGELSS_64 @@ -637,6 +642,7 @@ #define DGEQRF DGEQRF_64 #define DGEQRF DGEQRF_64 #define DGEQRFP DGEQRFP_64 +#define DGEQRS DGEQRS_64 #define DGEQRT DGEQRT_64 #define DGEQRT2 DGEQRT2_64 #define DGEQRT3 DGEQRT3_64 @@ -1205,8 +1211,10 @@ #define SGELQ2 SGELQ2_64 #define SGELQF SGELQF_64 #define SGELQT SGELQT_64 +#define SGELQS SGELQS_64 #define SGELQT3 SGELQT3_64 #define SGELS SGELS_64 +#define SGELRS SGELRS_64 #define SGELSD SGELSD_64 #define SGELSS SGELSS_64 #define SGELST SGELST_64 @@ -1229,6 +1237,7 @@ #define SGEQRF SGEQRF_64 #define SGEQRF SGEQRF_64 #define SGEQRFP SGEQRFP_64 +#define SGEQRS SGEQRS_64 #define SGEQRT SGEQRT_64 #define SGEQRT2 SGEQRT2_64 #define SGEQRT3 SGEQRT3_64 @@ -1763,9 +1772,11 @@ #define ZGELQ ZGELQ_64 #define ZGELQ2 ZGELQ2_64 #define ZGELQF ZGELQF_64 +#define ZGELQS ZGELQS_64 #define ZGELQT ZGELQT_64 #define ZGELQT3 ZGELQT3_64 #define ZGELS ZGELS_64 +#define ZGELRS ZGELRS_64 #define ZGELSD ZGELSD_64 #define ZGELSS ZGELSS_64 #define ZGELST ZGELST_64 @@ -1788,6 +1799,7 @@ #define ZGEQRF ZGEQRF_64 #define ZGEQRF ZGEQRF_64 #define ZGEQRFP ZGEQRFP_64 +#define ZGEQRS ZGEQRS_64 #define ZGEQRT ZGEQRT_64 #define ZGEQRT2 ZGEQRT2_64 #define ZGEQRT3 ZGEQRT3_64 From 354a16f22f984ce1ff161657c4db9b7ad352b136 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 30 Nov 2024 08:49:18 -0500 Subject: [PATCH 200/206] Removed mod files and extranous file changes (hopefully) --- SRC/clarft.f | 44 +++++++++++++++++++++---------------------- SRC/dgelqf.f | 4 ++-- SRC/dgeqlf.f | 4 ++-- SRC/dgerqf.f | 3 +-- SRC/dlarft.f | 44 +++++++++++++++++++++---------------------- SRC/dorglq.f | 3 ++- SRC/dorgql.f | 2 +- SRC/dorgrq.f | 4 ++-- SRC/dormlq.f | 2 +- SRC/dormql.f | 4 ++-- SRC/dormqr.f | 3 ++- SRC/la_constants.mod | Bin 1563 -> 0 bytes SRC/la_xisnan.mod | Bin 321 -> 0 bytes SRC/slarft.f | 2 +- 14 files changed, 60 insertions(+), 59 deletions(-) delete mode 100644 SRC/la_constants.mod delete mode 100644 SRC/la_xisnan.mod diff --git a/SRC/clarft.f b/SRC/clarft.f index 08ef9cc224..204903be46 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -159,8 +159,8 @@ *> \endverbatim *> * ===================================================================== - RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, - $ LDT ) + RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, + $ TAU, T, LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -319,8 +319,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = T_{1,2}*V_{2,2} * - CALL CTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL CTRMM('Right', 'Lower', 'No transpose', 'Unit', L, + $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} @@ -410,8 +410,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = T_{1,2}*V_{2,2}' * - CALL CTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, - $ V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL CTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} @@ -426,8 +426,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = -T_{1,1}*T_{1,2} * - CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T, LDT, T(1, L+1), LDT) + CALL CTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} @@ -490,8 +490,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL CLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL CLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' @@ -504,8 +504,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = T_{2,1}*V_{2,1} * - CALL CTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, - $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + CALL CTRMM('Right', 'Upper', 'No transpose', 'Unit', L, + $ K-L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} @@ -520,8 +520,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL CTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL CTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * @@ -585,8 +585,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL CLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL CLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} @@ -597,8 +597,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = T_{2,1}*V_{1,2}' * - CALL CTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, - $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + CALL CTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, + $ ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} @@ -614,13 +614,13 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL CTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL CTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * - CALL CTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ ONE, T, LDT, T(K-L+1,1), LDT) + CALL CTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) END IF END SUBROUTINE diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index f0eb00a55d..7d146b0e1e 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -251,8 +251,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), - $ LDA, TAU( I ), WORK, LDWORK ) + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right * diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index 7da963aeaf..8cc69cdb1f 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -256,8 +256,8 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, - $ IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, + CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, + $ A( 1, N-K+I ), LDA, TAU( I ), WORK, $ LDWORK ) * * Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 8760ee04b3..94e90bca10 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -257,8 +257,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * H = H(i+ib-1) . . . H(i+1) H(i) * CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, - $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, - $ LDWORK ) + $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 66b8c3d922..679de121bf 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -159,8 +159,8 @@ *> \endverbatim *> * ===================================================================== - RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, - $ LDT ) + RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, + $ TAU, T, LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -315,8 +315,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = T_{1,2}*V_{2,2} * - CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', L, + $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} @@ -406,8 +406,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = T_{1,2}*V_{2,2}' * - CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, - $ V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} @@ -422,8 +422,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = -T_{1,1}*T_{1,2} * - CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T, LDT, T(1, L+1), LDT) + CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} @@ -486,8 +486,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL DLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL DLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' @@ -500,8 +500,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = T_{2,1}*V_{2,1} * - CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, - $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', L, + $ K-L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} @@ -516,8 +516,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * @@ -581,8 +581,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, + $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} @@ -593,8 +593,8 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = T_{2,1}*V_{1,2}' * - CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, - $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, + $ ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} @@ -610,13 +610,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * - CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ ONE, T, LDT, T(K-L+1,1), LDT) + CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) END IF END SUBROUTINE diff --git a/SRC/dorglq.f b/SRC/dorglq.f index 47edfe4eda..a1a1147b8d 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -253,7 +253,8 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right diff --git a/SRC/dorgql.f b/SRC/dorgql.f index 8ac4cbf003..f931f5a9c8 100644 --- a/SRC/dorgql.f +++ b/SRC/dorgql.f @@ -260,7 +260,7 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, + CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f index 54e109b492..c805484578 100644 --- a/SRC/dorgrq.f +++ b/SRC/dorgrq.f @@ -261,8 +261,8 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, - $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK) + CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, + $ A( II, 1 ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right * diff --git a/SRC/dormlq.f b/SRC/dormlq.f index ac6f931047..85ca134737 100644 --- a/SRC/dormlq.f +++ b/SRC/dormlq.f @@ -316,7 +316,7 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/dormql.f b/SRC/dormql.f index 9020c6abd9..11022d78c6 100644 --- a/SRC/dormql.f +++ b/SRC/dormql.f @@ -310,8 +310,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, - $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT) + CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB, + $ A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * * H or H**T is applied to C(1:m-k+i+ib-1,1:n) diff --git a/SRC/dormqr.f b/SRC/dormqr.f index 7793103b33..a9f8ba2279 100644 --- a/SRC/dormqr.f +++ b/SRC/dormqr.f @@ -309,7 +309,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, * Form the triangular factor of the block reflector * H = H(i) H(i+1) . . . H(i+ib-1) * - CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ), + CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, + $ I ), $ LDA, TAU( I ), WORK( IWT ), LDT ) IF( LEFT ) THEN * diff --git a/SRC/la_constants.mod b/SRC/la_constants.mod deleted file mode 100644 index b8006a566979124de13911e5efcec9baedca2f6f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1563 zcmV+$2ITo4iwFP!000001La%abD~HPe&?^4H_U@u12dq$t!3Cf>k>>Eb9Z|$78@{2 zoxvQC+b#e4>lqk8;-Hp5q>}7bXyr$L-80kQbT?nW%;t;v*hbGA_jT=||GY5rHvv*L zLq(6F=fs|iR^jFut)1oLCWvAuh@(%d5mtJ=D^$lnMI2lyaJc8cj?^W4Hs}^FeYy;( ziqxJT#GxNV{^J!$D$-D|cQ>C+tm}ulg&yqR?b)Ape`+r*d!Y!Coglu;{$lw3@?cLE z)0vH|8|xOX7~h~fxQ{ZP&&S`EvxkK>UtU{xmVIs6lW&Q>a|_O*{Bn%A01&v40Mc`i zSix5cDZ?0E4ve831}VXyNPYDDwI4j4s6K)}^QnD5op1n3C4gfMuk6v77Bohnu>l(Y zaMml(usDcwg~#*ptp!giD_pd9rtb9i?q)ifF8cT5KP>(L{;bIiKDYkL2857{swtD1 zeZLsPoe!L@;!i`&e?DWCNjR6-JmJW8L7D(^6L_7%sHLd1BQXvD<4fqR{9nz&{0;6h zVK>o)=GiB`UXD*;_x=hWirFLN6rjd|6l_y4P4N**`4P!A8d4|x4rq@lhG2@V7j8P` zZ+zmI9wF8J?mq>u&yB*YUI7dKmYoP-C@%hd)+v#?PJ;_v&wu(6Up%VeE-FoqNn@B^ zqOKw8YZZP1-r=q`ui?dmqDQ+4IEdSLC~Uw_SPlvJi0eQ39K=P^5v|NeG$15y)3Le^ zCum2HD_|e)OQU#1Y!$&}H`cz1Mb)RPLphWIgYuC`#stevKvn9in!_rb%9dK6(R$n&^IWER7B4D?jL!}Wa zN5u$6^t|pMW$)`$zGmo*Wkdk%;!%|sLQ*jV84rm&I0UO!cb!p@*t`72!a0^)>5P%Y zKSJ;F2_rcg6Jr)}2j>%n;DH-VZZqzflnAIlD60>#7j{!!QGZxgAA)S?xc7kM5F=^N#S(BJpxXj$k%X#(S&wNC3SHgOB+g)D zp`Fr5UF3Qs2gB$>J0+32sE?d57>qEqQVKZ}i*u0187$tnR0BB^3^@qKWL%(~;zwQc zUz5*&lW~DoiXJtAsc;PA0j*R!>hep4TNnvwr^<0An8W1_69~YzwGMu zL%h&}ky&`}1EWFq>H|i@!W#k@jk3miFnQ8u&l06@tYxj-Am~{WGzdiW;=-|!bg{yb znKyy5TMhC)NRWnk{~$=CLfaiiSr=aNZPLBQ`6NzTzEb87-;u1R2n3q-;(%a?9u_z@ z^X?Cj28!sL0AVQF4d8er3iTNAqP?&Xt9I`WAo$Es^87wVJl&t>$3fCXf*FoUmY@ZJ zW*JTpj5I|E=Hcl={^TUvmU)V2tTMZa6i8wjosSB) diff --git a/SRC/la_xisnan.mod b/SRC/la_xisnan.mod deleted file mode 100644 index 1b5610476a459fda31282807dce61ffd51c6d396..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 321 zcmV-H0lxkpiwFP!000001I3fcYQr!PhVOccxye4HC|(lx=z0mJwp4`O(o-?D3xUK2 zyDfSAYKfPmY3U(QB!Ncr!+iQR+Qf|K+^4W_tB+j`pLN%7+XnE`#qiqI<$GPhTi5Pk zSH2v!eN#3!@hw4yVZt>g8a5^pTd@o*3aL66@K_Ur1@@>JmIb)FAjKG#U>Faa1yNY= z2nu>n*%MtPG>>Qw84HUvTF5+vQIMiz9*7umL4!PDRAZ%VlLUSWj>-`jV!^A<3|Hx_ z=`uoPqSYzScQ%c14mO06Y=oM@X{I@?978ObWUL(}lf??j2HgLjS8K`RDV=@hl?(Ww zIK*@W%A?N{|L%8l;DR|QEVArbqwq-7^^P1W_{kj2;LRA;*JN=1&LA6lY-b``YW_?F TR@3_t@fFY)*n0O@xdQ+IFY=W< diff --git a/SRC/slarft.f b/SRC/slarft.f index 449c4b5a75..aa508de2dd 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -160,7 +160,7 @@ *> * ===================================================================== RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, - $ LDT ) + $ TAU, T, LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- From 273ab49035a92f06324c0cde4b2be2f725b1d15d Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 30 Nov 2024 08:51:18 -0500 Subject: [PATCH 201/206] removed extranous changes (hopefully x2) --- SRC/dgelqf.f | 3 ++- SRC/dgeqlf.f | 3 +-- SRC/dgerqf.f | 2 +- SRC/dorglq.f | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 7d146b0e1e..77ecbfd787 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -252,7 +252,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * H = H(i) H(i+1) . . . H(i+ib-1) * CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, - $ I ), LDA, TAU( I ), WORK, LDWORK ) + $ I ), + $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right * diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f index 8cc69cdb1f..d472e3365e 100644 --- a/SRC/dgeqlf.f +++ b/SRC/dgeqlf.f @@ -257,8 +257,7 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * H = H(i+ib-1) . . . H(i+1) H(i) * CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB, - $ A( 1, N-K+I ), LDA, TAU( I ), WORK, - $ LDWORK ) + $ A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left * diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f index 94e90bca10..8cabdc36ee 100644 --- a/SRC/dgerqf.f +++ b/SRC/dgerqf.f @@ -256,7 +256,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * Form the triangular factor of the block reflector * H = H(i+ib-1) . . . H(i+1) H(i) * - CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, + CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB, $ A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right diff --git a/SRC/dorglq.f b/SRC/dorglq.f index a1a1147b8d..c41367ced4 100644 --- a/SRC/dorglq.f +++ b/SRC/dorglq.f @@ -254,7 +254,7 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) * H = H(i) H(i+1) . . . H(i+ib-1) * CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, - $ I ), + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H**T to A(i+ib:m,i:n) from the right From d4741c8a574386765267d69e5a77fa541a085d04 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 30 Nov 2024 08:52:03 -0500 Subject: [PATCH 202/206] removed all extranous changes --- SRC/dgelqf.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f index 77ecbfd787..03bbb8e1e3 100644 --- a/SRC/dgelqf.f +++ b/SRC/dgelqf.f @@ -252,7 +252,7 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * H = H(i) H(i+1) . . . H(i+ib-1) * CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I, - $ I ), + $ I ), $ LDA, TAU( I ), WORK, LDWORK ) * * Apply H to A(i+ib:m,i:n) from the right From db48820da796f8c54baf375139725a8d8101fd3c Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 30 Nov 2024 11:05:04 -0500 Subject: [PATCH 203/206] lowered line length to hopefully fix build failures in the CI --- SRC/clarft.f | 47 ++++++++++++++++-------------- SRC/dlarft.f | 62 +++++++++++++++++++++------------------ SRC/slarft.f | 82 ++++++++++++++++++++++++++++------------------------ SRC/zlarft.f | 80 ++++++++++++++++++++++++++------------------------ 4 files changed, 147 insertions(+), 124 deletions(-) diff --git a/SRC/clarft.f b/SRC/clarft.f index 204903be46..de8b97bf9c 100644 --- a/SRC/clarft.f +++ b/SRC/clarft.f @@ -305,15 +305,15 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * * Compute T_{2,2} recursively * - CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L - T(J,L+I) = CONJG(V(L+I,J)) + T(J, L+I) = CONJG(V(L+I, J)) END DO END DO * @@ -327,7 +327,8 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, - $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) + $ V(K+1, 1), LDV, V(K+1, L+1), LDV, ONE, T(1, L+1), + $ LDT) * * At this point, we have that T_{1,2} = V_1'*V_2 * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -341,7 +342,7 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{1,2} = T_{1,2}*T_{2,2} * CALL CTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(LQ) THEN * @@ -399,14 +400,14 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * * Compute T_{2,2} recursively * - CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL CLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{1,2} * - CALL CLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) + CALL CLACPY('All', L, K-L, V(1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*V_{2,2}' * @@ -491,28 +492,29 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L - T(K-L+I,J) = CONJG(V(N-K+J, K-L+I)) + T(K-L+I, J) = CONJG(V(N-K+J, K-L+I)) END DO END DO * * T_{2,1} = T_{2,1}*V_{2,1} * CALL CTRMM('Right', 'Upper', 'No transpose', 'Unit', L, - $ K-L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + $ K-L, ONE, V(N-K+1, 1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, - $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(1, K-L+1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2'*V_1 * All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} @@ -521,12 +523,13 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{2,1} = -T_{2,2}*T_{2,1} * CALL CTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL CTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) ELSE * * Else means RQ case @@ -586,26 +589,27 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * Compute T_{2,2} recursively * CALL CLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} * - CALL CLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), - $ LDT) + CALL CLACPY('All', L, K-L, V(K-L+1, N-K+1), LDV, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*V_{1,2}' * CALL CTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, - $ ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) + $ ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL CGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, - $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(K-L+1, 1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2*V_1' @@ -615,12 +619,13 @@ RECURSIVE SUBROUTINE CLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{2,1} = -T_{2,2}*T_{2,1} * CALL CTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, - $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL CTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) END IF END SUBROUTINE diff --git a/SRC/dlarft.f b/SRC/dlarft.f index 679de121bf..c27bb1a806 100644 --- a/SRC/dlarft.f +++ b/SRC/dlarft.f @@ -301,29 +301,30 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * * Compute T_{2,2} recursively * - CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L - T(J,L+I) = V(L+I,J) + T(J, L+I) = V(L+I, J) END DO END DO * * T_{1,2} = T_{1,2}*V_{2,2} * CALL DTRMM('Right', 'Lower', 'No transpose', 'Unit', L, - $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, - $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) + $ V(K+1, 1), LDV, V(K+1, L+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1'*V_2 * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -332,12 +333,12 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{1,2} = -T_{1,1}*T_{1,2} * CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(LQ) THEN * @@ -395,26 +396,27 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * * Compute T_{2,2} recursively * - CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL DLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{1,2} * - CALL DLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) + CALL DLACPY('All', L, K-L, V(1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*V_{2,2}' * CALL DTRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, - $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1*V_2' * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -423,13 +425,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{1,2} = -T_{1,1}*T_{1,2} * CALL DTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(QL) THEN * * Break V apart into 6 components @@ -487,28 +489,29 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * Compute T_{2,2} recursively * CALL DLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L - T(K-L+I,J) = V(N-K+J, K-L+I) + T(K-L+I, J) = V(N-K+J, K-L+I) END DO END DO * * T_{2,1} = T_{2,1}*V_{2,1} * CALL DTRMM('Right', 'Upper', 'No transpose', 'Unit', L, - $ K-L, ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + $ K-L, ONE, V(N-K+1, 1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, - $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(1, K-L+1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2'*V_1 * All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} @@ -517,12 +520,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{2,1} = -T_{2,2}*T_{2,1} * CALL DTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL DTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) ELSE * * Else means RQ case @@ -581,27 +585,28 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * * Compute T_{2,2} recursively * - CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, - $ TAU(K-L+1), T(K-L+1,K-L+1), LDT) + CALL DLARFT(DIRECT, STOREV, N, L, V(K-L+1, 1), LDV, + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} * - CALL DLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), - $ LDT) + CALL DLACPY('All', L, K-L, V(K-L+1, N-K+1), LDV, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*V_{1,2}' * CALL DTRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, - $ ONE, V(1, N-K+1), LDV, T(K-L+1,1), LDT) + $ ONE, V(1, N-K+1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL DGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, - $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(K-L+1, 1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2*V_1' @@ -611,12 +616,13 @@ RECURSIVE SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, * T_{2,1} = -T_{2,2}*T_{2,1} * CALL DTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, - $ K-L, NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL DTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) END IF END SUBROUTINE diff --git a/SRC/slarft.f b/SRC/slarft.f index aa508de2dd..ad3a4d924c 100644 --- a/SRC/slarft.f +++ b/SRC/slarft.f @@ -159,7 +159,7 @@ *> \endverbatim *> * ===================================================================== - RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, + RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, $ TAU, T, LDT ) * * -- LAPACK auxiliary routine -- @@ -301,29 +301,30 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L - T(J,L+I) = V(L+I,J) + T(J, L+I) = V(L+I, J) END DO END DO * * T_{1,2} = T_{1,2}*V_{2,2} * - CALL STRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL STRMM('Right', 'Lower', 'No transpose', 'Unit', L, + $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, - $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) + $ V(K+1, 1), LDV, V(K+1, L+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1'*V_2 * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -332,12 +333,12 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * T_{1,2} = -T_{1,1}*T_{1,2} * CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(LQ) THEN * @@ -395,26 +396,27 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL SLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{1,2} * - CALL SLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) + CALL SLACPY('All', L, K-L, V(1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*V_{2,2}' * - CALL STRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, ONE, - $ V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL STRMM('Right', 'Upper', 'Transpose', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, - $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1*V_2' * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -422,14 +424,14 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = -T_{1,1}*T_{1,2} * - CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T, LDT, T(1, L+1), LDT) + CALL STRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL STRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(QL) THEN * * Break V apart into 6 components @@ -486,29 +488,30 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL SLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL SLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L - T(K-L+I,J) = V(N-K+J, K-L+I) + T(K-L+I, J) = V(N-K+J, K-L+I) END DO END DO * * T_{2,1} = T_{2,1}*V_{2,1} * - CALL STRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, - $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + CALL STRMM('Right', 'Upper', 'No transpose', 'Unit', L, + $ K-L, ONE, V(N-K+1, 1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('Transpose', 'No transpose', L, K-L, N-K, ONE, - $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(1, K-L+1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2'*V_1 * All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} @@ -516,13 +519,14 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL STRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL STRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL STRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) ELSE * * Else means RQ case @@ -581,27 +585,28 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL SLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL SLARFT(DIRECT, STOREV, N, L, V(K-L+1, 1), LDV, + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} * - CALL SLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), - $ LDT) + CALL SLACPY('All', L, K-L, V(K-L+1, N-K+1), LDV, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*V_{1,2}' * - CALL STRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, ONE, - $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + CALL STRMM('Right', 'Lower', 'Transpose', 'Unit', L, K-L, + $ ONE, V(1, N-K+1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL SGEMM('No transpose', 'Transpose', L, K-L, N-K, ONE, - $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(K-L+1, 1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2*V_1' @@ -610,13 +615,14 @@ RECURSIVE SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL STRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL STRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * - CALL STRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ ONE, T, LDT, T(K-L+1,1), LDT) + CALL STRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) END IF END SUBROUTINE diff --git a/SRC/zlarft.f b/SRC/zlarft.f index bccb4325e9..4d98b7f154 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -305,29 +305,30 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{2,1}' * DO J = 1, L DO I = 1, K-L - T(J,L+I) = CONJG(V(L+I,J)) + T(J, L+I) = CONJG(V(L+I, J)) END DO END DO * * T_{1,2} = T_{1,2}*V_{2,2} * - CALL ZTRMM('Right', 'Lower', 'No transpose', 'Unit', L, K-L, - $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL ZTRMM('Right', 'Lower', 'No transpose', 'Unit', L, + $ K-L, ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{3,1}'*V_{3,2} + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, - $ V(K+1, 1), LDV, V(K+1,L+1), LDV, ONE, T(1, L+1), LDT) + $ V(K+1, 1), LDV, V(K+1, L+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1'*V_2 * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -336,12 +337,12 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * T_{1,2} = -T_{1,1}*T_{1,2} * CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(LQ) THEN * @@ -399,26 +400,27 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1,L+1), LDV, - $ TAU(L+1), T(L+1,L+1), LDT) + CALL ZLARFT(DIRECT, STOREV, N-L, K-L, V(L+1, L+1), LDV, + $ TAU(L+1), T(L+1, L+1), LDT) * * Compute T_{1,2} * T_{1,2} = V_{1,2} * - CALL ZLACPY('All', L, K - L, V(1,L+1), LDV, T(1, L+1), LDT) + CALL ZLACPY('All', L, K-L, V(1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*V_{2,2}' * - CALL ZTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, ONE, - $ V(L+1, L+1), LDV, T(1, L+1), LDT) + CALL ZTRMM('Right', 'Upper', 'Conjugate', 'Unit', L, K-L, + $ ONE, V(L+1, L+1), LDV, T(1, L+1), LDT) * * T_{1,2} = V_{1,3}*V_{2,3}' + T_{1,2} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, - $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, T(1, L+1), LDT) + $ V(1, K+1), LDV, V(L+1, K+1), LDV, ONE, + $ T(1, L+1), LDT) * * At this point, we have that T_{1,2} = V_1*V_2' * All that is left is to pre and post multiply by -T_{1,1} and T_{2,2} @@ -426,14 +428,14 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{1,2} = -T_{1,1}*T_{1,2} * - CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T, LDT, T(1, L+1), LDT) + CALL ZTRMM('Left', 'Upper', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T, LDT, T(1, L+1), LDT) * * T_{1,2} = T_{1,2}*T_{2,2} * CALL ZTRMM('Right', 'Upper', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T(L+1,L+1), LDT, T(1, L+1), LDT) + $ K-L, ONE, T(L+1, L+1), LDT, T(1, L+1), LDT) ELSE IF(QL) THEN * * Break V apart into 6 components @@ -490,29 +492,30 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL ZLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL ZLARFT(DIRECT, STOREV, N, L, V(1, K-L+1), LDV, + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2}' * DO J = 1, K-L DO I = 1, L - T(K-L+I,J) = CONJG(V(N-K+J, K-L+I)) + T(K-L+I, J) = CONJG(V(N-K+J, K-L+I)) END DO END DO * * T_{2,1} = T_{2,1}*V_{2,1} * - CALL ZTRMM('Right', 'Upper', 'No transpose', 'Unit', L, K-L, - $ ONE, V(N-K+1,1), LDV, T(K-L+1,1), LDT) + CALL ZTRMM('Right', 'Upper', 'No transpose', 'Unit', L, + $ K-L, ONE, V(N-K+1, 1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,2}'*V_{2,1} + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('Conjugate', 'No transpose', L, K-L, N-K, ONE, - $ V(1,K-L+1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(1, K-L+1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2'*V_1 * All that is left is to pre and post multiply by -T_{2,2} and T_{1,1} @@ -520,13 +523,14 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL ZTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL ZTRMM('Left', 'Lower', 'No transpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * CALL ZTRMM('Right', 'Lower', 'No transpose', 'Non-unit', L, - $ K-L, ONE, T, LDT, T(K-L+1,1), LDT) + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) ELSE * * Else means RQ case @@ -585,27 +589,28 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * Compute T_{2,2} recursively * - CALL ZLARFT(DIRECT, STOREV, N, L, V(K-L+1,1), LDV, TAU(K-L+1), - $ T(K-L+1,K-L+1), LDT) + CALL ZLARFT(DIRECT, STOREV, N, L, V(K-L+1, 1), LDV, + $ TAU(K-L+1), T(K-L+1, K-L+1), LDT) * * Compute T_{2,1} * T_{2,1} = V_{2,2} * - CALL ZLACPY('All', L, K-L, V(K-L+1,N-K+1), LDV, T(K-L+1,1), - $ LDT) + CALL ZLACPY('All', L, K-L, V(K-L+1, N-K+1), LDV, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*V_{1,2}' * - CALL ZTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, ONE, - $ V(1, N-K+1), LDV, T(K-L+1,1), LDT) + CALL ZTRMM('Right', 'Lower', 'Conjugate', 'Unit', L, K-L, + $ ONE, V(1, N-K+1), LDV, T(K-L+1, 1), LDT) * * T_{2,1} = V_{2,1}*V_{1,1}' + T_{2,1} * Note: We assume K <= N, and GEMM will do nothing if N=K * CALL ZGEMM('No transpose', 'Conjugate', L, K-L, N-K, ONE, - $ V(K-L+1,1), LDV, V, LDV, ONE, T(K-L+1,1), LDT) + $ V(K-L+1, 1), LDV, V, LDV, ONE, T(K-L+1, 1), + $ LDT) * * At this point, we have that T_{2,1} = V_2*V_1' @@ -614,13 +619,14 @@ RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, * * T_{2,1} = -T_{2,2}*T_{2,1} * - CALL ZTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ NEG_ONE, T(K-L+1,K-L+1), LDT, T(K-L+1,1), LDT) + CALL ZTRMM('Left', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, NEG_ONE, T(K-L+1, K-L+1), LDT, + $ T(K-L+1, 1), LDT) * * T_{2,1} = T_{2,1}*T_{1,1} * - CALL ZTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, K-L, - $ ONE, T, LDT, T(K-L+1,1), LDT) + CALL ZTRMM('Right', 'Lower', 'No tranpose', 'Non-unit', L, + $ K-L, ONE, T, LDT, T(K-L+1, 1), LDT) END IF END SUBROUTINE From e9b05ef6e96673b875089b899188cf227d8767c8 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sat, 30 Nov 2024 11:19:15 -0500 Subject: [PATCH 204/206] Updated variants information as well as fixed trailing line in zlarft --- SRC/VARIANTS/Makefile | 10 ++++++++-- SRC/VARIANTS/README | 2 ++ SRC/VARIANTS/larft/LL-LVL2/clarft.f | 2 +- SRC/VARIANTS/larft/LL-LVL2/dlarft.f | 2 +- SRC/VARIANTS/larft/LL-LVL2/slarft.f | 2 +- SRC/VARIANTS/larft/LL-LVL2/zlarft.f | 2 +- SRC/zlarft.f | 4 ++-- 7 files changed, 16 insertions(+), 8 deletions(-) diff --git a/SRC/VARIANTS/Makefile b/SRC/VARIANTS/Makefile index 35e50cbc2c..4b0575cc6f 100644 --- a/SRC/VARIANTS/Makefile +++ b/SRC/VARIANTS/Makefile @@ -30,9 +30,11 @@ LUREC = lu/REC/cgetrf.o lu/REC/dgetrf.o lu/REC/sgetrf.o lu/REC/zgetrf.o QRLL = qr/LL/cgeqrf.o qr/LL/dgeqrf.o qr/LL/sgeqrf.o qr/LL/zgeqrf.o +LARFTL2 = larft/LL-LVL2/clarft.o larft/LL-LVL2/dlarft.o larft/LL-LVL2/slarft.o larft/LL-LVL2/zlarft.o + .PHONY: all -all: cholrl.a choltop.a lucr.a lull.a lurec.a qrll.a +all: cholrl.a choltop.a lucr.a lull.a lurec.a qrll.a larftl2.a cholrl.a: $(CHOLRL) $(AR) $(ARFLAGS) $@ $^ @@ -58,9 +60,13 @@ qrll.a: $(QRLL) $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +larftl2.a: $(LARFTL2) + $(AR) $(ARFLAGS) $@ $^ + $(RANLIB) $@ + .PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: - rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL) + rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL) $(LARFTL2) cleanlib: rm -f *.a diff --git a/SRC/VARIANTS/README b/SRC/VARIANTS/README index ef7626debe..217cfa3e01 100644 --- a/SRC/VARIANTS/README +++ b/SRC/VARIANTS/README @@ -23,6 +23,7 @@ This directory contains several variants of LAPACK routines in single/double/com - [sdcz]geqrf with QR Left Looking Level 3 BLAS version algorithm [2]- Directory: SRC/VARIANTS/qr/LL - [sdcz]potrf with Cholesky Right Looking Level 3 BLAS version algorithm [2]- Directory: SRC/VARIANTS/cholesky/RL - [sdcz]potrf with Cholesky Top Level 3 BLAS version algorithm [2]- Directory: SRC/VARIANTS/cholesky/TOP + - [sdcz]larft using a Left Looking Level 2 BLAS version algorithm - Directory: SRC/VARIANTS/larft/LL-LVL2 References:For a more detailed description please refer to - [1] Toledo, S. 1997. Locality of Reference in LU Decomposition with Partial Pivoting. SIAM J. Matrix Anal. Appl. 18, 4 (Oct. 1997), @@ -44,6 +45,7 @@ Corresponding libraries created in SRC/VARIANTS: - QR Left Looking : qrll.a - Cholesky Right Looking : cholrl.a - Cholesky Top : choltop.a + - LARFT Level 2: larftl2.a =========== diff --git a/SRC/VARIANTS/larft/LL-LVL2/clarft.f b/SRC/VARIANTS/larft/LL-LVL2/clarft.f index 9e2e4503e3..9a7000eff3 100644 --- a/SRC/VARIANTS/larft/LL-LVL2/clarft.f +++ b/SRC/VARIANTS/larft/LL-LVL2/clarft.f @@ -1,4 +1,4 @@ -*> \brief \b CLARFT forms the triangular factor T of a block reflector H = I - vtvH +*> \brief \b CLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm * * =========== DOCUMENTATION =========== * diff --git a/SRC/VARIANTS/larft/LL-LVL2/dlarft.f b/SRC/VARIANTS/larft/LL-LVL2/dlarft.f index d9ef2f77b6..19b7c7b1b2 100644 --- a/SRC/VARIANTS/larft/LL-LVL2/dlarft.f +++ b/SRC/VARIANTS/larft/LL-LVL2/dlarft.f @@ -1,4 +1,4 @@ -*> \brief \b DLARFT forms the triangular factor T of a block reflector H = I - vtvH +*> \brief \b DLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm * * =========== DOCUMENTATION =========== * diff --git a/SRC/VARIANTS/larft/LL-LVL2/slarft.f b/SRC/VARIANTS/larft/LL-LVL2/slarft.f index 31b7951819..e1578e2587 100644 --- a/SRC/VARIANTS/larft/LL-LVL2/slarft.f +++ b/SRC/VARIANTS/larft/LL-LVL2/slarft.f @@ -1,4 +1,4 @@ -*> \brief \b SLARFT forms the triangular factor T of a block reflector H = I - vtvH +*> \brief \b SLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm. * * =========== DOCUMENTATION =========== * diff --git a/SRC/VARIANTS/larft/LL-LVL2/zlarft.f b/SRC/VARIANTS/larft/LL-LVL2/zlarft.f index be773becc2..6abadd501e 100644 --- a/SRC/VARIANTS/larft/LL-LVL2/zlarft.f +++ b/SRC/VARIANTS/larft/LL-LVL2/zlarft.f @@ -1,4 +1,4 @@ -*> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH +*> \brief \b ZLARFT VARIANT: left-looking Level 2 BLAS version of the algorithm. * * =========== DOCUMENTATION =========== * diff --git a/SRC/zlarft.f b/SRC/zlarft.f index 4d98b7f154..900795afad 100644 --- a/SRC/zlarft.f +++ b/SRC/zlarft.f @@ -159,8 +159,8 @@ *> \endverbatim *> * ===================================================================== - RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, - $ LDT ) + RECURSIVE SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, + $ TAU, T, LDT ) * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- From 29dbac94c32cf7743e7ef4898e070a36341b96e9 Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Sun, 1 Dec 2024 23:50:10 -0500 Subject: [PATCH 205/206] Fixing misspelling of 'triangular' in {s,d,c,z}gemmtr.f --- BLAS/SRC/cgemmtr.f | 6 +++--- BLAS/SRC/dgemmtr.f | 6 +++--- BLAS/SRC/sgemmtr.f | 6 +++--- BLAS/SRC/zgemmtr.f | 6 +++--- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/BLAS/SRC/cgemmtr.f b/BLAS/SRC/cgemmtr.f index 68063cbdaf..a5f552960d 100644 --- a/BLAS/SRC/cgemmtr.f +++ b/BLAS/SRC/cgemmtr.f @@ -50,9 +50,9 @@ *> On entry, UPLO specifies whether the lower or the upper *> triangular part of C is access and updated. *> -*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> UPLO = 'L' or 'l', the lower triangular part of C is used. *> -*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> UPLO = 'U' or 'u', the upper triangular part of C is used. *> \endverbatim * *> \param[in] TRANSA @@ -154,7 +154,7 @@ *> Before entry, the leading n by n part of the array C must *> contain the matrix C, except when beta is zero, in which *> case C need not be set on entry. -*> On exit, the upper or lower trinangular part of the matrix +*> On exit, the upper or lower triangular part of the matrix *> C is overwritten by the n by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim diff --git a/BLAS/SRC/dgemmtr.f b/BLAS/SRC/dgemmtr.f index 74e0ce0dac..cab5b71fc8 100644 --- a/BLAS/SRC/dgemmtr.f +++ b/BLAS/SRC/dgemmtr.f @@ -50,9 +50,9 @@ *> On entry, UPLO specifies whether the lower or the upper *> triangular part of C is access and updated. *> -*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> UPLO = 'L' or 'l', the lower triangular part of C is used. *> -*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> UPLO = 'U' or 'u', the upper triangular part of C is used. *> \endverbatim * *> \param[in] TRANSA @@ -154,7 +154,7 @@ *> Before entry, the leading n by n part of the array C must *> contain the matrix C, except when beta is zero, in which *> case C need not be set on entry. -*> On exit, the upper or lower trinangular part of the matrix +*> On exit, the upper or lower triangular part of the matrix *> C is overwritten by the n by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim diff --git a/BLAS/SRC/sgemmtr.f b/BLAS/SRC/sgemmtr.f index 1aeff65e03..257ff8bde2 100644 --- a/BLAS/SRC/sgemmtr.f +++ b/BLAS/SRC/sgemmtr.f @@ -50,9 +50,9 @@ *> On entry, UPLO specifies whether the lower or the upper *> triangular part of C is access and updated. *> -*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> UPLO = 'L' or 'l', the lower triangular part of C is used. *> -*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> UPLO = 'U' or 'u', the upper triangular part of C is used. *> \endverbatim * *> \param[in] TRANSA @@ -154,7 +154,7 @@ *> Before entry, the leading n by n part of the array C must *> contain the matrix C, except when beta is zero, in which *> case C need not be set on entry. -*> On exit, the upper or lower trinangular part of the matrix +*> On exit, the upper or lower triangular part of the matrix *> C is overwritten by the n by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim diff --git a/BLAS/SRC/zgemmtr.f b/BLAS/SRC/zgemmtr.f index 9f30488021..01dd91c387 100644 --- a/BLAS/SRC/zgemmtr.f +++ b/BLAS/SRC/zgemmtr.f @@ -50,9 +50,9 @@ *> On entry, UPLO specifies whether the lower or the upper *> triangular part of C is access and updated. *> -*> UPLO = 'L' or 'l', the lower tringular part of C is used. +*> UPLO = 'L' or 'l', the lower triangular part of C is used. *> -*> UPLO = 'U' or 'u', the upper tringular part of C is used. +*> UPLO = 'U' or 'u', the upper triangular part of C is used. *> \endverbatim * *> \param[in] TRANSA @@ -154,7 +154,7 @@ *> Before entry, the leading n by n part of the array C must *> contain the matrix C, except when beta is zero, in which *> case C need not be set on entry. -*> On exit, the upper or lower trinangular part of the matrix +*> On exit, the upper or lower triangular part of the matrix *> C is overwritten by the n by n matrix *> ( alpha*op( A )*op( B ) + beta*C ). *> \endverbatim From 487c60ac5514c86b3c3d347ffec3cd6af4ca477a Mon Sep 17 00:00:00 2001 From: Johnathan Rhyne Date: Mon, 2 Dec 2024 00:04:06 -0500 Subject: [PATCH 206/206] updating gitignore to ignore the mod files when we compile --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index 568e67b33f..cd6f0ad023 100644 --- a/.gitignore +++ b/.gitignore @@ -43,3 +43,7 @@ build* DOCS/man DOCS/explore-html output_err + +# Mod files from compilation in SRC +SRC/la_constants.mod +SRC/la_xisnan.mod